www.pudn.com > MyIOCP.rar > IOCPComponent.pas, change:2009-03-17,size:24680b


unit IOCPComponent; 
{ 
   根据网络上的例子修改封装的 
   里面有详细的注解. 
   QQ:46494153 
   2009-03-17 
} 
interface 
 
uses 
  Windows,Messages, SysUtils, Classes,WinSock2,Math,Forms; 
 
const WM_IOCP = WM_USER + 300;//消息 目前未使用 
    DATA_BUFSIZE = 1024 * 1024; //数据缓冲区大小 
    IPLen = 15;  //IP地址长度 V4 = 255.255.255.255 
type 
  TIOCPException = Exception; 
   //完成端口数据结构 
  PLinkInfo = ^TLinkInfo; 
  TLinkInfo = record //连接信息 
    Skt: TSocket; 
    IP: array [0..IPLen -1] of Char; 
    Port: integer; 
  end; 
 
  LPVOID = Pointer; 
  LPPER_IO_OPERATION_DATA = ^ PER_IO_OPERATION_DATA ; 
  PER_IO_OPERATION_DATA = packed record 
    Overlapped: OVERLAPPED; 
    DataBuf: TWSABUF; 
    Buffer: array [0..DATA_BUFSIZE -1] of CHAR; //接收缓存区 
    SendPointer: PChar;     //发送的指针头 
    SendPointerSize: DWORD; //发送指针大小   用于发送完毕释放申请的内存 
    BytesSEND: DWORD; 
    BytesRECV: DWORD; 
  end; 
 
  LPPER_HANDLE_DATA = ^ PER_HANDLE_DATA;//单句柄数据结构  
  PER_HANDLE_DATA = packed record 
    Socket: TSocket; 
  end;    
  //事件声明 
  TIOCPReadEvent = procedure(ASkt: TSocket;AData: PChar;ADataLen: Integer) of object; //读取数据 
  TIOCPConnectEvent = procedure(ASkt: TSocket;ALinkInfo: PLinkInfo;var Accept: Boolean) of object;//连接 
  TIOCPDisConnectEvent = procedure(ASkt: TSocket) of object;//断开连接 
 
  TIOCPCustomComponent = class(TComponent) //公共类 
  private 
    FHandle: THandle; 
    FOnRead: TIOCPReadEvent; 
    FOnDisConnect: TIOCPDisConnectEvent; 
    FOnConnect: TIOCPConnectEvent; 
    FCompletionPort: THandle; 
    function GetHandle: THandle; 
    procedure SetOnRead(const Value: TIOCPReadEvent); 
    procedure SetOnDisConnect(const Value: TIOCPDisConnectEvent); 
    procedure SetOnConnect(const Value: TIOCPConnectEvent); 
    function GetCompletionPort: THandle; 
  protected 
    Flags: integer;  
    PerHandleData: LPPER_HANDLE_DATA; 
    PerIoData: LPPER_IO_OPERATION_DATA; 
    procedure WMProc(var Msg: TMessage);Message WM_IOCP; 
    procedure DoRead(ASkt: TSocket;AData: PChar;ADataLen: Integer); 
    procedure DoConnect(ASkt: TSocket;ALinkInfo: PLinkInfo;var Accept: Boolean); virtual; 
    procedure DoDisConnect(ASkt: TSocket); virtual; 
    procedure WriteLog(ALogText: string); 
  public 
    property Handle: THandle read GetHandle; 
    property CompletionPort: THandle read GetCompletionPort; 
    constructor Create(AOwner: TComponent);override; 
    destructor Destroy; override; 
    function SendData(ASkt: TSocket; AData: PChar; ADataLen: Int64): Boolean; 
  published 
    property OnRead: TIOCPReadEvent read FOnRead write SetOnRead; 
    property OnConnect: TIOCPConnectEvent read FOnConnect write SetOnConnect; 
    property OnDisConnect: TIOCPDisConnectEvent read FOnDisConnect write SetOnDisConnect; 
  end; 
   
  TIOCPServer = class;  //对象相互引用声明 
 
  TThreadServer = class(TThread) //服务监听线程 
  private 
    FIOCPServer: TIOCPServer; 
  protected 
    procedure Execute; override; 
  public 
    constructor Create(Owner:TIOCPServer); 
    destructor Destroy; override; 
  end; 
 
  TServerWorkerThread = class(TThread) //服务工作者线程 
  private 
    FCompletionPort: THandle; 
    FOwner: TIOCPCustomComponent; 
  protected 
    procedure Execute; override; 
  public 
    constructor Create(ACompletionPort: THandle;AOwner:TIOCPCustomComponent); 
    destructor Destroy; override; 
  end; 
 
  TIOCPServer = class(TIOCPCustomComponent) //服务端 
  private 
    FThreadServer: TThreadServer; 
    FLinkList: TStringList; 
    FActive: Boolean; 
    FPort: Integer; 
    function GetLinkCount: integer; 
    procedure SetActive(const Value: Boolean); 
    procedure SetPort(const Value: Integer); 
    property OnConnect; 
  protected 
    procedure DoConnect(ASkt: TSocket;ALinkInfo: PLinkInfo;var Accept: Boolean); override; 
    procedure DoDisConnect(ASkt: TSocket); override; 
  public 
    constructor Create(AOwner: TComponent);override; 
    destructor Destroy; override; 
    Property LinkCount: integer read GetLinkCount; //当前连接个数 
    function BroadCast(AData: PChar;ADataLen: Int64): Integer;//广播 
  published 
    property Active: Boolean read FActive write SetActive default False; //激活 
    property Port: Integer read FPort write SetPort default 6666; 
  end; 
 
  TIOCPClient = class(TIOCPCustomComponent) //客户端 
  private 
    FSkt: TSocket; 
    FPort: Integer; 
    FConnected: Boolean; 
    FHost: string; 
    procedure SetPort(const Value: Integer); 
    procedure SetConnected(const Value: Boolean); 
    procedure SetHost(const Value: string); 
    property OnConnect; 
    //function SendData(ASkt: TSocket; AData: PChar; ADataLen: Int64): Boolean; 
  protected 
    procedure DoDisConnect(ASkt: TSocket); override; //断开连接 
  public 
    constructor Create(AOwner: TComponent);override; 
    destructor Destroy; override; 
    procedure Connect; 
    function SendData(AData: PChar; ADataLen: Int64): Boolean; 
    property Connected: Boolean read FConnected write SetConnected; 
  published 
    property Host: string read FHost write SetHost; 
    property Port: Integer read FPort write SetPort default 6666; 
  end; 
 
procedure Register; 
 
implementation 
{$R *.dcr} 
procedure Register; 
begin 
  RegisterComponents('Standard', [TIOCPServer,TIOCPClient]); 
end; 
 
{ TIOCPCustomComponent } 
 
constructor TIOCPCustomComponent.Create(AOwner: TComponent); 
var 
  wsData:TWsaData; 
begin 
  inherited; 
  FHandle := Handle; 
 
  if WSAStartUp($202, wsData) <> 0 then 
  begin 
   WSACleanup(); 
   WriteLog('加载WinSock2失败.'); 
   exit; 
  end; 
  WriteLog('加载WinSock2成功,版本:' + Inttostr(wsData.wVersion) + '  ' + wsData.szDescription); 
end; 
 
destructor TIOCPCustomComponent.Destroy; 
begin 
  WSACleanup(); 
  inherited; 
end; 
 
procedure TIOCPCustomComponent.DoConnect(ASkt: TSocket;ALinkInfo: PLinkInfo;var Accept: Boolean); 
begin 
  if Assigned(FOnConnect) then 
  FOnConnect(ASkt,ALinkInfo,Accept); 
end; 
 
procedure TIOCPCustomComponent.DoDisConnect(ASkt: TSocket); 
begin 
  if Assigned(FOnDisConnect) then 
  FOnDisConnect(ASkt); 
end; 
 
procedure TIOCPCustomComponent.DoRead(ASkt: TSocket; AData: PChar; 
  ADataLen: Integer); 
var 
  DataBuf: array of Char; 
begin 
  SetLength(DataBuf,ADataLen+1); 
  Move(AData^,DataBuf[0],ADataLen); 
  if Assigned(FOnRead) then 
  FOnRead(ASkt,PChar(@(DataBuf[0])),ADataLen); 
  //FreeAndNil(DataBuf); 
end; 
 
function TIOCPCustomComponent.GetCompletionPort: THandle; 
var 
  LocalSI: TSystemInfo; 
  I: integer; 
  ServerWorkerThread: TServerWorkerThread; 
begin 
  if FCompletionPort=0 then 
  begin 
    FCompletionPort:=CreateIOCompletionPort(INVALID_HANDLE_VALUE,0,0,0); 
    WriteLog('创建一个完成端口。'); 
    GetSystemInfo(LocalSI); 
    //根据CPU的数量创建CPU*2数量的工作者线程。 
    for I:=0 to LocalSI.dwNumberOfProcessors * 2 -1 do 
    begin 
      ServerWorkerThread := TServerWorkerThread.Create(CompletionPort,Self); 
    end; 
  end; 
  result := FCompletionPort 
end; 
 
function TIOCPCustomComponent.GetHandle: THandle; 
begin 
  if FHandle=0 then 
    FHandle := AllocateHWnd(WMProc); 
  result := FHandle; 
end; 
 
 
function TIOCPCustomComponent.SendData(ASkt: TSocket; AData: PChar; 
  ADataLen: Int64): Boolean; 
var 
  PerIoData: LPPER_IO_OPERATION_DATA ; 
  SendBytes: DWORD; 
  SendBuf:PChar; 
begin 
  //申请内存 
  SendBuf := AData; 
  SendBuf := GetMemory(ADataLen); 
  StrCopy(SendBuf,AData); 
  try 
    //在这里申请一个发送数据的"单IO数据结构" 
    PerIoData := LPPER_IO_OPERATION_DATA(GlobalAlloc(GPTR, sizeof(PER_IO_OPERATION_DATA))); 
    if (PerIoData = nil) then 
    begin 
      Result:=false; 
      exit; 
    end; 
    ZeroMemory(@PerIoData.Overlapped, sizeof(OVERLAPPED)); 
 
    //设置发送标记 
    PerIoData.BytesRECV := 0; 
    PerIoData.DataBuf.len := Min(DATA_BUFSIZE,ADataLen); 
    PerIoData.DataBuf.buf:= SendBuf; 
    PerIoData.BytesSEND := ADataLen; 
    PerIoData.SendPointer := SendBuf; 
    PerIoData.SendPointerSize := ADataLen; 
    Flags := 0; 
    //使用WSASend函数将数据发送 
    if (WSASend(ASkt, @(PerIoData.DataBuf), 1, @SendBytes, 0,@(PerIoData.Overlapped), nil) = SOCKET_ERROR) then 
    begin 
      if (WSAGetLastError() <> ERROR_IO_PENDING) then 
      begin 
        WriteLog(Inttostr(WSAGetLastError())); 
      //最近在检查代码的时候发现以前这里只是使用Exit来退出是不正确的。这里需要删除申请的单IO数据结构,否子会出现内存泄露。 (2008年3月24日) 
      //Exit; 
      //表示发送失败,以后也不会有处理在工作者线程处出现。 
        if PerIoData <> nil then 
        begin 
          GlobalFree(DWORD(PerIoData)); 
        end; 
        Result:=false; 
        Exit; 
      end; 
    end; 
    Result:=true; 
  except 
    Result:=false; 
  end; 
 
end; 
 
procedure TIOCPCustomComponent.SetOnConnect( 
  const Value: TIOCPConnectEvent); 
begin 
  FOnConnect := Value; 
end; 
 
procedure TIOCPCustomComponent.SetOnDisConnect( 
  const Value: TIOCPDisConnectEvent); 
begin 
  FOnDisConnect := Value; 
end; 
 
procedure TIOCPCustomComponent.SetOnRead(const Value: TIOCPReadEvent); 
begin 
  FOnRead := Value; 
end; 
 
procedure TIOCPCustomComponent.WMProc(var Msg: TMessage); 
begin 
 
end; 
 
procedure TIOCPCustomComponent.WriteLog(ALogText: string); 
begin 
 
end; 
 
{ TIOCPServer } 
 
function TIOCPServer.BroadCast(AData: PChar; ADataLen: Int64): Integer; 
var 
  i: integer; 
begin 
  for i := 0 to LinkCount -1 do 
  begin 
    SendData(StrToInt(FlinkList.Strings[i]),AData,ADataLen); 
  end; 
end; 
 
constructor TIOCPServer.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner); 
  //CompletionPort 
  //MessageBox(Handle, PChar(Inttostr(CompletionPort)), '提示:', MB_OK); 
  FLinkList := TStringList.Create; 
  FPort := 6666; 
  FActive := false; 
end; 
 
destructor TIOCPServer.Destroy; 
begin 
  if Assigned(FLinkList) then FreeAndNil(FLinkList); 
  inherited; 
end; 
 
procedure TIOCPServer.DoConnect(ASkt: TSocket;ALinkInfo: PLinkInfo;var Accept: Boolean); 
begin 
  inherited; 
  if Assigned(FLinkList) and Accept then 
  begin 
    FLinkList.AddObject(IntToStr(ASkt),TObject(ALinkInfo)); 
  end; 
end; 
 
procedure TIOCPServer.DoDisConnect(ASkt: TSocket); 
begin 
  inherited; 
  if assigned(FLinkList) then 
  begin 
    FLinkList.Delete(FLinkList.IndexOf(IntToStr(ASkt))); 
  end; 
end; 
 
function TIOCPServer.GetLinkCount: integer; 
begin 
  result := FLinkList.Count;  
end; 
 
procedure TIOCPServer.SetActive(const Value: Boolean); 
var 
  sto:TSockAddrIn; 
  Acceptsc :TSocket; 
  Listensc: integer; 
  Flags: integer; 
  RecvBytes: DWord; 
begin 
  if FActive <> Value then FActive := Value; 
 
  if FActive then 
  begin 
    if not Assigned(FThreadServer) then 
    begin 
      FThreadServer := TThreadServer.Create(self); 
    end; 
  end 
  else 
  begin 
 
  end; 
end; 
 
procedure TIOCPServer.SetPort(const Value: Integer); 
begin 
  if FPort <> Value then 
  begin 
    if Value <= 0 then raise Exception.Create('无效端口号!'); 
    FPort := Value; 
  end; 
end; 
{ TThreadServer } 
 
constructor TThreadServer.Create(Owner: TIOCPServer); 
begin 
  inherited Create(False); 
  FreeOnTerminate := True; 
  FIOCPServer := Owner; 
end; 
 
destructor TThreadServer.Destroy; 
begin 
 
  inherited; 
end; 
 
procedure TThreadServer.Execute; 
var 
  wsData:TWsaData; 
  Listensc: integer; 
  RecvBytes: DWORD; 
  sto:TSockAddrIn; 
  Acceptsc :TSocket; 
  Accept: Boolean; 
  Addr: TSockAddr; 
  AddrLen: integer; 
  LinkInfo: PLinkInfo; 
begin 
  with FIOCPServer do 
  begin 
    Listensc:=WSASocket(AF_INET,SOCK_STREAM,0,nil,0,WSA_FLAG_OVERLAPPED); 
    if Listensc=SOCKET_ERROR then 
    begin 
      closesocket(Listensc); 
      WSACleanup(); 
    end; 
    sto.sin_family:=AF_INET; 
    sto.sin_port:=htons(Port); 
    sto.sin_addr.s_addr:=htonl(INADDR_ANY); 
    if bind(Listensc,@sto,sizeof(sto))=SOCKET_ERROR then 
    begin 
     closesocket(Listensc); 
    end; 
    listen(Listensc,20); 
    //创建一个套接字,将此套接字和一个端口绑定并监听此端口。 
    while (FActive) do 
    begin 
      //Acceptsc:= WSAAccept(Listensc, nil, nil, nil, 0); 
      AddrLen := SizeOf(Addr); 
      Acceptsc:= WSAAccept(Listensc, @Addr,@AddrLen , nil, 0); 
      //当客户端有连接请求的时候,WSAAccept函数会新创建一个套接字Acceptsc。 
      //这个套接字就是和客户端通信的时候使用的套接字。 
      if (Acceptsc= SOCKET_ERROR) then 
      begin 
        closesocket(Listensc); 
        exit; 
      end; 
      Accept := True; 
      New(LinkInfo);//申请内存 
      LinkInfo^.Skt := Acceptsc; 
      FillChar(LinkInfo^.IP,SizeOf(LinkInfo^.IP),0); 
      //LinkInfo^.IP := inet_ntoa(Addr.sin_addr); 
      StrCopy(LinkInfo^.IP,inet_ntoa(Addr.sin_addr)); 
      LinkInfo^.Port :=  ntohs(Addr.sin_port); 
      DoConnect(Acceptsc,LinkInfo,Accept); 
      if not Accept then //如果不允许连接 就断开 
      begin 
 
        shutdown(Acceptsc,SD_BOTH); 
        closesocket(Acceptsc); 
        dispose(LinkInfo); //释放申请的内存 
        Continue;     //继续监听 
      end; 
      //判断Acceptsc套接字创建是否成功,如果不成功则退出。 
      PerHandleData := LPPER_HANDLE_DATA (GlobalAlloc(GPTR, sizeof(PER_HANDLE_DATA))); 
      if (PerHandleData = nil) then 
      begin 
        exit; 
      end; 
      PerHandleData.Socket := Acceptsc; 
      //创建一个单句柄数据结构”将Acceptsc套接字绑定。       
 
      if (CreateIoCompletionPort(Acceptsc, CompletionPort, DWORD(PerHandleData), 0) = 0) then 
      begin 
        exit; 
      end; 
      //将套接字、完成端口和单句柄数据结构”三者绑定在一起。 
      PerIoData := LPPER_IO_OPERATION_DATA(GlobalAlloc(GPTR, sizeof(PER_IO_OPERATION_DATA))); 
      if (PerIoData = nil) then 
      begin 
        exit; 
      end; 
      ZeroMemory(@PerIoData.Overlapped, sizeof(OVERLAPPED)); 
      PerIoData.BytesSEND := 0; 
      PerIoData.BytesRECV := 0; 
      PerIoData.DataBuf.len := DATA_BUFSIZE; 
      PerIoData.DataBuf.buf := @PerIoData.Buffer; 
      Flags := 0; 
      //创建一个单IO数据结构”其中将PerIoData.BytesSEND 和PerIoData.BytesRECV 均设置成0。 
      //说明此单IO数据结构”是用来接受的。 
      if (WSARecv(Acceptsc, @(PerIoData.DataBuf), 1, @RecvBytes, @Flags,@(PerIoData.Overlapped), nil) = SOCKET_ERROR) then 
      begin 
        //最近在检查代码的时候发现以前这里只是使用Exit来退出是不正确的。这里需要删除申请的单IO数据结构,否子会出现内存泄露。 (2008年3月24日) 
          if (WSAGetLastError() <> ERROR_IO_PENDING) then 
          begin 
            closesocket(AcceptSc); 
            if PerIoData <> nil then 
            begin 
              GlobalFree(DWORD(PerIoData)); 
            end; 
            Continue; 
          end; 
      end; 
      //用此单IO数据结构”来接受Acceptsc套接字的数据。 
      end; 
  end; 
end; 
 
{ TServerWorkerThread } 
 
constructor TServerWorkerThread.Create(ACompletionPort: THandle; 
  AOwner: TIOCPCustomComponent); 
begin 
  inherited Create(False); 
  FCompletionPort := ACompletionPort; 
  FOwner := AOwner; 
end; 
 
destructor TServerWorkerThread.Destroy; 
begin 
 
  inherited; 
end; 
 
procedure TServerWorkerThread.Execute; 
var 
  CompletionPort: THandle; 
  PerHandleData: LPPER_HANDLE_DATA; 
  BytesTransferred: DWORD; 
  PerIoData: LPPER_IO_OPERATION_DATA; 
  TempSc: TSocket; 
  flags:Integer; 
  RecvBytes,SendBytes: PDWord; 
  //自定义 
 
  DataBuf: array [0..DATA_BUFSIZE -1] of Char; 
  Str,StrLen: string; 
  sFileStream: TFileStream; 
  sFileBuf: PChar; 
begin 
   CompletionPort:= FCompletionPort; 
   try 
     //得到创建线程是传递过来的IOCP 
     while(TRUE) do 
     begin 
          //WriteLog(inttostr(CompletionPort) + '工作线程开始服务'); 
          //工作者线程会停止到GetQueuedCompletionStatus函数处,直到接受到数据为止 
          if (GetQueuedCompletionStatus(CompletionPort, BytesTransferred,DWORD(PerHandleData), POverlapped(PerIoData), INFINITE) = False) then 
          begin 
            //当客户端连接断开或者客户端调用closesocket函数的时候,函数GetQueuedCompletionStatus会返回错误。如果我们加入心跳后,在这里就可以来判断套接字是否依然在连接。 
            if PerHandleData<>nil then 
            begin 
              if Assigned(FOwner) then 
              begin 
                FOwner.DoDisConnect(PerHandleData.Socket); 
              end; 
              closesocket(PerHandleData.Socket); 
              GlobalFree(DWORD(PerHandleData)); 
            end; 
            if PerIoData<>nil then 
            begin 
              GlobalFree(DWORD(PerIoData)); 
            end; 
            continue; 
          end; 
          if (BytesTransferred = 0) then 
          begin 
             //当客户端调用shutdown函数来从容断开的时候,我们可以在这里进行处理。 
             if PerHandleData<>nil then 
             begin  
               if Assigned(FOwner) then 
               begin 
                  FOwner.DoDisConnect(PerHandleData.Socket); 
               end; 
               TempSc:=PerHandleData.Socket;  
               shutdown(PerHandleData.Socket,1); 
               closesocket(PerHandleData.Socket); 
               GlobalFree(DWORD(PerHandleData)); 
             end; 
             if PerIoData<>nil then 
             begin 
               GlobalFree(DWORD(PerIoData)); 
             end; 
             continue; 
          end; 
          //在上一篇中我们说到IOCP可以接受来自客户端的数据和自己发送出去的数据,两种数据的区别在于我们定义的结构成员BytesRECV和BytesSEND的值。所以下面我们来判断数据的来自方向。因为我们发送出去数据的时候我们设置了结构成员BytesSEND。所以如果BytesRECV=0同时BytesSEND=0那么此数据就是我们接受到的客户端数据。(这种区分方法不是唯一的,个人可以有自己的定义方法。只要可以区分开数据来源就可以。) 
          if (PerIoData.BytesRECV = 0) and (PerIoData.BytesSEND = 0) then 
          begin 
             PerIoData.BytesRECV := BytesTransferred; 
             PerIoData.BytesSEND := 0; 
          end 
          else 
          begin 
            // PerIoData.BytesSEND := BytesTransferred; 
             PerIoData.BytesRECV := 0; 
          end; 
          //当是接受来自客户端的数据是,我们进行数据的处理。 
          if (PerIoData.BytesRECV > PerIoData.BytesSEND) then 
          begin 
            PerIoData.DataBuf.buf := PerIoData.Buffer + PerIoData.BytesSEND; 
            PerIoData.DataBuf.len := PerIoData.BytesRECV - PerIoData.BytesSEND; 
       
            FOwner.DoRead(PerHandleData.Socket,PerIoData.DataBuf.buf,Integer(BytesTransferred)); 
 
            //当我们将数据处理完毕以后,应该将此套接字设置为结束状态,同时初始化和它绑定在一起的数据结构。 
            ZeroMemory(@(PerIoData.Overlapped), sizeof(OVERLAPPED)); 
            PerIoData.BytesRECV := 0; 
            Flags := 0; 
            ZeroMemory(@(PerIoData.Overlapped), sizeof(OVERLAPPED)); 
            PerIoData.DataBuf.len := data_BUFSIZE; 
            ZeroMemory(@PerIoData.Buffer,sizeof(@PerIoData.Buffer)); 
            PerIoData.DataBuf.buf := @PerIoData.Buffer; 
            if (WSARecv(PerHandleData.Socket, @(PerIoData.DataBuf), 1, @RecvBytes, @Flags,@(PerIoData.Overlapped), nil) = SOCKET_ERROR) then 
            begin 
              if (WSAGetLastError() <> ERROR_IO_PENDING) then //ERROR_IO_PENDING在完成端口是正常的 
              begin 
                if PerHandleData<>nil then 
                begin 
                  TempSc:=PerHandleData.Socket; 
                  closesocket(PerHandleData.Socket); 
                  GlobalFree(DWORD(PerHandleData)); 
                end; 
                if PerIoData<>nil then 
                begin 
                  GlobalFree(DWORD(PerIoData)); 
                end; 
                continue; 
              end; 
            end; 
          end 
          //当我们判断出来接受的数据是我们发送出去的数据的时候,在这里我们清空我们申请的内存空间 
          else 
          begin 
            {$IFDEF Debug} WriteLog('本次发送:' + Inttostr(BytesTransferred)); {$EndIF} 
            if PerIoData.BytesSEND - BytesTransferred <> 0 then 
            begin 
              //没有发送完就继续发送 
              PerIoData.BytesRECV := 0; 
              PerIoData.BytesSEND := PerIoData.BytesSEND - BytesTransferred; 
              PerIoData.DataBuf.len := Min(DATA_BUFSIZE,PerIoData.BytesSEND); 
              PerIoData.DataBuf.buf:= Pointer(Integer(PerIoData.DataBuf.buf) + BytesTransferred);// SendBuf; 
               
              Flags := 0; 
              //使用WSASend函数将数据发送 
              if (WSASend(PerHandleData.Socket, @(PerIoData.DataBuf), 1, @SendBytes, 0,@(PerIoData.Overlapped), nil) = SOCKET_ERROR) then 
              begin 
                if (WSAGetLastError() <> ERROR_IO_PENDING) then 
                begin 
 
 
                //最近在检查代码的时候发现以前这里只是使用Exit来退出是不正确的。这里需要删除申请的单IO数据结构,否子会出现内存泄露。 (2008年3月24日) 
                //Exit; 
                //表示发送失败,以后也不会有处理在工作者线程处出现。 
                  if PerIoData <> nil then 
                  begin 
                    //FreeMem(PerIoData.DataBuf.buf); 
                     //FreeMem(PerIoData.SendPointer,PerIoData.SendPointerSize); 
                     GlobalFree(DWORD(PerIoData));   
                  end; 
                  MessageBox(0, PChar(SysErrorMessage(WSAGetLastError())), 
                      '提示:', MB_OK); 
                  //Exit; 
                  Continue; 
                end; 
              end; 
            end 
            else 
            begin 
              FreeMemory(PerIoData.SendPointer); 
              GlobalFree(DWORD(PerIoData)); 
            end; 
          end; 
     end; 
   except 
     raise; 
   end; 
end; 
 
{ TIOCPClient } 
 
procedure TIOCPClient.Connect; 
var 
  RecvBytes: DWORD; 
  Addr: TSockAddr; 
begin 
  Addr.sin_family:=AF_INET; 
  Addr.sin_port:=htons(FPort); 
  Addr.sin_addr.s_addr:=inet_addr(PChar(FHost)); 
  if WinSock2.connect(FSkt,@Addr,Sizeof(Addr)) <> 0 then 
  begin 
    raise TIOCPException.Create('连接失败!'); 
  end; 
 
  PerHandleData := LPPER_HANDLE_DATA (GlobalAlloc(GPTR, sizeof(PER_HANDLE_DATA))); 
  if (PerHandleData = nil) then 
  begin 
    raise TIOCPException.Create('创建单句柄失败!'); 
    exit; 
  end; 
  PerHandleData.Socket := FSkt; 
  //创建一个单句柄数据结构”将FSkt套接字绑定。       
 
  if (CreateIoCompletionPort(FSkt, CompletionPort, DWORD(PerHandleData), 0) = 0) then 
  begin 
    exit; 
  end; 
  //将套接字、完成端口和单句柄数据结构”三者绑定在一起。 
  PerIoData := LPPER_IO_OPERATION_DATA(GlobalAlloc(GPTR, sizeof(PER_IO_OPERATION_DATA))); 
  if (PerIoData = nil) then 
  begin 
    raise TIOCPException.Create('套接字、完成端口和单句柄数据结构三者绑定在一起失败!'); 
    exit; 
  end; 
  ZeroMemory(@PerIoData.Overlapped, sizeof(OVERLAPPED)); 
  PerIoData.BytesSEND := 0; 
  PerIoData.BytesRECV := 0; 
  PerIoData.DataBuf.len := DATA_BUFSIZE; 
  PerIoData.DataBuf.buf := @PerIoData.Buffer; 
  Flags := 0; 
  //创建一个单IO数据结构”其中将PerIoData.BytesSEND 和PerIoData.BytesRECV 均设置成0。 
  //说明此单IO数据结构”是用来接受的。 
  if (WSARecv(FSkt, @(PerIoData.DataBuf), 1, @RecvBytes, @Flags,@(PerIoData.Overlapped), nil) = SOCKET_ERROR) then 
  begin 
    //最近在检查代码的时候发现以前这里只是使用Exit来退出是不正确的。这里需要删除申请的单IO数据结构,否子会出现内存泄露。 (2008年3月24日) 
      if (WSAGetLastError() <> ERROR_IO_PENDING) then 
      begin 
        closesocket(FSkt); 
        if PerIoData <> nil then 
        begin 
          GlobalFree(DWORD(PerIoData)); 
        end; 
        //raise TIOCPException.Create('套接字等待接收失败!'); 
        raise TIOCPException.CreateRes(WSAGetLastError); 
        Exit; 
 
      end; 
  end; 
  //用此单IO数据结构”来接受Acceptsc套接字的数据。 
end; 
 
constructor TIOCPClient.Create(AOwner: TComponent); 
begin 
  inherited; 
  FPort := 6666; 
  FConnected := false; 
 
  FSkt:=WSASocket(AF_INET,SOCK_STREAM,0,nil,0,WSA_FLAG_OVERLAPPED); 
  if FSkt=SOCKET_ERROR then 
  begin 
    CloseSocket(FSkt); 
    WSACleanup(); 
    raise TIOCPException.Create('创建套接字失败!'); 
  end; 
end; 
 
destructor TIOCPClient.Destroy; 
begin 
  CloseSocket(FSkt); 
  inherited; 
end; 
 
procedure TIOCPClient.DoDisConnect(ASkt: TSocket); 
begin 
  inherited; 
 
end; 
 
function TIOCPClient.SendData(AData: PChar; ADataLen: Int64): Boolean; 
begin 
  result := inherited SendData(FSkt, AData, ADataLen); 
end; 
 
procedure TIOCPClient.SetConnected(const Value: Boolean); 
begin 
  FConnected := Value; 
end; 
 
procedure TIOCPClient.SetHost(const Value: string); 
begin 
  FHost := Value; 
end; 
 
procedure TIOCPClient.SetPort(const Value: Integer); 
begin 
  if FPort <> Value then 
  begin 
    if Value <= 0 then raise Exception.Create('无效端口号!'); 
    FPort := Value; 
  end; 
end; 
 
end.