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;
执行时数据线程经常死掉,不知道为什么,我的临界区使用有问题吗?
以上是部分代码,不知道诸位能否看明白
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;
执行时数据线程经常死掉,不知道为什么,我的临界区使用有问题吗?
以上是部分代码,不知道诸位能否看明白