Delphi expands Tsimplethread to TThread

Its application: Treadhtmlthread in this

Unit usimplethread;interfaceuses system.classes, system.sysutils, System.syncobjs;type//display information, call method DOONSTATUSMSG (  AMSG);  Tonstatusmsg = procedure (amsg:string) of object;  Display debug information, commonly used to display error messages, usage doondebugmsg (amsg);  Tondebugmsg = tonstatusmsg; Tsimplethread = Class (TThread) public type//"Execute procedure" category definition Tgeneralproc = procedure;    Ordinary, namely procedure dosomething; Tobjectproc = procedure of object; Class, that is, the txxxx.dosomethign; Use more Tanonymousproc = reference to procedure; Anonymous private type Tprockind = (pkgeneral, pkobject, pkanonymous);    "Execution process" of the category private Fgeneralproc:tgeneralproc;    Fobjproc:tobjectproc;    Fanoproc:tanonymousproc;    Fprockind:tprockind; Fevent:tevent; For blocking, it is a semaphore factivex:boolean;    Whether Com is supported in the thread, if you want to access IE in the thread, set to True fonstatusmsg:tonstatusmsg;    fondebugmsg:tondebugmsg; Ftagid:integer; Give the thread a code name, the online pool when used to make a difference fparam:integer; Give thread a parameter, convenient to identify procedure Selfstart; Trigger thread to run procedure Doexecute; The code that runs inside this functionIs "thread space" procedure doonexception (e:exception);    The exception information shows the call doondebugmsg (AMSG);    Procedure Settagid (const value:integer);    Procedure SetParam (const value:integer);    Procedure setonstatusmsg (const VALUE:TONSTATUSMSG);  Procedure setondebugmsg (const VALUE:TONDEBUGMSG); protected Fwaitstop:boolean; The end flag, which can be used in an inheriting class to determine whether the thread stopped running procedure doonstatusmsg (amsg:string); Display general Information procedure doondebugmsg (amsg:string); Display the mode information procedure Execute; Override Heavy Duty Tthread.execute procedure Onthreadprocerr (e:exception); Virtual Abnormal occurrence event procedure waitthreadstop; Wait for thread to end procedure BeforeExecute; Virtual Look at the name, do not explain Procedure AfterExecute; Virtual Look at the name, do not explain procedure sleepexceptstopped (atimeout:cardinal);    This is tall, to explain. {Sometimes when a thread doesn't have a task, it takes a break, but when it does, it may receive an instruction to exit the thread. This function is to check the stop instruction at the time of the break. Public//Change the parameters of Create, Allowedactivex: Whether it is allowed Permitted thread code access to Com constructor Create (Allowedactivex:boolean = false);    Reintroduce; destructor Destroy; Override Procedure Exeprocinthread (APROC:TGENERALPROC); overload;    These three, external interfaces. Procedure Exeprocinthread (APROC:TOBJECTPROC);    overload; Procedure Exeprocinthread (APROC:TANONYMOUSPROC);    overload; Procedure Startthread;    Virtual      {The startup thread is typically called only once.} It is then executed by the thread's response event} procedure Stopthread; Virtual    Stop Thread Property onstatusmsg:tonstatusmsg read fonstatusmsg write setonstatusmsg;    Property ondebugmsg:tondebugmsg read Fondebugmsg write setondebugmsg;    Property Waitstop:boolean read Fwaitstop;    Property Tagid:integer read Ftagid write Settagid;  Property Param:integer read Fparam write SetParam; End;implementationuses activex;procedure Tsimplethread.afterexecute;beginend;procedure Tsimplethread.beforeexecute;beginend;constructor tsimplethread.create (Allowedactivex:boolean); var bguid:tguid;  Begin inherited Create (false);  Factivex: = Allowedactivex; Freeonterminate: = false;  We want to manually free thread createguid (BGUID); Fevent: = Tevent.create (Nil, true,False, Guidtostring (Bguid)); End;destructor Tsimplethread.destroy;begin Stopthread; Stop Waitthreadstop first;    Wait for the thread to stop {in the Destroy of the inheriting class, also write these two sentences. For example: no better way to find, this code can not save destructor Txxthread.destroy;    Begin Stopthread;    Waitthreadstop; Xxx.    Free;    inherited;  End  } Fevent.free; Inherited;end;procedure Tsimplethread.doexecute;  The code executed within this function is running the begin beforeexecute in the multithreaded space;    Repeat fevent.waitfor; Fevent.resetevent; The next waitfor has been waiting {here to try a lot, the total selfstart feel there is a conflict, after several modifications and use of proof, there is no need to lock here, because only call Startthread once, the remaining to the line Cheng should event} if n          OT Terminated then//if the thread needs to exit begin try case fprockind of Pkgeneral:fgeneralproc;          Pkobject:fobjproc;        Pkanonymous:fanoproc;      End        Except on E:exception do begin Doonexception (e);      End    End  End  Until Terminated;  AfterExecute; The code runs here, which means that the thread does not exist. I can't go back, we have to release the resources. End;procedure tsimplethread.doondebugmsg (amsg:string); begin if Assigned (fondebugmsg) then fondebugmsg (amsg); end;procedure tsimplethread.doonexception (e:exception); var serrmsg:string  ; begin serrmsg: = ' ClassName: ' + ClassName + #13 # #;  Serrmsg: = serrmsg + ' TagID: ' + inttostr (ftagid) + #13 # #;  Serrmsg: = serrmsg + ' Param: ' + inttostr (Param) + #13 # #;  Serrmsg: = serrmsg + ' errmsg: ' + e.message + #13 # #;  Doondebugmsg (SERRMSG);    Onthreadprocerr (e); end;procedure tsimplethread.doonstatusmsg (amsg:string); begin if Assigned (fonstatusmsg) Then    Fonstatusmsg (amsg); end;procedure tsimplethread.execute;begin//Support Com if Factivex then begin CoInitialize (nil);    Try Doexecute;    Finally CoUninitialize;  End  End Else Doexecute;end;procedure tsimplethread.exeprocinthread (APROC:TGENERALPROC); begin fgeneralproc: = AProc;  Fprockind: = pkgeneral;  Selfstart;end;procedure Tsimplethread.exeprocinthread (APROC:TOBJECTPROC); begin fobjproc: = AProc;  Fprockind: = Pkobject; Selfstart;end;procedure Tsimplethread.exeprocinthread (Aproc: Tanonymousproc); begin fanoproc: = Aproc;  Fprockind: = pkanonymous; Selfstart;end;procedure Tsimplethread.onthreadprocerr (e:exception); begin;end;procedure TSimpleThread.SelfStart; Begin//Often try many times, eventually written like this, run without problems if Fevent.waitfor (0) <> wrsignaled then fevent.setevent; Let waitfor no longer wait end;procedure Tsimplethread.stopthread;begin//Inherit class code, need to check fwaitstop to control thread end fwaitstop: = True;end;pro Cedure tsimplethread.setondebugmsg (const value:tondebugmsg); begin fondebugmsg: = Value;end;procedure Tsimplethread.setonstatusmsg (const value:tonstatusmsg); begin fonstatusmsg: = Value;end;procedure Tsimplethread.setparam (const value:integer); begin Fparam: = Value;end;procedure tsimplethread.settagid (const Value: Begin Ftagid: = Value;end;procedure tsimplethread.sleepexceptstopped (atimeout:cardinal); var boldtime:  Cardinal;begin//Sleep detection exit instruction to ensure that thread sequence exits//multiple threads work at the same time, to ensure proper exit, it is not easy to boldtime: = GetTickCount;    While not waitstop does begin sleep (50); if (gettickcount-boldtime) > Atimeout then break; End;end;procedure tsimplethread.startthread;begin fwaitstop: = False;end;procedure TSimpleThread.WaitThreadStop;  Begin//wait for thread to end Stopthread;  Terminate;  Selfstart; Waitfor;end;end.

　　

Delphi expands Tsimplethread to TThread