idtcpconnection.pas

Indy控件的使用源代码

{ $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:  10365: IdTCPConnection.pas 
{
    Rev 1.1    4/17/2003 4:58:38 PM  BGooijen
  cleaned up CheckForDisconnect a little
}
{
{   Rev 1.0    2002.11.12 10:55:02 PM  czhower
}
unit IdTCPConnection;

interface

{
2002-04-12 - Andrew P.Rybin
  - ReadLn bugfix and optimization
2002-01-20 - Chad Z. Hower a.k.a Kudzu
  -WriteBuffer change was not correct. Removed. Need info on original problem to fix properly.
  -Modified ReadLnWait
2002-01-19 - Grahame Grieve
  - Fix to WriteBuffer to accept -1 from the stack.
  Also fixed to clean up FWriteBuffer if connection lost.
2002-01-19 - Chad Z. Hower a.k.a Kudzu
  -Fix to ReadLn
2002-01-16 - Andrew P.Rybin
  -ReadStream optimization, TIdManagedBuffer new
2002-01-03 - Chad Z. Hower a.k.a Kudzu
  -Added MaxLineAction
  -Added ReadLnSplit
2001-12-27 - Chad Z. Hower a.k.a Kudzu
  -Changes and bug fixes to InputLn
  -Modifed how buffering works
    -Added property InputBuffer
    -Moved some things to TIdBuffer
  -Modified ReadLn
  -Added LineCount to Capture
2001-12-25 - Andrew P.Rybin
  -MaxLineLength,ReadLn,InputLn and Merry Christmas!
Original Author and Maintainer:
  -Chad Z. Hower a.k.a Kudzu
}

uses
  Classes,
  IdException, IdComponent, IdGlobal, IdSocketHandle, IdIntercept, IdIOHandler, IdRFCReply,
  IdIOHandlerSocket;

const
  GRecvBufferSizeDefault = 32 * 1024;
  GSendBufferSizeDefault = 32 * 1024;
  IdMaxLineLengthDefault = 16 * 1024;
  IdInBufCacheSizeDefault= 32 * 1024; //TIdManagedBuffer.PackReadedSize
  IdDefTimeout = 0;

type
  TIdBufferBytesRemoved = procedure(ASender: TObject; const ABytes: Integer) of object;
  //DONE 5 -cBeta!!! -oAPR: Make this a buffered stream for more efficiency.
  TIdSimpleBuffer = class(TMemoryStream)
  protected
    FOnBytesRemoved: TIdBufferBytesRemoved;
  public
    constructor Create(AOnBytesRemoved: TIdBufferBytesRemoved = nil); reintroduce;
    function  Extract(const AByteCount: Integer): string; virtual;
    procedure Remove (const AByteCount: integer); virtual;
  End;//TIdSimpleBuffer

  TIdManagedBuffer = class(TIdSimpleBuffer)
  protected
    FPackReadedSize: Integer;
    FReadedSize: Integer;
    procedure SetPackReadedSize(const Value: Integer);
  public
    constructor Create(AOnBytesRemoved: TIdBufferBytesRemoved = nil);
    procedure Clear; //also clear "Readed"
    function  Extract(const AByteCount: Integer): string; override; //since Memory is not virtual
    function  Memory: Pointer; //ptr to not readed data
    procedure PackBuffer; //clear "Readed"
    procedure Remove (const AByteCount: integer); override;
    function  Seek(Offset: Longint; Origin: Word): Longint; override;
    //
    property  PackReadedSize: Integer read FPackReadedSize write SetPackReadedSize default IdInBufCacheSizeDefault;
  End;//TIdManagedBuffer

  TIdTCPConnection = class(TIdComponent)
  protected
    FASCIIFilter: boolean;
    // TODO - Change the "move" functions to read write functinos. Get as much as possible down
    // to just TStream so we can replace it easily
    FClosedGracefully: Boolean;
    FGreeting: TIdRFCReply;
    FFreeIOHandlerOnDisconnect: Boolean;
    FInputBuffer: TIdManagedBuffer;
    FIntercept: TIdConnectionIntercept;
    FIOHandler: TIdIOHandler;
    FLastCmdResult: TIdRFCReply;
    FMaxLineAction: TIdMaxLineAction;
    FMaxLineLength: Integer;
    FOnDisconnected: TNotifyEvent;
    FReadLnSplit: Boolean;
    FReadLnTimedOut: Boolean;
    FReadTimeout: Integer;
    FRecvBufferSize: Integer;
    FRecvBuffer: TIdSimpleBuffer; // To be used by ReadFromStack only
    FSendBufferSize: Integer;
    FSocket: TIdIOHandlerSocket;
    FWriteBuffer: TIdSimpleBuffer;
    FWriteBufferThreshhold: Integer;
    //
    procedure BufferRemoveNotify(ASender: TObject; const ABytes: Integer);
    procedure DoOnDisconnected; virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure PerformCapture(ADest: TObject; out VLineCount: Integer; const ADelim: string;
     const AIsRFCMessage: Boolean);
    procedure ResetConnection; virtual;
    procedure SetIntercept(AValue: TIdConnectionIntercept);
    procedure SetIOHandler(AValue: TIdIOHandler);
  public
    function AllData: string; virtual;
    procedure CancelWriteBuffer;
    procedure Capture(ADest: TStream; const ADelim: string = '.';
     const AIsRFCMessage: Boolean = True); overload;
    procedure Capture(ADest: TStream; out VLineCount: Integer; const ADelim: string = '.';
     const AIsRFCMessage: Boolean = True); overload;
    procedure Capture(ADest: TStrings; const ADelim: string = '.';
     const AIsRFCMessage: Boolean = True); overload;
    procedure Capture(ADest: TStrings; out VLineCount: Integer; const ADelim: string = '.';
     const AIsRFCMessage: Boolean = True); overload;
    procedure CheckForDisconnect(const ARaiseExceptionIfDisconnected: boolean = true;
     const AIgnoreBuffer: boolean = false); virtual;
    procedure CheckForGracefulDisconnect(const ARaiseExceptionIfDisconnected: Boolean = True);
     virtual;
    function CheckResponse(const AResponse: SmallInt; const AAllowedResponses: array of SmallInt)
     : SmallInt; virtual;
    procedure ClearWriteBuffer;
    procedure CloseWriteBuffer;
    function Connected: Boolean; virtual;
    constructor Create(AOwner: TComponent); override;
    function CurrentReadBuffer: string;
    destructor Destroy; override;
    procedure Disconnect; virtual;
    procedure DisconnectSocket; virtual;
    procedure FlushWriteBuffer(const AByteCount: Integer = -1);
    procedure GetInternalResponse;
    function GetResponse(const AAllowedResponses: array of SmallInt): SmallInt; overload; virtual;
    function GetResponse(const AAllowedResponse: SmallInt): SmallInt; overload;
    property Greeting: TIdRFCReply read FGreeting write FGreeting;
    function InputLn(const AMask: String = ''; AEcho: Boolean = True; ATabWidth: Integer = 8;
     AMaxLineLength: Integer = -1): String;
    procedure OpenWriteBuffer(const AThreshhold: Integer = -1);
    // RaiseExceptionForCmdResult - Overload necesary as a exception as a default param doesnt work
    procedure RaiseExceptionForLastCmdResult; overload; virtual;
    procedure RaiseExceptionForLastCmdResult(AException: TClassIdException); overload; virtual;
    procedure ReadBuffer(var ABuffer; const AByteCount: Longint);
    function ReadCardinal(const AConvert: boolean = true): Cardinal;
    function ReadChar: Char;
    // ReadFromStack must be only call to Recv
    function ReadFromStack(const ARaiseExceptionIfDisconnected: Boolean = True;
      ATimeout: Integer = IdTimeoutDefault;
      const ARaiseExceptionOnTimeout: Boolean = True): Integer; virtual;
    function ReadInteger(const AConvert: boolean = true): Integer;
    function ReadLn(ATerminator: string = LF;
      const ATimeout: Integer = IdTimeoutDefault; AMaxLineLength: Integer = -1): string; virtual;
    function ReadLnWait(AFailCount: Integer = MaxInt): string;
    function ReadSmallInt(const AConvert: boolean = true): SmallInt;
    procedure ReadStream(AStream: TStream; AByteCount: LongInt = -1;
     const AReadUntilDisconnect: boolean = false);
    function ReadString(const ABytes: Integer): string;
    procedure ReadStrings(var AValue: TStrings; AReadLinesCount: Integer = -1);
    function SendCmd(const AOut: string; const AResponse: SmallInt = -1): SmallInt; overload;
    function SendCmd(const AOut: string; const AResponse: Array of SmallInt): SmallInt; overload; virtual;
    function WaitFor(const AString: string): string;
    procedure Write(const AOut: string); virtual;
    // WriteBuffer must be the ONLY call to SEND - all data goes thru this method
    procedure WriteBuffer(const ABuffer; AByteCount: Longint; const AWriteNow: Boolean = False);
    procedure WriteCardinal(AValue: Cardinal; const AConvert: Boolean = True);
    procedure WriteHeader(AHeader: TStrings);
    procedure WriteInteger(AValue: Integer; const AConvert: Boolean = True);
    procedure WriteLn(const AOut: string = ''); virtual;
    procedure WriteRFCReply(AReply: TIdRFCReply);
    procedure WriteRFCStrings(AStrings: TStrings);
    procedure WriteSmallInt(AValue: SmallInt; const AConvert: Boolean = True);
    procedure WriteStream(AStream: TStream; const AAll: Boolean = True;
     const AWriteByteCount: Boolean = False; const ASize: Integer = 0); virtual;
    procedure WriteStrings(AValue: TStrings; const AWriteLinesCount: Boolean = False);
    function WriteFile(const AFile: String; const AEnableTransferFile: Boolean = False): Cardinal; virtual;
    //
    property ClosedGracefully: Boolean read FClosedGracefully;
    property InputBuffer: TIdManagedBuffer read FInputBuffer;
    property LastCmdResult: TIdRFCReply read FLastCmdResult;
    property ReadLnSplit: Boolean read FReadLnSplit;
    property ReadLnTimedOut: Boolean read FReadLnTimedOut;
    property Socket: TIdIOHandlerSocket read FSocket;
  published
    property ASCIIFilter: boolean read FASCIIFilter write FASCIIFilter default False;
    property Intercept: TIdConnectionIntercept read FIntercept write SetIntercept;
    property IOHandler: TIdIOHandler read FIOHandler write SetIOHandler;
    property MaxLineLength: Integer read FMaxLineLength write FMaxLineLength default IdMaxLineLengthDefault;
    property MaxLineAction: TIdMaxLineAction read FMaxLineAction write FMaxLineAction;
    property ReadTimeout: Integer read FReadTimeout write FReadTimeout default IdDefTimeout;
    property RecvBufferSize: Integer read FRecvBufferSize write FRecvBufferSize
     default GRecvBufferSizeDefault;
    property SendBufferSize: Integer read FSendBufferSize write FSendBufferSize
     default GSendBufferSizeDefault;
    // Events
    property OnDisconnected: TNotifyEvent read FOnDisconnected write FOnDisconnected;
    property OnWork;
    property OnWorkBegin;
    property OnWorkEnd;
  end;

  EIdTCPConnectionError = class(EIdException);
  EIdObjectTypeNotSupported = class(EIdTCPConnectionError);
  EIdNotEnoughDataInBuffer = class(EIdTCPConnectionError);
  EIdInterceptPropIsNil = class(EIdTCPConnectionError);
  EIdInterceptPropInvalid = class(EIdTCPConnectionError);
  EIdIOHandlerPropInvalid = class(EIdTCPConnectionError);
  EIdNoDataToRead = class(EIdTCPConnectionError);
  EIdNotConnected = class(EIdTCPConnectionError);
  EIdFileNotFound = class(EIdTCPConnectionError);

implementation

uses
  IdAntiFreezeBase, IdStack, IdStackConsts, IdStream, IdResourceStrings,
  SysUtils;

function TIdTCPConnection.AllData: string;
begin
  BeginWork(wmRead); try
    Result := '';
    while Connected do begin
      Result := Result + CurrentReadBuffer;
    end;
  finally EndWork(wmRead); end;
end;

procedure TIdTCPConnection.PerformCapture(ADest: TObject; out VLineCount: Integer;
 const ADelim: string; const AIsRFCMessage: Boolean);
const
  wDoublePoint = ord('.') shl 8 + ord('.');
type
  PWord = ^Word;
var
  s: string;
begin
  VLineCount := 0;
  BeginWork(wmRead); try
    repeat
      s := ReadLn;
      if s = ADelim then begin
        Exit;
      end;
      // For RFC 822 retrieves
      // No length check necessary, if only one byte it will be byte x + #0.
      if AIsRFCMessage and (PWord(PChar(S))^ = wDoublePoint) then begin
        Delete(s, 1, 1);
      end;
      // Write to output
      Inc(VLineCount);
      if ADest is TStrings then begin
        TStrings(ADest).Add(s);
      end else if ADest is TStream then begin
        TIdStream(ADest).WriteLn(s);
      end else if ADest <> nil then begin
        raise EIdObjectTypeNotSupported.Create(RSObjectTypeNotSupported);
      end;
    until False;
  finally EndWork(wmRead); end;
end;

procedure TIdTCPConnection.CheckForDisconnect(const ARaiseExceptionIfDisconnected: Boolean = True;
 const AIgnoreBuffer: Boolean = False);
var
  LDisconnected: Boolean;
begin
  LDisconnected := False;
  // ClosedGracefully // Server disconnected
  // IOHandler = nil // Client disconnected
  if (IOHandler <> nil) then begin
    if ClosedGracefully then begin
      if IOHandler.Connected then begin
      	DisconnectSocket;
        // Call event handlers to inform the user program that we were disconnected
        DoStatus(hsDisconnected);
        DoOnDisconnected;
      end;
      LDisconnected := True;
    end else begin
      LDisconnected := not IOHandler.Connected;
    end;
  end;
  if LDisconnected then begin
    // Do not raise unless all data has been read by the user
    if ((InputBuffer.Size = 0) or AIgnoreBuffer) and ARaiseExceptionIfDisconnected then begin
      (* ************************************************************* //
      ------ If you receive an exception here, please read. ----------

      If this is a SERVER
      -------------------
      The client has disconnected the socket normally and this exception is used to notify the
      server handling code. This exception is normal and will only happen from within the IDE, not
      while your program is running as an EXE. If you do not want to see this, add this exception
      or EIdSilentException to the IDE options as exceptions not to break on.

      From the IDE just hit F9 again and Indy will catch and handle the exception.

      Please see the FAQ and help file for possible further information.
      The FAQ is at http://www.nevrona.com/Indy/FAQ.html

      If this is a CLIENT
      -------------------
      The server side of this connection has disconnected normaly but your client has attempted
      to read or write to the connection. You should trap this error using a try..except.
      Please see the help file for possible further information.

      // ************************************************************* *)
      raise EIdConnClosedGracefully.Create(RSConnectionClosedGracefully);
    end;
  end;
end;

function TIdTCPConnection.Connected: Boolean;
begin
  CheckForDisconnect(False);
  Result := IOHandler <> nil;
  if Result then begin
    Result := IOHandler.Connected;
  end;
end;

constructor TIdTCPConnection.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FReadTimeout := IdDefTimeout;
  FGreeting := TIdRFCReply.Create(nil);
  FLastCmdResult := TIdRFCReply.Create(nil);
  FRecvBuffer := TIdSimpleBuffer.Create;

  RecvBufferSize := GRecvBufferSizeDefault;
  FSendBufferSize := GSendBufferSizeDefault;
  FInputBuffer := TIdManagedBuffer.Create(BufferRemoveNotify);
  FMaxLineLength := IdMaxLineLengthDefault;
end;

function TIdTCPConnection.CurrentReadBuffer: string;
begin
  Result := '';
  if Connected then begin
    ReadFromStack(False);
  end;
  Result := InputBuffer.Extract(InputBuffer.Size);
end;

destructor TIdTCPConnection.Destroy;
begin
  // DisconnectSocket closes IOHandler etc. Dont call Disconnect - Disconnect may be override and
  // try to read/write to the socket.
  DisconnectSocket;

  // Because DisconnectSocket does not free the IOHandler we have to do it here.
  if FFreeIOHandlerOnDisconnect then begin
    FreeAndNil(FIOHandler);
    FFreeIOHandlerOnDisconnect := False;
  end;

  FreeAndNil(FInputBuffer);
  FreeAndNil(FRecvBuffer);
  FreeAndNil(FLastCmdResult);
  FreeAndNil(FGreeting);
  inherited Destroy;
end;

procedure TIdTCPConnection.Disconnect;
var
  LConnected: boolean;
begin
  {
   there are a few possible situations here:
   1) we are still connected, then everything works as before,
      status disconnecting, then disconnect, status disconnected
   2) we are not connected, and this is just some "rogue" call to
      disconnect(), then nothing happens
   3) we are not connected, because ClosedGracefully, then
      LConnected will be false, but the implicit call to
      CheckForDisconnect (inside Connected) will call the events
  }
  LConnected := Connected;
  if LConnected then begin
    DoStatus(hsDisconnecting);
    DisconnectSocket;
  end;
  // NOT in DisconnectSocket. DisconnectSocket is used to kick ReadFromStack and others
  // out of their blocking calls and they rely on the binding after that
  if FFreeIOHandlerOnDisconnect then begin
    FreeAndNil(FIOHandler);
    FFreeIOHandlerOnDisconnect := False;
  end;
  if LConnected then begin
    DoOnDisconnected;
    DoStatus(hsDisconnected);
  end;
end;

procedure TIdTCPConnection.DoOnDisconnected;
begin
  if Assigned(OnDisconnected) then begin
    OnDisconnected(Self);
  end;
end;

function TIdTCPConnection.GetResponse(const AAllowedResponses: array of SmallInt): SmallInt;
begin
  GetInternalResponse;
  Result := CheckResponse(LastCmdResult.NumericCode, AAllowedResponses);
end;

procedure TIdTCPConnection.RaiseExceptionForLastCmdResult(AException: TClassIdException);
begin
  raise AException.Create(LastCmdResult.Text.Text);
end;

procedure TIdTCPConnection.RaiseExceptionForLastCmdResult;
begin
  raise EIdProtocolReplyError.CreateError(LastCmdResult.NumericCode, LastCmdResult.Text.Text);
end;

procedure TIdTCPConnection.ReadBuffer(var ABuffer; const AByteCount: Integer);
begin
  if (AByteCount > 0) and (@ABuffer <> nil) then begin
    // Read from stack until we have enough data
    while (InputBuffer.Size < AByteCount) do begin
      ReadFromStack;
      CheckForDisconnect(True, True);
    end;
    // Copy it to the callers buffer
    Move(InputBuffer.Memory^, ABuffer, AByteCount);
    // Remove used data from buffer
    InputBuffer.Remove(AByteCount);
  end;
end;