Здравствуйте! Помогите пожалуйста доделать следующую процедуру(CreateList):
| Код |
type
PBook= ^TBook;
TBook=record
Next:PBook;
Author:string[15];
Name:string[41];
Publish:string[7];
year:word;
pages:word;
end;
var
Book,
Beglist:Pbook;
Rel:pointer;
a:TBook;
Fbooks:file of TBook;
FI, FO:text;
procedure createlist;
begin
...
end;
procedure writelist(headline:string);
begin
rewrite(FO);
Writeln(FO);
Writeln(FO, Headline);
book:=beglist;
while book<> NIL do
begin
with book^ do
writeln(FO, Author:15, Name:41, Publish:7, Year:5, Pages:4);
book:=book^.next;
end;
close(FO);
end;
procedure SortAuthor;
var stop, first:boolean;
book1, book2:Pbook;
begin
repeat
stop:=true;
book:=beglist;
first:=true;
while book^.next <> NIL do
begin
if book^.Author > Book^.next^.Author then begin
book1:=book;
book:=book^.next;
if first then
beglist:=book
else
begin
book2:=beglist;
while book2^.next <> book1 do
book2:=book2^.next;
book2^.next:=book
end;
book1^.next :=book^.next;
book^.next:=book1;
stop:=false;
end;
first:=false;
book:=book^.next;
end;
until stop;
end;
procedure writefile;
begin
assign (Fbooks, 'z6file.txt');
rewrite(Fbooks);
book:=beglist;
while book <> NIL do
begin
write(Fbooks, Book^);
book:=book^.next;
end;
close(Fbooks);
end;
procedure readfile;
var
k:integer;
book1:Pbook;
begin
reset(FBooks);
k:=filesize(FBooks);
release(Rel);
beglist:=NIL;
while k>= 0 do
begin
book1:=book;
dec(k);
if k<0 then
break;
seek(FBooks, k);
New(book);
if beglist = NIL then
Beglist:=book
else
book1^.next:=book;
read(FBooks, Book^);
Book^.next:=NIL
end;
close(Fbooks);
end;
begin
Mark(Rel);
Createlist;
assign(FO, 'z6.res');
writelist('Spisok:');
SortAuthor;
Writelist('otsortirovannij spisok:');
Writefile;
readfile;
writelist('otsortirovano v protivopoloznom porjadke:');
release(Rel);
END.
|
|