Форум: "Начинающим";
Текущий архив: 2010.03.28;
Скачать: [xml.tar.bz2];

Вниз

Утечка памяти   Найти похожие ветки 

← →
Цукор5   (2010-01-26 11:48) [0]

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

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 11:59) [1]

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

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

---

← →
Ega23 ©   (2010-01-26 11:59) [2]

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

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  Лепишь к месту и не к месту.

---

← →
Цукор5   (2010-01-26 12:08) [3]

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

Спасибо!


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


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

Спасибо!

---

← →
Цукор5   (2010-01-26 12:13) [4]

> Dispose    <------


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

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


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

---

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

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

---

← →
Сергей М. ©   (2010-01-26 12:46) [6]

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

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2010.03.28;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.004 c