| delphi线程池 // 单元功用: 线程池 // 单元设计: 陈新光 // 设计日期: 2012-09-03 unit ThreadPool; interface uses system.Classes, system.SyncObjs, system.SysUtils, system.DateUtils, GlobalVar, Vcl.Forms, Winapi.Windows; type TWorkThread = class(TThread) private FThreadMethod: TThreadMethod; Fsync: Boolean; FEvent: THandle; protected procedure Execute; override; public constructor Create; overload; destructor Destroy; override; property Sync: Boolean read Fsync write Fsync; property ThreadMethod: TThreadMethod read FThreadMethod write FThreadMethod; procedure Run; end; PServerObject = ^TServerObject; TServerObject = record ServerObject: TWorkThread; InUse: Boolean; end; TThreadPool = class private FCriticalSection: TCriticalSection; FServerObjects: TList; FPoolSize: integer; public constructor Create; overload; destructor Destroy; override; function Lock: TWorkThread; procedure Unlock(Value: TWorkThread); procedure Init; property PoolSize: integer read FPoolSize write FPoolSize; end; var G_ThreadPool: TThreadPool; implementation uses CommonFunction; constructor TThreadPool.Create; begin FPoolSize := G_ThreadPoolSize; FServerObjects := TList.Create; FCriticalSection := TCriticalSection.Create; end; destructor TThreadPool.Destroy; begin while FServerObjects.Count > 0 do begin Dispose(PServerObject(FServerObjects[0])); FServerObjects.Delete(0); end; FreeAndNil(FServerObjects); FreeAndNil(FCriticalSection); inherited Destroy; end; procedure TThreadPool.Init; var i: integer; p: PServerObject; begin if not Assigned(FServerObjects) then exit; for i := 1 to FPoolSize do begin New(p); if Assigned(p) then begin p^.ServerObject := TWorkThread.Create; p^.InUse := False; FServerObjects.Add(p); end; end; end; function TThreadPool.Lock: TWorkThread; var i: integer; begin Result := nil; try FCriticalSection.Enter; try for i := 0 to FServerObjects.Count - 1 do begin if (not PServerObject(FServerObjects[i])^.InUse) then begin PServerObject(FServerObjects[i])^.InUse := True; Result := PServerObject(FServerObjects[i])^.ServerObject; Break; end; end; finally FCriticalSection.Leave; end; except on E: Exception do begin LogInfo('TThreadPool.Lock' + E.Message); exit; end; end; end; procedure TThreadPool.Unlock(Value: TWorkThread); var i: integer; begin if not Assigned(Value) then exit; try FCriticalSection.Enter; try for i := 0 to FServerObjects.Count - 1 do begin if Value = PServerObject(FServerObjects[i])^.ServerObject then begin PServerObject(FServerObjects[i])^.InUse := False; // Value.Suspended := True; Value.ThreadMethod := nil; Break; end; end; finally FCriticalSection.Leave; end; except on E: Exception do begin LogInfo('TThreadPool.Unlock' + E.Message); exit; end; end; end; { TWorkThread } constructor TWorkThread.Create; begin FEvent := CreateEvent(nil, True, False, nil); Create(True); FreeOnTerminate := True; end; destructor TWorkThread.Destroy; begin CloseHandle(FEvent); inherited; end; procedure TWorkThread.Execute; begin inherited; while not Terminated do if WaitForSingleObject(FEvent, INFINITE) = WAIT_OBJECT_0 then if Assigned(FThreadMethod) then if Fsync then Synchronize(FThreadMethod) else FThreadMethod; end; procedure TWorkThread.Run; begin PulseEvent(FEvent); end; end. |
