guiunit.pas

一个国外比较早的IOCP控件

unit GUIUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, DnAbstractExecutor, DnThreadExecutor, DnTcpReactor,
  DnAbstractLogger, DnCallbackLogger, DnWinSockMgr, DnTcpListener,
  DnTcpConnecter, DnTcpAbstractRequestor, DnTcpRequestor, DnRtl, DnInterfaces;

type
  TChatForm = class(TForm)
    ThreadExecutor: TDnThreadExecutor;
    TcpReactor: TDnTcpReactor;
    Logger: TDnCallbackLogger;
    WinSockMgr: TDnWinSockMgr;
    TcpListener: TDnTcpListener;
    TcpRequestor: TDnTcpRequestor;
    TcpConnecter: TDnTcpConnecter;
    Label1: TLabel;
    EdClientIP: TEdit;
    Label2: TLabel;
    EdClientPort: TEdit;
    Label3: TLabel;
    EdMessage: TEdit;
    BtSend: TButton;
    BtStartStop: TButton;
    LBHistory: TListBox;
    procedure BtStartStopClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TcpListenerIncoming(Context: TDnThreadContext;
      Channel: IDnChannel);
    procedure TcpRequestorLineRead(Context: TDnThreadContext;
      Channel: IDnChannel; Key: Pointer; ReceivedLine: String;
      EolFound: Boolean);
    procedure BtSendClick(Sender: TObject);
    procedure TcpConnecterConnect(Context: TDnThreadContext;
      Channel: IDnChannel; Key: Pointer; const IP: String; Port: Word);
    procedure TcpConnecterError(Context: TDnThreadContext;
      Channel: IDnChannel; Key: Pointer; ErrorCode: Cardinal);
    procedure TcpRequestorError(Context: TDnThreadContext;
      Channel: IDnChannel; Key: Pointer; ErrorCode: Cardinal);
    procedure TcpRequestorClientClose(Context: TDnThreadContext;
      Channel: IDnChannel; Key: Pointer);
    procedure LoggerLogMessage(Level: TDnLogLevel; const Msg: String);
    procedure TcpRequestorWrite(Context: TDnThreadContext;
      Channel: IDnChannel; Key: Pointer; Buf: PChar; BufSize: Cardinal);
    procedure TcpRequestorClose(Context: TDnThreadContext;
      Channel: IDnChannel; Key: Pointer);
  private
    FStarted: Boolean;
  public
    procedure Start;
    procedure Stop;
  end;

var
  ChatForm: TChatForm;

implementation

{$R *.DFM}

procedure TChatForm.Start;
begin
  WinsockMgr.Active := True;
  Logger.Active := True;
  ThreadExecutor.Active := True;
  TcpReactor.Active := True;
  TcpRequestor.Active := True;
  TcpConnecter.Active := True;
  TcpListener.Active := True;
end;

procedure TChatForm.Stop;
begin
  TcpListener.Active := False;
  TcpReactor.CloseChannels;
  //your code for waiting tasks finishing should be here
  //....
  TcpRequestor.Active := False;
  TcpConnecter.Active := False;
  TcpReactor.Active := False;
  ThreadExecutor.Active := False;
  Logger.Active := False;
  WinsockMgr.Active := False;
end;

procedure TChatForm.BtStartStopClick(Sender: TObject);
begin
  if not FStarted then
    Start
  else
    Stop;
  FStarted := not FStarted;
  BtSend.Enabled := FStarted;
  if FStarted then
    BtStartStop.Caption := 'Stop'
  else
    BtStartStop.Caption := 'Stop';
end;

procedure TChatForm.FormCreate(Sender: TObject);
begin
  FStarted := False;
end;

procedure TChatForm.TcpListenerIncoming(Context: TDnThreadContext;
  Channel: IDnChannel);
begin
  //ok, read the incoming message
  TcpRequestor.ReadLine(Channel, Nil, 65535);
end;

procedure TChatForm.TcpRequestorLineRead(Context: TDnThreadContext;
  Channel: IDnChannel; Key: Pointer; ReceivedLine: String;
  EolFound: Boolean);
var Resp: String;
begin
  Resp := 'Message from ' + Channel.RemoteAddr + ':' + IntToStr(Channel.RemotePort)+ '. Message is: ';
  if EolFound then
    Resp := Resp + Copy(ReceivedLine, 1, Length(ReceivedLine) - 2) //remove CRLF
  else
    Resp := Resp + ReceivedLine;
  LBHistory.Items.Add(Resp);
  TcpRequestor.ReadLine(Channel, Nil, 65535);
end;

procedure TChatForm.BtSendClick(Sender: TObject);
var Channel: IDnChannel;
begin
  Channel := TcpReactor.MakeChannel(EdClientIP.Text, StrToInt(EdClientPort.Text));
  Self.TcpConnecter.Connect(Channel, Nil, 120000);
end;

procedure TChatForm.TcpConnecterConnect(Context: TDnThreadContext;
  Channel: IDnChannel; Key: Pointer; const IP: String; Port: Word);
var Msg: String;
begin
  Msg := EdMessage.Text + #13#10;
  TcpRequestor.WriteString(Channel, Nil, Msg);
end;

procedure TChatForm.TcpConnecterError(Context: TDnThreadContext;
  Channel: IDnChannel; Key: Pointer; ErrorCode: Cardinal);
begin
  Logger.LogMsg(llMandatory, 'Cannot connect to ' + Channel.RemoteAddr + ':' + IntToStr(Channel.RemotePort));
end;

procedure TChatForm.TcpRequestorError(Context: TDnThreadContext;
  Channel: IDnChannel; Key: Pointer; ErrorCode: Cardinal);
begin
  Logger.LogMsg(llMandatory, 'Cannot perform IO. Error code is ' + IntToStr(ErrorCode));
  TcpRequestor.Close(Channel, Nil, True);
end;

procedure TChatForm.TcpRequestorClientClose(Context: TDnThreadContext;
  Channel: IDnChannel; Key: Pointer);
begin
  TcpRequestor.Close(Channel, Nil, True);
end;

procedure TChatForm.LoggerLogMessage(Level: TDnLogLevel;
  const Msg: String);
begin
  LBHistory.Items.Add('Logger: ' + Msg)
end;

procedure TChatForm.TcpRequestorWrite(Context: TDnThreadContext;
  Channel: IDnChannel; Key: Pointer; Buf: PChar; BufSize: Cardinal);
begin
  TcpRequestor.Close(Channel, Nil);
end;

procedure TChatForm.TcpRequestorClose(Context: TDnThreadContext;
  Channel: IDnChannel; Key: Pointer);
begin
  Channel := Nil;
  //TcpReactor.RemoveChannel(Channel);
end;

end.