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

zhuminghua 2009-01-23 09:54:40
同事写的一个简单的测试程序,用定时器往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.
...全文
212 点赞 收藏 33
写回复
33 条回复
zhuminghua 2009年02月02日
太久没用,都忘记有ThreadList这东西了
回复 点赞
liangpei2008 2009年02月01日

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

回复 点赞
lenism521 2009年01月24日
我也遇到过这个问题!~ 某个对象没有释放或者释放不是时候。。 你那个临界区没必要在线程执行过程里创建再释放掉!~应该在线程初始化里创建。注意你的timer里还用到临界区呢!~ 解决办法:你把线程里的cs.Free去掉!~临界区初始化在线程初始化里创建!
回复 点赞
zhuminghua 2009年01月24日
自己丁页
回复 点赞
fjtxwd 2009年01月24日
回复 点赞
舞台中央的我 2009年01月23日
好长阿 ! 县学习 !
回复 点赞
starluck 2009年01月23日
[Quote=引用 22 楼 Avan_Lau 的回复:]
哈哈,我明天才回家过年。
楼主,把timer时间间隔,设长一点,再看内存状况
[/Quote]


要不就把時間調長點,看內存的情況吧。
回复 点赞
金卯刀 2009年01月23日
哈哈,我明天才回家过年。
楼主,把timer时间间隔,设长一点,再看内存状况
回复 点赞
simonhehe 2009年01月23日
oo
楼上几位这是不过年了啊
回复 点赞
zhuminghua 2009年01月23日
汗,要怎么注意啊,10几行代码摆就在那,肯定是没用申请其它内存啊
回复 点赞
金卯刀 2009年01月23日
综合timer时间间隔、线程优先级和临界区等其他因素考虑,子线程得到释放主 线程对象的机会有多少呢?当然还要考虑楼上的说法
回复 点赞
starluck 2009年01月23日



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

還有內存增加過快,釋放需要一定的時間。
回复 点赞
zhuminghua 2009年01月23日
10几分钟涨了40几K,如果长时间跑,程序肯定会死掉的
回复 点赞
bdmh 2009年01月23日
你的泄露程度有多少,如果只是很小的连续增长,也算正常,因为在程序高速运行时,数据的计算必定要占用内存,而释放是需要时间的,内存没有立即的减小,是可以理解的

所以你要看你程序的泄露程度,如果内存没有疯狂的增长,而且可以回落,应该算正常
回复 点赞
zhuminghua 2009年01月23日
就算将TCriticalSection和TList对象放到Create里面,还是会有内存泄露的,你们可以试试看的
回复 点赞
starluck 2009年01月23日
問題太大了,再改進下;




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.



回复 点赞
金卯刀 2009年01月23日
10樓的答案應該可以,修正一下十一樓的,手誤:
應該是屬于線程的范疇
回复 点赞
bdmh 2009年01月23日
临界设置是有点问题
放到Execute外创建
回复 点赞
金卯刀 2009年01月23日
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構造方法里面,或者放到主線程創建,這樣應該就不會有問題了。
回复 点赞
starluck 2009年01月23日


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.


回复 点赞
发动态
发帖子
语言基础/算法/系统设计
创建于2007-08-02

3418

社区成员

3.3w+

社区内容

Delphi 语言基础/算法/系统设计
社区公告
暂无公告