iocpcomponent.~pas

一个用delphi封装的IOCP（完成端口）控件

  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
               //WriteLog(' Socket:(' +inttostr(PerHandleData.Socket) + ') 断开连接.');
               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.