IOCP实现的任务队列

unit IOCPQueue;

interface

uses windows, classes;

type

  TOnQueueProc = procedure(sender: tobject; ParamA, ParamB: integer) of object;

  TIOCPQueue = class
  private
    FCompletionPort: THandle;
    FOnQueueProc: TOnQueueProc;
    FOverlapped: Overlapped;
    procedure Run;
  public
    constructor create(OnQueueProc: TOnQueueProc);
    destructor Destroy; override;
    procedure PostQueueState(ParamA, ParamB: integer);
    procedure Close;
  end;

implementation
  uses SysUtils;


{ TIOCPQueuue }

//Post关闭消息
procedure TIOCPQueue.Close;
begin
  PostQueuedCompletionStatus(FCompletionPort, 0, 0, @FOverlapped);
end;

//创建完成端口
constructor TIOCPQueue.create;
begin
  FOnQueueProc := OnQueueProc;
  FCompletionPort := CreateIoCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
  if FCompletionPort = 0 then
    raise Exception.Create('TIOCPQueue Create Error FCompletionPort=0');

    TThread.CreateAnonymousThread(Run).Start;
end;

//关闭完成端口句柄
destructor TIOCPQueue.Destroy;
begin
  Close;
  CloseHandle(FCompletionPort);
  inherited;
end;

//提交完成端口消息
procedure TIOCPQueue.PostQueueState(ParamA, ParamB: integer);
begin
  PostQueuedCompletionStatus(FCompletionPort, ParamA, ParamB, nil);
end;

//查询完成端口，状态
procedure TIOCPQueue.Run;
var
  Transfered: DWORD;
  {$IF RTLVersion > 22.0} //XE2,XE3
   key: NativeUInt    ;
  {$ELSE}
   key: DWORD;
  {$IFEND}
  o: POverlapped;
  ret: bool;
begin
  while true do
  begin
    ret := GetQueuedCompletionStatus(FCompletionPort, Transfered,
      key, POverlapped(o), INFINITE);
    if ret then
    begin
      if o = nil then
        FOnQueueProc(self, Transfered, key)
      else
        break;
    end;
  end;
end;

end.