dntcprequestor.pas

一个国外比较早的IOCP控件

// The contents of this file are used with permission, subject to
// the Mozilla Public License Version 1.1 (the "License"); you may
// not use this file except in compliance with the License. You may
// obtain a copy of the License at
// http://www.mozilla.org/MPL/MPL-1.1.html
//
// Software distributed under the License is distributed on an
// "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
// implied. See the License for the specific language governing
// rights and limitations under the License.
{$I DnConfig.inc}
unit DnTcpRequestor;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Winsock2,
  DnConst, DnRtl, DnInterfaces, DnTcpReactor, DnTcpAbstractRequestor,
  DnTcpRequests;

type
  TDnTcpRead =          procedure (Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                          Buf: PChar; BufSize: Cardinal) of object;
  TDnTcpWrite =         procedure (Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                           Buf: PChar; BufSize: Cardinal) of object;
  TDnTcpError =         procedure (Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                           ErrorCode: Cardinal) of object;
  TDnTcpClose =         procedure (Context: TDnThreadContext; Channel: IDnChannel;
                            Key: Pointer) of object;
  TDnTcpClientClose =   procedure (Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer) of object;
  TDnTcpLine =          procedure (Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                          ReceivedLine: String; EolFound: Boolean) of object;
  TDnTcpConnect =       procedure (Context: TDnThreadContext; Channel: IDnChannel;
                          Key: Pointer) of object;
  TDnTcpConnectError =  procedure (Context: TDnThreadContext; Channel: IDnChannel;
                          Key: Pointer; ErrorCode: Cardinal) of object;

  TDnTcpRequestor = class(TDnTcpAbstractRequestor,
                          IDnTcpReadHandler, IDnTcpWriteHandler,
                          IDnTcpCloseHandler, IDnTcpLineHandler,
                          IUnknown)
  protected
    FTcpRead:         TDnTcpRead;
    FTcpWrite:        TDnTcpWrite;
    FTcpError:        TDnTcpError;
    FTcpClose:        TDnTcpClose;
    FTcpClientClose:  TDnTcpClientClose;
    FTcpLine:         TDnTcpLine;

    //IDnTcpReadHandler
    procedure DoRead(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                          Buf: PChar; BufSize: Cardinal);
    procedure DoReadError(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                           ErrorCode: Cardinal);
    procedure DoReadClose(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer);

    //IDnTcpWriteHandler
    procedure DoWrite(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                           Buf: PChar; BufSize: Cardinal);
    procedure DoWriteError(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                           ErrorCode: Cardinal);

    //IDnTcpCloseHandler
    procedure DoCloseError(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                           ErrorCode: Cardinal);
    procedure DoClose(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer);

    //IDnTcpLineHandler
    procedure DoLine( Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                      ReceivedLine: String; EolFound: Boolean );
    procedure DoLineError(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                           ErrorCode: Cardinal);
    procedure DoLineClose(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer);


    procedure DoClientClose(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer);
    procedure DoError(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                      ErrorCode: Cardinal);


  public
    constructor Create{$IFDEF ROOTISCOMPONENT}(AOwner: TComponent);override{$ENDIF};
    destructor Destroy; override;
    procedure Read(Channel: IDnChannel; Key: Pointer; Buf: PChar; BufSize: Cardinal);
    procedure ReadString(Channel: IDnChannel; Key: Pointer; Size: Integer);
    procedure RawRead(Channel: IDnChannel; Key: Pointer; Buf: PChar; MaxSize: Cardinal);
    procedure Write(Channel: IDnChannel; Key: Pointer; Buf: PChar;  BufSize: Cardinal);
    procedure WriteString(Channel: IDnChannel; Key: Pointer; Buf: String);
    procedure Close(Channel: IDnChannel; Key: Pointer; Brutal: Boolean = False);
    procedure ReadLine(Channel: IDnChannel; Key: Pointer; MaxSize: Cardinal);
  published
    property OnRead:          TDnTcpRead read FTcpRead write FTcpRead;
    property OnWrite:         TDnTcpWrite read FTcpWrite write FTcpWrite;
    property OnClose:         TDnTcpClose read FTcpClose write FTcpClose;
    property OnError:         TDnTcpError read FTcpError write FTcpError;
    property OnLineRead:      TDnTcpLine read FTcpLine write FTcpLine;
    property OnClientClose:   TDnTcpClientClose read FTcpClientClose write FTcpClientClose;
  end;


procedure Register;

implementation

procedure Register;
begin
  {$IFDEF ROOTISCOMPONENT}
  RegisterComponents('DNet', [TDnTcpRequestor]);
  {$ENDIF}
end;

//----------------------------------------------------------------------------

constructor TDnTcpRequestor.Create{$IFDEF ROOTISCOMPONENT}(AOwner: TComponent){$ENDIF};
begin
  inherited Create{$IFDEF ROOTISCOMPONENT}(AOwner){$ENDIF};
  FTcpRead := Nil;
  FTcpWrite := Nil;
  FTcpError := Nil;
  FTcpClose := Nil;
  FTcpLine := Nil;
  FTcpClientClose := Nil;
end;

destructor TDnTcpRequestor.Destroy;
begin
  inherited Destroy;
end;

procedure TDnTcpRequestor.Read(Channel: IDnChannel; Key: Pointer; Buf: PChar; BufSize: Cardinal);
var Request: TDnTcpRequest;
begin
  CheckAvail;
  Request := TDnTcpReadRequest.Create(Channel, Key, Self, Buf, BufSize);
  Channel.RunRequest(Request);
end;

procedure TDnTcpRequestor.ReadString(Channel: IDnChannel; Key: Pointer; Size: Integer);
var Request: TDnTcpRequest;
begin
  CheckAvail;
  Request := TDnTcpReadRequest.CreateString(Channel, Key, Self, Size);
  Channel.RunRequest(Request);
end;

procedure TDnTcpRequestor.RawRead(Channel: IDnChannel; Key: Pointer; Buf: PChar; MaxSize: Cardinal);
var Request: TDnTcpRequest;
begin
  CheckAvail;
  Request := TDnTcpReadRequest.Create(Channel, Key, Self, Buf, MaxSize, False);
  Channel.RunRequest(Request);
end;

procedure TDnTcpRequestor.Write(Channel: IDnChannel; Key: Pointer; Buf: PChar; BufSize: Cardinal);
var Request: TDnTcpRequest;
begin
  CheckAvail;
  Request := TDnTcpWriteRequest.Create(Channel, Key, Self, Buf, BufSize);
  Channel.RunRequest(Request);
end;

procedure TDnTcpRequestor.WriteString(Channel: IDnChannel; Key: Pointer; Buf: String);
var Request: TDnTcpRequest;
begin
  CheckAvail;
  Request := TDnTcpWriteRequest.CreateString(Channel, Key, Self, Buf);
  Channel.RunRequest(Request);
end;

procedure TDnTcpRequestor.Close(Channel: IDnChannel; Key: Pointer; Brutal: Boolean);
var Request: TDnTcpRequest;
begin
  CheckAvail;
  Request := TDnTcpCloseRequest.Create(Channel, Key, Self, Brutal);
  Channel.RunRequest(Request);
end;

procedure TDnTcpRequestor.ReadLine(Channel: IDnChannel; Key: Pointer; MaxSize: Cardinal);
var Request: TDnTcpRequest;
begin
  CheckAvail;
  Request := TDnTcpLineRequest.Create(Channel, Key, Self, MaxSize);
  Channel.RunRequest(Request);
end;

procedure TDnTcpRequestor.DoRead( Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                                  Buf: PChar; BufSize: Cardinal);
begin
  try
    if Assigned(FTcpRead) then
      FTcpRead(Context, Channel, Key, Buf, BufSize);
  except
    on E: Exception do
      Self.PostLogMessage(E.Message);
  end;
end;

procedure TDnTcpRequestor.DoReadError(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                                      ErrorCode: Cardinal);
begin
  Self.DoError(Context, Channel, Key, ErrorCode);
end;

procedure TDnTcpRequestor.DoReadClose(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer);
begin
  Self.DoClientClose(Context, Channel, Key);
end;

procedure TDnTcpRequestor.DoWrite(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                                  Buf: PChar; BufSize: Cardinal);
begin
  try
    if Assigned(FTcpWrite) then
      FTcpWrite(Context, Channel, Key, Buf, BufSize);
  except
    on E: Exception do
      Self.PostLogMessage(E.Message);
  end;
end;

procedure TDnTcpRequestor.DoWriteError( Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                                        ErrorCode: Cardinal );
begin
  Self.DoError(Context, Channel, Key, ErrorCode);
end;

procedure TDnTcpRequestor.DoError(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                                  ErrorCode: Cardinal);
begin
  try
    if Assigned(FTcpError) then
      FTcpError(Context, Channel, Key, ErrorCode);
  except
    on E: Exception do
      Self.PostLogMessage(E.Message);
  end;
end;

procedure TDnTcpRequestor.DoClose(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer);
begin
  try
    if Assigned(FTcpClose) then
      FTcpClose(Context, Channel, Key);
  except
    on E: Exception do
      Self.PostLogMessage(E.Message);
  end;
end;

procedure TDnTcpRequestor.DoCloseError( Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                                        ErrorCode: Cardinal );
begin
  Self.DoError(Context, Channel, Key, ErrorCode);
end;

procedure TDnTcpRequestor.DoClientClose(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer);
begin
  try
    if Assigned(FTcpClientClose) then
      FTcpClientClose(Context, Channel, Key);
  except
    on E: Exception do
      Self.PostLogMessage(E.Message);
  end;
end;

procedure TDnTcpRequestor.DoLine( Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                                  ReceivedLine: String; EolFound: Boolean );
begin
  try
    if Assigned(FTcpLine) then
      FTcpLine(Context, Channel, Key, ReceivedLine, EolFound);
  except
    on E: Exception do
      Self.PostLogMessage(E.Message);
  end;
end;

procedure TDnTcpRequestor.DoLineClose(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer);
begin
  Self.DoClientClose(Context, Channel, Key);
end;

procedure TDnTcpRequestor.DoLineError(Context: TDnThreadContext; Channel: IDnChannel; Key: Pointer;
                                      ErrorCode: Cardinal );
begin
  Self.DoError(Context, Channel, Key, ErrorCode);
end;

end.