线程、内存泄露问题 顺便过年散分

[zhuminghua]

同事写的一个简单的测试程序，用定时器往TList里加对象，另外开一个线程进行扫描TList，发现里面有对象就释放掉对象。但是时间长了会内存泄露，在任务管理器里可以看到进程不断增加。看了半天没找出问题，代码如下：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;


type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Timer1: TTimer;
    Button3: TButton;
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses
  Unit2;

var
  mythread:repthread;


{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
var
  newtestclass:testclass;
begin
  mythread.cs.Enter;
  newtestclass:=testclass.Create;
  newtestclass.val:=100;
//  newtestclass.buflen:=100;
//  setlength(newtestclass.buf,newtestclass.buflen);
  mythread.replist.Add(newtestclass);
  mythread.cs.Leave;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Timer1.Enabled:=true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Timer1.Enabled:=false;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  mythread:=repthread.Create(false);
end;

end.

unit Unit2;

interface

uses
  Classes,SyncObjs,SysUtils;

type
  testclass=class
    val:integer;
//    buf:array of byte;
//    buflen:integer;
//    public
//    destructor  Destroy; override;
  end;
type
  repthread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  public
    replist:TLIST;
    RUNing:boolean;
    cs:TCriticalSection;
  end;

implementation

uses Unit1;

{ repthread }

procedure repthread.Execute;
var
  ACTtestclass:testclass;
  Index: Integer;
begin
  { Place thread code here }
  replist:=TLIST.Create;
  RUNing:=true;
  cs:=TCriticalSection.Create;
  while RUNing do
  begin
    cs.Enter;
    if replist.Count>0 then
    begin
     { ACTtestclass:=testclass(replist.Items[0]);
      replist.Delete(0);
//      setlength(ACTtestclass.buf,0);
      ACTtestclass.Destroy;
      replist.Pack;     }
      Index := RepList.Count - 1;
      if RepList.Items[Index] <> nil then
      begin
        TObject(RepList.Items[Index]).Free;
        RepList.Delete(Index);
      end;
    end
    else
    begin
      sleep(100);
    end;
    cs.Leave;
  end;
  cs.Free;
end;


{destructor testclass.Destroy;
begin
  inherited;
end;}
end.

[starluck]

unit Unit2;

interface

uses
  Classes,SyncObjs,SysUtils;

type
  testclass=class
    val:integer;
//    buf:array of byte;
//    buflen:integer;
//    public
//    destructor  Destroy; override;
  end;
type
  repthread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  public
    replist:TLIST;
    RUNing:boolean;
    cs:TCriticalSection;
    constructor Create(CreateSuspended: Boolean); overload;
  end;

implementation

uses Unit1;

{ repthread }
procedure repthread.Create(CreateSuspended: Boolean);
begin
  inherited create; 
 { Place thread code here }
  replist:=TLIST.Create;
  RUNing:=true;
  cs:=TCriticalSection.Create;  // 建立臨界限   ，如果放在EXECUTE裏那不亂了。
end;

procedure repthread.Execute;
var
  ACTtestclass:testclass;
  Index: Integer;
begin

  while RUNing do
  begin
    cs.Enter;
    if replist.Count>0 then
    begin
     { ACTtestclass:=testclass(replist.Items[0]);
      replist.Delete(0);
//      setlength(ACTtestclass.buf,0);
      ACTtestclass.Destroy;
      replist.Pack;     }
      Index := RepList.Count - 1;
      if RepList.Items[Index] <> nil then
      begin
        TObject(RepList.Items[Index]).Free;
        RepList.Delete(Index);
      end;
    end
    else
    begin
      sleep(100);
    end;
    cs.Leave;
  end;
  cs.Free;
end;


{destructor testclass.Destroy;
begin
  inherited;
end;}
end.

[金卯刀]

procedure TForm1.Timer1Timer(Sender: TObject);//后面執行這個事件
var
newtestclass:testclass;
begin
mythread.cs.Enter; //在主線程執行時，調用子線程的東西，這時系統會是什么狀況？
newtestclass:=testclass.Create;
newtestclass.val:=100;
// newtestclass.buflen:=100;
// setlength(newtestclass.buf,newtestclass.buflen);
mythread.replist.Add(newtestclass);
mythread.cs.Leave;
end;
procedure TForm1.Button3Click(Sender: TObject);//你應該是先執行這個事件
begin
mythread:=repthread.Create(false);
end;

線程代碼中的臨界區以及list的創建是在execute中的，應該是屬于線程的范疇。
你可以把這兩個對象放到子線程的create構造方法里面，或者放到主線程創建，這樣應該就不會有問題了。

[bdmh]

临界设置是有点问题
放到Execute外创建

[金卯刀]

10樓的答案應該可以，修正一下十一樓的，手誤：
應該是屬于子線程的范疇

[starluck]

問題太大了，再改進下；

unit Unit2;

interface

uses
  Classes,SyncObjs,SysUtils;

type
  testclass=class
    val:integer;
//    buf:array of byte;
//    buflen:integer;
//    public
//    destructor  Destroy; override;
  end;
type
  repthread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  public
    replist:TLIST;
    RUNing:boolean;
    cs:TCriticalSection;
    constructor Create(CreateSuspended: Boolean); overload;
    destructor Destroy; override;
  end;

implementation

uses Unit1;

{ repthread }
procedure repthread.Create(CreateSuspended: Boolean);
begin
  inherited create; 
 { Place thread code here }
  replist:=TLIST.Create;
  RUNing:=true;
  cs:=TCriticalSection.Create;  // 建立臨界限   ，如果放在EXECUTE裏那不亂了。
end;

destructor repthread.Destroy;
begin
  Runing := false;
  if Assigned(repList) then FreeAndNil(repList);
  cs.free;
  inherited Destroy;
end;

procedure repthread.Execute;
var
  ACTtestclass:testclass;
  Index: Integer;
begin

  while RUNing do
  begin
    cs.Enter;
    if replist.Count>0 then
    begin
      Index := RepList.Count - 1;
      if RepList.Items[Index] <> nil then
      begin
        TObject(RepList.Items[Index]).Free;
        RepList.Delete(Index);
      end;
    end
    else
    begin
      sleep(100);
    end;
    cs.Leave;
  end;
end;


{destructor testclass.Destroy;
begin
  inherited;
end;}
end.

[zhuminghua]

就算将TCriticalSection和TList对象放到Create里面，还是会有内存泄露的，你们可以试试看的

[bdmh]

你的泄露程度有多少,如果只是很小的连续增长,也算正常,因为在程序高速运行时,数据的计算必定要占用内存,而释放是需要时间的,内存没有立即的减小,是可以理解的

所以你要看你程序的泄露程度,如果内存没有疯狂的增长,而且可以回落,应该算正常

[zhuminghua]

10几分钟涨了40几K，如果长时间跑，程序肯定会死掉的

[starluck]

要注意的你 testclass 有沒有申請其它的內存，在FREE的時候是不是沒有釋放。

還有內存增加過快，釋放需要一定的時間。

[金卯刀]

综合timer时间间隔、线程优先级和临界区等其他因素考虑，子线程得到释放主 线程对象的机会有多少呢？当然还要考虑楼上的说法

[zhuminghua]

汗，要怎么注意啊，10几行代码摆就在那，肯定是没用申请其它内存啊

[simonhehe]

oo
楼上几位这是不过年了啊

[金卯刀]

哈哈，我明天才回家过年。
楼主，把timer时间间隔，设长一点，再看内存状况

[starluck]

[Quote=引用 22 楼 Avan_Lau 的回复:]
哈哈，我明天才回家过年。
楼主，把timer时间间隔，设长一点，再看内存状况
[/Quote]


要不就把時間調長點，看內存的情況吧。

[舞台中央的我]

好长阿 ！ 县学习 ！

[fjtxwd]

顶

[zhuminghua]

自己丁页

[lenism521]

我也遇到过这个问题！~ 某个对象没有释放或者释放不是时候。。 你那个临界区没必要在线程执行过程里创建再释放掉！~应该在线程初始化里创建。注意你的timer里还用到临界区呢！~ 解决办法：你把线程里的cs.Free去掉！~临界区初始化在线程初始化里创建！

[liangpei2008]

  //应该是线程同步的问题，用ThreadList做多好，LZ非要自己实现一遍ThreadList的功能...... 
  

[zhuminghua]

太久没用，都忘记有ThreadList这东西了