frmiocpserver.pas

楠楠写的DBiocp例子都是源码

unit frmIOCPServer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, uCircularBuffer, uIOCompletionPort,
  uDIThreadPool, uDIIocpTcpServer, uDITcpCircularPacketSocketServer, ExtCtrls, Spin;

const
  WM_DISPLAY = WM_USER +1;

type

  TfrmServer = class(TForm)
    p1: TPanel;
    Panel3: TPanel;
    p3: TPanel;
    Button1: TButton;
    Button3: TButton;
    Panel2: TPanel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label18: TLabel;
    Panel4: TPanel;
    Edit1: TEdit;
    SpinEdit1: TSpinEdit;
    SpinEdit3: TSpinEdit;
    SpinEdit4: TSpinEdit;
    CheckBox1: TCheckBox;
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    SpinEdit5: TSpinEdit;
    SpinEdit2: TSpinEdit;
    CheckBox2: TCheckBox;
    Timer1: TTimer;
    Label7: TLabel;
    Label19: TLabel;
    Label8: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label17: TLabel;
    Label15: TLabel;
    Label24: TLabel;
    Label26: TLabel;
    Label27: TLabel;
    Label31: TLabel;
    Label32: TLabel;
    Label34: TLabel;
    Button4: TButton;
    Label1: TLabel;
    Label6: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label13: TLabel;
    DBLabel1: TLabel;
    DBLabel2: TLabel;
    DBLabel3: TLabel;
    DBLabel4: TLabel;
    DBLabel5: TLabel;
    DBLabel6: TLabel;
    DBLabel7: TLabel;
    DBLabel8: TLabel;
    DBLabel9: TLabel;
    DBLabel10: TLabel;
    DBLabel11: TLabel;
    DBLabel12: TLabel;
    DBLabel13: TLabel;
    DBLabel14: TLabel;
    DBLabel15: TLabel;
    DBLabel16: TLabel;
    DBLabel17: TLabel;
    DBLabel18: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
    procedure DisPlayMsg(var Message: TMessage); message WM_DISPLAY;
  public
    { Public declarations }
  end;



var
  frmServer: TfrmServer;
  _DIThreadPool: TDIThreadPool;
  _CircularBuffer: TCircularBuffer;
  _IOCompletionPort: TIOCompletionPort;
  _DITcpCircularPacketSocketServer: TDITcpCircularPacketSocketServer;

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

procedure TfrmServer.DisPlayMsg(var Message: TMessage);
begin
  //ListBox1.Items.Add(string(Msg.LParam));
end;

procedure TfrmServer.Button1Click(Sender: TObject);
var
  bMonitor: Boolean;
  nPort: Integer;
  iWorkThread, iMaxConn, iMaxFreeContext, iMaxFreeBuffer: DWORD;
begin
  nPort := StrToInt(Edit1.Text);
  iMaxConn := SpinEdit4.Value;
  iMaxFreeContext := SpinEdit3.Value;
  iMaxFreeBuffer := SpinEdit2.Value;
  iWorkThread :=  SpinEdit1.Value;
  bMonitor := CheckBox2.Checked;

  _DITcpCircularPacketSocketServer.StartServe(nPort, iMaxConn, iMaxFreeContext, iMaxFreeBuffer);
  _DIThreadPool.FIOWorkThreads := iWorkThread;

  Button1.Enabled := not _DIThreadPool.StartThreadPool;
  Button3.Enabled := not Button1.Enabled;
end;

procedure TfrmServer.Button2Click(Sender: TObject);
var
  sMsg: String;
  pData: PChar;
  pOutData: array[1..100] of char;
  iLen: Integer;
begin
  _CircularBuffer := TCircularBuffer.Create(5);
  GetMem(pData, 100);
  sMsg := '12';
  StrPCopy(pData, sMsg);
  _CircularBuffer.WriteCirBuffer(pData, Length(sMsg));
  sMsg := '345678';
  StrPCopy(pData, sMsg);
  _CircularBuffer.WriteCirBuffer(pData, Length(sMsg));

  //GetMem(pOutData, 100);
  FillChar(pOutData, SizeOf(pOutData), 0);
  iLen := _CircularBuffer.ReadCirBuffer(@pOutData);
   sMsg := pchar(@pOutData[1]);
  ShowMessage(sMsg);

  sMsg := 'ABCD';
  StrPCopy(pData, sMsg);
  _CircularBuffer.WriteCirBuffer(pData, Length(sMsg));
  
  FillChar(pOutData, SizeOf(pOutData), 0);
  _CircularBuffer.ReadCirBuffer(@pOutData);
  sMsg := pchar(@pOutData[1]);
  ShowMessage(sMsg);

  sMsg := '12345';
  StrPCopy(pData, sMsg);
  _CircularBuffer.WriteCirBuffer(pData, Length(sMsg));

  FillChar(pOutData, SizeOf(pOutData), 0);
  _CircularBuffer.ReadCirBuffer(@pOutData);
  sMsg := pchar(@pOutData[1]);
  ShowMessage(sMsg);
end;

procedure TfrmServer.Button3Click(Sender: TObject);
begin
  _DIThreadPool.StopThreadPool;
  Button3.Enabled := False;
  Button1.Enabled := not Button3.Enabled;
end;

procedure TfrmServer.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;
  _DITcpCircularPacketSocketServer :=  TDITcpCircularPacketSocketServer.Create(_IOCompletionPort);
  _DIThreadPool := TDIThreadPool.Create(_DITcpCircularPacketSocketServer);
end;

procedure TfrmServer.FormDestroy(Sender: TObject);
begin
  _DIThreadPool.StopThreadPool;
  FreeAndNil(_DIThreadPool);
  FreeAndNil(_DITcpCircularPacketSocketServer );
  FreeAndNil(_IOCompletionPort);
end;

procedure TfrmServer.Timer1Timer(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 := _DITcpCircularPacketSocketServer.FPoolClientContext.GetClientContextCount;
  nIocpBufCount := _DITcpCircularPacketSocketServer.FPoolBuffer.GetBufferCount;
  nAcceptExBufCount := _DITcpCircularPacketSocketServer.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 TfrmServer.Button4Click(Sender: TObject);
begin
  ABoutFrm := TABoutFrm.Create(nil);
  ABoutFrm.ShowModal;
end;

end.