Скачиваний:
9
Добавлен:
17.06.2023
Размер:
2.35 Mб
Скачать

ПРИЛОЖЕНИЕ А

Функциональная модель информационной системы по стандарту IDEF0

и методологии SADT

Функциональная модель представлена на рисунках А.1-А.4.

Рисунок А.1 - Уровень А-0

Рисунок А.2 - Уровень А1 «Определение уровня доступа в систему»

22

Рисунок А.3 - Уровень А3 «Изменение базы данных»

Рисунок А.4 - Уровень А4 «Обработка запроса клиента»

Рисунок А.3 – Диаграмма IDEF3 третьего уровня «Смена пароля»

23

ПРИЛОЖЕНИЕ Б Свойства полей

Рисунок Б. 1 – Свойтсво полей таблицы «Pacient»

Рисунок Б. 2– Свойтсво полей таблицы «NePsix»

Рисунок Б. 3 – Свойтсво полей таблицы «diagnoz»

Рисунок Б. 4 – Свойтсво полей таблицы «Vidacha»

Рисунок Б. 5 – Свойтсво полей таблицы «rCen»

Рисунок Б. 6 – Свойтсво полей таблицы «pass»

Рисунок Б. 7 – Свойтсво полей таблицы «PacDig»

Рисунок Б. 8 – Свойтсво полей таблицы «Sprav»

24

ПРИЛОЖЕНИЕ В Листинг программы

unitpass;

 

showmessage('База данных по

showmessage('Программа

interface

 

указанному пути не

будет закрыта!');

uses

 

найдена!');

 

application.Terminate;

Windows, Messages,

exit;

 

end

SysUtils, Variants, Classes,

end;

 

else canclose:=false;

Graphics, Controls, Forms,

try

 

end;

Dialogs, Buttons, StdCtrls,

dm.ADO.Connected:=false;

procedure

ExtCtrls,inifiles;

dm.ADO.ConnectionString:='Pro

TFpass.BitBtn1Click(Sender:

type

 

vider=Microsoft.Jet.OLEDB.4.0

TObject);

TFpass = class(TForm)

;Data Source='+dbp+';Persist

begin

Panel1: TPanel;

Security Info=False';

if e1.Text='' then

Panel2: TPanel;

dm.ADO.Connected:=true;

showmessage('Выневвелиимяполь

BitBtn1: TBitBtn;

except

 

зователя')

BitBtn2: TBitBtn;

showmessage('Произошлаошибкап

else if e2.Text='' then

Label1: TLabel;

риподключениикбазе');

showmessage('Выневвелипароль'

e1: TEdit;

exit;

 

)

Label2: TLabel;

end;

 

else

e2: TEdit;

end;

 

begin

Label3: TLabel;

procedure

 

dm.temp.Active:=false;

e3: TEdit;

TFpass.SpeedButton1Click(Send

 

SpeedButton1:

er: TObject);

 

dm.temp.CommandText:='select

TSpeedButton;

 

var inifile:tinifile;

log from pass where

procedure

 

dbp:string;

 

(login="'+e1.Text+'") and

FormShow(Sender: TObject);

begin

 

(pass="'+e2.Text+'")';

procedure

 

if dm.od.Execute then

dm.temp.Active:=true;

SpeedButton1Click(Sender:

begin

 

if dm.temp.RecordCount>0

TObject);

 

e3.Text:=dm.od.FileName;

then

procedure

 

try

 

begin

BitBtn2Click(Sender:

dm.ADO.Connected:=false;

if

TObject);

 

dm.ADO.ConnectionString:='Pro

dm.temp.Fields[0].AsBoolean=t

procedure

 

vider=Microsoft.Jet.OLEDB.4.0

rue then

FormCloseQuery(Sender:

;Data

 

begin

TObject; var CanClose:

Source='+dm.od.FileName+';Per

fpass.Hide;

Boolean);

 

sist Security Info=False';

fmain.showmodal;

procedure

 

dm.ADO.Connected:=true;

end

BitBtn1Click(Sender:

except

 

else

TObject);

 

 

 

begin

private

 

showmessage('Произошлаошибкап

 

{ Private declarations }

риподключениикбазе');

fmain.N4.Visible:=false;

public

 

exit;

 

 

{ Public declarations }

end;

 

fmain.N2.Visible:=false;

end;

 

IniFile

:=

fpass.Hide;

var

 

TIniFile.Create(ExtractFilePa

fmain.showmodal;

Fpass: TFpass;

th(Application.ExeName)+'opti

end;

implementation

ons.ini');

//

end

uses datm, main;

загрузкаизфаланастроекпутикба

else

{$R *.dfm}

 

зе

 

begin

procedure

 

 

 

 

TFpass.FormShow(Sender:

inifile.WriteString('Options'

showmessage('Проверьтеправиль

TObject);

 

, 'DBPath', dm.od.FileName);

ностьпароля');

var inifile:tinifile;

IniFile.Free;

 

exit;

dbp:string;

 

end;

 

end;

begin

 

end;

 

end;

IniFile

:=

procedure

 

end;

TIniFile.Create(ExtractFilePa

TFpass.BitBtn2Click(Sender:

end.

th(Application.ExeName)+'opti

TObject);

 

program Psixi;

ons.ini');

//

begin

 

uses

загрузкаизфаланастроекпутикба

closequery;

 

Forms,

зе

 

end;

 

pass in 'pass.pas' {Fpass},

DBP :=

 

procedure

 

datm in 'datm.pas' {dm:

IniFile.ReadString('Options',

TFpass.FormCloseQuery(Sender:

TDataModule},

'DBPath',

 

TObject; var CanClose:

main in 'main.pas' {fmain},

ExtractFilePath(Application.E

Boolean);

 

Chpass in 'Chpass.pas'

xeName)+'');

 

begin

 

{FChpass},

e3.Text:=dbp;

 

if

 

diagnoz in 'diagnoz.pas'

IniFile.Free;

 

application.MessageBox('Выхот

{Fdiagnoz},

if fileexists(dbp)=false then

итевыйтиизпрограммы?','Выходи

aDiagnoz in 'aDiagnoz.pas'

begin

 

зпрограммы',mb_yesno+mb_iconq

{FaDiagnoz},

 

 

uestion)=idyes then

pacient in 'pacient.pas'

 

 

begin

 

{Fpacient},

25

aPacient in 'aPacient.pas'

Button5: TButton;

While not dm.temp.Eof do

{FaPacient},

Button6: TButton;

begin

Vidacha in 'Vidacha.pas'

DBGrid1: TDBGrid;

fasprav.cb2.Items.Add(dm.temp

{FVidacha},

ToolButton1: TToolButton;

.fields[0].AsString);

avidacha in 'avidacha.pas'

Button8: TButton;

dm.temp.Next;

{Favidacha},

WordApplication1:

end;

Sprav in 'Sprav.pas'

TWordApplication;

fasprav.ShowModal;

{FSprav},

WordDocument1:

end;

aSprav in 'aSprav.pas'

TWordDocument;

procedure

{FaSprav},

Button9: TButton;

TFSprav.Button2Click(Sender:

ot1 in 'ot1.pas' {fot1},

ToolButton2: TToolButton;

TObject);

ot2 in 'ot2.pas' {Fot2};

procedure

begin

{$R *.res}

Button1Click(Sender:

if

begin

TObject);

dm.sp.Fields[0].AsString=''

Application.Initialize;

procedure

then

Application.Title :=

Button2Click(Sender:

begin

'Психоневрологическийдиспансе

TObject);

showmessage('Запись для

р';

procedure

редактирования отсутствует');

 

Button3Click(Sender:

exit;

Application.CreateForm(TFpass

TObject);

end;

, Fpass);

procedure

if

Application.CreateForm(Tdm,

Button7Click(Sender:

dm.sp.Fields[5].AsBoolean=TRU

dm);

TObject);

E then

 

procedure

begin

Application.CreateForm(Tfmain

Button5Click(Sender:

showmessage('Данную запись

, fmain);

TObject);

изменить невозможно');

Application.CreateForm(TFChpa

procedure

exit;

ss, FChpass);

Button6Click(Sender:

end;

 

TObject);

tmp:=dm.sp.Fields[0].AsString

Application.CreateForm(TFdiag

procedure

;tm:=1;

noz, Fdiagnoz);

Button4Click(Sender:

//***************************

 

TObject);

***

Application.CreateForm(TFaDia

procedure

if

gnoz, FaDiagnoz);

FormCloseQuery(Sender:

fmain.Update('sp','sprav')=fa

 

TObject; var CanClose:

lse then

Application.CreateForm(TFpaci

Boolean);

begin

ent, Fpacient);

procedure

showmessage('Данная запись

 

Button8Click(Sender:

используется другим

Application.CreateForm(TFaPac

TObject);

пользователем');

ient, FaPacient);

procedure

exit;

 

FormShow(Sender: TObject);

end;

Application.CreateForm(TFVida

procedure

//***************************

cha, FVidacha);

Button9Click(Sender:

***

 

TObject);

dm.temp.Active:=false;

Application.CreateForm(TFavid

private

dm.temp.CommandText:='Select

acha, Favidacha);

{ Private declarations }

id_pc,fio_pc from pacient

 

public

where (datas_pc is not null)

Application.CreateForm(TFSpra

{ Public declarations }

order by fio_pc ';

v, FSprav);

end;

dm.temp.Active:=true;

 

var

While not dm.temp.Eof do

Application.CreateForm(TFaSpr

FSprav: TFSprav;

begin

av, FaSprav);

implementation

fasprav.cb1.Items.Add(dm.temp

 

uses datm, aSprav, main;

.fields[0].AsString+')

Application.CreateForm(Tfot1,

{$R *.dfm}

'+dm.temp.fields[1].AsString)

fot1);

procedure

;

 

TFSprav.Button1Click(Sender:

dm.temp.Next;

Application.CreateForm(TFot2,

TObject);

end;

Fot2);

begin

dm.temp.Active:=false;

Application.Run;

tm:=0;

dm.temp.CommandText:='Select

end.

fasprav.cb1.Clear;fasprav.cb2

kto_vid from vidacha order by

unit Sprav;

.Clear;

kto_vid';

interface

dm.temp.Active:=false;

dm.temp.Active:=true;

uses

dm.temp.CommandText:='Select

While not dm.temp.Eof do

Windows, Messages,

id_pc,fio_pc from pacient

begin

SysUtils, Variants, Classes,

where (datas_pc is not null)

fasprav.cb2.Items.Add(dm.temp

Graphics, Controls, Forms,

order by fio_pc ';

.fields[0].AsString);

Dialogs, Grids, DBGrids,

dm.temp.Active:=true;

dm.temp.Next;

StdCtrls, ToolWin, ComCtrls,

While not dm.temp.Eof do

end;

WordXP, OleServer,registry;

begin

dm.temp.Active:=false;

type

fasprav.cb1.Items.Add(dm.temp

dm.temp.CommandText:='Select

TFSprav = class(TForm)

.fields[0].AsString+')

id_pc,fio_pc from

ToolBar1: TToolBar;

'+dm.temp.fields[1].AsString)

pacient,sprav where

Button1: TButton;

;

(id_pc=id_pc_sp) and

Button2: TButton;

dm.temp.Next;

(id_sp='+tmp+')';

Button3: TButton;

end;

dm.temp.Active:=true;

ToolBar2: TToolBar;

dm.temp.Active:=false;

fasprav.cb1.Text:=dm.temp.fie

e1: TEdit;

dm.temp.CommandText:='Select

ldbyname('id_pc').AsString+')

Button4: TButton;

kto_vid from vidacha order by

'+dm.temp.fieldbyname('fio_pc

Button7: TButton;

kto_vid';

').AsString;

ToolBar3: TToolBar;

dm.temp.Active:=true;

 

26

fasprav.cb2.Text:=dm.sp.field byname('kto_vid').AsString; fasprav.dtp1.date:=dm.sp.fiel dbyname('data_sp').asdatetime

;

FaSprav.cb1Change(Sender);FaS

prav.cb2Change(Sender);

fasprav.ShowModal;

end; procedure

TFSprav.Button3Click(Sender:

TObject); begin

if dm.sp.Fields[0].AsString='' then

begin showmessage('Запись для

редактирования отсутствует'); exit;

end;

tmp:=dm.sp.Fields[0].AsString

;tm:=1; if

dm.sp.Fields[5].AsBoolean=FAL SE then

begin if

fmain.Delete('sp','sprav',tmp )=false then

begin showmessage('Данная

запись используется другим пользователем');

exit; end

else dm.sp.Requery(); end

else begin if

fmain.Delete('np','nepsix',tm p)=false then

begin showmessage('Данная

запись используется другим пользователем');

exit; end

else dm.sp.Requery(); end;

nd;

procedure TFSprav.Button7Click(Sender: TObject);

begin e1.Clear;

dm.sp.Active:=false;

dm.sp.CommandText:='(select id_sp,fio_pc,kto_vid,cena_sp, data_sp,lg_vid from vidacha,pacient,sprav where (id_pc=id_pc_sp) and (id_vid=id_vid_sp) and (fio_pc like "%'+e1.Text+'%")) UNION (select id_np,fio_np,kto_vid,cena_np, data_np,lg_np from vidacha,NePsix where (id_vid=id_vid_np) and (fio_np like "%'+e1.Text+'%"))'; dm.sp.Active:=true;

end; procedure

TFSprav.Button5Click(Sender:

TObject);

begin e1.Clear;

dm.sp.Active:=false;

dm.sp.CommandText:='(select id_sp,fio_pc,kto_vid,cena_sp, data_sp from vidacha,pacient,sprav where (id_pc=id_pc_sp) and (id_vid=id_vid_sp) order by data_sp) UNION (select id_np,fio_np,kto_vid,cena_np, data_np from vidacha,NePsix where (id_vid=id_vid_np) order by data_np)'; dm.sp.Active:=true;

end; procedure

TFSprav.Button6Click(Sender:

TObject); begin e1.Clear;

dm.sp.Active:=false;

dm.sp.CommandText:='(select id_sp,fio_pc,kto_vid,cena_sp, data_sp from vidacha,pacient,sprav where (id_pc=id_pc_sp) and (id_vid=id_vid_sp) order by cena_sp) UNION (select id_np,fio_np,kto_vid,cena_np, data_np from vidacha,NePsix where (id_vid=id_vid_np) order by cena_np)'; dm.sp.Active:=true;

end; procedure

TFSprav.Button4Click(Sender:

TObject); begin

dm.sp.Active:=false;

dm.sp.CommandText:='(select id_sp,fio_pc,kto_vid,cena_sp, data_sp,lg_vid from vidacha,pacient,sprav where (id_pc=id_pc_sp) and (id_vid=id_vid_sp) and (fio_pc like "%'+e1.Text+'%")) UNION (select id_np,fio_np,kto_vid,cena_np, data_np,lg_np from vidacha,NePsix where (id_vid=id_vid_np) and (fio_np like "%'+e1.Text+'%"))'; dm.sp.Active:=true;

end; procedure

TFSprav.FormCloseQuery(Sender : TObject; var CanClose: Boolean);

begin e1.Clear;close; end;

procedure TFSprav.Button8Click(Sender: TObject);

var

Template,NewTemplate,FindText , NewStr, Replace,ReplaceWith:OleVarian t; LinkToFile,SaveWithDocument,R ange:OleVariant;

Table1: Table; i: integer; flag:boolean; Reg: TRegistry;

begin //Проверяем,

инсталлированли Word

Reg := TRegistry.Create; Reg.RootKey :=

HKEY_CLASSES_ROOT;

flag:=reg.KeyExists('Word.App

lication');

reg.Free;

//flag:=true;

if flag=false then begin

application.MessageBox('Word

неустанволен','Отчет',mb_ok+m b_iconstop);

exit;

end;

if dm.sp.Fields[5].AsBoolean=TRU E then

begin WordApplication1.Connect; //

Устанавливаемсвязьссервером //Открываемшаблон otchet.dot

в Word Template:=ExtractFilePath(App lication.EXEName)+'\Шаблоны\С

правка.dot'; //путькшаблонудокумента

WordApplication1.Documents.Ad

d(Template,EmptyParam,EmptyPa

ram,EmptyParam);//

создаемдокументнаосновешаблон

а

WordDocument1.ConnectTo(WordA

pplication1.ActiveDocument); //Связываемкомпонент

WordDocument1 c

активнымдокументом (т.е. столькочтосозданнымдокументом

)

//Заполняем таблицу списка объектов

Replace:=true; // параметр,

задающий режим замены

FindText:='#1'; // что меняем

ReplaceWith:=dm.sp.fieldbynam e('data_sp').AsString; //

начтоменяем

WordDocument1.Range.Find.Exec

ute(FindText,EmptyParam,Empty

Param,

EmptyParam,EmptyParam,EmptyPa

ram,EmptyParam,

EmptyParam,EmptyParam,Replace

With,Replace,EmptyParam,Empty

Param,EmptyParam,EmptyParam);

Replace:=true; // параметр,

задающий режим замены

FindText:='#2'; // что меняем

ReplaceWith:=dm.sp.fieldbynam e('fio_pc').AsString; // на что меняем

WordDocument1.Range.Find.Exec

ute(FindText,EmptyParam,Empty

Param,

EmptyParam,EmptyParam,EmptyPa

ram,EmptyParam,

EmptyParam,EmptyParam,Replace

With,Replace,EmptyParam,Empty

Param,EmptyParam,EmptyParam);

dm.temp.Active:=false;

dm.temp.CommandText:='select adr_np,dr_np from nepsix WHERE

27

(id_np='+dm.sp.Fields[0].AsSt

FindText:='#2'; // что

flag:boolean;

ring+')';

меняем

Reg: TRegistry;

dm.temp.Active:=true;

ReplaceWith:=dm.sp.fieldbynam

begin

Replace:=true; // параметр,

e('fio_pc').AsString; // на

fio:=inputbox('Выдачасправки'

задающийрежимзамены

что меняем

,'ФИОобратившегося','');

FindText:='#3'; //

WordDocument1.Range.Find.Exec

if fio='' then

чтоменяемReplaceWith:=dm.temp

ute(FindText,EmptyParam,Empty

begin

.fieldbyname('dr_np').AsStrin

Param,

showmessage('Вы не ввели

g; //

EmptyParam,EmptyParam,EmptyPa

ФИО обратившегося');

начтоменяемWordDocument1.Rang

ram,EmptyParam,

exit;

e.Find.Execute(FindText,Empty

EmptyParam,EmptyParam,Replace

end;

Param,EmptyParam,

With,Replace,EmptyParam,Empty

data:=inputbox('Выдача

EmptyParam,EmptyParam,EmptyPa

Param,EmptyParam,EmptyParam);

справки','День рождения','');

ram,EmptyParam,

dm.temp.Active:=false;

try

EmptyParam,EmptyParam,Replace

 

 

With,Replace,EmptyParam,Empty

dm.temp.CommandText:='select

data:=datetostr(strtodate(dat

Param,EmptyParam,EmptyParam);

adr_pc,dr_pc from

a));

Replace:=true; // параметр,

pacient,sprav WHERE

except

задающий режим замены

(id_pc=id_pc_sp) and

showmessage('Ошибка в

FindText:='#4'; // что

(id_sp='+dm.sp.Fields[0].AsSt

формате даты! Формат:

меняем

ring+')';

дд.мм.гггг');

ReplaceWith:=dm.temp.fieldbyn

dm.temp.Active:=true;

exit;

ame('adr_np').AsString; // на

Replace:=true; // параметр,

end;

что меняем

задающийрежимзамены

dm.temp.Active:=false;

WordDocument1.Range.Find.Exec

FindText:='#3'; //

dm.temp.CommandText:='select

ute(FindText,EmptyParam,Empty

чтоменяемReplaceWith:=dm.temp

id_pc from pacient where

Param,

.fieldbyname('dr_pc').AsStrin

(fio_pc="'+fio+'") and

EmptyParam,EmptyParam,EmptyPa

g; //

(dr_pc=#'+fmain.data(strtodat

ram,EmptyParam,

начтоменяемWordDocument1.Rang

e(data))+'#)';

EmptyParam,EmptyParam,Replace

e.Find.Execute(FindText,Empty

dm.temp.Active:=true;

With,Replace,EmptyParam,Empty

Param,EmptyParam,

if dm.temp.RecordCount>0 then

Param,EmptyParam,EmptyParam);

EmptyParam,EmptyParam,EmptyPa

showmessage('Данныйпациентсос

WordApplication1.Visible:=tru

ram,EmptyParam,

тоит/состоялнаучете!'+#13+'Во

e; //делаемприложение MS Word

EmptyParam,EmptyParam,Replace

спользуйтесьдругимсервисомвыд

видимым

With,Replace,EmptyParam,Empty

ачисправок')

 

Param,EmptyParam,EmptyParam);

else

WordApplication1.Disconnect;

Replace:=true; // параметр,

begin

// Разрываемсвязьссерверо

задающий режим замены

 

end

FindText:='#4'; // что

adr:=inputbox('Выдачасправки'

else

меняем

,'Адресобратившегося','');

begin

ReplaceWith:=dm.temp.fieldbyn

if fio='' then

WordApplication1.Connect; //

ame('adr_pc').AsString; // на

begin

Устанавливаемсвязьссервером

что меняем

showmessage('Вы не ввели

//Открываемшаблон

WordDocument1.Range.Find.Exec

адрес обратившегося');

otchet.dot в Word

ute(FindText,EmptyParam,Empty

exit;

Template:=ExtractFilePath(App

Param,

end;

lication.EXEName)+'\Шаблоны\С

EmptyParam,EmptyParam,EmptyPa

kto:=inputbox('Выдача

правка.dot';

ram,EmptyParam,

справки','Кто

//путькшаблонудокументаWordAp

EmptyParam,EmptyParam,Replace

запрашивает?','');

plication1.Documents.Add(Temp

With,Replace,EmptyParam,Empty

if fio='' then

late,EmptyParam,EmptyParam,Em

Param,EmptyParam,EmptyParam);

begin

ptyParam);//

WordApplication1.Visible:=tru

showmessage('Вы не ввели

создаемдокументнаосновешаблон

e; //делаемприложение MS Word

адрес обратившегося');

аWordDocument1.ConnectTo(Word

видимым

exit;

Application1.ActiveDocument);

 

end;

//СвязываемкомпонентWordDocum

WordApplication1.Disconnect;

dm.temp.Active:=false;

ent1 cактивнымдокументом

// Разрываемсвязьссерверо

 

(т.е.

end;

dm.temp.CommandText:='select

столькочтосозданнымдокументом

end;

st_vid,id_vid from vidacha

)

procedure

where (kto_vid="'+kto+'")';

//Заполняем таблицу списка

TFSprav.FormShow(Sender:

dm.temp.Active:=true;

объектов

TObject);

if dm.temp.RecordCount<1

Replace:=true; // параметр,

begin

then

задающий режим замены

dbgrid1.DataSource:=dm.sps;

showmessage('Даннойструктурын

FindText:='#1'; // что

end;

етвБД')

меняем

procedure

else

ReplaceWith:=dm.sp.fieldbynam

TFSprav.Button9Click(Sender:

begin

e('data_sp').AsString; // на

TObject);

 

что меняем

var

cena:=dm.temp.Fields[0].AsStr

WordDocument1.Range.Find.Exec

fio,adr,data,kto,cena,id:stri

ing;

ute(FindText,EmptyParam,Empty

ng;

 

Param,

 

id:=dm.temp.Fields[1].AsStrin

EmptyParam,EmptyParam,EmptyPa

Template,NewTemplate,FindText

g;

ram,EmptyParam,

, NewStr,

end;

EmptyParam,EmptyParam,Replace

Replace,ReplaceWith:OleVarian

dm.com.CommandText:='Insert

With,Replace,EmptyParam,Empty

t;

into nepsix

Param,EmptyParam,EmptyParam);

LinkToFile,SaveWithDocument,R

(fio_np,id_vid_np,data_np,cen

Replace:=true; // параметр,

ange:OleVariant;

a_np,dr_np,adr_np) values

задающий режим замены

Table1: Table;

("'+fio+'",'+id+',"'+datetost

 

i: integer;

 

28

r(date)+'","'+cena+'","'+data

With,Replace,EmptyParam,Empty

var

+'","'+adr+'")';

Param,EmptyParam,EmptyParam);

FVidacha: TFVidacha;

dm.com.Execute;

Replace:=true; // параметр,

implementation

//Проверяем, инсталлирован

задающий режим замены

uses datm, avidacha, main;

ли Word

FindText:='#4'; // что

{$R *.dfm}

Reg := TRegistry.Create;

меняем

procedure

Reg.RootKey :=

ReplaceWith:=adr; //

TFVidacha.Button1Click(Sender

HKEY_CLASSES_ROOT;

начтоменяемWordDocument1.Rang

: TObject);

 

e.Find.Execute(FindText,Empty

begin

flag:=reg.KeyExists('Word.App

Param,EmptyParam,

tm:=0;

lication');

EmptyParam,EmptyParam,EmptyPa

favidacha.ShowModal;

reg.Free;

ram,EmptyParam,

end;

//flag:=true;

EmptyParam,EmptyParam,Replace

procedure

if flag=false then

With,Replace,EmptyParam,Empty

TFVidacha.Button2Click(Sender

begin

Param,EmptyParam,EmptyParam);

: TObject);

 

WordApplication1.Visible:=tru

begin

application.MessageBox('Word

e; //делаемприложение MS Word

if

неустанволен','Отчет',mb_ok+m

видимым

dm.vid.Fields[0].AsString=''

b_iconstop);

 

then

exit;

WordApplication1.Disconnect;

begin

end;

// Разрываемсвязьссерверо

showmessage('Запись для

WordApplication1.Connect; //

end;

редактирования отсутствует');

Устанавливаемсвязьссервером

end;

exit;

 

end.

end;

//Открываемшаблонotchet.dotвW

unit Vidacha;

tmp:=dm.vid.Fields[0].AsStrin

ordTemplate:=ExtractFilePath(

interface

g;tm:=1;

Application.EXEName)+'\Шаблон

uses

//***************************

ы\Справка.dot';

Windows, Messages,

***

//путькшаблонудокументаWordAp

SysUtils, Variants, Classes,

if

plication1.Documents.Add(Temp

Graphics, Controls, Forms,

fmain.Update('vid','vidacha')

late,EmptyParam,EmptyParam,Em

Dialogs, Grids, DBGrids,

=false then

ptyParam);//

StdCtrls, ToolWin, ComCtrls;

begin

создаемдокументнаосновешаблон

 

showmessage('Данная запись

аWordDocument1.ConnectTo(Word

type

используется другим

Application1.ActiveDocument);

TFVidacha = class(TForm)

пользователем');

//СвязываемкомпонентWordDocum

ToolBar1: TToolBar;

exit;

ent1 cактивнымдокументом

Button1: TButton;

end;

(т.е.

Button2: TButton;

//***************************

столькочтосозданнымдокументом

Button3: TButton;

***

)

ToolBar2: TToolBar;

favidacha.e1.Text:=dm.vid.fie

//Заполняем таблицу списка

e1: TEdit;

ldbyname('kto_vid').AsString;

объектов

Button4: TButton;

favidacha.e2.Text:=dm.vid.fie

Replace:=true; // параметр,

Button7: TButton;

ldbyname('st_vid').AsString;

задающий режим замены

ToolBar3: TToolBar;

tmpc:=favidacha.e2.Text;

FindText:='#1'; // чтоменяем

Button5: TButton;

favidacha.ShowModal;

ReplaceWith:=datetostr(date);

Button6: TButton;

end;

//

DBGrid1: TDBGrid;

procedure

начтоменяемWordDocument1.Rang

ToolButton1: TToolButton;

TFVidacha.Button3Click(Sender

e.Find.Execute(FindText,Empty

procedure

: TObject);

Param,EmptyParam,

Button1Click(Sender:

begin

EmptyParam,EmptyParam,EmptyPa

TObject);

if

ram,EmptyParam,

procedure

dm.vid.Fields[0].AsString=''

EmptyParam,EmptyParam,Replace

Button2Click(Sender:

then

With,Replace,EmptyParam,Empty

TObject);

begin

Param,EmptyParam,EmptyParam);

procedure

showmessage('Запись для

Replace:=true; // параметр,

Button3Click(Sender:

редактирования отсутствует');

задающий режим замены

TObject);

exit;

FindText:='#2'; // что

procedure

end;

меняем

Button7Click(Sender:

tmp:=dm.vid.Fields[0].AsStrin

ReplaceWith:=fio; //

TObject);

g;tm:=1;

начтоменяемWordDocument1.Rang

procedure

if

e.Find.Execute(FindText,Empty

FormCloseQuery(Sender:

fmain.Delete('vid','vidacha',

Param,EmptyParam,

TObject; var CanClose:

tmp)=false then

EmptyParam,EmptyParam,EmptyPa

Boolean);

begin

ram,EmptyParam,

procedure

showmessage('Данная запись

EmptyParam,EmptyParam,Replace

Button4Click(Sender:

используется другим

With,Replace,EmptyParam,Empty

TObject);

пользователем');

Param,EmptyParam,EmptyParam);

procedure

exit;

Replace:=true; // параметр,

Button5Click(Sender:

end

задающий режим замены

TObject);

else dm.vid.Requery();

FindText:='#3'; // что

procedure

end;

меняем

Button6Click(Sender:

procedure

ReplaceWith:=data; //

TObject);

TFVidacha.Button7Click(Sender

начтоменяемWordDocument1.Rang

procedure

: TObject);

e.Find.Execute(FindText,Empty

FormShow(Sender: TObject);

begin

Param,EmptyParam,

private

e1.Clear;

EmptyParam,EmptyParam,EmptyPa

{ Private declarations }

dm.vid.Active:=false;

ram,EmptyParam,

public

dm.vid.CommandText:='select

EmptyParam,EmptyParam,Replace

{ Public declarations }

id_vid, kto_vid, st_vid from

 

end;

Vidacha';

29

dm.vid.Active:=true;

{ Public declarations }

showmessage('Подобнаязаписьуж

end;

end;

есуществует')

procedure

var

else

TFVidacha.FormCloseQuery(Send

FaDiagnoz: TFaDiagnoz;

begin

er: TObject; var CanClose:

implementation

 

Boolean);

uses datm;

dm.com.CommandText:='Update

begin

{$R *.dfm}

diagnoz SET

e1.Clear;close;

procedure

nazv_d="'+e1.Text+'",sh_d="'+

end;

TFaDiagnoz.BitBtn2Click(Sende

e2.Text+'" WHERE

procedure

r: TObject);

(id_d='+tmp+')';

TFVidacha.Button4Click(Sender

begin

dm.com.Execute;

: TObject);

closequery;

 

begin

end;

showmessage('Записьуспешноизм

dm.vid.Active:=false;

procedure

енена');

dm.vid.CommandText:='select

TFaDiagnoz.FormCloseQuery(Sen

dm.d.Requery();

id_vid, kto_vid, st_vid from

der: TObject;

closequery;

Vidacha where (kto_vid like

var CanClose: Boolean);

end;

"%'+e1.Text+'%")';

begin

end;

dm.vid.Active:=true;

if tm=1 then

end;

end;

begin

end;

procedure

dm.com.CommandText:='Update

end.

TFVidacha.Button5Click(Sender

diagnoz set log_d=FALSE WHERE

unit aPacient;

: TObject);

(id_d='+tmp+')';

interface

begin

dm.com.Execute;

uses

e1.Clear;

end;

Windows, Messages,

dm.vid.Active:=false;

e1.Clear;e2.Clear;

SysUtils, Variants, Classes,

dm.vid.CommandText:='select

close;

Graphics, Controls, Forms,

id_vid, kto_vid, st_vid from

end;

Dialogs, StdCtrls, Buttons,

Vidacha order by kto_vid';

procedure

ExtCtrls, ComCtrls, Grids,

dm.vid.Active:=true;

TFaDiagnoz.BitBtn1Click(Sende

DBGrids, DB, ADODB,jpeg;

end;

r: TObject);

type

procedure

begin

TFaPacient = class(TForm)

TFVidacha.Button6Click(Sender

if (e1.Text='') or

Panel1: TPanel;

: TObject);

(e2.Text='') then

BitBtn1: TBitBtn;

begin

showmessage('Вы не заполнили

BitBtn2: TBitBtn;

e1.Clear;

одно или несколько полей')

Panel2: TPanel;

dm.vid.Active:=false;

else

Label1: TLabel;

dm.vid.CommandText:='select

begin

Label2: TLabel;

id_vid, kto_vid, st_vid from

if tm=0 then

e1: TEdit;

Vidacha order by st_vid';

begin

e2: TEdit;

dm.vid.Active:=true;

dm.temp.Active:=false;

Panel3: TPanel;

end;

 

Image1: TImage;

procedure

dm.temp.CommandText:='Select

Panel4: TPanel;

TFVidacha.FormShow(Sender:

id_d from diagnoz where

GroupBox1: TGroupBox;

TObject);

(nazv_d="'+e1.Text+'") or

cb: TComboBox;

begin

(sh_d="'+e2.text+'")';

SpeedButton1:

dbgrid1.DataSource:=dm.vids;

dm.temp.Active:=true;

TSpeedButton;

end;

if dm.temp.RecordCount>0

SpeedButton2:

end.

then

TSpeedButton;

unit aDiagnoz;

showmessage('Подобнаязаписьуж

DBGrid1: TDBGrid;

interface

есуществует')

Label3: TLabel;

uses

else

dtp1: TDateTimePicker;

Windows, Messages,

begin

cb1: TComboBox;

SysUtils, Variants, Classes,

 

Label4: TLabel;

Graphics, Controls, Forms,

dm.com.CommandText:='Insert

cb2: TComboBox;

Dialogs, StdCtrls, Buttons,

into diagnoz (nazv_d,sh_d)

Label5: TLabel;

ExtCtrls;

values

cb3: TComboBox;

type

("'+e1.Text+'","'+e2.Text+'")

Label6: TLabel;

TFaDiagnoz = class(TForm)

';

Label7: TLabel;

Panel1: TPanel;

dm.com.Execute;

e3: TEdit;

BitBtn1: TBitBtn;

 

Label8: TLabel;

BitBtn2: TBitBtn;

showmessage('Записьуспешнодоб

dtp2: TDateTimePicker;

Panel2: TPanel;

авлена');

pd: TADODataSet;

Label1: TLabel;

dm.d.Requery();

pds: TDataSource;

Label2: TLabel;

closequery;

od: TOpenDialog;

e1: TEdit;

end;

Label9: TLabel;

e2: TEdit;

end

procedure

procedure

else

BitBtn2Click(Sender:

BitBtn2Click(Sender:

begin

TObject);

TObject);

dm.temp.Active:=false;

procedure

procedure

 

FormCloseQuery(Sender:

FormCloseQuery(Sender:

dm.temp.CommandText:='Select

TObject; var CanClose:

TObject; var CanClose:

id_d from diagnoz where

Boolean);

Boolean);

(nazv_d="'+e1.Text+'") or

procedure

procedure

(sh_d="'+e2.text+'")';

BitBtn1Click(Sender:

BitBtn1Click(Sender:

dm.temp.Active:=true;

TObject);

TObject);

if

procedure

private

(dm.temp.RecordCount>0) and

cb1KeyPress(Sender: TObject;

{ Private declarations }

(tmp<>dm.temp.Fields[0].asstr

var Key: Char);

public

ing) then

 

30

procedure

end;

begin

cbKeyPress(Sender: TObject;

if tm=0 then

 

var Key: Char);

begin

dm.com.CommandText:='Update

procedure

dm.temp.Active:=false;

pacient SET

cb2KeyPress(Sender: TObject;

 

fio_pc="'+e1.Text+'",adr_pc="

var Key: Char);

dm.temp.CommandText:='Select

'+e2.Text+'",dr_pc="'+datetos

procedure

id_pc from pacient where

tr(dtp1.date)+'",pol_pc="'+cb

cb3KeyPress(Sender: TObject;

(fio_pc="'+e1.Text+'") and

1.Text+'",trud_pc="'+cb2.Text

var Key: Char);

(adr_pc="'+e2.text+'")';

+'",inv_pc="'+cb3.Text+'",tel

procedure

dm.temp.Active:=true;

_pc="'+e3.Text+'",datap_pc="'

cbChange(Sender: TObject);

if dm.temp.RecordCount>0

+datetostr(dtp2.Date)+'",foto

procedure

then

_pc="'+NameFile(od.FileName,t

SpeedButton1Click(Sender:

showmessage('Подобнаязаписьуж

rue)+'" WHERE

TObject);

есуществует')

(id_pc='+tmp+')';

procedure

else

dm.com.Execute;

SpeedButton2Click(Sender:

begin

if

TObject);

if

fileexists(ExtractFilePath(Ap

procedure

(fileexists(ExtractFilePath(A

plication.ExeName)+'Фото\'+Na

Image1Click(Sender: TObject);

pplication.ExeName)+'Фото\'+N

meFile(od.FileName,true))=fal

procedure

ameFile(od.FileName,true))=tr

se then

FormShow(Sender: TObject);

ue) then

begin

private

begin

copyfile(pchar(od.FileName),p

{ Private declarations }

showmessage('Фото с

char(ExtractFilePath(Applicat

public

данным именем уже

ion.ExeName)+'Фото\'+NameFile

{ Public declarations }

существует');

(od.FileName,true)),true);

end;

exit;

end;

var

end;

showmessage('Запись

FaPacient: TFaPacient;

copyfile(pchar(od.FileName),p

успешно изменена');

implementation

char(ExtractFilePath(Applicat

dm.pc.Requery();

uses datm,UEasyPath;

ion.ExeName)+'Фото\'+NameFile

closequery;

{$R *.dfm}

(od.FileName,true)),true);

end;

procedure

 

end;

TFaPacient.BitBtn2Click(Sende

dm.com.CommandText:='Insert

end;

r: TObject);

into pacient

end;

begin

(fio_pc,adr_pc,dr_pc,pol_pc,t

procedure

closequery;

rud_pc,inv_pc,tel_pc,datap_pc

TFaPacient.cb1KeyPress(Sender

end;

,foto_pc) values

: TObject; var Key: Char);

procedure

("'+e1.Text+'","'+e2.Text+'",

begin

TFaPacient.FormCloseQuery(Sen

"'+datetostr(dtp1.date)+'","'

key:=#0;

der: TObject;

+cb1.Text+'","'+cb2.Text+'","

end;

var CanClose: Boolean);

'+cb3.Text+'","'+e3.Text+'","

procedure

begin

'+datetostr(dtp2.Date)+'","'+

TFaPacient.cbKeyPress(Sender:

if tm=1 then

NameFile(od.FileName,true)+'"

TObject; var Key: Char);

begin

)';

begin

dm.com.CommandText:='Update

dm.com.Execute;

key:=#0;

pacient set log_pc=FALSE

dm.temp.Active:=false;

end;

WHERE (id_pc='+tmp+')';

 

procedure

dm.com.Execute;

dm.temp.CommandText:='Select

TFaPacient.cb2KeyPress(Sender

end;

max(id_pc) from pacient';

: TObject; var Key: Char);

e1.Clear;e2.Clear;e3.Clear;

dm.temp.Active:=true;

begin

cb1.Itemindex:=-

 

key:=#0;

1;cb2.Itemindex:=-

dm.com.CommandText:='Update

end;

1;cb3.Itemindex:=-1;

pacdig set

procedure

dtp1.Date:=date;dtp2.date:=da

id_pc_pd="'+dm.temp.Fields[0]

TFaPacient.cb3KeyPress(Sender

te;

.AsString+'" where

: TObject; var Key: Char);

image1.Picture:=nil;

id_pc_pd=0';

begin

cb.Clear;

dm.com.Execute;

key:=#0;

close;

 

end;

end;

showmessage('Записьуспешнодоб

procedure

procedure

авлена');

TFaPacient.cbChange(Sender:

TFaPacient.BitBtn1Click(Sende

dm.pc.Requery();

TObject);

r: TObject);

closequery;

begin

begin

end;

dm.temp.Active:=false;

if (e1.Text='') or

end

dm.temp.CommandText:='select

(e2.Text='') or (e3.Text='')

else

id_d from diagnoz where

or (cb1.Text='') or

begin

(nazv_d="'+cb.Text+'")';

(cb2.Text='') or

dm.temp.Active:=false;

dm.temp.Active:=true;

(cb3.Text='') then

 

id_d:=dm.temp.Fields[0].AsStr

showmessage('Вынезаполнилиодн

dm.temp.CommandText:='Select

ing;

оилинесколькополей')

id_pc from pacient where

end;

else

(fio_pc="'+e1.Text+'") and

procedure

begin

(adr_pc="'+e2.text+'")';

TFaPacient.SpeedButton1Click(

if dtp2.Date<=dtp1.date

dm.temp.Active:=true;

Sender: TObject);

then

if

begin

begin

(dm.temp.RecordCount>0) and

if cb.Text='' then

showmessage('Дата

(tmp<>dm.temp.Fields[0].asstr

showmessage('Выневыбралидиагн

постановки на учет не может

ing) then

оз')

быть меньше или равна дате

showmessage('Подобнаязаписьуж

else

рождения');

есуществует')

begin

exit;

else

 

31

Соседние файлы в папке Курсовые работы