idcmdtcpclient.pas

网络控件适用于Delphi6

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  21518: IdCmdTCPClient.pas
{
    Rev 1.16    6/11/2004 8:48:16 AM  DSiders
  Added "Do not Localize" comments.
}
{
{   Rev 1.15    5/18/04 9:12:26 AM  RLebeau
{ Bug fix for SetExceptionReply() property setter
}
{
{   Rev 1.14    5/16/04 5:18:04 PM  RLebeau
{ Added setter method to ExceptionReply property
}
{
    Rev 1.13    5/10/2004 6:10:38 PM  DSiders
  Removed unused member var FCommandHandlersInitialized.
}
{
{   Rev 1.12    2004.03.06 1:33:00 PM  czhower
{ -Change to disconnect
{ -Addition of DisconnectNotifyPeer
{ -WriteHeader now write bufers
}
{
{   Rev 1.11    2004.03.01 5:12:24 PM  czhower
{ -Bug fix for shutdown of servers when connections still existed (AV)
{ -Implicit HELP support in CMDserver
{ -Several command handler bugs
{ -Additional command handler functionality.
}
{
{   Rev 1.10    2004.02.03 4:17:10 PM  czhower
{ For unit name changes.
}
{
{   Rev 1.9    2004.01.20 10:03:22 PM  czhower
{ InitComponent
}
{
{   Rev 1.8    1/4/04 8:46:16 PM  RLebeau
{ Added OnBeforeCommandHandler and OnAfterCommandHandler events
}
{
    Rev 1.7    11/4/2003 10:25:40 PM  DSiders
  Removed duplicate FReplyClass member in TIdCmdTCPClient (See
  TIdTCPConnection).
}
{
{   Rev 1.6    10/21/2003 10:54:20 AM  JPMugaas
{ Fix for new API change.
}
{
{   Rev 1.5    2003.10.18 9:33:24 PM  czhower
{ Boatload of bug fixes to command handlers.
}
{
{   Rev 1.4    2003.10.02 10:16:26 AM  czhower
{ .Net
}
{
{   Rev 1.3    2003.09.19 11:54:26 AM  czhower
{ -Completed more features necessary for servers
{ -Fixed some bugs
}
{
    Rev 1.2    7/9/2003 10:55:24 PM  BGooijen
  Restored all features
}
{
{   Rev 1.1    7/9/2003 04:36:06 PM  JPMugaas
{ You now can override the TIdReply with your own type.  This should illiminate
{ some warnings about some serious issues.  TIdReply is ONLY a base class with
{ virtual methods.
}
{
{   Rev 1.0    7/7/2003 7:06:40 PM  SPerry
{ Component that uses command handlers
}
{
{   Rev 1.0    7/6/2003 4:47:26 PM  SPerry
{ Units that use Command handlers
}
{
  Original author: Sergio Perry
  Description: TCP client that uses CommandHandlers
}
unit IdCmdTCPClient;

interface

uses
  Classes, SysUtils,
  IdContext, IdGlobal, IdReply, IdThread, IdTCPClient, IdCommandHandlers;

type
  TIdCmdTCPClient = class;

  { Events }
  TIdCmdTCPClientAfterCommandHandlerEvent = procedure(ASender: TIdCmdTCPClient;
    AContext: TIdContext) of object;
  TIdCmdTCPClientBeforeCommandHandlerEvent = procedure(ASender: TIdCmdTCPClient;
    var AData: string; AContext: TIdContext) of object;

  { Listening Thread }
  TIdCmdTCPClientListeningThread = class(TIdThread)
  protected
    FContext: TIdContext;
    FClient: TIdCmdTCPClient;
    FRecvData: String;
    //
    procedure Run; override;
  public
    constructor Create(AClient: TIdCmdTCPClient); reintroduce;
    destructor Destroy; override;
    //
    property Client: TIdCmdTCPClient read FClient;
    property RecvData: String read FRecvData write FRecvData;
  end;

  { TIdCmdTCPClient }
  TIdCmdTCPClient = class(TIdTCPClient)
  protected
    FExceptionReply: TIdReply;
    FOnConnect: TNotifyEvent;
    FOnDisconnect: TNotifyEvent;
    FListeningThread: TIdCmdTCPClientListeningThread;
    FCommandHandlers: TIdCommandHandlers;
    FCommandHandlersEnabled: Boolean;
    FOnAfterCommandHandler: TIdCmdTCPClientAfterCommandHandlerEvent;
    FOnBeforeCommandHandler: TIdCmdTCPClientBeforeCommandHandlerEvent;
    //
    procedure DoAfterCommandHandler(ASender: TIdCommandHandlers; AContext: TIdContext);
    procedure DoBeforeCommandHandler(ASender: TIdCommandHandlers; var AData: string;
      AContext: TIdContext);
    procedure InitComponent; override;
    procedure SetExceptionReply(AValue: TIdReply);
  public
    procedure Connect; override;
    destructor Destroy; override;
    procedure Disconnect(AImmediate: Boolean); override;
  published
    property CommandHandlers: TIdCommandHandlers read FCommandHandlers write FCommandHandlers;
    property CommandHandlersEnabled: boolean read FCommandHandlersEnabled
      write FCommandHandlersEnabled default IdCommandHandlersEnabledDefault;
    property ExceptionReply: TIdReply read FExceptionReply write SetExceptionReply;
    //
    property OnAfterCommandHandler: TIdCmdTCPClientAfterCommandHandlerEvent
      read FOnAfterCommandHandler write FOnAfterCommandHandler;
    property OnBeforeCommandHandler: TIdCmdTCPClientBeforeCommandHandlerEvent
      read FOnBeforeCommandHandler write FOnBeforeCommandHandler;
    property OnConnect: TNotifyEvent read FOnConnect write FOnConnect;
    property OnDisconnect: TNotifyEvent read FOnDisconnect write FOnDisconnect;
  end;

implementation

uses IdReplyRFC;

{ Listening Thread }

constructor TIdCmdTCPClientListeningThread.Create(AClient: TIdCmdTCPClient);
begin
  inherited Create(False);
  //
  FContext := TIdContext.Create(AClient, nil, nil);
  FClient := AClient;
  FreeOnTerminate := False;
end;

destructor TIdCmdTCPClientListeningThread.Destroy;
begin
  inherited Destroy;
  FreeAndNil(FContext);
end;

procedure TIdCmdTCPClientListeningThread.Run;
begin
  FRecvData := FClient.IOHandler.ReadLn;
  FClient.CommandHandlers.HandleCommand(FContext, FRecvData);
  //Synchronize(?);
  FClient.IOHandler.CheckForDisconnect;
end;

{ TIdCmdTCPClient }

destructor TIdCmdTCPClient.Destroy;
begin
  FreeAndNil(FExceptionReply);
  FreeAndNil(FCommandHandlers);
  inherited Destroy;
end;

procedure TIdCmdTCPClient.Connect;
begin
  inherited Connect;
  //
  if Assigned(FOnConnect) then
  begin
    OnConnect(Self);
  end;
  FListeningThread := TIdCmdTCPClientListeningThread.Create(Self);
end;

procedure TIdCmdTCPClient.Disconnect(AImmediate: Boolean);
begin
  if Assigned(FListeningThread) then begin
    with FListeningThread do begin
      Terminate;
      WaitFor;
    end;
  end;
  //
  FreeAndNil(FListeningThread);
  inherited;
  //
  if Assigned(FOnDisconnect) then begin
    OnDisconnect(Self);
  end;
end;

procedure TIdCmdTCPClient.DoAfterCommandHandler(ASender: TIdCommandHandlers;
  AContext: TIdContext);
begin
  if Assigned(OnAfterCommandHandler) then begin
    OnAfterCommandHandler(Self, AContext);
  end;
end;

procedure TIdCmdTCPClient.DoBeforeCommandHandler(ASender: TIdCommandHandlers;
  var AData: string; AContext: TIdContext);
begin
  if Assigned(OnBeforeCommandHandler) then begin
    OnBeforeCommandHandler(Self, AData, AContext);
  end;
end;

procedure TIdCmdTCPClient.InitComponent;
begin
  inherited;

  FExceptionReply := FReplyClass.Create(nil);
  ExceptionReply.SetReply(500, 'Unknown Internal Error'); {do not localize}

  FCommandHandlersEnabled := IdCommandHandlersEnabledDefault;
  FCommandHandlers := TIdCommandHandlers.Create(Self, FReplyClass, nil, ExceptionReply);
  FCommandHandlers.OnAfterCommandHandler := DoAfterCommandHandler;
  FCommandHandlers.OnBeforeCommandHandler := DoBeforeCommandHandler;
end;

procedure TIdCmdTCPClient.SetExceptionReply(AValue: TIdReply);
begin
  FExceptionReply.Assign(AValue);
end;

end.