Winsock完成端口模型-Delphi代码

原文出处 《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.