我的线程经常死掉,用了临界区好想不起作用,请高手指点,急!!!(高分求救) (200分)

  • 主题发起人 主题发起人 rocjing
  • 开始时间 开始时间
R

rocjing

Unregistered / Unconfirmed
GUEST, unregistred user!
TThreadProc = procedure of object;
TCheckThread = class(TThread)
private
{ Private declarations }
FThreadProc: TThreadProc;
protected
procedure Execute;
override;
public
property ThreadProc: TThreadProc read FThreadProc write FThreadProc;
end;

TDataThread = class(TThread)
private
{ Private declarations }
FThreadProc: TThreadProc;
protected
procedure Execute;
override;
public
property ThreadProc: TThreadProc read FThreadProc write FThreadProc;
end;

TArrWorkPlace = array of TWorkPlace;
TArrCheck = array of TCheckObject;
TArrCheckThread = array of TCheckThread;
TCheckMgr = class
private
FWorkPlaceList: TArrWorkPlace;
//工位列表
FCheckList: TArrCheck;
//检测对象列表
FExecThreadList:TArrCheckThread;
//执行线程列表
FDataThread: TDataThread;
//数据处理线程
FTaskTimer: TTimer;
protected
public
constructor create(aGUIHandle: THandle);
destructor Destroy;
override;
procedure CheckProc();
procedure DataProc();
function InitCard():boolean;
procedure InitChkObj();
procedure InitWorkPlaceObj();
procedure InitThreadObj();
procedure UnInitCard();
procedure UnInitChkObj();
procedure UnInitWorkPlaceObj();
procedure UnInitThreadObj();
end;

implementation
uses FactoryMethod, DataModule, GlobalObject;
procedure TCheckThread.Execute;
begin
while truedo
try
if Assigned(FThreadProc) then
FThreadProc;
sleep(1);
except
end;
end;

procedure TDataThread.Execute;
begin
while truedo
try
if Assigned(FThreadProc) then
FThreadProc;
sleep(10);
except
end;
end;

constructor TCheckMgr.create(aGUIHandle: THandle);
var
i:integer;
begin
// inherited;
InitCard();
InitChkObj();
InitWorkPlaceObj();
InitThreadObj();
FTaskTimer := TTimer.Create(application);
FTaskTimer.Interval := 2000;
FTaskTimer.OnTimer := TaskTimerProc;
FTaskTimer.Enabled := false;
end;

destructor TCheckMgr.Destroy;
begin
FTaskTimer.Free;
UnInitCard();
UnInitChkObj();
UnInitWorkPlaceObj();
UnInitThreadObj();
inherited;
end;

procedure TCheckMgr.CheckProc();
var
i:integer;
begin
for i:= low(FCheckList) to high(FCheckList)do
begin
EnterCriticalSection(CS);
FCheckList.CheckKernel;
LeaveCriticalSection(CS);
end;
end;

procedure TCheckMgr.DataProc();
var
i:integer;
begin
for i:= low(FCheckList) to high(FCheckList)do
begin
EnterCriticalSection(CS);
FCheckList.DataKernel;
LeaveCriticalSection(CS);
end;
end;
procedure TCheckMgr.InitThreadObj();
var
i:integer;
aThreadCount: integer;
begin
GetSysPara(aThreadCount);
aThreadCount := 1;
//{临时测试}
setlength(FExecThreadList,aThreadCount);
for i:= 0 to aThreadCount -1do
begin
FExecThreadList := TCheckThread.Create(true);
FExecThreadList.ThreadProc := CheckProc;
end;
FDataThread := TDataThread.Create(true);
FDataThread.ThreadProc := DataProc;
end;
执行时数据线程经常死掉,不知道为什么,我的临界区使用有问题吗?
以上是部分代码,不知道诸位能否看明白
 
你的 CS 在什么地方创建的?
另,TaskTimerProc 的内容呢?
贴出来看看才行
 
procedure TCheckMgr.CheckProc();
var
i:integer;
begin
EnterCriticalSection(CS);
for i:= low(FCheckList) to high(FCheckList)do
FCheckList.CheckKernel;
LeaveCriticalSection(CS);
end;

procedure TCheckMgr.DataProc();
var
i:integer;
begin
EnterCriticalSection(CS);
for i:= low(FCheckList) to high(FCheckList)do
FCheckList.DataKernel;
LeaveCriticalSection(CS);
end;
 
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1787317
 
后退
顶部