unit1.pas

一个用delphi封装的IOCP（完成端口）控件

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    IOCPServer1: TIOCPServer;
    IdTCPClient1: TIdTCPClient;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Edit1: TEdit;
    Button5: TButton;
    Button6: TButton;
    IOCPClient1: TIOCPClient;
    Button7: TButton;
    Button8: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure IOCPServer1DisConnect(ASkt: Integer);
    procedure IOCPServer1Read(ASkt: Integer; AData: PAnsiChar;
      ADataLen: Integer);
    procedure Button4Click(Sender: TObject);
    procedure IOCPServer1Connect(ASkt: Integer; ALinkInfo: PLinkInfo;
      var Accept: Boolean);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure IOCPClient1Read(ASkt: Integer; AData: PAnsiChar;
      ADataLen: Integer);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin

  IOCPServer1.Active := True;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  IdTCPClient1.Connect(1000);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  IdTCPClient1.DisconnectSocket;
end;

procedure TForm1.IOCPServer1DisConnect(ASkt: Integer);
var
  S: string;
begin
  S := Inttostr(ASkt) + ' : 断开';
  self.caption :=S;
  Memo1.Lines.Add(s);
end;

procedure TForm1.IOCPServer1Read(ASkt: Integer; AData: PAnsiChar;
  ADataLen: Integer);
begin
 // Showmessage(PChar(AData));
  //Memo1.Lines.Text :=AData;
  Memo1.Lines.Add(AData);
  IOCPServer1.SendData(ASkt,AData,ADataLen);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  s: string;
  i: integer;
begin
  for i := 0 to StrToInt(Edit1.text)-1 do
  begin
    s:= s+ inttostr(i+1) + '测试发送';
  end;
  IdTCPClient1.Write(s);
  IdTCPClient1.ReadTimeout := 1000;
  Memo2.Lines.Text := IdTCPClient1.ReadString(length(s));

  if Memo2.Lines.Text <> s then
  Showmessage('不一致');
end;

procedure TForm1.IOCPServer1Connect(ASkt: Integer; ALinkInfo: PLinkInfo;
  var Accept: Boolean);
var
  s: string;
begin
  s := Format('Socket: [%d] IP:[%s] Port:[%d] 请求连接.',[ALinkInfo^.Skt,ALinkInfo^.IP,ALinkInfo^.Port]);

  self.caption :=Inttostr(IOCPServer1.LinkCount);
  Memo1.Lines.Add(s);
  Memo1.Lines.Add('当前连接个数:' + Inttostr(IOCPServer1.LinkCount));
  //Accept := false;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  s: string;
begin
  s := '测试广播发送';
  IOCPServer1.BroadCast(PChar(s),Length(s));
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  s: string;
begin
  if IOCPServer1.Active then
  begin
   // Showmessage('本程序的服务端已经执行,如果执行等待的话会组塞整个程序');
    exit;
  end;
  s := '测试广播接收';
  s := IdTCPClient1.ReadString(length(s));
  Memo2.Text := s;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  IOCPClient1.Connect;
end;

procedure TForm1.Button8Click(Sender: TObject);
var
  s: string;
  i: integer;
  c: char;
begin
  c := 'A';
  for i := 0 to StrToInt(Edit1.text)-1 do
  begin
    //s:= s+ inttostr(i+1) + '测试发送';
    s:= s+ c;
  end;

  //IdTCPClient1.ReadTimeout := 1000;
  //Memo2.Lines.Text := IdTCPClient1.ReadString(length(s));

  IOCPClient1.SendData(PChar(s),Length(s));
end;

procedure TForm1.IOCPClient1Read(ASkt: Integer; AData: PAnsiChar;
  ADataLen: Integer);
begin
  Memo2.Lines.Add(AData);
end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin
  if IOCPServer1.Active then
  begin
    IOCPServer1.BroadCast('广播消息',8);
  end;
end;

end.