clientmain.pas

iocp小程序

unit ClientMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, Spin;

const
  WM_RevMsg = WM_USER + 1001;
type
  TRevThread = class;

  TClient = record
    IdTcpClient: TIdTCPClient;
    Thread: TRevThread;
  end;
  
  TFmMain = class(TForm)
    pnl1: TPanel;
    lbl1: TLabel;
    edtServer: TEdit;
    lbl2: TLabel;
    edtPort: TEdit;
    btnConnect: TButton;
    pnl2: TPanel;
    btnSend: TButton;
    mmoSend: TMemo;
    btnDisConnect: TButton;
    mmoRev: TMemo;
    seCount: TSpinEdit;
    lbl3: TLabel;
    procedure btnConnectClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure btnDisConnectClick(Sender: TObject);
  private
    FRevThread: TRevThread;
    FClients: array of TClient;
  public
    { Public declarations }
    procedure WMRevMsg(var AMsg: TMessage); message WM_RevMsg;
  end;

  TRevThread = class(TThread)
  public
    FIdTcpClient: TIdTCPClient;
    procedure Execute; override;
  end;

var
  FmMain: TFmMain;

implementation

{$R *.dfm}

procedure TFmMain.btnConnectClick(Sender: TObject);
var
  i: Integer;
begin
  Screen.Cursor := crHourGlass;
  try
    //try
      SetLength(FClients, seCount.Value);
      for i := Low(FClients) to High(FClients) do
      begin
        FClients[i].IdTcpClient := TIdTCPClient.Create(nil);
        FClients[i].IdTcpClient.Host := edtServer.Text;
        FClients[i].IdTcpClient.Port := StrToInt(edtPort.Text);
        FClients[i].IdTcpClient.Connect(-1);
        FClients[i].Thread := TRevThread.Create(True);
        FClients[i].Thread.FIdTcpClient := FClients[i].IdTcpClient;
        FClients[i].Thread.FreeOnTerminate := True;
        FClients[i].Thread.Resume;
        Sleep(100);
      end;
      btnConnect.Enabled := False;
      btnDisConnect.Enabled := True;
    //except
      //btnDisConnectClick(nil);
    //end;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TFmMain.btnSendClick(Sender: TObject);
var
  i: Integer;
begin
  Screen.Cursor := crHourGlass;
  try
    for i := Low(FClients) to High(FClients) do
    begin
      if FClients[i].IdTcpClient.Connected then
      begin
        FClients[i].IdTcpClient.WriteStrings(mmoSend.Lines);
        Sleep(10);
      end;
    end;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TFmMain.btnDisConnectClick(Sender: TObject);
var
  i: Integer;
begin
  Screen.Cursor := crHourGlass;
  try
    for i := Low(FClients) to High(FClients) do
    begin
      if Assigned(FClients[i].IdTcpClient) then
      begin
        FClients[i].IdTcpClient.Disconnect;
        Sleep(100);
        //FClients[i].Thread.Terminate;
        //WaitForSingleObject(FClients[i].Thread.Handle, INFINITE);
        FreeAndNil(FClients[i].IdTcpClient);
      end;
    end;
    btnConnect.Enabled := True;
    btnDisConnect.Enabled := False;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TFmMain.WMRevMsg(var AMsg: TMessage);
var
  sMessage: string;
begin
  sMessage := PChar(AMsg.WParam);
  FreeMem(PChar(AMsg.WParam));
  mmoRev.Lines.Add(DateTimeToStr(Now) + ': ' + sMessage);
end;

{ TRevThread }

procedure TRevThread.Execute;
var
  s: string;
  pBuf: PChar;
begin
  inherited;
  while not Terminated do
  begin
    try
      if not FIdTcpClient.Connected then Terminate;
      try
        s := FIdTcpClient.ReadLn();
      except
        ;
      end;
      //if not Assigned(FIdTcpClient) then Exit;
      if s = '' then Exit;
      GetMem(pBuf, Length(s)+1);
      CopyMemory(@pBuf[0], @s[1],  Length(s));
      pBuf[ Length(s)] := #0;
      //内存在接收方释放，否则会造成内存泄漏
      SendMessage(FmMain.Handle, WM_RevMsg, WParam(@pBuf[0]), 0);
    except
      Exit; 
    end;
  end;
end;  

end.