Скачиваний:
126
Добавлен:
08.05.2014
Размер:
1.75 Кб
Скачать
program exploit11(foreign);
uses Crt;
type
MyType=record
termin:string[50];
txt:array[1..4] of string[80];
n:pointer;
end;
pMyType=^MyType;
var p,c,n:pMyType; f:Text; s:string; i:integer; fl,fl1:boolean;
first:pMyType; k:Char;
procedure W1;
begin
Window(1,1,35,13);
end;

procedure W2;
begin
Window(41,1,79,13);
end;

procedure W3;
begin
Window(1,14,79,24);
end;

begin
Assign(f,'laba.dat');
{$I-} reset(f); {$I+}
if IOResult<>0 then begin
Writeln('file not found'); Halt;
end;
i:=0; fl:=true;
while not Eof(f) do begin
readln(f,s);
if s[1]='#' then begin Delete(s,1,1);
if fl then begin
New(c); first:=c; fl:=false; p:=c;
end
else begin
p:=c; new(c); p^.n:=c;
end;
c^.termin:=s;
for i:=1 to 4 do begin c^.txt[i]:=''; Readln(f,c^.txt[i]); end;
i:=0;
end;
end;
c^.n:=nil; Close(f); fl:=true; clrscr; W1;
repeat
if fl then
begin
c:=first; fl:=false;
end
else c:=c^.n;
Writeln(c^.termin);
until c^.n=nil;
W2;
repeat
clrscr;
Write('Enter a word: '); readln(s);
W3;
clrscr; fl:=true;
fl1:=false;
repeat
if fl then
begin
c:=first;
fl:=false;
end
else c:=c^.n;
if c^.termin=s then
begin
for i:=1 to 5 do Writeln(c^.txt[i]);
fl1:=true;
end;
until c^.n=nil;
if not fl1 then Writeln('Termin "',s,'" not found!');
W2;
clrscr;
repeat
Write('Search another? (Y/N):');
k:=readkey;
Writeln(k);
until k in ['y','Y','n','N'];
until k in ['n','N'];
end.


Соседние файлы в папке задание №6 — 1