Вопросы к экзамену с ответами и демо-программами на Паскале / 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.