IOCP做的高效率线程池类源码：GThreadPool

{********************************************************************************
*     GThradPool：完成端口线程池                                       *
*   Copyright C 2009  GuestCode 代码客（卢益贵）  版权所有                *
*  QQ:48092788  E-Mail:gcode@qq.com  源码博客：http://blog.csdn.net/guestcode   *
********************************************************************************}

unit GThreadPool;

interface

uses
  Windows, Classes;

type
  PGThread =^ TGThread;
  TGThread = record
    pOwner: Pointer;
    pNext: PGThread;
    ThreadHnd: THandle;
    ThreadID: DWord;
    pData: pointer;
  end;

  TGThreadPool = class
  private
    FCompletionPort: THandle;
    FThreads: PGThread;
    FThreadNumber: Integer;
    FIsShutdown: BOOL;
    FAllowPost: BOOL;
    FQueueCount: Integer;
  protected
    procedure OnThreadBegin(Thread: DWord); virtual;
    procedure OnThreadEnd(Thread: DWord); virtual;
    procedure OnRun(pData: Pointer; Sender, wParam, lParam: DWord); virtual;
  public
    constructor Create(ThreadNumber: Integer); virtual;
    destructor Destroy(); override;
    procedure SetData(Thread: DWord; pData: Pointer);
    function GetData(Thread: DWord): Pointer; overload;
    function GetData(): Pointer; overload;
    function PostQueue(Sender, wParam, lParam: DWord): BOOL;
  end;

implementation

{ TGThreadPool }

function GThreadPoolProc(pThread: PGThread): DWORD; stdcall;
var
  Sender, wParam, lParam: DWord;
begin
  with pThread^, TGThreadPool(pOwner) do
  begin
    OnThreadBegin(DWORD(pThread));
    while True do
    begin
      GetQueuedCompletionStatus(FCompletionPort, Sender, DWORD(wParam), POverlapped(lParam), INFINITE);
      if FIsShutdown then
        break;
      OnRun(pData, Sender, wParam, lParam);
      InterlockedDecrement(FQueueCount);
    end;
    OnThreadEnd(DWORD(pThread));
  end;
  Result := 0;
  SetEvent(pThread^.ThreadHnd);
end;

constructor TGThreadPool.Create(ThreadNumber: Integer);
var
  i: Integer;
  pThread: PGThread;
begin
  inherited Create();

  FIsShutdown := False;
  FAllowPost := TRUE;
  FQueueCount := 0;
  if ThreadNumber <1 then
    ThreadNumber := 1;
  FThreadNumber := ThreadNumber;
  FCompletionPort := CreateIoCompletionPort(INVALID_HANDLE_VALUE, 0, 0, ThreadNumber);

  FThreads := nil;
  for i := 1 to FThreadNumber do
  begin
    GetMem(pThread, sizeof(TGThread));
    ZeroMemory(pThread, sizeof(TGThread));
    pThread^.pNext := FThreads;
    FThreads := pThread;
    pThread^.pOwner := self;
    pThread^.ThreadHnd := CreateThread(nil, 0, @GThreadPoolProc, pThread, 0, pThread^.ThreadID);
  end;
end;

destructor TGThreadPool.Destroy();
var
  pThread, tmp: PGThread;
begin
  FAllowPost := FALSE;
   
  while FQueueCount <> 0 do
  begin
    Sleep(1);
  end;

  FIsShutdown := True;
 
  pThread := FThreads;
  while (pThread <> nil) do
  begin
    PostQueuedCompletionStatus(FCompletionPort, 0, 0, nil);
    pThread := pThread^.pNext;
  end;
 
  pThread := FThreads;
  while (pThread <> nil) do
  begin
    WaitForSingleObject(pThread^.ThreadHnd, INFINITE);
    pThread := pThread^.pNext;
  end;
 
  pThread := FThreads;
  while (pThread <> nil) do
  begin

    CloseHandle(pThread^.ThreadHnd);
    tmp := pThread;
    pThread := pThread^.pNext;
    FreeMem(tmp);
  end;
 
  CloseHandle(FCompletionPort);
  inherited;
end;

procedure TGThreadPool.OnThreadBegin(Thread: DWord);
begin
end;

procedure TGThreadPool.OnThreadEnd(Thread: DWord);
begin
end;

procedure TGThreadPool.OnRun(pData: Pointer; Sender, wParam, lParam: DWord);
begin
end;

function TGThreadPool.PostQueue(Sender, wParam, lParam: DWord): BOOL;
begin
  if FAllowPost then
  begin
    PostQueuedCompletionStatus(FCompletionPort, Sender, wParam, Pointer(lParam));
    InterlockedIncrement(FQueueCount);
    Result := True;
  end else
  begin
    Result := False;
  end;
end;

procedure TGThreadPool.SetData(Thread: DWord; pData: Pointer);
begin
  PGThread(Thread)^.pData := pData;
end;

function TGThreadPool.GetData(): Pointer;
var
  pThread: PGThread;
  ThreadID: DWord;
begin
  pThread := FThreads;
  ThreadID := GetCurrentThreadId();
  while (pThread <> nil) do
  begin
    if pThread^.ThreadID = ThreadID then
    begin
      Result := pThread^.pData;
      exit;
    end;
    pThread := pThread^.pNext;
  end;
  Result := nil;
end;

function TGThreadPool.GetData(Thread: DWord): Pointer;
begin
  Result := PGThread(Thread)^.pData;
end;

end.