frmiocpclient.pas

楠楠写的DBiocp例子都是源码

unit frmIOCPClient;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, uDIProtocol,  uIOCompletionPort,
  uDIThreadPool, uDITcpEchoSocketServer, uDIThread, Spin;
  {$I IOCP.inc}
type
  TIOCPClientFrm = class(TForm)
    p1: TPanel;
    p3: TPanel;
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    Panel2: TPanel;
    Label6: TLabel;
    Edit6: TEdit;
    Label1: TLabel;
    Edit1: TEdit;                                                                      
    Label2: TLabel;
    Label4: TLabel;
    Label3: TLabel;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    SpinEdit3: TSpinEdit;
    SpinEdit4: TSpinEdit;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    SpinEdit5: TSpinEdit;
    Label5: TLabel;
    tmr1: TTimer;
    Button3: TButton;
    Panel3: TPanel;
    Label9: TLabel;
    Label8: TLabel;
    Label7: TLabel;
    Label10: TLabel;
    Label34: TLabel;
    Label32: TLabel;
    Label31: TLabel;
    Label27: TLabel;
    Label26: TLabel;
    Label24: TLabel;
    Label19: TLabel;
    Label17: TLabel;
    Label15: TLabel;
    Label13: TLabel;
    Label12: TLabel;
    Label11: TLabel;
    Label14: TLabel;
    Label16: TLabel;
    DBLabel9: TLabel;
    DBLabel8: TLabel;
    DBLabel7: TLabel;
    DBLabel6: TLabel;
    DBLabel5: TLabel;
    DBLabel4: TLabel;
    DBLabel3: TLabel;
    DBLabel2: TLabel;
    DBLabel18: TLabel;
    DBLabel17: TLabel;
    DBLabel16: TLabel;
    DBLabel15: TLabel;
    DBLabel14: TLabel;
    DBLabel13: TLabel;
    DBLabel12: TLabel;
    DBLabel11: TLabel;
    DBLabel10: TLabel;
    DBLabel1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TDITestThread = class(TDIThread)
  protected
    procedure ThreadRoutine; override;
  end;

var
  IOCPClientFrm: TIOCPClientFrm;
  _DIThreadPool: TDIThreadPool;
  _IOCompletionPort: TIOCompletionPort;
  _DITcpEchoSocketServer: TDITcpEchoSocketServer;
  _TDITestThread : TDITestThread;
  m_bRun: Boolean;

implementation
  uses uDIMonitor, frmAbout;
{$R *.dfm}

procedure TDITestThread.ThreadRoutine;
var
  i: Integer;
  sServerIP: String;
  nPort: Integer;
  iMaxConn: DWORD;
begin
  sServerIP := Trim(IOCPClientFrm.Edit6.Text);
  nPort := StrToInt(IOCPClientFrm.Edit1.Text);
  iMaxConn := IOCPClientFrm.SpinEdit4.Value;

  for i:=1 to iMaxConn do begin
    if not m_bRun then Exit;
    if _DITcpEchoSocketServer.Connect(sServerIP, nPort) then
      {$IFDEF _ICOP_DEBUG}
          _DITcpEchoSocketServer.AppendLogMessage('第'+IntToStr(i)+'个客户端连接成功！')
      {$ENDIF}
    else
    begin
      {$IFDEF _ICOP_DEBUG}
          _DITcpEchoSocketServer.AppendErrorLogMessage('第'+IntToStr(i)+'个客户端连接失败！');
          _DITcpEchoSocketServer.AppendErrorLogMessage('TDITestThread线程退出！');
      {$ENDIF}
      Exit;
    end;
   end;

  //回射消息
  _DITcpEchoSocketServer.SendMsgToAll;
end;

procedure TIOCPClientFrm.FormCreate(Sender: TObject);
begin
  DBLabel1.Caption := '0';
  DBLabel2.Caption := '0';
  DBLabel3.Caption := '0';
  DBLabel4.Caption := '0';
  DBLabel5.Caption := '0';
  DBLabel6.Caption := '0';
  DBLabel7.Caption := '0';
  DBLabel8.Caption := '0';
  DBLabel9.Caption := '0';
  DBLabel10.Caption := '0';
  DBLabel11.Caption := '0';
  DBLabel12.Caption := '0';
  DBLabel13.Caption := '0';
  DBLabel14.Caption := '0';
  DBLabel15.Caption := '0';
  DBLabel16.Caption := '0';
  DBLabel17.Caption := '0';
  DBLabel18.Caption := '0';
  _IOCompletionPort := TIOCompletionPort.Create;
  _DITcpEchoSocketServer :=  TDITcpEchoSocketServer.Create(_IOCompletionPort);
  _DIThreadPool := TDIThreadPool.Create(_DITcpEchoSocketServer);
end;

procedure TIOCPClientFrm.FormDestroy(Sender: TObject);
begin
  if _DIThreadPool.FStarted then begin
    WaitForSingleObject(_TDITestThread.Handle, INFINITE);
    _TDITestThread.Free;
    _DIThreadPool.StopThreadPool;
  end;
  FreeAndNil(_DIThreadPool);
  FreeAndNil(_DITcpEchoSocketServer );
  FreeAndNil(_IOCompletionPort);
end;

procedure TIOCPClientFrm.Button1Click(Sender: TObject);
var
  i: Integer;
  sServerIP: String;
  nPort: Integer;
  iWorkThread, iMaxConn, iMaxFreeContext, iMaxFreeBuffer: DWORD;
begin
  m_bRun := TRUE;
  sServerIP := Trim(Edit6.Text);
  nPort := StrToInt(Edit1.Text);

  iMaxConn := SpinEdit4.Value;
  iMaxFreeBuffer := SpinEdit2.Value;
  iMaxFreeContext := SpinEdit3.Value;
  iWorkThread :=  SpinEdit1.Value;

  _DITcpEchoSocketServer.StartServe(-1, iMaxConn, iMaxFreeContext, iMaxFreeContext, IOClientStart);
  _DIThreadPool.FIOWorkThreads := iWorkThread;
  Button1.Enabled := not _DIThreadPool.StartThreadPool;
  Button2.Enabled := not Button1.Enabled;

  _TDITestThread := TDITestThread.Create;
  _TDITestThread.Run;
end;

procedure TIOCPClientFrm.tmr1Timer(Sender: TObject);
var
  nDay: Integer;
  nHour: Integer;
  nMinute: Integer;
  nSecond: Integer;
  nRecvGB: Integer;
  nRecvMB: Integer;
  nRecvKB: Integer;
  nRecvByte: Integer;
  nSecvGB: Integer;
  nSecvMB: Integer;
  nSecvKB: Integer;
  nSecvByte: Integer;
  rRecvRate: Real;
  rSendRate: Real;

  nNewBufferCount: Integer;
  nFreeBufferCount: Integer;
  nNewClientCount: Integer;
  nFreeClientCount: Integer;
  nExitFreeContextCount: Integer;

  nRecvCount: Integer;
  nSendCount: Integer;
  nIocpRecvCount: Integer;
  nIocpSendCount: Integer;
  nAcceptExBufCount: Integer;
  nIocpBufCount: Integer;
  nContextCount: Integer;
  nFreeContextCount: Integer;
  
  sRecvRate, sSendRate: String;
  iPos: Integer;
begin
  _DIMonitor.GetParams( nDay,
                        nHour,
                        nMinute,
                        nSecond,

                        nRecvGB,
                        nRecvMB,
                        nRecvKB,
                        nRecvByte,

                        nSecvGB,
                        nSecvMB,
                        nSecvKB,
                        nSecvByte,

                        rRecvRate,
                        rSendRate,

                        nNewBufferCount,
                        nFreeBufferCount,
                        nNewClientCount,
                        nFreeClientCount,
                        nExitFreeContextCount,
                                             
                        nRecvCount,
                        nSendCount,
                        nIocpRecvCount,
                        nIocpSendCount,

                        nAcceptExBufCount,
                        nIocpBufCount,
                        nContextCount,
                        nFreeContextCount );

  nFreeContextCount := _DITcpEchoSocketServer.FPoolClientContext.GetClientContextCount;
  nIocpBufCount := _DITcpEchoSocketServer.FPoolBuffer.GetBufferCount;
  nAcceptExBufCount := _DITcpEchoSocketServer.FMapAcceptExBuffer.GetBufferCount;

  DBLabel1.Caption := ' '+IntToStr(nContextCount)+'   ';
  DBLabel2.Caption := ' '+IntToStr(nAcceptExBufCount)+'   ';
  DBLabel3.Caption := ' '+IntToStr(nRecvCount)+'   ';
  DBLabel4.Caption := ' '+IntToStr(nIocpRecvCount)+'   ';

  sSendRate := FloatToStr(rSendRate);
  iPos := Pos('.', sSendRate);
  if iPos<>0 then
    DBLabel5.Caption := ' '+ Copy(sSendRate, 1, iPos-1)+'   '
  else
    DBLabel5.Caption := ' '+sSendRate+'   ';


  DBLabel6.Caption  := ' '+FloatToStr(nNewBufferCount)+'   ';
  DBLabel7.Caption  := ' '+FloatToStr(nNewClientCount)+'   ';

  DBLabel8.Caption := ' '+IntToStr(nRecvGB)+'   GB '+
                      ' '+IntToStr(nRecvMB)+'   MB '+
                      ' '+IntToStr(nRecvKB)+'   KB '+
                      ' '+IntToStr(nRecvByte)+'   Byte  ';

  
  DBLabel9.Caption := ' '+IntToStr(nSecvGB)+'   GB '+
                      ' '+IntToStr(nSecvMB)+'   MB '+
                      ' '+IntToStr(nSecvKB)+'   KB '+
                      ' '+IntToStr(nSecvByte)+'   Byte  ';

  DBLabel10.Caption := ' '+IntToStr(nDay)+ ' 天 '+
                       ' '+IntToStr(nHour)+ ' 时 '+
                       ' '+IntToStr(nMinute)+ ' 分 '+
                       ' '+IntToStr(nSecond)+ ' 秒  ';

  DBLabel11.Caption := ' '+FloatToStr(nExitFreeContextCount)+'   ';
  DBLabel12.Caption  := ' '+IntToStr(nFreeContextCount)+'   ';
  DBLabel13.Caption := ' '+FloatToStr(nFreeBufferCount)+'   ';
  DBLabel14.Caption := ' '+IntToStr(nSendCount)+'   ';
  DBLabel15.Caption := ' '+IntToStr(nIocpSendCount)+'   ';

  sRecvRate := FloatToStr(rRecvRate);
  iPos := Pos('.', sRecvRate);
  if iPos<>0 then
    DBLabel16.Caption := ' '+ Copy(sRecvRate, 1, iPos-1)+'   '
  else
    DBLabel16.Caption := ' '+sRecvRate+'   ';

  DBLabel17.Caption :=  ' '+FloatToStr(nFreeBufferCount)+'   ';
  DBLabel18.Caption := ' '+IntToStr(nFreeClientCount)+'   ';
  
end;

procedure TIOCPClientFrm.Button2Click(Sender: TObject);
begin
  m_bRun := FALSE;

  _DIThreadPool.StopThreadPool;
  Button2.Enabled := False;
  Button1.Enabled := not Button2.Enabled;
end;

procedure TIOCPClientFrm.Button3Click(Sender: TObject);
begin
  ABoutFrm := TABoutFrm.Create(nil);
  ABoutFrm.ShowModal;
end;

end.