Delphi-IOCP学习笔记<九>======性能测试和IOCP源码下载<5000个连接数>

procedure TfrmMain.btnEchoTesterClick(Sender: TObject);
var
  lvEchoTester:TEchoTester;
  i:Integer;
begin
  for I := 1 to StrToInt(edtCount.Text) do
  begin
    lvEchoTester := TEchoTester.Create;
    lvEchoTester.TcpClient.Host := '127.0.0.1';
    lvEchoTester.TcpClient.Port := StrToInt(edtPort.Text);
    lvEchoTester.Resume;
    FTesterList.Add(lvEchoTester);
  end;
end;

unit uEchoTester;

interface

uses
  Classes, IdTCPClient, SysUtils,
  uJSonStreamObject, IdGlobal, superobject,
  Windows;

type
  TEchoTester = class(TThread)
  private
    FTcpClient: TIdTcpClient;
    function createObject: TJSonStreamObject;
    procedure echoWork(pvObject: TJSonStreamObject);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Execute;override;

    property TcpClient: TIdTcpClient read FTcpClient;
  end;

implementation

uses
  ComObj, uJSonStreamCoder;

constructor TEchoTester.Create;
begin
  inherited Create(true);
  FTcpClient := TIdTcpClient.Create(nil);
end;

destructor TEchoTester.Destroy;
begin
  FTcpClient.Free;
  inherited Destroy;
end;

function TEchoTester.createObject: TJSonStreamObject;
var
  lvStream:TMemoryStream;
  lvData:String;
begin
  Result := TJSonStreamObject.Create;
  Result.JSon := SO();
  Result.JSon.I['cmdIndex'] := 1000;   //echo 数据测试
  Result.JSon.S['data'] := '测试发送打包数据';
  Result.JSon.S['key'] := CreateClassID;

  lvStream := TMemoryStream.Create;
  SetLength(lvData, 1024 * 4);
  FillChar(lvData[1], 1024 * 4, Ord('1'));
  lvStream.WriteBuffer(lvData[1], Length(lvData));
  Result.setStream(lvStream);
end;

procedure TEchoTester.echoWork(pvObject: TJSonStreamObject);
var
  lvStream, lvPackStream:TMemoryStream;
  lvData:String;
  lvBuffer:TIdBytes;
  l, j, x:Integer;
begin
  lvPackStream := TMemoryStream.Create;
  try
    TJSonStreamCoder.Encode(pvObject, lvPackStream);

    SetLength(lvBuffer, lvPackStream.Size);
    lvPackStream.Position := 0;
    lvPackStream.ReadBuffer(lvBuffer[0], lvPackStream.Size);
    FTcpClient.Socket.Write(lvBuffer);

    l := FTcpClient.Socket.ReadLongInt(False);
    j := FTcpClient.Socket.ReadLongInt(False);

    //json数据
    SetLength(lvBuffer, l);
    FTcpClient.Socket.ReadBytes(lvBuffer, l, False);
    SetLength(lvData, l);
    ZeroMemory(@lvData[1], l);
    CopyMemory(@lvData[1], @lvBuffer[0], l);
    pvObject.JSon := SO(lvData);
    
    SetLength(lvBuffer, j);
    FTcpClient.Socket.ReadBytes(lvBuffer, j, False);
    pvObject.Stream.Size := 0;
    pvObject.Stream.Write(lvBuffer[0], j);

    SetLength(lvBuffer, pvObject.Stream.Size);
    pvObject.Stream.Position := 0;
    pvObject.Stream.ReadBuffer(lvBuffer[0], pvObject.Stream.Size);

    SetLength(lvBuffer, 0);
  finally
    lvPackStream.Free;
  end;
end;

{ TEchoTester }

procedure TEchoTester.Execute;
var
  lvJSonObject:TJSonStreamObject;
begin
  FTcpClient.Connect;
  lvJSonObject := createObject;
  try
    while (not self.Terminated) do
    begin
      try
        echoWork(lvJSonObject);
      except

      end;
    end; 
    FTcpClient.Disconnect;
  finally
    lvJSonObject.Free;
  end;
end;

end.