idiohandler.pas

网络控件适用于Delphi6

{
    Rev 1.13    3/24/2003 11:01:36 PM  BGooijen
  WriteStrings is now buffered to increase speed
}
{
    Rev 1.12    3/19/2003 1:02:32 PM  BGooijen
  changed class function ConstructDefaultIOHandler a little (default parameter)
}
{
    Rev 1.11    3/13/2003 10:18:16 AM  BGooijen
  Server side fibers, bug fixes
}
{
    Rev 1.10    3/5/2003 11:03:06 PM  BGooijen
  Added Intercept here
}
{
    Rev 1.9    2/25/2003 11:02:12 PM  BGooijen
  InputBufferToStream now accepts a bytecount
}
{
{   Rev 1.8    2003.02.25 1:36:00 AM  czhower
}
{
{   Rev 1.7    12-28-2002 22:28:16  BGooijen
{ removed warning, added initialization and finalization part.
}
{
{   Rev 1.6    12-16-2002 20:43:28  BGooijen
{ Added class function ConstructIOHandler(....), and removed some comments
}
{
{   Rev 1.5    12-15-2002 23:02:38  BGooijen
{ added SendBufferSize
}
{
{   Rev 1.4    12-15-2002 20:50:32  BGooijen
{ FSendBufferSize was not initialized
}
{
{   Rev 1.3    12-14-2002 22:14:54  BGooijen
{ improved method to detect timeouts in ReadLn.
}
{
{   Rev 1.2    12/11/2002 04:09:28 AM  JPMugaas
{ Updated for new API.
}
{
{   Rev 1.1    2002.12.07 12:25:56 AM  czhower
}
{
{   Rev 1.0    11/13/2002 08:44:50 AM  JPMugaas
}
unit IdIOHandler;

{$I IdCompilerDefines.inc}

interface

uses
  Classes,
  IdAntiFreezeBase, IdBuffer, IdComponent, IdGlobal, IdExceptionCore,
  IdIntercept, IdStreamVCL, IdResourceStringsCore, IdTStrings;

const
  GRecvBufferSizeDefault = 32 * 1024;
  GSendBufferSizeDefault = 32 * 1024;
  IdMaxLineLengthDefault = 16 * 1024;
  // S.G. 6/4/2004: Maximum number of lines captured
  // S.G. 6/4/2004: Default to "unlimited"
  Id_IOHandler_MaxCapturedLines = -1;

type
  TIdIOHandlerClass = class of TIdIOHandler;

  {
  How does this fit in in the hierarchy against TIdIOHandlerSocket
  Destination - Socket - otehr file descendats it

  TIdIOHandler should only implement an interface. No default functionality
  except very simple read/write functions such as ReadCardinal, etc. Functions
  that cannot really be optimized beyond their default implementations.

  Some default implementations offer basic non optmized implementations.

  Yes, I know this comment conflicts. Its being worked on.
  }
  TIdIOHandler = class(TIdComponent)
  protected
    FClosedGracefully: Boolean;
    FConnectTimeout: Integer;
    FDestination: string;
    FHost: string;
    // IOHandlers typically receive more data than they need to complete each
    // request. They store this extra data in InputBuffer for future methods to
    // use. InputBuffer is what collects the input and keeps it if the current
    // method does not need all of it.
    //
    FInputBuffer: TIdBuffer;
    FIntercept: TIdConnectionIntercept;
    FMaxCapturedLines: Integer;
    FMaxLineAction: TIdMaxLineAction;
    FMaxLineLength: Integer;
    FOpened: Boolean;
    FPort: Integer;
    FReadLnSplit: Boolean;
    FReadLnTimedOut: Boolean;
    FReadTimeOut: Integer;
//TODO:
    FRecvBuffer: TIdBuffer; // To be used by ReadFromStack only
    FRecvBufferSize: Integer;
    FSendBufferSize: Integer;

    FWriteBuffer: TIdBuffer;
    FWriteBufferThreshhold: Integer;

    //
    procedure BufferRemoveNotify(ASender: TObject; ABytes: Integer);
    function GetDestination: string; virtual;
    procedure InitComponent; override;
    procedure InterceptReceive(
      var VBuffer: TIdBytes
      );
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure PerformCapture(ADest: TObject; out VLineCount: Integer;
     const ADelim: string; AIsRFCMessage: Boolean); virtual;
    procedure RaiseConnClosedGracefully;
    procedure SetDestination(const AValue: string); virtual;
    procedure SetHost(const AValue: string); virtual;
    procedure SetPort(AValue: Integer); virtual;
    procedure SetIntercept(AValue: TIdConnectionIntercept); virtual;
    // This is the main Read function which all other default implementations
    // use.
    function ReadFromSource(ARaiseExceptionIfDisconnected: Boolean = True;
     ATimeout: Integer = IdTimeoutDefault;
     ARaiseExceptionOnTimeout: Boolean = True): Integer; virtual;
     abstract;
  public
    procedure AfterAccept; virtual;
    function Connected: Boolean; virtual;
    destructor Destroy; override;
    // CheckForDisconnect allows the implementation to check the status of the
    // connection at the request of the user or this base class.
    procedure CheckForDisconnect(ARaiseExceptionIfDisconnected: Boolean = True;
     AIgnoreBuffer: Boolean = False); virtual; abstract;
    // Does not wait or raise any exceptions. Just reads whatever data is
    // available (if any) into the buffer. Must NOT raise closure exceptions.
    // It is used to get avialable data, and check connection status. That is
    // it can set status flags about the connection.
    procedure CheckForDataOnSource(ATimeout: Integer = 0); virtual; abstract;
    procedure Close; virtual;
    procedure CloseGracefully; virtual;
    class function MakeDefaultIOHandler(AOwner: TComponent = nil)
     : TIdIOHandler;
    class function MakeIOHandler(ABaseType: TIdIOHandlerClass;
     AOwner: TComponent = nil): TIdIOHandler;
    class procedure RegisterIOHandler;
    class procedure SetDefaultClass;
    function WaitFor(const AString: string): string; virtual;
    // This is different than WriteDirect. WriteDirect goes
    // directly to the network or next level. WriteBuffer allows for buffering
    // using WriteBuffers. This should be the only call to WriteDirect
    // unless the calls that bypass this are aware of WriteBuffering or are
    // intended to bypass it.
    procedure Write(
      ABuffer: TIdBytes
      ); overload; virtual;
    // This is the main write function which all other default implementations
    // use. If default implementations are used, this must be implemented.
    procedure WriteDirect(
      ABuffer: TIdBytes
      ); virtual;

    procedure Open; virtual;
    function Readable(AMSec: Integer = IdTimeoutDefault): Boolean; virtual;
    //
    // Optimal Extra Methods
    //
    // These methods are based on the core methods. While they can be
    // overridden, they are so simple that it is rare a more optimal method can
    // be implemented. Because of this they are not overrideable.
    //
    //
    // Write Methods
    //
    // Only the ones that have a hope of being better optimized in descendants
    // have been marked virtual
    procedure Write(const AOut: string); overload; virtual;
    procedure WriteLn(const AOut: string = ''); virtual;
    procedure Write(AValue: TIdStrings; AWriteLinesCount: Boolean = False);
              overload; virtual;
    procedure Write(AValue: Char); overload;
    procedure Write(AValue: Cardinal; AConvert: Boolean = True); overload;
    procedure Write(AValue: Integer; AConvert: Boolean = True); overload;
    procedure Write(AValue: SmallInt; AConvert: Boolean = True); overload;
    procedure Write(AValue: Int64; AConvert: Boolean = True); overload;
    procedure Write(
      AStream: TIdStreamVCL;
      ASize: Integer = 0;
      AWriteByteCount: Boolean = False
      ); overload; virtual;
    // Not overloaded because it does not have a unique type for source
    // and could be easily unresolvable with future additions
    function WriteFile(
      const AFile: String;
      AEnableTransferFile: Boolean = False
      ): Cardinal;
      virtual;
    //
    // Read methods
    //
    function AllData: string; virtual;
    function InputLn(const AMask: String = ''; AEcho: Boolean = True;
     ATabWidth: Integer = 8; AMaxLineLength: Integer = -1): String; virtual;
    // Capture
    // Not virtual because each calls PerformCapture which is virtual
    procedure Capture(ADest: TStream); overload; // .Net overload
    procedure Capture(ADest: TStream; ADelim: string;
              AIsRFCMessage: Boolean = True); overload;
    procedure Capture(ADest: TStream; out VLineCount: Integer;
              const ADelim: string = '.'; AIsRFCMessage: Boolean = True);
              overload;
    procedure Capture(ADest: TIdStrings); overload; // .Net overload
    procedure Capture(ADest: TIdStrings; const ADelim: string;
              AIsRFCMessage: Boolean = True); overload;
    procedure Capture(ADest: TIdStrings; out VLineCount: Integer;
              const ADelim: string = '.'; AIsRFCMessage: Boolean = True);
              overload;
    //
    // Read___
    // Cannot overload, compiler cannot overload on return values
    //
    procedure ReadBytes(var VBuffer: TIdBytes; AByteCount: Integer; AAppend:boolean=true); virtual;
    // ReadLn
    function ReadLn: string; overload; // .Net overload
    function ReadLn(ATerminator: string;
             ATimeout: Integer = IdTimeoutDefault;
             AMaxLineLength: Integer = -1)
             : string; overload; virtual;
    function ReadLnWait(AFailCount: Integer = MaxInt): string; virtual;
    // Added for retrieving lines over 16K long}
    function ReadLnSplit(var AWasSplit: Boolean; ATerminator: string = LF;
             ATimeout: Integer = IdTimeoutDefault;
             AMaxLineLength: Integer = -1): string;
    // Read - Simple Types
    function ReadChar: Char;
    function ReadString(ABytes: Integer): string;
    function ReadCardinal(AConvert: Boolean = True): Cardinal;
    function ReadInteger(AConvert: Boolean = True): Integer;
    function ReadInt64(AConvert: Boolean = True): Int64;
    function ReadSmallInt(AConvert: Boolean = True): SmallInt;
    //
    procedure ReadStream(AStream: TIdStreamVCL; AByteCount: LongInt = -1;
     AReadUntilDisconnect: Boolean = False); virtual;
    procedure ReadStrings(ADest: TIdStrings; AReadLinesCount: Integer = -1);
    //
    // WriteBuffering Methods
    //
    procedure WriteBufferCancel; virtual;
    procedure WriteBufferClear; virtual;
    procedure WriteBufferClose; virtual;
    procedure WriteBufferFlush; overload; //.Net overload
    procedure WriteBufferFlush(AByteCount: Integer); overload; virtual;
    procedure WriteBufferOpen; overload; //.Net overload
    procedure WriteBufferOpen(AThreshhold: Integer); overload; virtual;
    function WriteBufferingActive: Boolean;
    //
    // InputBuffer Methods
    //
    function InputBufferIsEmpty: Boolean;
    //
    // These two are direct access and do no reading of connection
    procedure InputBufferToStream(AStream: TIdStreamVCL; AByteCount: Integer = -1);
    function InputBufferAsString: string;
    //
    // Properties
    //
    property ConnectTimeout: Integer read FConnectTimeout write FConnectTimeout default 0;
    property ClosedGracefully: Boolean read FClosedGracefully;
    // TODO: Need to name this consistent. Originally no access was allowed,
    // but new model requires it for writing. Will decide after next set
    // of changes are complete what to do with Buffer prop.
    //
    // Is used by SuperCore
    property InputBuffer: TIdBuffer read FInputBuffer;
    property MaxCapturedLines: Integer read FMaxCapturedLines write FMaxCapturedLines default Id_IOHandler_MaxCapturedLines;
    property Opened: Boolean read FOpened;
    property ReadTimeout: Integer read FReadTimeOut write FReadTimeOut;
    property ReadLnTimedout:boolean read fReadLnTimedout ;
    property WriteBufferThreshhold: Integer read FWriteBufferThreshhold;
    //
    // Events
    //
    property OnWork;
    property OnWorkBegin;
    property OnWorkEnd;
  published
    property Destination: string read GetDestination write SetDestination;
    property Host: string read FHost write SetHost;
    property Intercept: TIdConnectionIntercept read FIntercept
     write SetIntercept;
    property MaxLineLength: Integer read FMaxLineLength write FMaxLineLength default IdMaxLineLengthDefault;
    property MaxLineAction: TIdMaxLineAction read FMaxLineAction write FMaxLineAction;
    property Port: Integer read FPort write SetPort;
    // RecvBufferSize is used by some methods that read large amounts of data.
    // RecvBufferSize is the amount of data that will be requested at each read
    // cycle. RecvBuffer is used to receive then send to the Intercepts, after
    // that it goes to InputBuffer
    property RecvBufferSize: Integer read FRecvBufferSize write FRecvBufferSize
     default GRecvBufferSizeDefault;
    // SendBufferSize is used by some methods that have to break apart large
    // amounts of data into smaller pieces. This is the buffer size of the
    // chunks that it will create and use.
    property SendBufferSize: Integer read FSendBufferSize write FSendBufferSize
     default GSendBufferSizeDefault;
  end;

implementation

uses
  IdStack, IdException, IdResourceStrings,
  SysUtils;

var
  GIOHandlerClassDefault: TIdIOHandlerClass = nil;
  GIOHandlerClassList: TList = nil;

{ TIdIOHandler }

procedure TIdIOHandler.Close;
begin
  if Intercept <> nil then begin
    Intercept.Disconnect;
  end;
  FOpened := False;
end;

destructor TIdIOHandler.Destroy;
begin
  Close;
  FreeAndNil(FRecvBuffer);
  FreeAndNil(FInputBuffer);
  inherited;
end;

procedure TIdIOHandler.AfterAccept;
begin
  //
end;

procedure TIdIOHandler.Open;
begin
  FOpened := True;
  FClosedGracefully := False;
  // Recreate FRecvBuffer
  FreeAndNil(FRecvBuffer);
  FRecvBuffer := TIdBuffer.Create;
  //
  FreeAndNil(FInputBuffer);
  FInputBuffer := TIdBuffer.Create(BufferRemoveNotify);
end;

procedure TIdIOHandler.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, OPeration);
  if (Operation = opRemove) and (AComponent = FIntercept) then begin
    FIntercept := nil;
  end;
end;

procedure TIdIOHandler.SetIntercept(AValue: TIdConnectionIntercept);
begin
  FIntercept := AValue;
  // add self to the Intercept's free notification list
  if Assigned(FIntercept) then begin
    FIntercept.FreeNotification(Self);
  end;
end;

class procedure TIdIOHandler.SetDefaultClass;
begin
  GIOHandlerClassDefault := Self;
  RegisterIOHandler;
end;

class function TIdIOHandler.MakeDefaultIOHandler(AOwner: TComponent = nil)
 : TIdIOHandler;
begin
  Result := GIOHandlerClassDefault.Create(AOwner);
end;

class procedure TIdIOHandler.RegisterIOHandler;
begin
  if GIOHandlerClassList = nil then begin
    GIOHandlerClassList := TList.Create;
  end;
{$ifndef DotNetExclude}
  //TODO: Reenable this. Dot net wont allow class references as objects
  // Use an array?
  if GIOHandlerClassList.IndexOf(Self) = -1 then begin
    GIOHandlerClassList.Add(Self);
  end;
{$endif}
end;

{
  Creates an IOHandler of type ABaseType, or descendant.
}
class function TIdIOHandler.MakeIOHandler(ABaseType: TIdIOHandlerClass;
 AOwner: TComponent = nil): TIdIOHandler;
var
  i: Integer;