База данных

Program FileZap;
Const
max_naim = 200;
max_firma = 150;
Type
Tzap=Record
naim :string[max_naim];
firma:String[max_firma];
stoim :integer;
obem:integer;
kol :integer;
Tfile=File Of Tzap;
 
Function FileExist(Const nameF:String):Boolean;
Var F:File;
Begin 
Assign(F,nameF);
{$I-}
Reset(F);
{$I+}
If IOResult=0 then 
Begin
FileExist:=TRUE;
Close(F);
End
Else
FileExist:=FALSE;
End;
 
Procedure SozdFZ(Const nameF:String);
Var
z:Tzap;
otv:Char;
FZ:Tfile;
Begin
If FileExist(nameF) then
Begin
WriteLn('File ',nameF,' est!');
Exit;
End;
Assign(FZ,nameF);
Rewrite(FZ);
WriteLn('vvedite dannie:');
Repeat
Write ('Naimenovanie ');
Readln(z.naim);
Write ('firma');
Readln(z.firma);
Write ('Stoimost ');
Readln (z.stoim);
Write ('obem ');
Readln (z.obem);
Write ('kolichestvo ');
Readln (z.kol);
Write(FZ,z);
Write('Prodolzhit ? (y) ');
ReadLn(otv);
Until Not (otv In ['y']);
Close(FZ);
End;
 
Procedure ProsmFZ(Const nameF:String);
Var
z:Tzap;
FZ:Tfile;
Begin
If Not FileExist(nameF) then Begin
WriteLn('File ',nameF,' est!');
Exit;
End;
Assign(FZ,nameF);
Reset(FZ);
If Eof(FZ) then 
Begin
WriteLn('File ',nameF,' pust!');
Exit;
End;
WriteLn('Soderzhimoe faila : ',nameF);
While Not(Eof(FZ))
Do Begin
Read(FZ,z);
Writeln(z.naim,' ',z.firma,' ',z.stoim,' ',z.obem,' ',z.kol);
End;
Close(FZ);
End;
 
Procedure SortFZ(Const nameF:String);
Var
z1,z2:Tzap;
i:Word;
flag:Boolean;
FZ:Tfile;
nkz:Word;
Begin
If Not FileExist(nameF) then Begin
WriteLn('File ',nameF,' est !');
Exit;
End;
Assign(FZ,nameF);
Reset(FZ);
nkz:=FileSize(FZ)-1;
flag:=TRUE;
While (nkz>0) and flag
Do Begin
flag:=FALSE;
For i:=0 To nkz-1
Do Begin
Seek(FZ,i);
Read(FZ,z1,z2);
If z1.naim>z2.naim then Begin
Seek(FZ,FilePos(FZ)-2);
Write(FZ,z2,z1);
flag:=TRUE;
End;
End;
nkz:=nkz-1;
End;
Close(FZ)
End;
 
Procedure UsechFZ(Const nameF:String;kz:Word);
Var
FZ:Tfile;
Begin
If Not FileExist(nameF) then 
WriteLn(' UsechFZ: file ',nameF,' NO!')
Else Begin
Assign(FZ,nameF);
Reset(FZ);
If kz<FileSize(FZ)
Then Begin
Seek(FZ,kz);
Truncate(FZ);
Close(FZ);
End;
End;
End;
 
 
Var
nameFZ :String;
kPol:Word;
r:0..4;
{$R+}
Begin
WriteLn ('Enter name of file:');
Read(nameFZ);
Repeat
WriteLn('Zadaite rezhim raboti programmi !');
WriteLn('1 - sozd, 2 - sort,');
Write('3 - prosmotr, 4 - usechenie, 0 - exit : ');
ReadLn(r);
Case r Of
1: SozdFZ(nameFZ);
2: SortFZ(nameFZ);
3: ProsmFZ(nameFZ);
4: Begin Write('Kol-vo? ');
ReadLn(kPol);
UsechFZ(nameFZ,kPol);
End;
End;
WriteLn;
Until r=0;
End.