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

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

Утечка памяти [D7, XP]

Цукор5 ©   (2010-01-26 11:48:00) 

Добрый. Имеем следующее :

unit TCPPart;

interface

uses Classes,WinSock;

type
TTCPPart = packed record
  ClientSocket:TSocket;
  ClientHandle:THandle;
end;
PTCPPart = ^TTCPPart;

type
 TTCPPartList = class(TList)
 private
   function    GetItem (Index: Integer): TTCPPart;
   procedure   SetItem(Index:Integer;Value:TTCPPart);
 public
   constructor Create;
   destructor  Destroy; override;
   property    Items[Index: Integer]: TTCPPart read GetItem write SetItem; default;
   procedure   Clear; override;
   //
   procedure   AddClient(Socket:TSocket;Handle:THandle);
   procedure   DropBySocket(Socket:TSocket);
  end;

implementation

{ TTCPPartList }

procedure TTCPPartList.AddClient(Socket: TSocket; Handle: THandle);
 var P:PTCPPart;
begin
 New(P);
 P^.ClientSocket:=Socket;
 P^.ClientHandle:=Handle;
 inherited Add(P);
end;

procedure TTCPPartList.Clear;
var I: Integer;
begin
 for I := 0 to Count - 1 do
  Dispose(PTCPPart(inherited Items[I])) ;
 inherited Clear;
end;

constructor TTCPPartList.Create;
begin
 inherited Create;
end;

destructor TTCPPartList.Destroy;
begin
 Clear;
 inherited Destroy;
end;

procedure TTCPPartList.DropBySocket(Socket: TSocket);
 var I:Integer;
begin
 for I:=Count-1 downto 0 do
 begin
   if PTCPPart(inherited Items[I]).ClientSocket =Socket then
   begin
     Delete(I);
     Break;
   end;
 end;
end;

function TTCPPartList.GetItem(Index: Integer): TTCPPart;
begin
 Result := PTCPPart(inherited Items[Index])^;
end;

procedure TTCPPartList.SetItem(Index: Integer; Value: TTCPPart);
begin
 PTCPPart(inherited Items[Index])^:=Value;
end;

end.


Вызываю так :

procedure TForm1.Button3Click(Sender: TObject);
 var P:TTCPPartList;
 I:Integer;
begin
P:=TTCPPartList.Create;
P.AddClient(1,1);
P.AddClient(2,2);
P.AddClient(3,3);
P.AddClient(4,4);
P.AddClient(5,5);
//
P.DropBySocket(3);  // имеем утечку в 8 байт( размер TTCPPart)
//
for I:=0 to P.Count-1 do
begin
  Memo1.Lines.Add(Format('%d socket %d',[I,P.Items[I].ClientSocket ]));
end;
//
P.Free;
end;


Как избежать сабжа ?

---

Сергей М.   (2010-01-26 12:46:00) [1]

procedure TTCPPartList.AddClient(Socket: TSocket; Handle: THandle);
var P:PTCPPart;
begin
New(P);
P^.ClientSocket:=Socket;
P^.ClientHandle:=Handle;
inheritedAdd(P); // указание inherited здесь бессмысленно, потому что метод  Add предка в классе TTCPPartList не переопределен и не перекрыт
end;

---

Цукор5   (2010-01-26 12:34:00) [2]

Пардон. [4] не актуально. Разобрался.
а [3] актуально. На счет литературы

---

Цукор5   (2010-01-26 12:13:00) [3]

> Dispose    <------


А с какими параметрами его вызывать-то ?

Dispose(PTCPPart(Items[I])) ;
Dispose(PTCPPart(inherited Items[I])) ;


Все дает ошибку ((

---

Цукор5   (2010-01-26 12:08:00) [4]

2 Ega23 ©   (26.01.10 11:59) [2]

Спасибо!


> Ты слишком злоупотребляешь inherited  Лепишь к месту и не
> к месту.


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

Спасибо!

---

Сергей М.   (2010-01-26 11:59:00) [5]

Каждый вызов New() должен обязательносопровождаться соответствующим вызовом Dispose()

В DropBySocket() он у тебя напрочь отсутствует

---

Ega23   (2010-01-26 11:59:00) [6]

Естественно. Кто память-то освобождать будет?

procedure TTCPPartList.DropBySocket(Socket: TSocket);
var I:Integer;
begin
for I:=Count-1 downto 0 do
begin
  if PTCPPart(inherited Items[I]).ClientSocket =Socket then
  begin
    Dispose    <------
    Delete(I);
    Break;
  end;
end;
end;

З.Ы.
Рекомендую вместо всех этих выкрутасов перекрыть метод Notify
З.З.Ы.
Ты слишком злоупотребляешь inherited Лепишь к месту и не к месту.

---

Наверх