Mega Code Archive
Tbaseworkerthread
<![CDATA[
unit uThreader;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TBaseWorkerThread=class;
TInterThreadComm=record
tT:TBaseWorkerThread;
BufferLen:cardinal;
Reason:cardinal;
end;
TBaseWorkerThread=class
private
IsActive:longbool;
TId,ThreadH,CThreadH:cardinal;
StackS:cardinal;
CS,gCS:_RTL_CRITICAL_SECTION;
IsW:longbool;
protected
ThreadStartSnyc:cardinal;
procedure ThreadS ();stdcall;
procedure ThreadAPC ();stdcall;
function IsThreadB:longbool;
public
destructor Destroy;
//THREAD EVENTS!
procedure OnCreateThread;virtual;abstract;
procedure DoJob;virtual;abstract;
procedure OnJobDone;virtual;abstract;
procedure OnDestroyThread;virtual;abstract;
procedure OnMainThreadNotify(Reason:cardinal;Buffer:pointer;BufferLength:cardinal);virtual;abstract;
property StackSize:cardinal read StackS write StackS;
property IsThreadBusy:longbool read IsThreadB;
property ThreadHandle:cardinal read ThreadH;
property ThreadId:cardinal read TId;
function StartThread ():longbool;virtual;
function StartWork ():longbool;virtual;
function CallBackMainThread(Reason:cardinal;Buffer:pointer;BufferLength:cardinal):longbool;virtual;
function DestroyWorkerThread:longbool;
procedure EnterSynchronize;
procedure LeaveSynchronize;
end;
procedure Tmr_Proc (Hwnd,uMsg,IdEvent,eTime:cardinal);stdcall;
procedure Usr_Proc (const Param:TInterThreadComm);stdcall;
implementation
{ TBaseWorkerThreader }
function TBaseWorkerThread.CallBackMainThread(Reason:cardinal;Buffer:pointer;BufferLength:cardinal):longbool;
var
X:cardinal;
begin
X:=GlobalAlloc(0,12+BufferLength);
TInterThreadComm(pointer(x)^).tT:=Self;
TInterThreadComm(pointer(x)^).BufferLen :=BufferLength;
TInterThreadComm(pointer(x)^).Reason :=Reason;
if BufferLength<>0 then Copymemory(pointer(x+12),Buffer,BufferLength);
result:=QueueUserAPC(addr(Usr_Proc),CThreadH,X);
end;
destructor TBaseWorkerThread.Destroy;
begin
DestroyWorkerThread;
end;
function TBaseWorkerThread.DestroyWorkerThread: longbool;
begin
result:=false;
if ThreadHandle<>0 then
begin
TerminateThread(ThreadHandle,0);
DeleteCriticalSection(cS);DeleteCriticalSection(gcS);
OnDestroyThread;
CloseHandle(ThreadHandle);
CloseHandle(cThreadH);
ThreadH:=0;
cThreadH:=0;
TId:=0;
result:=true;
IsW:=false;
end;
end;
function TBaseWorkerThread.IsThreadB: longbool;
begin
EnterCriticalSection(cS);
result:=IsW;
LeaveCriticalSection(cS);
end;
procedure TBaseWorkerThread.EnterSynchronize;
begin
EnterCriticalSection(gCs);
end;
procedure TBaseWorkerThread.LeaveSynchronize;
begin
LeaveCriticalSection(gCs);
end;
function TBaseWorkerThread.StartThread(): longbool;
var
ThreadSA:procedure ()of object;stdcall;
cProcess:cardinal;
begin
result:=false;
if ThreadHandle<>0 then exit;
ThreadSA:=ThreadS;
ThreadStartSnyc:=CreateEvent(0,false,false,0);
ThreadH:=CreateThread(0,StackS,addr(ThreadSA),self,0,TId);
WaitForSingleObject(ThreadStartSnyc,INFINITE);
CloseHandle(ThreadStartSnyc);
result:=longbool(ThreadHandle);
if result then begin
InitializeCriticalSection(cs);InitializeCriticalSection(gcs);
if cardinal(TlsGetValue(200))=0 then TlsSetValue(200,pointer(SetTimer(0,GetCurrentThreadId,0,addr(Tmr_Proc))));
cProcess:=OpenProcess(PROCESS_ALL_ACCESS,true,GetCurrentProcessId);
DuplicateHandle (cProcess,GetCurrentThread, cProcess,addr(CThreadH), $1F03FF, true, 0);
CloseHandle(cProcess);
end;
end;
function TBaseWorkerThread.StartWork: longbool;
var
ThreadSA:procedure ()of object;stdcall;
begin
result:=false;
if ThreadH=0 then exit;
ThreadSA:=ThreadAPC;
result:=QueueUserAPC(addr(ThreadSA),ThreadH,cardinal(self));
end;
procedure TBaseWorkerThread.ThreadAPC;
begin
EnterCriticalSection(cS);
IsW:=true;
LeaveCriticalSection(cS);
DoJob;
end;
procedure TBaseWorkerThread.ThreadS();
begin
SetEvent(ThreadStartSnyc);
OnCreateThread;
while TRUE do begin
SleepEx(INFINITE,true);
EnterCriticalSection(cS);
IsW:=false;
LeaveCriticalSection(cS);
OnJobDone;
end;
end;
procedure Tmr_Proc (Hwnd,uMsg,IdEvent,eTime:cardinal);
begin
SleepEx(0,true);
end;
procedure Usr_Proc (const Param:TInterThreadComm);stdcall;
begin
Param.tT.OnMainThreadNotify(Param.Reason,pointer(cardinal(addr(Param))+12),Param.BufferLen);
GlobalFree(cardinal(addr(Param)));
end;
end.
]]>