Форум программистов
 
Регистрация на форуме тут, о проблемах пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль.

Как купить рекламу на форуме


Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail


Ответ
 
Опции темы Поиск в этой теме
Старый 10.01.2012, 09:41   #1
stas45rus
Пользователь
 
Регистрация: 26.08.2011
Сообщений: 46
По умолчанию Переполнение

Всем здравствуйте. Подскажите пжл. почему программа выдаёт переполнение кучи. Вот код:
Код:
PROGRAM TY;
Uses Crt;
TYPE
  Knot=^PKnot;
  PKnot=Record
         Counter:Longint;
         Symbol:Byte;
         Right,Left:Knot;
         Next,Prev:Knot;
        End;
VAR
  P,X,Root:Knot;
  f:File;
  r:Text;
  ch:Char;
  st:String;

Function InsertList2(Var P,X:Knot; s:Longint; i:Byte):Knot;
Begin
  If P=Nil Then
   begin
     New(P);
     P^.Counter:=s;
     P^.Symbol:=i;
     P^.Next:=Nil;
     P^.Prev:=Nil;
     X:=P;
   end
  Else
   begin
     New(X^.Next);
     X^.Next^.Prev:=X;
     X:=X^.Next;
     X^.Counter:=s;
     X^.Symbol:=i;
     X^.Next:=Nil;
   end;
  InsertList2:=P;
End;

Function SortingList2(P:Knot):Knot;
Var
  s:Longint;
  i:Byte;
  X,N:Knot;
Begin
  X:=P;
  While X<>Nil Do
   begin
     N:=X^.Next;
     While N<>Nil Do
      begin
        If N^.Counter<X^.Counter Then
         begin
           s:=N^.Counter;
           i:=N^.Symbol;
           N^.Counter:=X^.Counter;
           N^.Symbol:=X^.Symbol;
           X^.Counter:=s;
           X^.Symbol:=i;
         end;
        N:=N^.Next;
      end;
     X:=X^.Next;
   end;
  SortingList2:=X;
End;

Procedure AdditionList2(Var P:Knot);
Var
  X:Knot;
  s:Longint;
  i:Byte;
Begin
  X:=P;
  i:=0;
  While (X<>Nil) and (X^.Next<>Nil) Do
   begin
     s:=X^.Counter+X^.Next^.Counter;
     InsertList2(P,X,s,i);
     SortingList2(P);
     X:=X^.Next^.Next;
   end;
End;  

Procedure Print(P:Knot);
Begin
  While P<>Nil Do
   begin
     Writeln(r,P^.Counter,' ',P^.Symbol);
     P:=P^.Next;
   end;
  Writeln(r); 
  While X<>Nil Do
   begin
     Writeln(r,X^.Counter,' ',X^.Symbol);
     X:=X^.Prev;
   end;  
End;

Procedure Compression;
Var
  i,Buf:Byte;
  s:Longint;
Begin
  For i:=0 To 255 Do
   begin
     s:=0;
     While not(eof(f)) Do
      begin
        BlockRead(f,Buf,1);
        If i=Buf Then Inc(s);
      end;
     If eof(f) Then Seek(f,0);
     If s<>0 Then InsertList2(P,X,s,i);
   end;
  SortingList2(P);
  AdditionList2(P);
  Print(P);
End;

BEGIN
 ClrScr;
 Writeln('Для архивации файла нажмите ''a''.');
 Writeln('Для распвковки файла нажмите ''r''.');
 Writeln('Для отмены нажмите любую клавишу.');
 ch:=ReadKey;
 Case ch Of
   #97:begin
         Writeln('Введите полный путь и имя файла:');
         Readln(st);
         Assign(f,st);
         Reset(f,1);
         If FileSize(f)=0 Then Writeln('Файл пуст!!!')
          Else
           begin
             Assign(r,'D:\Kopiya.TXT');
             Rewrite(r);

             Compression;

             Close(r);
           end;
         Close(f);
       end;
  Else Halt;
 end; 
 Readln;
END.
stas45rus вне форума Ответить с цитированием
Старый 11.01.2012, 19:54   #2
ViktorR
Участник клуба
 
Регистрация: 23.10.2010
Сообщений: 1,813
По умолчанию

Каков размер подставляемого файла?
Упаковка делается блоками?
После каждого упакованного блока память надо освобождать от списка.
Т.е. new() - есть, а dispose() - не видно.

Как то так ...
Как-то так, ...
ViktorR вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме 20000 рублей в месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
переполнение буфера goluzov Общие вопросы C/C++ 21 28.11.2011 08:04
переполнение буфера Dimarik Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 1 13.07.2011 01:24
Переполнение стека NoHeart Общие вопросы Delphi 8 08.11.2009 16:03
Переполнение стека Ake Паскаль, Turbo Pascal, PascalABC.NET 3 30.05.2009 21:39
Переполнение Стека Викдон Паскаль, Turbo Pascal, PascalABC.NET 0 19.12.2008 19:16


Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru
Пеллетный котёл Emtas
котлы EMTAS