iocpdemo,数据回显

//iocpdemo,数据回显:简单的接受客户端连接,并原样返回客户端发送过来的消息
unit unMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, JwaWinsock2, ExtCtrls;

type
  TMysktOper = (soSend,soRecv);
  TClientSkt = packed record
    Ovlap: WSAOVERLAPPED;
    Handle: TSocket;
    SendBuf: array[0..4095] of byte;
    RecvBuf: array[0..4095] of byte;
    lpbsend: LPWSABUF;
    lpbrecv: LPWSABUF;
    sendbytes,recvbytes: Cardinal;
    Oper: TMysktOper;
  end;
  PClientSkt = ^TClientSkt;

  TMyThrd = class(TThread)
  protected
    procedure Execute; override;
  end;
  TLsnThrd = class(TThread)
  protected
    procedure Execute; override;
  end;
  TfrmMain = class(TForm)
    btnStart: TButton;
    btnStop: TButton;
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FLsn: TLsnThrd;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

var
  G_IOCP: THandle = 0;
  G_overlap: TOverlapped;
  G_clients: integer = 0;
  G_Stoped: Boolean = false;  

{$R *.dfm}

procedure TfrmMain.btnStartClick(Sender: TObject);
begin
  Flsn := TLsnThrd.Create(false);
end;

{ TMyThrd }

procedure TMyThrd.Execute;
var
  bts: Cardinal;
  keydata: Cardinal;
  ov: LPWSAOVERLAPPED;
  r: bool;
  skt: PClientSkt;
  lpb: LPWSABUF;
  flag: Cardinal;
begin
//  inherited;
  FreeOnTerminate := True;
  while not Terminated do
  begin
    r := GetQueuedCompletionStatus(G_IOCP,bts,keydata,POverlapped(ov),WSA_INFINITE);
    if (not r) or (ov = nil) then
      begin
        //RaiseLastOSError
      end
    else begin
       skt := PClientSkt(ov);
       FillChar(ov^,sizeof(_OVERLAPPED),0);
       if skt^.Oper = soRecv then
       begin
         move(skt^.RecvBuf[0],skt^.SendBuf[0],bts);
         skt^.lpbsend^.len := bts;
         skt^.lpbsend.buf := @(skt^.SendBuf[0]);
         WSASend(skt^.Handle,skt^.lpbsend,1,skt^.sendbytes,0,ov,nil);
         skt^.Oper := soSend;
       end
       else begin
         skt^.lpbrecv.buf := @skt^.RecvBuf[0];
         skt^.lpbrecv.len := 4095;
         flag := 0;
         WSARecv(skt^.Handle,skt^.lpbrecv,1,skt^.recvbytes,flag,ov,nil);
         skt^.Oper := soRecv;
       end;
    end;
  end;
end;

procedure TfrmMain.btnStopClick(Sender: TObject);
begin
  G_Stoped := True;
  exit;

end;

{ TLsnThrd }

procedure TLsnThrd.Execute;
var
  lsn,acpt: TSocket;
  wsa: WSAData;
  i,w: integer;
  sysinfo: SYSTEM_INFO;
  FWorkThreads: array of THandle;
  addr: sockaddr_in;
  pmyskt: PClientSkt;
  flag: Cardinal;
  pskaddr: PSockAddr;
  evLsn: Cardinal;
  evs: array[0..0] of Cardinal;
  idx: dword;
begin
  FreeOnTerminate := True;
  if G_IOCP = 0 then
    G_IOCP := CreateIoCompletionPort(INVALID_HANDLE_VALUE,0,0,0);
  if G_IOCP = 0 then
    Raise Exception.Create('create IO Complete Port Fail!!');
  w := WSAStartup(MakeWord(2,2),wsa);
  if w <> 0 then
    Raise Exception.Create('WINSOCK 2 Startup fail,error code: '+IntToStr(w));


  GetSystemInfo(sysinfo);
  SetLength(FWorkThreads,sysinfo.dwNumberOfProcessors * 2 + 1);
  for i := 0 to sysinfo.dwNumberOfProcessors * 2 + 1 do
    FWorkThreads[i] := Cardinal(TMyThrd.Create(False));
//  exit;
  lsn := WSASocket(AF_INET,SOCK_STREAM,IPPROTO_TCP,nil,0,WSA_FLAG_OVERLAPPED);
  if lsn = INVALID_SOCKET then
    Raise Exception.Create('Create listening socket fail,error code:'+IntToStr(WSAGetLastError));
  addr.sin_family := AF_INET;
  addr.sin_addr.S_addr := htonl(INADDR_ANY);
  addr.sin_port := htons(5500);
  if bind(lsn,@addr,sizeof(addr)) <> 0 then
    Raise Exception.Create('Binding listening socket fail,error code:'+IntToStr(WSAGetLastError));
  evLsn := WSACreateEvent;
  evs[0] := evLsn;
  WSAEventSelect(lsn,evLsn,FD_ACCEPT);
  if listen(lsn,10) <> 0 then
    Raise Exception.Create('Listening socket fail,error code:'+IntToStr(WSAGetLastError));

  G_Stoped := False;
  while true do
  begin
    if G_Stoped then
      Break;
    i := sizeof(addr);
    idx := WSAWaitForMultipleEvents(1,@evs[0],true,1000,False);
    if idx - WSA_WAIT_EVENT_0 = 0 then
    begin
      WSAResetEvent(evLsn);
      acpt := accept(lsn,@addr,@i);
      if acpt = INVALID_SOCKET then
        Raise Exception.Create('Accepting socket fail,error code:'+IntToStr(WSAGetLastError));
      InterlockedIncrement(G_Clients);
      GetMem(pmyskt,sizeof(TClientSkt));
  //    GetMem(pmyskt^.Ovlap,sizeof(TOverlapped));
      FillChar(pmyskt^.Ovlap,sizeof(TOverlapped),0);
      GetMem(pmyskt^.lpbsend,sizeof(WSABUF));
      GetMem(pmyskt^.lpbrecv,sizeof(WSABUF));
      pmyskt^.Handle := acpt;

      pmyskt^.lpbrecv.buf := @pmyskt^.RecvBuf[0];
      pmyskt^.lpbrecv.len := 4095;
      if  CreateIoCompletionPort(acpt,G_IOCP,Cardinal(pmyskt),0) = 0 then
        RaiseLastOSError;
      flag := 0;
      pmyskt^.Oper := soRecv;
      WSARecv(acpt,pmyskt^.lpbrecv,1,pmyskt^.recvbytes,flag,@pmyskt^.Ovlap,nil);
    end;
  end;
  for i := 0 to Length(FWorkThreads)-1 do
    TThread(FWorkThreads[i]).Terminate;
  closesocket(lsn);
  WSACloseEvent(evLsn);
  CloseHandle(G_IOCP);
  WSACleanup;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if not G_Stoped then
    btnStop.Click;
  Sleep(2000);
end;

end.

object frmMain: TfrmMain
  Left = 0
  Top = 0
  Caption = 'IOCP Demo'
  ClientHeight = 381
  ClientWidth = 595
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  PixelsPerInch = 96
  TextHeight = 13
  object btnStart: TButton
    Left = 48
    Top = 8
    Width = 75
    Height = 25
    Caption = #21551#21160
    TabOrder = 0
    OnClick = btnStartClick
  end
  object btnStop: TButton
    Left = 48
    Top = 39
    Width = 75
    Height = 25
    Caption = #20572#27490
    TabOrder = 1
    OnClick = btnStopClick
  end
end