1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
| var
Form1: TForm1;
implementation
type dt=record day,month,year: byte
end;
t_sotr = record
fam, im, ot, dol: string[30];
dt_pr:dt
end;
t_file = file of t_sotr;
var man:t_sotr; f:t_file;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.Cells[0,0]:='Фамилия';
StringGrid1.Cells[1,0]:='Имя';
StringGrid1.Cells[2,0]:='Отчество';
StringGrid1.Cells[3,0]:='Должность';
StringGrid1.Cells[4,0]:='День';
StringGrid1.Cells[5,0]:='Месяц';
StringGrid1.Cells[6,0]:='Год';
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var filename:string;
i:byte; (* номер строки в сетке *)
begin
StringGrid1.Visible:=True;
filename:='C:\Temp\workers.txt';
AssignFile(f,filename); (* связывание логического и
физического файла *)
if FileExists(filename) (* проверка существования фи-
зического файла *)
then
begin
(* открытие файла для чтения *)
reset(f); i:=1;
(* изменение количества строк в сетке в зависимо-
сти от длины файла *)
StringGrid1.RowCount:=FileSize(f)+1;
(* пока не конец файла читаются компоненты файла и
выводятся в сетку *)
while not eof(f) do
begin
read(f,man);
StringGrid1.Cells[0,i]:=man.fam;
StringGrid1.Cells[1,i]:=man.im;
StringGrid1.Cells[2,i]:=man.ot;
StringGrid1.Cells[3,i]:=man.dol;
StringGrid1.Cells[4,i]:=IntToStr(man.dt_pr.day);
StringGrid1.Cells[5,i]:=IntToStr(man.dt_pr.month);
StringGrid1.Cells[6,i]:=IntToStr(man.dt_pr.year);
inc(i)
end ; (*while *)
CloseFile(f)
end (* then *)
else
ShowMessage('Файла ‘+filename+’ не существует!');
end;
procedure TForm1.Button1Click(Sender: TObject);
var filename:string; (* имя физического файла *)
flag,net:boolean;(* логические переменные *)
z:set of byte; (* множество номеров однофамиль-
цев *)
i,j:integer; (* счетчики циклов *)
man1:t_sotr; (* запись об однофамильце *)
result:string; (* список однофамильцев *)
begin result:='';
filename:='C:\temp\Familia\workers.txt';
AssignFile(f,filename);
if FileExists(filename)
then
begin
(* открытие существующего файла с информацией о со-
трудниках фирмы *)
reset(f);
net:=true; z:=[];
(* поиск однофамильцев *)
for i:=0 to filesize(f)-2 do
begin
seek(f,i); read(f,man); flag:=false;
for j:=i+1 to filesize(f)-1 do
begin
seek(f,j); read(f,man1);
if man.fam=man1.fam
then
begin
if not (j in z) then result:= result+ man1.fam+
' '+man1.im+' '+man1.ot+' - '+man1.dol+chr(13);
flag:=true; net:=false; z:=z+[j]
end
end;
if flag and not (i in z) then
result:=result+man.fam+' '+man.im+' '+man.ot+' '+man.dol+chr(13);
end;
CloseFile(f)
end;
(* запись отрицательного результата поиска *)
if net=true
then result:=result+'Однофамильцев нет';
ShowMessage(result) ;
end;
end. |