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

http://www.cnblogs.com/qiubole/archive/2006/04/06/368296.html

Winsock完成端口模型-Delphi代码的更多相关文章

  1. winsock编程IOCP模型实现代码

    winsock编程IOCP模型实现代码 话不多说,上代码.借鉴<windows核心编程>部分源码和CSDN小猪部分代码. stdafx.h依赖头文件: #include <iostr ...

  2. WinSock 完成端口模型

    之前写了关于Winsock的重叠IO模型,按理来说重叠IO模型与之前的模型相比,它的socket即是非阻塞的,也是异步的,它基本上性能非常高,但是它主要的缺点在于,即使我们使用历程来处理完成通知,但是 ...

  3. winsock编程WSAAsyncSelect模型

    winsock编程WSAAsyncSelect模型 WSAAsyncSelect模型也称异步选择模型,其核心函数是WSAAsyncSelect.它可以用来在一个socket上接收以windows消息为 ...

  4. winsock编程select模型

    winsock编程select模型 网络服务端连接数量过多时,为每一个连接申请一个线程会让机器性能急剧下降(大多说是因为线程在用户态和内核态之间切换会占用大量的CPU时间片).为了解决多线程带来的性能 ...

  5. winsock I/O模型的分析

    几种winsock I/O模型的分析 套接字是通信的基础,是支持网络协议数据通信的基本接口.Winsocket 提供了一些有趣的I/O模型,有助于应用程序通过一种“异步”方式,一次对一个或者多个套接字 ...

  6. winsock的io模型(终极篇)

    最近在看服务器框架的搭建,看了不少,都是零零碎碎的,觉得看的差不多了,可以写点最后的总结了,然后,竟然发现了这篇文章,总结做的特别好,肯定比我总结写要好多了,所以我也就不写了,直接转吧...... 套 ...

  7. WinSock 重叠IO模型

    title: WinSock 重叠IO模型 tags: [WinSock 模型, 网络编程, 重叠IO模型] date: 2018-06-29 20:26:13 categories: Windows ...

  8. EF自动生成的模型edmx代码分析

    edmx代码分析 本文分析Entity Framework从数据库自动生成的模型文件代码(扩展名为edmx). 1. 概述 本文使用的数据库结构尽量简单,只有2个表,一个用户表和一个分公司表(相当于部 ...

  9. Delphi代码中嵌入ASM代码

    前言 Delphi作为一个快速高效的开发平台,使用的人越来越多,但熟悉在Delphi代码中嵌入ASM代码的程序员我想不多,因为这方面的资料太少了,另一方面,它还需要有基本的汇编语言知识,关於汇编语言的 ...

随机推荐

  1. CSS各个浏览器Hack的写法

    Hack是针对不同的浏览器去写不同的CSS样式,从而让各浏览器能达到一致的渲染效果,那么针对不同的浏览器写不同的CSS CODE的过程,就叫CSS HACK,同时也叫写CSS Hack.然后将Hack ...

  2. 基于lnmp.org的xdebug安装

    1. 下载xdebug wget http://xdebug.org/files/xdebug-2.3.3.tgz 2. 创建一个目录: mkdir ./xdebug 3. 复制xdebug包到xde ...

  3. 演出排期JavaScript

    <script language="JavaScript" type="text/javascript"> var diarydays=" ...

  4. Delphi XE5教程6:单元的结构和语法

    内容源自Delphi XE5 UPDATE 2官方帮助<Delphi Reference>,本人水平有限,欢迎各位高人修正相关错误! 也欢迎各位加入到Delphi学习资料汉化中来,有兴趣者 ...

  5. Mysql主从同步(复制)

    目录: mysql主从同步定义      主从同步机制 配置主从同步      配置主服务器      配置从服务器 使用主从同步来备份      使用mysqldump来备份      备份原始文件 ...

  6. JQuery解析JSon

    JsonCreatet.ashx页面 JSonAnalysis.aspx测试页面 一般处理程序中使用Newtonsoft.Json来序列化json 页面使用Jquery 来解析Json数据 Jquer ...

  7. Winfrom 抓取web页面内容代码

    WebRequest request = WebRequest.Create("http://1.bjapp.sinaapp.com/play.php?a=" + PageUrl) ...

  8. 1096. Consecutive Factors (20)

    Among all the factors of a positive integer N, there may exist several consecutive numbers. For exam ...

  9. 【转】微软MVP攻略 (如何成为MVP?一个SQL Server MVP的经验之谈)

    一.本文所涉及的内容(Contents) 本文所涉及的内容(Contents) 初衷 什么是微软MVP? 成为微软MVP的条件? 如何成为微软MVP? (一) 申请时间划分 (二) 前期准备 (三) ...

  10. Ubuntu下的网络配置(USTC)

    1. 配置静态ip      ubuntu的网络配置信息放在 /etc/network/interfaces 中 sudo gedit /etc/network/interfacesauto lo 下 ...