Вопросы к экзамену с ответами и демо-программами на Паскале / EX11-16

program ex11_16;
uses crt;
type
TMyRec=record
Key: word;
Name: string[12];
Year:word;
end;
var
RecGl: TMyRec;
f: longint;
t: boolean;
{======================================}
procedure RandomFill(f1:string);
var
i:byte;
inF: File of TMyRec;
Rec: TMyRec;
begin
randomize;
assign(inF,f1);
{$I-}
reWrite(inF);
if ioresult<>0 then begin write('Can not create file!'); exit; end;
{$I+}
for i:=1 to 6+random(5) do
begin
Rec.Name:='';
Rec.Key:=1+random(6);
Rec.Year:=1950+random(57);
while length(Rec.Name)<(8+random(6)) do Rec.Name:=Rec.Name+chr(ord('a')+random(26));
Rec.Name[1]:=UpCase(Rec.Name[1]);
write(inF, Rec);
end;
Close(inF);
end;
{=============================================}
procedure SortRandomFill(f1:string);
var
i:byte;
inF: File of TMyRec;
Rec: TMyRec;
begin
randomize;
assign(inF,f1);
{$I-}
reWrite(inF);
if ioresult<>0 then begin write('Can not create file!'); exit; end;
{$I+}
for i:=1 to 6+random(10) do
begin
Rec.Name:='';
Rec.Key:=i;
Rec.Year:=1950+random(57);
while length(Rec.Name)<(8+random(6)) do Rec.Name:=Rec.Name+chr(ord('a')+random(26));
Rec.Name[1]:=UpCase(Rec.Name[1]);
write(inF, Rec);
end;
Close(inF);
end;
{=============================================}

procedure RandomRec(var Rec: TMyRec);

begin
randomize;
Rec.Name:='';
Rec.Key:=1+random(6);
Rec.Year:=1950+random(57);
while length(Rec.Name)<(8+random(6)) do Rec.Name:=Rec.Name+chr(ord('a')+random(26));
Rec.Name[1]:=UpCase(Rec.Name[1]);
end;
{=========================================}
procedure ShowFile(f1:string);
var
inF: File of TMyRec;
Rec: TMyRec;
begin
assign(inF,f1);
{$I-}
reset(inF);
if ioresult<>0 then begin write('File not found!'); exit; end;
{$I+}
while not EOF(inF) do
begin
read(inF,Rec);
writeln ('Key: ',Rec.Key,'; Name: ',Rec.Name,'; Year: ',Rec.Year,';');
end;
close(inF);
end;
{=========================================}
procedure ShowRec(Rec: TMyRec);
begin
writeln ('Key: ',Rec.Key,'; Name: ',Rec.Name,'; Year: ',Rec.Year,';');
end;

{============================================}
procedure ex11(f1:string; DelKey:word);
var
Rec: TMyRec;
inF: File of TMyRec;
i,c:longint;
begin
assign(inF,f1);
{$I-}
reset(inF);
if ioresult<>0 then begin write('File not found!'); exit; end;
{$I+}
i:=1;
c:=0;
while i<FileSize(inF)+1 do
begin
read(inF,Rec);
if Rec.Key=DelKey then begin inc(i); inc(c); end
else
begin
seek(inF,i-c-1);
Write(inF,Rec);
seek(inF,i);
inc(i);
end;
end;
seek(inF,FileSize(inF)-c);
truncate(inF);
Close(inF);
end;
{============================================}
procedure ex12(f1:string; Key: word; UpdRec: TMyRec);
var
Rec: TMyRec;
inF,outF: File of TMyRec;
i:longint;
begin
assign(inF,f1);
{$I-}
reset(inF);
if ioresult<>0 then begin write('File not found!'); exit; end;
{$I+}
i:=1;
while i<FileSize(inF)+1 do
begin
read(inF,Rec);
if Rec.Key=Key then
begin
seek(inF,i-1);
Write(inF, UpdRec);
inc(i);
end
else inc(i);
end;
Close(inF);
end;
{============================================}
procedure ex13(f1: string; var NewRec: TMyRec);
var
inF: File of TMyRec;
Rec: TMyRec;
max: word;
begin
assign(inF,f1);
{$I-}
reset(inF);
if ioresult<>0 then begin write('File not found!'); exit; end;
{$I+}
read(inF, Rec);
NewRec:=Rec;
while not EOF(inF) do
begin
read(inF, Rec);
if NewRec.Key<Rec.Key then NewRec:=Rec;
end;
end;
{============================================}
function ex14(f1:string):longint;
var
inF: File of TMyRec;
Rec: TMyRec;
i,c:longint;
min:word;
begin
assign(inF,f1);
{$I-}
reset(inF);
if ioresult<>0 then begin write('File not found!'); exit; end;
{$I+}
i:=1;
c:=0;
read(inF,Rec);
min:=Rec.Key;
while not EOF(inF) do
begin
read(inF,Rec);
if min>Rec.Key then begin min:=Rec.Key; i:=Filepos(inF); end;
inc(c);
end;
ex14:=i;
end;
{============================================}
function ex15(f1: string; max:word):Boolean;
var
Rec: TMyRec;
inF: File of TMyRec;
begin
assign(inF,f1);
{$I-}
reset(inF);
if ioresult<>0 then begin write('File not found!'); exit; end;
{$I+}
seek(inF,FileSize(inF)-1);
read(inF,Rec);
ex15:=Rec.Key<max;
end;
{============================================}
procedure ex16(f1,f2: string; a,b:word);
var
Rec: TMyRec;
inF,outF: File of TMyRec;
begin
assign(inF,f1);
assign(outF,f2);
{$I-}
reset(inF);
if ioresult<>0 then begin write('File not found!'); exit; end;
reWrite(outF);
if ioresult<>0 then begin write('Can not create file!'); close(inF); exit; end;
{$I+}
read(inF,Rec);
while Rec.Key<=b do
begin
if (Rec.Key in [a..b]) then
begin
write(outF,Rec);
read(inF,Rec);
end
else read(inF,Rec);
end;
close(inF);
close(outF);
end;
{============================================}
begin
clrscr;
SortRandomFill('ex1101');
ShowFile('ex1101');
ex16('ex1101','ex1102', 4, 9);
ShowFile('ex1102');
{t:=ex15('ex1101',2);
writeln(t);
ex11('ex1101',6);
writeln('==========================================');
RandomRec(RecGl);
ShowRec(RecGl);
ex12('ex1101',5,RecGl);
writeln('==========================================');
writeln('File update:');
ShowFile('ex1101');
ex13('ex1101',RecGl);
ShowRec(RecGl);
writeln('==========================================');
f:=ex14('ex1101');
writeln('Minimalnoe znachenie polya "Key" codergitcyav v ',f,' zapisi tipa "TMyRec" ');
}repeat
until readkey=#27;
end.