原文出处 《Windows网络编程技术》第8章 完成端口模型

由于原书附的是C代码，我把其翻译成Delphi代码。

其中winsock2.pas在delphi中不带，要另外下载http://jungla.dit.upm.es/~bti/files/winsock2.pas

program CompletionIO;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  WinSock2 in 'WinSock2.pas',
  Mains in 'Mains.pas';

begin
    main();
end.

// Module Name: iocmplt.cpp
//
// Description:
//
//    This sample illustrates how to develop a simple echo server Winsock
//    application using the completeion port I/O model. This
//    sample is implemented as a console-style application and simply prints
//    messages when connections are established and removed from the server.
//    The application listens for TCP connections on port 5150 and accepts them
//    as they arrive. When this application receives data from a client, it
//    simply echos (this is why we call it an echo server) the data back in
//    it's original form until the client closes the connection.
//
//  2005-2-5
//    cpp convert to delphi pas  by johnson
//   

unit Mains;

interface

uses Windows, WinSock2, WinSock, Sysutils;

const
 PORT         = 5150;
 DATA_BUFSIZE = 8192;

type
  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] of CHAR;
    BytesSEND: DWORD;
    BytesRECV: DWORD;
  end;

  LPPER_HANDLE_DATA = ^ PER_HANDLE_DATA;
  PER_HANDLE_DATA = packed record
    Socket: TSocket;
  end;

  procedure main;

implementation

function ServerWorkerThread(CompletionPortID: LPVOID): DWORD; stdcall; forward;

procedure printf(Fmt: string; num: Integer);
begin
  WriteLn(Format(Fmt, [num]));
end;

procedure main;
var
  InternetAddr: SOCKADDR_IN;
  Listen: TSOCKET;
  Accept: TSOCKET;
  CompletionPort: THANDLE ;
  SystemInfo: SYSTEM_INFO ;
  PerHandleData: LPPER_HANDLE_DATA ;
  PerIoData: LPPER_IO_OPERATION_DATA ;
  i: Integer;
  RecvBytes:  DWORD;
  Flags: DWORD;
  ThreadID: DWORD ;
  wsaData: TWSADATA ;
  Ret: DWORD ;

  ThreadHandle: THANDLE;
begin
    Ret := WSAStartup($0202, wsaData);
    if (Ret <> 0) then
    begin
      printf('WSAStartup failed with error %d', Ret);
      Exit;
    end;

   // Setup an I/O completion port.
   CompletionPort := CreateIoCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
   if (CompletionPort = 0) then
   begin
      printf( 'CreateIoCompletionPort failed with error: %d', GetLastError());
      Exit;
   end;

   // Determine how many processors are on the system.

   GetSystemInfo(SystemInfo);

   // Create worker threads based on the number of processors available on the
   // system. Create two worker threads for each processor.

   for i:= 0 to SystemInfo.dwNumberOfProcessors * 2 - 1 do
   begin

      // Create a server worker thread and pass the completion port to the thread.
      ThreadHandle := CreateThread(nil, 0, @ServerWorkerThread, Pointer(CompletionPort),
         0, ThreadID);
      if (ThreadHandle = 0) then
      begin
         printf('CreateThread() failed with error %d', GetLastError());
         Exit;
      end;

      // Close the thread handle
      CloseHandle(ThreadHandle);
   end;

   // Create a listening socket
   Listen := WSASocket(AF_INET, SOCK_STREAM, 0, nil, 0, WSA_FLAG_OVERLAPPED);
   if (Listen = INVALID_SOCKET) then
   begin
      printf('WSASocket() failed with error %d', WSAGetLastError());
      exit;
   end;

   InternetAddr.sin_family := AF_INET;
   InternetAddr.sin_addr.s_addr := htonl(INADDR_ANY);
   InternetAddr.sin_port := htons(PORT);

   if (bind(Listen, InternetAddr, sizeof(InternetAddr)) = SOCKET_ERROR) then
   begin
      printf('bind() failed with error %d', WSAGetLastError());
      exit;
   end;

   // Prepare socket for listening

   if (Winsock.listen(Listen, 5) = SOCKET_ERROR) then
   begin
      printf('listen() failed with error %d', WSAGetLastError());
      exit;
   end
   else
   begin
      printf('Server listen on port = %d ...', PORT);
   end;

   // Accept connections and assign to the completion port.
   while(TRUE) do
   begin
      Accept := WSAAccept(Listen, nil, nil, nil, 0);
      if (Accept = SOCKET_ERROR) then
     begin
        printf('WSAAccept() failed with error %d', WSAGetLastError());
        exit;
     end;

      // Create a socket information structure to associate with the socket
      PerHandleData := LPPER_HANDLE_DATA (GlobalAlloc(GPTR, sizeof(PER_HANDLE_DATA)));
      if (PerHandleData = nil) then
      begin
        printf('GlobalAlloc() failed with error %d', WSAGetLastError());
        exit;
      end;

      // Associate the accepted socket with the original completion port.

      printf('Socket number %d connected', Accept);
      PerHandleData.Socket := Accept;

      if (CreateIoCompletionPort(Accept, CompletionPort, DWORD(PerHandleData), 0) = 0) then
      begin
        printf('CreateIoCompletionPort() failed with error %d', WSAGetLastError());
        exit;
      end;

      // Create per I/O socket information structure to associate with the
      // WSARecv call below.

      PerIoData := LPPER_IO_OPERATION_DATA(GlobalAlloc(GPTR, sizeof(PER_IO_OPERATION_DATA)));
      if (PerIoData = nil) then
      begin
        printf('GlobalAlloc() failed with error %d', WSAGetLastError());
        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;
      if (WSARecv(Accept, @(PerIoData.DataBuf), 1, @RecvBytes, @Flags,
         @(PerIoData.Overlapped), nil) = SOCKET_ERROR) then
      begin
         if (WSAGetLastError() <> ERROR_IO_PENDING) then
         begin
           printf('WSARecv() failed with error %d', WSAGetLastError());
           exit;
         end
      end;

    end;
end;

function ServerWorkerThread(CompletionPortID: LPVOID): DWORD; stdcall;
var
   CompletionPort: THANDLE;
   BytesTransferred: DWORD ;
 //  Overlapped: POVERLAPPED;
   PerHandleData: LPPER_HANDLE_DATA ;
   PerIoData: LPPER_IO_OPERATION_DATA ;
   SendBytes, RecvBytes: DWORD;
   Flags: DWORD ;
begin
   CompletionPort := THANDLE( CompletionPortID);

   Result:= 0;

   while(TRUE) do
   begin

      if (GetQueuedCompletionStatus(CompletionPort, BytesTransferred,
         DWORD(PerHandleData), POverlapped(PerIoData), INFINITE) = False) then
      begin
         printf('GetQueuedCompletionStatus failed with error %d', GetLastError());
         exit;
      end;

      // First check to see if an error has occured on the socket and if so
      // then close the socket and cleanup the SOCKET_INFORMATION structure
      // associated with the socket.

      if (BytesTransferred = 0) then
      begin
         printf('Closing socket %d\', PerHandleData.Socket);

         if (closesocket(PerHandleData.Socket) = SOCKET_ERROR) then
         begin
            printf('closesocket() failed with error %d', WSAGetLastError());
            exit;
         end;

         GlobalFree(DWORD(PerHandleData));
         GlobalFree(DWORD(PerIoData));
         continue;
      end;

      // Check to see if the BytesRECV field equals zero. If this is so, then
      // this means a WSARecv call just completed so update the BytesRECV field
      // with the BytesTransferred value from the completed WSARecv() call.

      if (PerIoData.BytesRECV = 0) then
      begin
         PerIoData.BytesRECV := BytesTransferred;
         PerIoData.BytesSEND := 0;
      end
      else
      begin
         PerIoData.BytesSEND := PerIoData.BytesSEND + BytesTransferred;
      end;

      if (PerIoData.BytesRECV > PerIoData.BytesSEND) then
      begin

         // Post another WSASend() request.
         // Since WSASend() is not gauranteed to send all of the bytes requested,
         // continue posting WSASend() calls until all received bytes are sent.

         ZeroMemory(@(PerIoData.Overlapped), sizeof(OVERLAPPED));

         PerIoData.DataBuf.buf := PerIoData.Buffer + PerIoData.BytesSEND;
         PerIoData.DataBuf.len := PerIoData.BytesRECV - PerIoData.BytesSEND;

         if (WSASend(PerHandleData.Socket, @(PerIoData.DataBuf), 1, @SendBytes, 0,
            @(PerIoData.Overlapped), nil) = SOCKET_ERROR) then
         begin
            if (WSAGetLastError() <> ERROR_IO_PENDING) then
            begin
               printf('WSASend() failed with error %d', WSAGetLastError());
               Exit;
            end;
         end;
      end
      else
      begin
         PerIoData.BytesRECV := 0;

         // Now that there are no more bytes to send post another WSARecv() request.

         Flags := 0;
         ZeroMemory(@(PerIoData.Overlapped), sizeof(OVERLAPPED));

         PerIoData.DataBuf.len := DATA_BUFSIZE;
         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
            begin
               printf('WSARecv() failed with error %d', WSAGetLastError());
               exit;
            end;
         end;
      end;
   end;
end;

end.