Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Проблема с освобождением памяти [D5, Win2k]


Страницы:   1 2 3

Duncan ©   (2004-06-16 15:23:00) 

Я создаю список, через некоторое время кидаю его в БД и освобождаю. Но в результате оперативка тает на глазах и не освобождается. Освобождается она только после завершения программы, но т.к. мне нужен сервис, то соответственно постоянно оперативка пожирается при попытке обработать очередной файл. Вот структура и процедура уничтожения списка:

//По горизонтали идет идут данные PTIP_B, для каждого из которого в низ идут данные типа PTIP_A.
type Traf=record
 IP_A, IP_B:longword;
 ASN_A, ASN_B, INT_A, INT_B:word;
 BYTES_A, BYTES_B: longword;
 DT: TDateTime;
 end;

 PTIP_A=^TIP_A;
 TIP_A=record
   down:PTIP_A;
   IP_A:longword;
   INT_A, int_B, ASN_A, ASN_B:word;
   BYTES_A, BYTES_B: longword;
   DT: TDateTime;
   end;

 PTIP_B=^TIP_B;
 TIP_B=record
   next:PTIP_B;
   down:PTIP_A;
   IP_B:longword;
   end;

procedure SaveAndDestroy;
var
 i, count:integer;
 p,p1:PTIP_B;
 a,a1:PTIP_A;
begin
 new(p);
 wtr.StartTransaction;
 for i:=0 to 255 do begin
   p:=arrpoint[i];
   while (p<>nil) do begin
     new(a); a:=p^.down;
     while (a<>nil) do begin
       with qIns do begin
         //Пишем в бд
         end;
       inc(count);
       if count>700 then begin
         wtr.Commit; count:=count-700;
         wtr.StartTransaction; end;
       new(a1); a1:=a;
       a:=a^.down; dispose(a1);
       end;
     dispose(a); new(p1);
     p1:=p; p:=p^.next; dispose(p1); end;
   arrpoint[i]:=nil; end;
 wtr.Commit;
 dispose(p);
end;

cyborg   (2004-06-17 17:42:00) [1]

Чтобы присвоить значения, которые хранятся по указателям нужно не p:=zделать, а использовать Move(P^,Z^,SizeOf(Z));

Duncan   (2004-06-17 16:06:00) [2]

Спасибо всем кто пытался помочь.

Duncan   (2004-06-17 16:00:00) [3]

Sandman25 ©   (17.06.04 15:46) [38]

Может и заставит :) Но такие механические действия не должны влиять на логику работы с памятью :( Вообщем буду еще как-то пытаться ковырять эту лабуду.

Sandman25   (2004-06-17 15:46:00) [4]

[37] Duncan   (17.06.04 15:24)

а вот дальше уже самостоятельно. Может эта мука с отладкой заставит Вас использовать процедуры вместо копирования кусков кода.

Duncan   (2004-06-17 15:24:00) [5]

Ну да лоханулся, поменял на следующий вид, но ничего не изменилось
procedure AddIP_A(var d1:PTIP_A);
var q_a,d,q:PTIP_A;
 l:integer;
begin
  l:=0; new(q_a);
 if (d1=nil) or (d1^.IP_A>tr.IP_A) then begin
   q_a^.down:=d1; d1:=q_a;
   q_a^.IP_A:=tr.IP_A; q_a^.INT_A:=tr.INT_A;
   q_a^.int_B:=tr.INT_B; q_a^.ASN_A:=tr.ASN_A; q_a^.ASN_B:=tr.ASN_B;
   q_a^.BYTES_A:=tr.BYTES_A; q_a^.BYTES_B:=tr.BYTES_B; q_a^.DT:=tr.DT end
 else begin
  q:=d1; d:=q;
 while (q<>nil) do begin
   l:=l+1;
   if q^.IP_A<tr.IP_A then begin d:=q; q:=Q^.down; end
   else if q^.IP_A>tr.IP_A then begin
     q_a^.down:=q;
     if l>1 then d^.down:=q_a else d1:=q_a;
     q_a^.IP_A:=tr.IP_A; q_a^.INT_A:=tr.INT_A;
     q_a^.int_B:=tr.INT_B; q_a^.ASN_A:=tr.ASN_A; q_a^.ASN_B:=tr.ASN_B;
     q_a^.BYTES_A:=tr.BYTES_A; q_a^.BYTES_B:=tr.BYTES_B; q_a^.DT:=tr.DT;
     break end
     else if q^.INT_A<tr.INT_A then begin d:=q; q:=Q^.down; end
       else if q^.INT_A>tr.INT_A then begin
         q_a^.down:=q;
         if l>1 then d^.down:=q_a else d1:=q_a;
         q_a^.IP_A:=tr.IP_A; q_a^.INT_A:=tr.INT_A;
         q_a^.int_B:=tr.INT_B; q_a^.ASN_A:=tr.ASN_A; q_a^.ASN_B:=tr.ASN_B;
         q_a^.BYTES_A:=tr.BYTES_A; q_a^.BYTES_B:=tr.BYTES_B; q_a^.DT:=tr.DT;
         break end
         else if q^.INT_B<tr.INT_B then begin d:=q; q:=Q^.down; end
           else if q^.INT_B>tr.INT_B then begin
             q_a^.down:=q;
             if l>1 then d^.down:=q_a else d1:=q_a;
             q_a^.IP_A:=tr.IP_A; q_a^.INT_A:=tr.INT_A;
             q_a^.int_B:=tr.INT_B; q_a^.ASN_A:=tr.ASN_A; q_a^.ASN_B:=tr.ASN_B;
             q_a^.BYTES_A:=tr.BYTES_A; q_a^.BYTES_B:=tr.BYTES_B; q_a^.DT:=tr.DT;
             break end
               else if q^.ASN_A<tr.ASN_A then begin d:=q; q:=Q^.down; end
                 else if q^.ASN_A>tr.ASN_A then begin
                   q_a^.down:=q;
                   if l>1 then d^.down:=q_a else d1:=q_a;
                   q_a^.IP_A:=tr.IP_A; q_a^.INT_A:=tr.INT_A;
                   q_a^.int_B:=tr.INT_B; q_a^.ASN_A:=tr.ASN_A; q_a^.ASN_B:=tr.ASN_B;
                   q_a^.BYTES_A:=tr.BYTES_A; q_a^.BYTES_B:=tr.BYTES_B; q_a^.DT:=tr.DT;
                   break; end
                   else if q^.ASN_B<tr.ASN_B then begin d:=q; q:=Q^.down; end
                     else if q^.ASN_B>tr.ASN_B then begin
                       q_a^.down:=q;
                       if l>1 then d^.down:=q_a else d1:=q_a;
                       q_a^.IP_A:=tr.IP_A; q_a^.INT_A:=tr.INT_A;
                       q_a^.int_B:=tr.INT_B; q_a^.ASN_A:=tr.ASN_A; q_a^.ASN_B:=tr.ASN_B;
                       q_a^.BYTES_A:=tr.BYTES_A; q_a^.BYTES_B:=tr.BYTES_B; q_a^.DT:=tr.DT;
                       break end
                       else begin
                         q^.BYTES_A:=q^.BYTES_A+tr.BYTES_A;
                         q^.BYTES_B:=q^.BYTES_B+tr.BYTES_B;
                          dispose(q_a);
                         break end; end;
 if (q=nil) then begin
   q_a^.down:=q; d^.down:=q_a;
   q_a^.IP_A:=tr.IP_A; q_a^.INT_A:=tr.INT_A;
   q_a^.int_B:=tr.INT_B; q_a^.ASN_A:=tr.ASN_A; q_a^.ASN_B:=tr.ASN_B;
   q_a^.BYTES_A:=tr.BYTES_A; q_a^.BYTES_B:=tr.BYTES_B; q_a^.DT:=tr.DT end
 end
end;

Sandman25   (2004-06-17 15:01:00) [6]

То есть new(d)

Sandman25   (2004-06-17 14:59:00) [7]

Ну вот, Вам же говорили про ошибку в другом месте :)

new(q_a); new(d); new(q);
d:=q; l:=0;

и как Вы после этого собираетесь освобождать память, занятую при new(q)?

Duncan   (2004-06-17 14:57:00) [8]

Аналогично только добавляется ветка вниз:

procedure AddIP_A(var d1:PTIP_A);
var q_a,d,q:PTIP_A;
 l:integer;
begin
 new(q_a); new(d); new(q);
 d:=q; l:=0;
 if (d1=nil) or (d1^.IP_A>tr.IP_A) then begin //Если список пуст или надо добавить в начале
   q_a^.down:=d1; d1:=q_a;
   q_a^.IP_A:=tr.IP_A; q_a^.INT_A:=tr.INT_A;
   q_a^.int_B:=tr.INT_B; q_a^.ASN_A:=tr.ASN_A; q_a^.ASN_B:=tr.ASN_B;
   q_a^.BYTES_A:=tr.BYTES_A; q_a^.BYTES_B:=tr.BYTES_B; q_a^.DT:=tr.DT end
 else begin
 q:=d1;
 while (q<>nil) do begin //Пока не конец
   l:=l+1; //Отслеживаем уровень
   if q^.IP_A<tr.IP_A then begin d:=q; q:=Q^.down; end //Спускаемся вниз
   else if q^.IP_A>tr.IP_A then begin //иначе добавляем
     q_a^.down:=q;
     if l>1 then d^.down:=q_a else d1:=q_a;
     q_a^.IP_A:=tr.IP_A; q_a^.INT_A:=tr.INT_A;
     q_a^.int_B:=tr.INT_B; q_a^.ASN_A:=tr.ASN_A; q_a^.ASN_B:=tr.ASN_B;
     q_a^.BYTES_A:=tr.BYTES_A; q_a^.BYTES_B:=tr.BYTES_B; q_a^.DT:=tr.DT;
     break
     end //Дальше аналогично только для других параметров
     else if q^.INT_A<tr.INT_A then begin d:=q; q:=Q^.down; end
       else if q^.INT_A>tr.INT_A then begin
         q_a^.down:=q;
         if l>1 then d^.down:=q_a else d1:=q_a;
         q_a^.IP_A:=tr.IP_A; q_a^.INT_A:=tr.INT_A;
         q_a^.int_B:=tr.INT_B; q_a^.ASN_A:=tr.ASN_A; q_a^.ASN_B:=tr.ASN_B;
         q_a^.BYTES_A:=tr.BYTES_A; q_a^.BYTES_B:=tr.BYTES_B; q_a^.DT:=tr.DT;
         break end
         else if q^.INT_B<tr.INT_B then begin d:=q; q:=Q^.down; end
           else if q^.INT_B>tr.INT_B then begin
             q_a^.down:=q;
             if l>1 then d^.down:=q_a else d1:=q_a;
             q_a^.IP_A:=tr.IP_A; q_a^.INT_A:=tr.INT_A;
             q_a^.int_B:=tr.INT_B; q_a^.ASN_A:=tr.ASN_A; q_a^.ASN_B:=tr.ASN_B;
             q_a^.BYTES_A:=tr.BYTES_A; q_a^.BYTES_B:=tr.BYTES_B; q_a^.DT:=tr.DT;
             break end
               else if q^.ASN_A<tr.ASN_A then begin d:=q; q:=Q^.down; end
                 else if q^.ASN_A>tr.ASN_A then begin
                   q_a^.down:=q;
                   if l>1 then d^.down:=q_a else d1:=q_a;
                   q_a^.IP_A:=tr.IP_A; q_a^.INT_A:=tr.INT_A;
                   q_a^.int_B:=tr.INT_B; q_a^.ASN_A:=tr.ASN_A; q_a^.ASN_B:=tr.ASN_B;
                   q_a^.BYTES_A:=tr.BYTES_A; q_a^.BYTES_B:=tr.BYTES_B; q_a^.DT:=tr.DT;
                   break; end
                   else if q^.ASN_B<tr.ASN_B then begin d:=q; q:=Q^.down; end
                     else if q^.ASN_B>tr.ASN_B then begin
                       q_a^.down:=q;
                       if l>1 then d^.down:=q_a else d1:=q_a;
                       q_a^.IP_A:=tr.IP_A; q_a^.INT_A:=tr.INT_A;
                       q_a^.int_B:=tr.INT_B; q_a^.ASN_A:=tr.ASN_A; q_a^.ASN_B:=tr.ASN_B;
                       q_a^.BYTES_A:=tr.BYTES_A; q_a^.BYTES_B:=tr.BYTES_B; q_a^.DT:=tr.DT;
                       break end
                       else begin
                         q^.BYTES_A:=q^.BYTES_A+tr.BYTES_A;
                         q^.BYTES_B:=q^.BYTES_B+tr.BYTES_B;
                         break end; end;
 if (q=nil) then begin //Если мы дошли до конца списка
   q_a^.down:=q; d^.down:=q_a;
   q_a^.IP_A:=tr.IP_A; q_a^.INT_A:=tr.INT_A;
   q_a^.int_B:=tr.INT_B; q_a^.ASN_A:=tr.ASN_A; q_a^.ASN_B:=tr.ASN_B;
   q_a^.BYTES_A:=tr.BYTES_A; q_a^.BYTES_B:=tr.BYTES_B; q_a^.DT:=tr.DT end
 end
end;

Sandman25   (2004-06-17 14:49:00) [9]

[32] Duncan   (17.06.04 14:39)

Это тоже вроде правильно, за исключением многократного дублирования, усложняющего понимание и поиск ошибок. А в AddIP_A что делается?

Duncan   (2004-06-17 14:39:00) [10]

Ну вот так у меня все это дело формируется:

      p^.next:=arrpoint[tr.ip_b div 16777216];
      if (p^.next<>nil) and (p^.next^.IP_B<=tr.IP_B) then begin //Если список не пуст
         p:=p^.next; q:=p;
        if p^.IP_B=tr.IP_B then AddIP_A(p^.down) //Добавляем ветку вниз
        else begin
          p:=p^.next;
          while (p<>nil) do //Идем горизонтально по списку
            if p^.IP_B=tr.IP_B then begin
              AddIP_A(p^.down); break; //Нашелся одинаковый элемент, добавляем ветку вниз
            end
            else if p^.IP_B<tr.IP_B then begin
              q:=p; p:=p^.next; //Пока значение меньше переходим дальше по списку
              end
              else begin //иначе вставляем элемент между предыдущим (q) и текущим элементом (p)
                new(q_b); q_b^.next:=p;
                q^.next:=q_b; q_b^.IP_B:=tr.IP_B;
                q_b^.down:=nil; AddIP_A(q_b^.down);
                break end;
          if (p=nil) then begin //Если конец списка
            new(q_b); q_b^.next:=p;
            q^.next:=q_b; q_b^.IP_B:=tr.IP_B;
            q_b^.down:=nil; AddIP_A(q_b^.down); end;
        end end
      else begin //Либо пустой список, либо после головы списка вставлять надо
        new(q_b); q_b^.next:=p^.next; q_b^.IP_B:=tr.IP_B;
        arrpoint[tr.ip_b div 16777216]:=q_b;
        q_b^.down:=nil; AddIP_A(q_b^.down); end;
      p:=nil;

Тимохов   (2004-06-17 14:28:00) [11]


> Вообщем если есть возможность и желание давай пообщаемся
> в аське 24753812.

аська у меня закрыта.

Вообще-то это не совсем список. Не знаю как по науке это назвается, я бы назвал двумерный список.

Я вряд ли тебе помогу - надо копать остальные исходники, а на это времени нет :(

Еще раз говорю - проверьте логику заполнения списка. Она должно соответствовать логике освобожденя списка. С учетом того, что в первоначальном вашем методе была масса ошибок - думаю при заполнении списка их не меньше.

Duncan   (2004-06-17 14:21:00) [12]

В том то все и дело, что в массиве arrpoint храняться так называемые головы (head) списков. Их всего 256 штук. Соответственно каждый из них указывает на элемент типа PTIP_B.
Единственное что массив описан так: ArrPoint: array [0..255] of Pointer;
При этом если бы они только не освобождались то потерялось бы не так много памяти.
Вообщем если есть возможность и желание давай пообщаемся в аське 24753812.

Тимохов   (2004-06-17 14:13:00) [13]


>  Причем я уверен, что проблема именно в этом месте.

зря уверены. в самом коде ничего криминального нет.
я тоже уверен.
смотрите внимательнее как вы создаете arrpoint. проверьте глазами соответствует ли логика освобождения массива логике заполнения массива?

Duncan   (2004-06-17 14:01:00) [14]

Тимохов ©   (17.06.04 13:52) [27]

Я ужастно дико извиняюсь, понимаю что всех уже достал тут, но очень надо. Причем я уверен, что проблема именно в этом месте. Могу прислать исходники если они помогут, хотя они написаны опять таки в стиле удобном мне для чтения.

Тимохов   (2004-06-17 13:52:00) [15]


> Duncan   (17.06.04 13:40) [25]

судя по всему ошибка в другом месте

Тимохов   (2004-06-17 13:51:00) [16]


> С уважением, Анатолий!

сомневаюсь

Duncan   (2004-06-17 13:40:00) [17]

Digitman ©   (16.06.04 17:33) [24]

Спасибо, мне это итак уже здесь разжували ...
Но вот только никто толком не смог мне сказать как память списка очистить. А если Вы считаете что я тупой, то будьте любезны потратьте 5-7 минут и модифицируйте мой неправильный код в более верный.


procedure SaveAndDestroy;
var
 i:integer;
 p,p1:PTIP_B;
 a,a1:PTIP_A;
begin
for i:=0 to 255 do begin
  p:=arrpoint[i];
  while (p<>nil) do begin
    a:=p^.down;
    while (a<>nil) do begin
      a1:=a^.down;
      dispose(a);
      a:=a1;
    end;
    p1:=p^.next;
    dispose(p);
    p:=p1;
  end;
  arrpoint[i]:=nil; end;
end;


С уважением, Анатолий!
P.S. Заранее огромное спасибо!

Digitman   (2004-06-16 17:33:00) [18]


> Duncan   (16.06.04 15:36) [5]
Просто я это в универе проходил
> .., но мы там вроде именно так и писали


если ты в "универе" не постиг банальной истины а-ля

New(P);
//до момента Dispose() не трожь кривыми руками указательную переменную Р ! И неважно, цикл или не цикл !
....
Dispose(Р);

Sandman25   (2004-06-16 17:18:00) [19]

[22] Duncan   (16.06.04 17:11)

Вроде все правильно, насколько я понимаю. Может, где-то еще память выделяется.

Duncan   (2004-06-16 17:11:00) [20]

Написал процедуру следующим образом, но ничего не помогает, память по прежнему расходуется.

procedure SaveAndDestroy;
var
 i, count:integer;
 p,p1:PTIP_B;
 a,a1:PTIP_A;
begin
 wtr.StartTransaction;
 for i:=0 to 255 do begin
   p:=arrpoint[i];
   while (p<>nil) do begin
     a:=p^.down;
     while (a<>nil) do begin
       with qIns do begin
         ParamByName('IP_A').AsInt64:=a^.IP_A; ParamByName('IP_B').AsInt64:=p^.IP_B;
         ParamByName('ASN_A').AsInteger:=a^.ASN_A; ParamByName('ASN_B').AsInteger:=a^.ASN_B;
         ParamByName('INT_A').AsInteger:=a^.INT_A; ParamByName('INT_B').AsInteger:=a^.INT_B;
         ParamByName('BYTES_A').AsInt64:=a^.BYTES_A; ParamByName('BYTES_B').AsInt64:=a^.BYTES_B;
         ParamByName('DT').AsDateTime:=a^.DT; ExecQuery end;
       inc(count);
       if count>700 then begin
         wtr.Commit; count:=count-700;
         wtr.StartTransaction; end;
       a1:=a^.down; dispose(a);
       a:=a1; end;
     p1:=p^.next; dispose(p);
     p:=p1; end;
   arrpoint[i]:=nil; end;
 wtr.Commit;
end;

Страницы:   1 2 3

Наверх

Титульная страница Поиск, карта сайта Написать письмо