1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Procedure Zanesenie; begin write('Vvedite tabelnii nomer rabotyschego: '); readln(s); write('Vvedite fameliu, imia, otchestvo rabochego: '); readln(d); write('Vvedite mesto raboti, spetsialnost: '); readln(f); write('Vvedite domashnii adres rabotauschego: '); readln(g); end;
Procedure SozdanieTree(var a: Adrzv; s: word; d, f, g: string); var z: Adrzv; j: AdrText; begin if a=Nil then begin New(j); j^.Fio:= d; j^.Work:= f; j^.Adres:= g;
New (z); z^.Key:= s; z^.Lev:= Nil; z^.Prav:= Nil; z^.Adr:=j; a:=z; end else begin if a^.Key>s then SozdanieTree(a^.Lev, s, d, f, g) else SozdanieTree(a^.Prav, s, d, f, g); end; end;
Procedure DelVedomost(var a:Adrzv); begin if a=Nil then exit; DelVedomost(a^.Lev); DelVedomost(a^.Prav); dispose(Adr); Adr:=Nil; dispose(a); a:=Nil; end;
Вопрос: правильно ли проведена очистка памяти (память должна возвращаться в кучу перед завершением работы программы)? Возникает ошибка при выполнении удаления адреса a^.Adr.
var i, m, q: byte; s, x: word; d, g, f: string[70]; a, Tree: Adrzv; j: AdrText;
W: File of Tabl; Wzveno: Tabl;
Procedure Pravila; begin write('--------------------------------------------------------------------------------'); writeln('Dlia povtornogo oznakomlenia s pravilami nazmite 11: '); writeln('Dlia formirovania dereva nazmite 1: '); writeln('Dlia priamogo vivoda spiska na ekran nazmite 2: '); writeln('Dlia obratnogo vivoda spiska na ekran nazmite 3: '); writeln('Dlia simmetrichnogo vivoda spiska na ekran nazmite 4: '); writeln('Dlia dobavlenia elementa v spisok nazmite 5: '); writeln('Dlia ydalenia elementa iz spiska nazmite 6: '); writeln('Dlia poisca elementa nazmite 7: '); writeln('Dlia zapis v fail nazmite 8: '); writeln('Dlia vivoda iz faila nazmite 9: '); writeln('Dlia vixoda iz programmi nazmite 0: '); write('--------------------------------------------------------------------------------'); end;
Procedure Zanesenie; begin write('Vvedite tabelnii nomer rabotyschego: '); readln(s); write('Vvedite fameliu, imia, otchestvo rabochego: '); readln(d); write('Vvedite mesto raboti, spetsialnost: '); readln(f); write('Vvedite domashnii adres rabotauschego: '); readln(g); end;
Procedure SozdanieTree(var a: Adrzv; s: word; d, f, g: string); var z: Adrzv; j: AdrText; begin if a=Nil then begin New(j); j^.Fio:= d; j^.Work:= f; j^.Adres:= g;
New (z); z^.Key:= s; z^.Lev:= Nil; z^.Prav:= Nil; z^.Adr:=j; a:=z; end else begin if a^.Key>s then SozdanieTree(a^.Lev, s, d, f, g) else SozdanieTree(a^.Prav, s, d, f, g); end; end;
Function Proverka(a: Adrzv): boolean; begin if a=Nil then Proverka:=false else Proverka:=true; end;
Procedure PrintPriam(a: Adrzv); var Adr: AdrText; begin if a<>Nil then begin write('--------------------------------------------------------------------------------'); Writeln('Tabelnii nomer:',a^.Key,' FIO: ', a^.Adr^.Fio); {Writeln('FIO: ', a^.Adr^.Fio); } writeln('Work: ', a^.Adr^.Work,' Adres: ', a^.Adr^.Adres); {writeln('Adres: ', a^.Adr^.Adres);} PrintPriam(a^.Lev); PrintPriam(a^.Prav); end; end;
Procedure PrintObratn(a: Adrzv); var Adr: AdrText; begin if a<>Nil then begin PrintObratn(a^.Lev); PrintObratn(a^.Prav); write('--------------------------------------------------------------------------------'); Writeln('Tabelnii nomer:',a^.Key); Writeln('FIO: ', a^.Adr^.Fio); writeln('Work: ', a^.Adr^.Work); writeln('Adres: ', a^.Adr^.Adres); end; end;
Procedure PrintSimmetr(a: Adrzv); var Adr: AdrText; begin if a<>Nil then begin PrintSimmetr(a^.Lev); write('--------------------------------------------------------------------------------'); Writeln('Tabelnii nomer:',a^.Key); Writeln('FIO: ', a^.Adr^.Fio); writeln('Work: ', a^.Adr^.Work); writeln('Adres: ', a^.Adr^.Adres); PrintSimmetr(a^.Prav); end; end;
Function FindElement(var a: Adrzv; s: word):Adrzv; begin if a=Nil then FindElement:=Nil else begin if s=a^.Key then FindElement:=a else if s<a^.Key then FindElement:=FindElement(a^.Lev, s) else FindElement:=FindElement(a^.Prav, s); end; end;
Procedure PrintElement(FindElement: Adrzv); begin
if FindElement=Nil then writeln('Rabotauschego c takim tabelnim nomerom net.') else begin write('--------------------------------------------------------------------------------'); Writeln('Tabelnii nomer: ',FindElement^.Key); Writeln('FIO: ', FindElement^.Adr^.Fio); writeln('Work: ', FindElement^.Adr^.Work); writeln('Adres: ', FindElement^.Adr^.Adres); write('--------------------------------------------------------------------------------'); end; end;
Procedure DelElement1(var a: Adrzv; S: word); var Q:Adrzv;
Procedure Ud(var E: Adrzv); begin if E^.Prav=Nil then begin Q^.Key:=E^.Key; Q^.Adr:=E^.Adr; Q:=E; E:=Q^.Lev; dispose(Q); End else Ud(E^.Prav); end;
begin if a=Nil then writeln('Rabotauschego c takim tabelnim nomerom net.') else begin if s<a^.Key then DelElement1(a^.Lev, s) else if s>a^.Key then DelElement1(a^.Prav, s) else begin if (a^.Lev=Nil) and (a^.Prav<>Nil) then begin Q:=a; a:=a^.Prav;
dispose(Q); end else
if (a^.Lev<>Nil) and (a^.Prav=Nil) then begin Q:=a; a:=a^.Lev;
dispose(Q); end else
if (a^.Lev=Nil) and (a^.Prav=Nil) then begin
dispose(a); a:=Nil;
end else
if (a^.Lev<>Nil) and (a^.Prav<>Nil) then begin Q:=a; Ud(Q^.Lev); end; END; end; end;
Procedure Prisvoenie(var a:Adrzv); var Adr: AdrText; begin if a<>Nil then begin Wzveno.Key:=a^.Key; Wzveno.FIO:=a^.Adr^.Fio; Wzveno.Work:=a^.Adr^.Work; Wzveno.Adres:=a^.Adr^.Adres; Write(W, Wzveno); Prisvoenie(a^.Lev); Prisvoenie(a^.Prav); end; end;
Procedure Infail(var a:Adrzv); var Adr: AdrText; begin assign(W,'Tree.Pas'); rewrite(W); Prisvoenie(a); close(W); writeln('Cpisok yspeshno soxranen'); end;
Procedure Izfail(var a: Adrzv); begin Assign(W,'Tree.PAS'); {$I-} Reset(W); {$I+} if ioresult<>0 then writeln('Fail ne naiden') else begin if eof(W) then writeln('Fail pust') else begin a:=Nil; repeat read(W,Wzveno); SozdanieTree(a, Wzveno.Key, Wzveno.FIO, Wzveno.Work, Wzveno.Adres); until eof(W); end; close(W); end; end;
Procedure DelVedomost(var a:Adrzv); begin if a=Nil then exit; DelVedomost(a^.Lev); DelVedomost(a^.Prav); dispose(a^.Adr); a^.Adr:=Nil; dispose(a); a:=Nil; end;
begin ClrScr; writeln('Vnimatelno izychite i zapomnite dannyy informatiy'); Pravila; repeat write('Vvedite nomer komandi: '); readln(m);
case m of 11: Pravila; 1: begin DelVedomost(Tree);
Tree:=Nil; writeln('Vvedite kollichestvo chelovek: '); readln(q); for i:=1 to q do begin Zanesenie; SozdanieTree (Tree, s, d, f, g); end; end; 2: begin if Proverka(Tree) then begin PrintPriam(Tree); write('--------------------------------------------------------------------------------'); end else writeln('Oshibka! Spiska ne suschestvuet.'); end; 3: begin if Proverka(Tree) then begin PrintObratn(Tree); write('--------------------------------------------------------------------------------'); end else writeln('Oshibka! Spiska ne suschestvuet.'); end; 4: begin if Proverka(Tree) then begin PrintSimmetr(Tree); write('--------------------------------------------------------------------------------'); end else writeln('Oshibka! Spiska ne suschestvuet.'); end; 5: begin if Proverka(Tree) then begin write('Vvedite dobavliaemoe kollichestvo chelovek: '); readln(q); for i:=1 to q do begin Zanesenie; SozdanieTree (Tree, s, d, f, g); end; end else writeln('Oshibka! Spiska ne suschestvuet.'); end; 6: begin if Proverka(Tree) then begin write('Vvedite tabelnii nomer rabochego: ' ); read(s); PrintElement(FindElement(Tree, s)); end else writeln('Oshibka! Spiska ne suschestvuet.'); end; 7: begin if Proverka(Tree) then begin write('Vvedite tabelnii nomer rabochego: ' ); read(s);
DelElement1(Tree, S);
if Proverka(Tree) then begin writeln('Izmenennii spisok:'); PrintPriam(Tree); write('--------------------------------------------------------------------------------'); end else writeln('Oshibka! Spiska ne suschestvuet.');
END; end; 8: begin if Proverka(Tree) then Infail(Tree) else writeln('Oshibka! Spiska ne suschestvuet.'); end; 9: begin DelVedomost(Tree); Izfail(Tree); PrintPriam(Tree); write('--------------------------------------------------------------------------------'); end;
Правила форума
Прочтите прежде чем задавать вопрос!
