Угу. Там вообще со всех сторон на самом-то деле...
Гм. Да я и не претендую на узнаваемость
Ты расстроен? Они все равно какие то унылые были. Правда и испанцы не намного веселее смотрелись
Я за Францию и Россию болел на Евро.
Течением принесло
program biblioteka;
uses crt;
type
k=^kniga;
u=^zveno;
kniga=record
naz:string;
avt:string;
izd:string;
god:string[4];
end;
zveno=record
inf:k;
next:u;
end;
procedure v_nachalo(var first:u; inf:kniga);
var
vsp:u;
begin
new(vsp);
vsp^.inf^.naz:=inf.naz;
vsp^.inf^.avt:=inf.avt;
vsp^.inf^.izd:=inf.izd;
vsp^.inf^.god:=inf.god;
vsp^.next:=first;
first:=vsp;
end;
procedure print(first:u);
var
vsp:u;
begin
vsp:=first;
while vsp <> nil do
begin
writeln('----------------------');
writeln(vsp^.inf^.naz);
writeln(vsp^.inf^.avt);
writeln(vsp^.inf^.izd,' ',vsp^.inf^.god);
vsp:=vsp^.next;
end; writeln
end;
procedure sv(first:u; s:string);
var
vsp:u;
f: file of kniga;
begin
vsp:=first;
assign(f,s);
rewrite(f);
while vsp<>nil do
begin
write(f,vsp^.inf^);
vsp:=vsp^.next;
end;
close(f);
end;
procedure red(first:u; s:string);
var
vsp:u;
f: file of kniga;
p,b:boolean;
n,z:string;
k:byte;
begin
vsp:=first;
p:=false;
writeln('Vvedite nazvanie knigi');
readln(n);
while vsp <> nil do
begin
if n=vsp^.inf^.naz then
begin
while p=false do
begin
writeln('Chto hotite redaktirovat?');
writeln('----------------------');
writeln('1-nazvanie');
writeln('2-avtora');
writeln('3-izdanie');
writeln(' 4-god');
writeln(' 5-vihod');
readln(k);
case k of
1:begin
writeln('vvedite novoe nazvanie');
readln(z);
vsp^.inf^.naz:=z;
end;
2:begin
writeln('vvedite novogo avtora');
readln(z);
vsp^.inf^.avt:=z;
end;
3:begin
writeln('vvedite novoe izdanie');
readln(z);
vsp^.inf^.izd:=z;
end;
4:begin
writeln('vvedite novii god');
readln(z);
vsp^.inf^.god:=z;
end
else
p:=true;
end;
end;
end;
vsp:=vsp^.next;
end;
if p=false then
writeln('Oshibka');
sv(first,s);
end;
procedure del(var first:u; pred:u; s:string);
var
vsp:u;
begin
if first=pred then
begin
vsp:=first;
first:=first^.next;
dispose(vsp);
end
else
begin
vsp:=pred^.next;
pred^.next:=pred^.next^.next;
dispose(vsp);
end;
sv(first,s);
end;
procedure poisk(first:u);
var
vsp:u;
c:byte;
p1,p2:string;
p:boolean;
begin
p:=false;
vsp:=first;
writeln('hotite iskat po 1 ili po 2 priznakam?');
readln(c);
if c=1 then
begin
writeln('vvedite priznak');
readln(p1);
while vsp <> nil do
begin
if(p1=vsp^.inf^.naz)or(p1=vsp^.inf^.avt)or(p1=vsp^.inf^.izd)or(p1=vsp^.inf^.god)then
begin
writeln('----------------------');
writeln(vsp^.inf^.naz);
writeln(vsp^.inf^.avt);
writeln(vsp^.inf^.izd,' ',vsp^.inf^.god);
p:=true;
end;
vsp:=vsp^.next;
end;
end
else
begin
writeln('vvedite pervii priznak');
readln(p1);
writeln('vvedite vtoroi priznak');
readln(p2);
while vsp <> nil do
begin
if(p1=vsp^.inf^.naz)or(p1=vsp^.inf^.avt)or(p1=vsp^.inf^.izd)or(p1=vsp^.inf^.god)then
if(p2=vsp^.inf^.naz)or(p2=vsp^.inf^.avt)or(p2=vsp^.inf^.izd)or(p2=vsp^.inf^.god)then
begin
writeln('----------------------');
writeln(vsp^.inf^.naz);
writeln(vsp^.inf^.avt);
writeln(vsp^.inf^.izd,' ',vsp^.inf^.god);
p:=true;
end;
vsp:=vsp^.next;
end;
end;
if p=false then
writeln('Oshibka');
end;
procedure sort(first:u; s:string);
var
tmp,rab:u;
tmps:kniga;
f: file of kniga;
k:byte;
begin
getmem(tmp,sizeof(zveno));
rab:=first;
writeln('Po kakomy priznaky sortirovat?');
writeln('----------------------');
writeln('1-nazvanie');
writeln('2-avtor');
writeln('3-izdanie');
writeln('4-god');
readln(k);
case k of
1:begin
while rab<>nil do
begin
tmp:=rab^.next;
while tmp<>nil do
begin
if tmp^.inf^.naz<rab^.inf^.naz then
begin
tmps:=tmp^.inf^;
tmp^.inf^:=rab^.inf^;
rab^.inf^:=tmps
end;
tmp:=tmp^.next
end;
rab:=rab^.next
end;
end;
2:begin
while rab<>nil do
begin
tmp:=rab^.next;
while tmp<>nil do
begin
if tmp^.inf^.avt<rab^.inf^.avt then
begin
tmps:=tmp^.inf^;
tmp^.inf^:=rab^.inf^;
rab^.inf^:=tmps
end;
tmp:=tmp^.next
end;
rab:=rab^.next
end;
end;
3:begin
while rab<>nil do
begin
tmp:=rab^.next;
while tmp<>nil do
begin
if tmp^.inf^.izd<rab^.inf^.izd then
begin
tmps:=tmp^.inf^;
tmp^.inf^:=rab^.inf^;
rab^.inf^:=tmps
end;
tmp:=tmp^.next
end;
rab:=rab^.next
end;
end;
4:begin
while rab<>nil do
begin
tmp:=rab^.next;
while tmp<>nil do
begin
if tmp^.inf^.god<rab^.inf^.god then
begin
tmps:=tmp^.inf^;
tmp^.inf^:=rab^.inf^;
rab^.inf^:=tmps
end;
tmp:=tmp^.next
end;
rab:=rab^.next
end;
end;
end;
sv(first,s);
end;
procedure st(var first:u);
var
v:boolean;
inf:kniga;
c:char;
k:byte;
vsp,t:u;
f: file of kniga;
s,n:string;
begin
writeln('Dlya sozdaniya novoi bazi nazhmite "S"');
writeln('Dlya zagruzki s diska nazhmite "Z"');
readln(c);
clrscr;
if c='s' then
begin
writeln('Sozdanie BD. Vvedite ima faila BD (s rasshireniem), naprimer "BD.dat" ');
readln(s);
end
else
begin
writeln('Zagruzka BD. Vvedite ima faila bd (s rasshireniem) naprimer "BD.dat" ');
readln(s);
assign(f,s);
reset(f);
while not eof (f) do
begin
read(f,inf);
v_nachalo(first,inf);
end;
close(f);
end;
v:=false;
while v=false do
begin
writeln('----------------------');
writeln('1-redaktirovat, 2-zadat knigu');
writeln('3-udalenie knigi, 4-poisk');
writeln('5-sortirovka, 6-pechat, 7-viiti');
readln(k);
case k of
1:begin
red(first,s);
end;
2:begin
writeln('vvedite nazvanie knigi');
readln(inf.naz);
writeln('Vvedite imya avtora');
readln(inf.avt);
writeln('Vvedite izdanie');
readln(inf.izd);
writeln('Vvedite god, v formate XXXX');
readln(inf.god);
v_nachalo(first,inf);
sv(first,s);
end;
3:begin
vsp:=first;
t:=first;
writeln('vvedite nazvanie knigi');
readln(n);
while vsp <> nil do
begin
if n=vsp^.inf^.naz then
del(first,t,s);
t:=vsp;
vsp:=vsp^.next;
end;
end;
4:begin
poisk(first);
end;
5:begin
sort(first,s);
end;
6:begin
print(first);
end
else
v:=true;
end;
end;
end;
var
bd:u;
begin
st(bd);
end.Жаль что всего с 2Гб памяти
