delphi线程池

QQ空间 新浪微博 腾讯微博 腾讯朋友 QQ收藏 百度空间 百度贴吧 更多

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.