restemplate/indy/Core/IdIOHandler.pas

2696 lines
88 KiB
Plaintext
Raw Normal View History

{
$Project$
$Workfile$
$Revision$
$DateUTC$
$Id$
This file is part of the Indy (Internet Direct) project, and is offered
under the dual-licensing agreement described on the Indy website.
(http://www.indyproject.org/)
Copyright:
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
$Log$
}
{
Rev 1.123 2/8/05 5:27:06 PM RLebeau
Bug fix for ReadLn().
Added try..finally block to ReadLnSplit().
Rev 1.122 1/27/05 3:09:30 PM RLebeau
Updated AllData() to call ReadFromSource() directly instead of using
CheckForDataOnSource(), since ReadFromSource() can return a disconnect
conditon. When data is in the InputBuffer, Connected() always return True
even if the socket is actually disconnected.
Rev 1.121 12/21/04 3:21:40 AM RLebeau
Removed compiler warning
Rev 1.120 17/12/2004 17:11:28 ANeillans
Compiler fix
Rev 1.119 12/12/04 2:23:52 PM RLebeau
Added WriteRFCStrings() method
Rev 1.118 12/11/2004 9:04:50 PM DSiders
Fixed comparison error in WaitFor.
Rev 1.117 12/10/04 2:00:24 PM RLebeau
Updated WaitFor() to not return more data than actually needed.
Updated AllData() to not concatenate the Result on every iteration of the
loop.
Rev 1.116 11/29/04 10:37:18 AM RLebeau
Updated write buffering methods to prevent Access Violations when used
incorrectly.
Rev 1.115 11/4/04 12:41:08 PM RLebeau
Bug fix for ReadLn()
Rev 1.114 10/26/2004 8:43:00 PM JPMugaas
Should be more portable with new references to TIdStrings and TIdStringList.
Rev 1.113 27.08.2004 21:58:18 Andreas Hausladen
Speed optimization ("const" for string parameters)
Rev 1.112 8/2/04 5:49:20 PM RLebeau
Moved ConnectTimeout over from TIdIOHandlerSocket
Rev 1.111 2004.08.01 19:36:14 czhower
Code optimization to WriteFile
Rev 1.110 7/24/04 12:53:54 PM RLebeau
Compiler fix for WriteFile()
Rev 1.109 7/23/04 6:39:14 PM RLebeau
Added extra exception handling to WriteFile()
Rev 1.108 7/21/2004 5:45:10 PM JPMugaas
Updated with Remy's change. This should work better and fix a problem with
looping with ReadStream and ReadUntilDisconnect.
Rev 1.107 7/21/2004 12:22:18 PM BGooijen
Reverted back 2 versions
Rev 1.104 6/29/04 12:16:16 PM RLebeau
Updated ReadChar() to call ReadBytes() directly instead of ReadString()
Rev 1.103 6/17/04 3:01:56 PM RLebeau
Changed ReadStream() to not extract too many bytes from the InputBuffer when
an error occurs
Rev 1.102 6/12/04 11:36:44 AM RLebeau
Changed ReadString() to pass the ABytes parameter to ReadBytes() instead of
the LBuf length
Rev 1.100 6/10/2004 6:52:12 PM JPMugaas
Regeneration to fix a bug in the package generator that I created. OOPS!!!
Rev 1.99 6/9/04 7:36:26 PM RLebeau
ReadString() bug fix
Rev 1.98 07/06/2004 20:55:36 CCostelloe
Fix for possible memory leak.
Rev 1.97 5/29/04 10:46:24 PM RLebeau
Updated AllData() to only append values to the result when there is actual
data in the buffer.
Rev 1.96 29/05/2004 21:07:40 CCostelloe
Bug fix (may need more investigation)
Rev 1.95 2004.05.20 1:39:54 PM czhower
Last of the IdStream updates
Rev 1.94 2004.05.20 12:34:22 PM czhower
Removed more non .NET compatible stream read and writes
Rev 1.93 2004.05.20 11:39:02 AM czhower
IdStreamVCL
Rev 1.92 5/3/2004 12:57:00 PM BGooijen
Fixes for 0-based
Rev 1.91 2004.05.03 11:15:44 AM czhower
Changed Find to IndexOf and made 0 based to be consistent.
Rev 1.90 4/24/04 12:40:04 PM RLebeau
Added Write() overload for Char type.
Rev 1.89 4/18/2004 11:58:00 PM BGooijen
ReadBytes with count=-1 reads everything available, ( and waits ReadTimeOut
time for data)
Rev 1.88 4/18/04 2:44:24 PM RLebeau
Read/write support for Int64 values
Rev 1.87 2004.04.18 12:51:58 AM czhower
Big bug fix with server disconnect and several other bug fixed that I found
along the way.
Rev 1.86 2004.04.16 11:30:28 PM czhower
Size fix to IdBuffer, optimizations, and memory leaks
Rev 1.85 2004.04.08 7:06:46 PM czhower
Peek support.
Rev 1.84 2004.04.08 3:56:28 PM czhower
Fixed bug with Intercept byte count. Also removed Bytes from Buffer.
Rev 1.83 2004.04.08 2:08:00 AM czhower
Saved before checkin this time...
Rev 1.82 7/4/2004 4:08:46 PM SGrobety
Re-introduce the IOHandler.MaxCapturedLines property
Rev 1.81 2004.04.07 3:59:46 PM czhower
Bug fix for WriteDirect.
Rev 1.79 2004.03.07 11:48:38 AM czhower
Flushbuffer fix + other minor ones found
Rev 1.78 2004.03.03 11:54:58 AM czhower
IdStream change
Rev 1.77 2004.03.02 2:47:08 PM czhower
.Net overloads
Rev 1.76 2004.03.01 5:12:28 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.75 2004.02.03 4:16:44 PM czhower
For unit name changes.
Rev 1.74 2004.01.21 9:36:00 PM czhower
.Net overload
Rev 1.73 2004.01.21 12:19:58 AM czhower
.Readln overload for .net
Rev 1.72 2004.01.20 10:03:26 PM czhower
InitComponent
Rev 1.71 1/11/2004 5:51:04 PM BGooijen
Added AApend parameter to ReadBytes
Rev 1.70 12/30/2003 7:17:56 PM BGooijen
.net
Rev 1.69 2003.12.28 1:05:54 PM czhower
.Net changes.
Rev 1.68 2003.12.28 11:53:28 AM czhower
Removed warning in .net.
Rev 1.67 2003.11.29 10:15:30 AM czhower
InternalBuffer --> InputBuffer for consistency.
Rev 1.66 11/23/03 1:46:28 PM RLebeau
Removed "var" specifier from TStrings parameter of ReadStrings().
Rev 1.65 11/4/2003 10:27:56 PM DSiders
Removed exceptions moved to IdException.pas.
Rev 1.64 2003.10.24 10:44:52 AM czhower
IdStream implementation, bug fixes.
Rev 1.63 10/22/03 2:05:40 PM RLebeau
Fix for TIdIOHandler::Write(TStream) where it was not reading the stream into
the TIdBytes correctly.
Rev 1.62 10/19/2003 5:55:44 PM BGooijen
Fixed todo in PerformCapture
Rev 1.61 2003.10.18 12:58:50 PM czhower
Added comment
Rev 1.60 2003.10.18 12:42:04 PM czhower
Intercept.Disconnect is now called
Rev 1.59 10/15/2003 7:39:28 PM DSiders
Added a formatted resource string for the exception raised in
TIdIOHandler.MakeIOHandler.
Rev 1.58 2003.10.14 1:26:50 PM czhower
Uupdates + Intercept support
Rev 1.57 2003.10.11 5:48:22 PM czhower
-VCL fixes for servers
-Chain suport for servers (Super core)
-Scheduler upgrades
-Full yarn support
Rev 1.56 9/10/2003 1:50:38 PM SGrobety
Removed all "const" keywords from boolean parameter interfaces. Might trigger
changes in other units.
Rev 1.55 10/5/2003 10:39:56 PM BGooijen
Write buffering
Rev 1.54 10/4/2003 11:03:12 PM BGooijen
ReadStream, and functions with network ordering
Rev 1.53 10/4/2003 7:10:46 PM BGooijen
ReadXXXXX
Rev 1.52 10/4/2003 3:55:02 PM BGooijen
ReadString, and some Write functions
Rev 1.51 04/10/2003 13:38:32 HHariri
Write(Integer) support
Rev 1.50 10/3/2003 12:09:30 AM BGooijen
DotNet
Rev 1.49 2003.10.02 8:29:14 PM czhower
Changed names of byte conversion routines to be more readily understood and
not to conflict with already in use ones.
Rev 1.48 2003.10.02 1:18:50 PM czhower
Changed read methods to be overloaded and more consistent. Will break some
code, but nearly all code that uses them is Input.
Rev 1.47 2003.10.02 10:16:26 AM czhower
.Net
Rev 1.46 2003.10.01 9:11:16 PM czhower
.Net
Rev 1.45 2003.10.01 2:46:36 PM czhower
.Net
Rev 1.42 2003.10.01 11:16:32 AM czhower
.Net
Rev 1.41 2003.10.01 1:37:34 AM czhower
.Net
Rev 1.40 2003.10.01 1:12:34 AM czhower
.Net
Rev 1.39 2003.09.30 1:22:56 PM czhower
Stack split for DotNet
Rev 1.38 2003.09.18 5:17:58 PM czhower
Implemented OnWork
Rev 1.37 2003.08.21 10:43:42 PM czhower
Fix to ReadStream from Doychin
Rev 1.36 08/08/2003 17:32:26 CCostelloe
Removed "virtual" from function ReadLnSplit
Rev 1.35 07/08/2003 00:25:08 CCostelloe
Function ReadLnSplit added
Rev 1.34 2003.07.17 1:05:12 PM czhower
More IOCP improvements.
Rev 1.33 2003.07.14 11:00:50 PM czhower
More IOCP fixes.
Rev 1.32 2003.07.14 12:54:30 AM czhower
Fixed graceful close detection if it occurs after connect.
Rev 1.31 2003.07.10 7:40:24 PM czhower
Comments
Rev 1.30 2003.07.10 4:34:56 PM czhower
Fixed AV, added some new comments
Rev 1.29 7/1/2003 5:50:44 PM BGooijen
Fixed ReadStream
Rev 1.28 6/30/2003 10:26:08 AM BGooijen
forgot to remove some code regarding to TIdBuffer.Find
Rev 1.27 6/29/2003 10:56:26 PM BGooijen
Removed .Memory from the buffer, and added some extra methods
Rev 1.26 2003.06.25 4:30:00 PM czhower
Temp hack fix for AV problem. Working on real solution now.
Rev 1.25 23/6/2003 22:33:14 GGrieve
fix CheckForDataOnSource - specify timeout
Rev 1.24 23/6/2003 06:46:52 GGrieve
allow block on checkForData
Rev 1.23 6/4/2003 1:07:08 AM BGooijen
changed comment
Rev 1.22 6/3/2003 10:40:34 PM BGooijen
FRecvBuffer bug fixed, it was freed, but never recreated, resulting in an AV
Rev 1.21 2003.06.03 6:28:04 PM czhower
Made check for data virtual
Rev 1.20 2003.06.03 3:43:24 PM czhower
Resolved InputBuffer inconsistency. Added new method and renamed old one.
Rev 1.19 5/25/2003 03:56:04 AM JPMugaas
Updated for unit rename.
Rev 1.18 2003.04.17 11:01:12 PM czhower
Rev 1.17 4/16/2003 3:29:30 PM BGooijen
minor change in ReadBuffer
Rev 1.16 4/1/2003 7:54:24 PM BGooijen
ReadLn default terminator changed to LF
Rev 1.15 3/27/2003 3:24:06 PM BGooijen
MaxLine* is now published
Rev 1.14 2003.03.25 7:42:12 PM czhower
try finally to WriteStrings
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;
interface
{$I IdCompilerDefines.inc}
uses
Classes,
IdException,
IdAntiFreezeBase, IdBuffer, IdBaseComponent, IdComponent, IdGlobal, IdExceptionCore,
IdIntercept, IdResourceStringsCore, IdStream;
(*$HPPEMIT '#if defined(_VCL_ALIAS_RECORDS)' *)
(*$HPPEMIT '#if !defined(UNICODE)' *)
(*$HPPEMIT '#pragma alias "@Idiohandler@TIdIOHandler@SetPortA$qqri"="@Idiohandler@TIdIOHandler@SetPort$qqri"' *)
(*$HPPEMIT '#else' *)
(*$HPPEMIT '#pragma alias "@Idiohandler@TIdIOHandler@SetPortW$qqri"="@Idiohandler@TIdIOHandler@SetPort$qqri"' *)
(*$HPPEMIT '#endif' *)
(*$HPPEMIT '#endif' *)
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
EIdIOHandler = class(EIdException);
EIdIOHandlerRequiresLargeStream = class(EIdIOHandler);
EIdIOHandlerStreamDataTooLarge = class(EIdIOHandler);
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 ReadUInt32, 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)
private
FLargeStream: Boolean;
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;
{$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FIntercept: TIdConnectionIntercept;
FMaxCapturedLines: Integer;
FMaxLineAction: TIdMaxLineAction;
FMaxLineLength: Integer;
FOpened: Boolean;
FPort: Integer;
FReadLnSplit: Boolean;
FReadLnTimedOut: Boolean;
FReadTimeOut: Integer;
//TODO:
FRecvBufferSize: Integer;
FSendBufferSize: Integer;
FWriteBuffer: TIdBuffer;
FWriteBufferThreshold: Integer;
FDefStringEncoding : IIdTextEncoding;
{$IFDEF STRING_IS_ANSI}
FDefAnsiEncoding : IIdTextEncoding;
{$ENDIF}
procedure SetDefStringEncoding(const AEncoding : IIdTextEncoding);
{$IFDEF STRING_IS_ANSI}
procedure SetDefAnsiEncoding(const AEncoding: IIdTextEncoding);
{$ENDIF}
//
procedure BufferRemoveNotify(ASender: TObject; ABytes: Integer);
function GetDestination: string; virtual;
procedure InitComponent; override;
procedure InterceptReceive(var VBuffer: TIdBytes);
{$IFNDEF USE_OBJECT_ARC}
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
{$ENDIF}
procedure PerformCapture(const ADest: TObject; out VLineCount: Integer;
const ADelim: string; AUsesDotTransparency: Boolean; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
); 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;
function ReadDataFromSource(var VBuffer: TIdBytes): Integer; virtual; abstract;
function WriteDataToTarget(const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer; virtual; abstract;
function SourceIsAvailable: Boolean; virtual; abstract;
function CheckForError(ALastResult: Integer): Integer; virtual; abstract;
procedure RaiseError(AError: 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.
function CheckForDataOnSource(ATimeout: Integer = 0): Boolean; virtual;
procedure Close; virtual;
procedure CloseGracefully; virtual;
class function MakeDefaultIOHandler(AOwner: TComponent = nil)
: TIdIOHandler;
class function MakeIOHandler(ABaseType: TIdIOHandlerClass;
AOwner: TComponent = nil): TIdIOHandler;
// Variant of MakeIOHandler() which returns nil if it cannot find a registered IOHandler
class function TryMakeIOHandler(ABaseType: TIdIOHandlerClass;
AOwner: TComponent = nil): TIdIOHandler;
class procedure RegisterIOHandler;
class procedure SetDefaultClass;
function WaitFor(const AString: string; ARemoveFromBuffer: Boolean = True;
AInclusive: Boolean = False; AByteEncoding: IIdTextEncoding = nil;
ATimeout: Integer = IdTimeoutDefault
{$IFDEF STRING_IS_ANSI}; AAnsiEncoding: IIdTextEncoding = nil{$ENDIF}
): string;
// 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(const ABuffer: TIdBytes; const ALength: Integer = -1; const AOffset: Integer = 0); 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(const ABuffer: TIdBytes; const ALength: Integer = -1; const AOffset: Integer = 0);
//
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; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
); overload; virtual;
procedure WriteLn(AEncoding: IIdTextEncoding = nil); overload;
procedure WriteLn(const AOut: string; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
); overload; virtual;
procedure WriteLnRFC(const AOut: string = ''; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
); virtual;
procedure Write(AValue: TStrings; AWriteLinesCount: Boolean = False;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
); overload; virtual;
procedure Write(AValue: Byte); overload;
procedure Write(AValue: Char; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
); overload;
// for iOS64, Delphi's Longint and LongWord are 64bit, so we can't rely on
// Write(Longint) and ReadLongint() being 32bit anymore, for instance when
// sending/reading a TStream with LargeStream=False. So adding new (U)IntX
// methods and deprecating the old ones...
//
procedure Write(AValue: Int16; AConvert: Boolean = True); overload;
procedure Write(AValue: UInt16; AConvert: Boolean = True); overload;
procedure Write(AValue: Int32; AConvert: Boolean = True); overload;
procedure Write(AValue: UInt32; AConvert: Boolean = True); overload;
procedure Write(AValue: Int64; AConvert: Boolean = True); overload;
procedure Write(AValue: TIdUInt64; AConvert: Boolean = True); overload;
//
procedure Write(AStream: TStream; ASize: TIdStreamSize = 0;
AWriteByteCount: Boolean = False); overload; virtual;
procedure WriteRFCStrings(AStrings: TStrings; AWriteTerminator: Boolean = True;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
);
// 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): Int64; virtual;
//
// Read methods
//
function AllData(AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string; virtual;
function InputLn(const AMask: string = ''; AEcho: Boolean = True;
ATabWidth: Integer = 8; AMaxLineLength: Integer = -1;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; AAnsiEncoding: IIdTextEncoding = nil{$ENDIF}
): string; virtual;
// Capture
// Not virtual because each calls PerformCapture which is virtual
procedure Capture(ADest: TStream; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
); overload; // .Net overload
procedure Capture(ADest: TStream; ADelim: string;
AUsesDotTransparency: Boolean = True; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
); overload;
procedure Capture(ADest: TStream; out VLineCount: Integer;
const ADelim: string = '.'; AUsesDotTransparency: Boolean = True;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
); overload;
procedure Capture(ADest: TStrings; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
); overload; // .Net overload
procedure Capture(ADest: TStrings; const ADelim: string;
AUsesDotTransparency: Boolean = True; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
); overload;
procedure Capture(ADest: TStrings; out VLineCount: Integer;
const ADelim: string = '.'; AUsesDotTransparency: Boolean = True;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
); overload;
//
// Read___
// Cannot overload, compiler cannot overload on return values
//
procedure ReadBytes(var VBuffer: TIdBytes; AByteCount: Integer; AAppend: Boolean = True); virtual;
// ReadLn
function ReadLn(AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string; overload; // .Net overload
function ReadLn(ATerminator: string; AByteEncoding: IIdTextEncoding
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string; overload;
function ReadLn(ATerminator: string; ATimeout: Integer = IdTimeoutDefault;
AMaxLineLength: Integer = -1; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string; overload; virtual;
//RLebeau: added for RFC 822 retrieves
function ReadLnRFC(var VMsgEnd: Boolean; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string; overload;
function ReadLnRFC(var VMsgEnd: Boolean; const ALineTerminator: string;
const ADelim: string = '.'; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string; overload;
function ReadLnWait(AFailCount: Integer = MaxInt;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string; virtual;
// Added for retrieving lines over 16K long}
function ReadLnSplit(var AWasSplit: Boolean; ATerminator: string = LF;
ATimeout: Integer = IdTimeoutDefault; AMaxLineLength: Integer = -1;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string;
// Read - Simple Types
function ReadChar(AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): Char;
function ReadByte: Byte;
function ReadString(ABytes: Integer; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string;
// for iOS64, Delphi's Longint and LongWord are changed to 64bit, so we can't
// rely on Write(Longint) and ReadLongint() being 32bit anymore, for instance
// when sending/reading a TStream with LargeStream=False. So adding new (U)IntX
// methods and deprecating the old ones...
//
function ReadInt16(AConvert: Boolean = True): Int16;
function ReadUInt16(AConvert: Boolean = True): UInt16;
function ReadInt32(AConvert: Boolean = True): Int32;
function ReadUInt32(AConvert: Boolean = True): UInt32;
function ReadInt64(AConvert: Boolean = True): Int64;
function ReadUInt64(AConvert: Boolean = True): TIdUInt64;
//
function ReadSmallInt(AConvert: Boolean = True): Int16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use ReadInt16()'{$ENDIF};{$ENDIF}
function ReadWord(AConvert: Boolean = True): UInt16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use ReadUInt16()'{$ENDIF};{$ENDIF}
function ReadLongInt(AConvert: Boolean = True): Int32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use ReadInt32()'{$ENDIF};{$ENDIF}
function ReadLongWord(AConvert: Boolean = True): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use ReadUInt32()'{$ENDIF};{$ENDIF}
//
procedure ReadStream(AStream: TStream; AByteCount: TIdStreamSize = -1;
AReadUntilDisconnect: Boolean = False); virtual;
procedure ReadStrings(ADest: TStrings; AReadLinesCount: Integer = -1;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
);
//
procedure Discard(AByteCount: Int64);
procedure DiscardAll;
//
// 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(AThreshold: 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: TStream; AByteCount: Integer = -1);
function InputBufferAsString(AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): 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;
//currently an option, as LargeFile support changes the data format
property LargeStream: Boolean read FLargeStream write FLargeStream;
property MaxCapturedLines: Integer read FMaxCapturedLines write FMaxCapturedLines default Id_IOHandler_MaxCapturedLines;
property Opened: Boolean read FOpened;
property ReadTimeout: Integer read FReadTimeOut write FReadTimeOut default IdTimeoutDefault;
property ReadLnTimedout: Boolean read FReadLnTimedout ;
property WriteBufferThreshold: Integer read FWriteBufferThreshold;
property DefStringEncoding : IIdTextEncoding read FDefStringEncoding write SetDefStringEncoding;
{$IFDEF STRING_IS_ANSI}
property DefAnsiEncoding : IIdTextEncoding read FDefAnsiEncoding write SetDefAnsiEncoding;
{$ENDIF}
//
// 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
//facilitate inlining only.
{$IFDEF DOTNET}
{$IFDEF USE_INLINE}
System.IO,
{$ENDIF}
{$ENDIF}
{$IFDEF WIN32_OR_WIN64}
Windows,
{$ENDIF}
{$IFDEF USE_VCL_POSIX}
{$IFDEF DARWIN}
Macapi.CoreServices,
{$ENDIF}
{$ENDIF}
{$IFDEF HAS_UNIT_Generics_Collections}
System.Generics.Collections,
{$ENDIF}
IdStack, IdStackConsts, IdResourceStrings,
SysUtils;
type
{$IFDEF HAS_GENERICS_TList}
TIdIOHandlerClassList = TList<TIdIOHandlerClass>;
{$ELSE}
// TODO: flesh out to match TList<TIdIOHandlerClass> for non-Generics compilers
TIdIOHandlerClassList = TList;
{$ENDIF}
var
GIOHandlerClassDefault: TIdIOHandlerClass = nil;
GIOHandlerClassList: TIdIOHandlerClassList = nil;
{$IFDEF DCC}
{$IFNDEF VCL_7_OR_ABOVE}
// RLebeau 5/13/2015: The Write(Int64) and ReadInt64() methods produce an
// "Internal error URW533" compiler error in Delphi 5, and an "Internal
// error URW699" compiler error in Delphi 6, so need to use some workarounds
// for those versions...
{$DEFINE AVOID_URW_ERRORS}
{$ENDIF}
{$ENDIF}
{ TIdIOHandler }
procedure TIdIOHandler.Close;
//do not do FInputBuffer.Clear; here.
//it breaks reading when remote connection does a disconnect
var
// under ARC, convert a weak reference to a strong reference before working with it
LIntercept: TIdConnectionIntercept;
begin
try
LIntercept := Intercept;
if LIntercept <> nil then begin
LIntercept.Disconnect;
end;
finally
FOpened := False;
WriteBufferClear;
end;
end;
destructor TIdIOHandler.Destroy;
begin
Close;
FreeAndNil(FInputBuffer);
FreeAndNil(FWriteBuffer);
inherited Destroy;
end;
procedure TIdIOHandler.AfterAccept;
begin
//
end;
procedure TIdIOHandler.Open;
begin
FOpened := False;
FClosedGracefully := False;
WriteBufferClear;
FInputBuffer.Clear;
FOpened := True;
end;
// under ARC, all weak references to a freed object get nil'ed automatically
{$IFNDEF USE_OBJECT_ARC}
procedure TIdIOHandler.Notification(AComponent: TComponent; Operation: TOperation);
begin
if (Operation = opRemove) and (AComponent = FIntercept) then begin
FIntercept := nil;
end;
inherited Notification(AComponent, OPeration);
end;
{$ENDIF}
procedure TIdIOHandler.SetIntercept(AValue: TIdConnectionIntercept);
begin
{$IFDEF USE_OBJECT_ARC}
// under ARC, all weak references to a freed object get nil'ed automatically
FIntercept := AValue;
{$ELSE}
if FIntercept <> AValue then begin
// remove self from the Intercept's free notification list
if Assigned(FIntercept) then begin
FIntercept.RemoveFreeNotification(Self);
end;
FIntercept := AValue;
// add self to the Intercept's free notification list
if Assigned(AValue) then begin
AValue.FreeNotification(Self);
end;
end;
{$ENDIF}
end;
class procedure TIdIOHandler.SetDefaultClass;
begin
GIOHandlerClassDefault := Self;
RegisterIOHandler;
end;
procedure TIdIOHandler.SetDefStringEncoding(const AEncoding: IIdTextEncoding);
var
LEncoding: IIdTextEncoding;
begin
if FDefStringEncoding <> AEncoding then
begin
LEncoding := AEncoding;
EnsureEncoding(LEncoding);
FDefStringEncoding := LEncoding;
end;
end;
{$IFDEF STRING_IS_ANSI}
procedure TIdIOHandler.SetDefAnsiEncoding(const AEncoding: IIdTextEncoding);
var
LEncoding: IIdTextEncoding;
begin
if FDefAnsiEncoding <> AEncoding then
begin
LEncoding := AEncoding;
EnsureEncoding(LEncoding, encOSDefault);
FDefAnsiEncoding := LEncoding;
end;
end;
{$ENDIF}
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 := TIdIOHandlerClassList.Create;
end;
{$IFNDEF DOTNET_EXCLUDE}
//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;
begin
Result := TryMakeIOHandler(ABaseType, AOwner);
if not Assigned(Result) then begin
raise EIdException.CreateFmt(RSIOHandlerTypeNotInstalled, [ABaseType.ClassName]);
end;
end;
class function TIdIOHandler.TryMakeIOHandler(ABaseType: TIdIOHandlerClass;
AOwner: TComponent = nil): TIdIOHandler;
var
i: Integer;
begin
if GIOHandlerClassList <> nil then begin
for i := GIOHandlerClassList.Count - 1 downto 0 do begin
if TIdIOHandlerClass(GIOHandlerClassList[i]).InheritsFrom(ABaseType) then begin
Result := TIdIOHandlerClass(GIOHandlerClassList[i]).Create;
Exit;
end;
end;
end;
Result := nil;
end;
function TIdIOHandler.GetDestination: string;
begin
Result := FDestination;
end;
procedure TIdIOHandler.SetDestination(const AValue: string);
begin
FDestination := AValue;
end;
procedure TIdIOHandler.BufferRemoveNotify(ASender: TObject; ABytes: Integer);
begin
DoWork(wmRead, ABytes);
end;
procedure TIdIOHandler.WriteBufferOpen(AThreshold: Integer);
begin
if FWriteBuffer <> nil then begin
FWriteBuffer.Clear;
end else begin
FWriteBuffer := TIdBuffer.Create;
end;
FWriteBufferThreshold := AThreshold;
end;
procedure TIdIOHandler.WriteBufferClose;
begin
try
WriteBufferFlush;
finally FreeAndNil(FWriteBuffer); end;
end;
procedure TIdIOHandler.WriteBufferFlush(AByteCount: Integer);
var
LBytes: TIdBytes;
begin
if FWriteBuffer <> nil then begin
if FWriteBuffer.Size > 0 then begin
FWriteBuffer.ExtractToBytes(LBytes, AByteCount);
WriteDirect(LBytes);
end;
end;
end;
procedure TIdIOHandler.WriteBufferClear;
begin
if FWriteBuffer <> nil then begin
FWriteBuffer.Clear;
end;
end;
procedure TIdIOHandler.WriteBufferCancel;
begin
WriteBufferClear;
WriteBufferClose;
end;
procedure TIdIOHandler.Write(const AOut: string; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
);
begin
if AOut <> '' then begin
AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
{$IFDEF STRING_IS_ANSI}
ASrcEncoding := iif(ASrcEncoding, FDefAnsiEncoding, encOSDefault);
{$ENDIF}
Write(
ToBytes(AOut, -1, 1, AByteEncoding
{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
)
);
end;
end;
procedure TIdIOHandler.Write(AValue: Byte);
begin
Write(ToBytes(AValue));
end;
procedure TIdIOHandler.Write(AValue: Char; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
);
begin
AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
{$IFDEF STRING_IS_ANSI}
ASrcEncoding := iif(ASrcEncoding, FDefAnsiEncoding, encOSDefault);
{$ENDIF}
Write(
ToBytes(AValue, AByteEncoding
{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
)
);
end;
procedure TIdIOHandler.Write(AValue: UInt32; AConvert: Boolean = True);
begin
if AConvert then begin
AValue := GStack.HostToNetwork(AValue);
end;
Write(ToBytes(AValue));
end;
procedure TIdIOHandler.Write(AValue: Int32; AConvert: Boolean = True);
begin
if AConvert then begin
AValue := Int32(GStack.HostToNetwork(UInt32(AValue)));
end;
Write(ToBytes(AValue));
end;
{$IFDEF HAS_UInt64}
{$IFDEF BROKEN_UInt64_HPPEMIT}
{$DEFINE HAS_TIdUInt64_QuadPart}
{$ENDIF}
{$ELSE}
{$IFNDEF HAS_QWord}
{$DEFINE HAS_TIdUInt64_QuadPart}
{$ENDIF}
{$ENDIF}
procedure TIdIOHandler.Write(AValue: Int64; AConvert: Boolean = True);
{$IFDEF AVOID_URW_ERRORS}
var
h: Int64;
{$ELSE}
{$IFDEF HAS_TIdUInt64_QuadPart}
var
h: TIdUInt64;
{$ENDIF}
{$ENDIF}
begin
if AConvert then begin
{$IFDEF AVOID_URW_ERRORS}
// assigning to a local variable to avoid an "Internal error URW533" compiler
// error in Delphi 5, and an "Internal error URW699" compiler error in Delphi
// 6. Later versions seem OK without it...
h := GStack.HostToNetwork(UInt64(AValue));
AValue := h;
{$ELSE}
{$IFDEF HAS_TIdUInt64_QuadPart}
// assigning to a local variable if UInt64 is not a native type, or if using
// a C++Builder version that has problems with UInt64 parameters...
h.QuadPart := UInt64(AValue);
h := GStack.HostToNetwork(h);
AValue := Int64(h.QuadPart);
{$ELSE}
AValue := Int64(GStack.HostToNetwork(UInt64(AValue)));
{$ENDIF}
{$ENDIF}
end;
Write(ToBytes(AValue));
end;
procedure TIdIOHandler.Write(AValue: TIdUInt64; AConvert: Boolean = True);
begin
if AConvert then begin
AValue := GStack.HostToNetwork(AValue);
end;
Write(ToBytes(AValue));
end;
procedure TIdIOHandler.Write(AValue: TStrings; AWriteLinesCount: Boolean = False;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
);
var
i: Integer;
LBufferingStarted: Boolean;
begin
AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
{$IFDEF STRING_IS_ANSI}
ASrcEncoding := iif(ASrcEncoding, FDefAnsiEncoding, encOSDefault);
{$ENDIF}
LBufferingStarted := not WriteBufferingActive;
if LBufferingStarted then begin
WriteBufferOpen;
end;
try
if AWriteLinesCount then begin
Write(AValue.Count);
end;
for i := 0 to AValue.Count - 1 do begin
WriteLn(AValue.Strings[i], AByteEncoding
{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
);
end;
if LBufferingStarted then begin
WriteBufferClose;
end;
except
if LBufferingStarted then begin
WriteBufferCancel;
end;
raise;
end;
end;
procedure TIdIOHandler.Write(AValue: UInt16; AConvert: Boolean = True);
begin
if AConvert then begin
AValue := GStack.HostToNetwork(AValue);
end;
Write(ToBytes(AValue));
end;
procedure TIdIOHandler.Write(AValue: Int16; AConvert: Boolean = True);
begin
if AConvert then begin
AValue := Int16(GStack.HostToNetwork(UInt16(AValue)));
end;
Write(ToBytes(AValue));
end;
function TIdIOHandler.ReadString(ABytes: Integer; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string;
var
LBytes: TIdBytes;
begin
if ABytes > 0 then begin
ReadBytes(LBytes, ABytes, False);
AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
{$IFDEF STRING_IS_ANSI}
ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
{$ENDIF}
Result := BytesToString(LBytes, 0, ABytes, AByteEncoding
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
end else begin
Result := '';
end;
end;
procedure TIdIOHandler.ReadStrings(ADest: TStrings; AReadLinesCount: Integer = -1;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
);
var
i: Integer;
begin
AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
{$IFDEF STRING_IS_ANSI}
ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
{$ENDIF}
if AReadLinesCount < 0 then begin
AReadLinesCount := ReadInt32;
end;
for i := 0 to AReadLinesCount - 1 do begin
ADest.Add(ReadLn(AByteEncoding
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
));
end;
end;
function TIdIOHandler.ReadUInt16(AConvert: Boolean = True): UInt16;
var
LBytes: TIdBytes;
begin
ReadBytes(LBytes, SizeOf(UInt16), False);
Result := BytesToUInt16(LBytes);
if AConvert then begin
Result := GStack.NetworkToHost(Result);
end;
end;
{$I IdDeprecatedImplBugOff.inc}
function TIdIOHandler.ReadWord(AConvert: Boolean = True): UInt16;
{$I IdDeprecatedImplBugOn.inc}
{$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
begin
Result := ReadUInt16(AConvert);
end;
function TIdIOHandler.ReadInt16(AConvert: Boolean = True): Int16;
var
LBytes: TIdBytes;
begin
ReadBytes(LBytes, SizeOf(Int16), False);
Result := BytesToInt16(LBytes);
if AConvert then begin
Result := Int16(GStack.NetworkToHost(UInt16(Result)));
end;
end;
{$I IdDeprecatedImplBugOff.inc}
function TIdIOHandler.ReadSmallInt(AConvert: Boolean = True): Int16;
{$I IdDeprecatedImplBugOn.inc}
{$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
begin
Result := ReadInt16(AConvert);
end;
function TIdIOHandler.ReadChar(AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): Char;
var
I, J, NumChars, NumBytes: Integer;
LBytes: TIdBytes;
{$IFDEF DOTNET}
LChars: array[0..1] of Char;
{$ELSE}
LChars: TIdWideChars;
{$IFDEF STRING_IS_ANSI}
LWTmp: TIdUnicodeString;
LATmp: TIdBytes;
{$ENDIF}
{$ENDIF}
begin
AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
{$IFDEF STRING_IS_ANSI}
ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
{$ENDIF}
// 2 Chars to handle UTF-16 surrogates
NumBytes := AByteEncoding.GetMaxByteCount(2);
SetLength(LBytes, NumBytes);
{$IFNDEF DOTNET}
SetLength(LChars, 2);
{$ENDIF}
NumChars := 0;
if NumBytes > 0 then
begin
for I := 1 to NumBytes do
begin
LBytes[I-1] := ReadByte;
NumChars := AByteEncoding.GetChars(LBytes, 0, I, LChars, 0);
if NumChars > 0 then begin
// RLebeau 10/19/2012: when Indy switched to its own UTF-8 implementation
// to avoid the MB_ERR_INVALID_CHARS flag on Windows, it accidentally broke
// this loop! Since this is not commonly used, this was not noticed until
// now. On Windows at least, GetChars() now returns >0 for an invalid
// sequence, so we have to check if any of the returned characters are the
// Unicode U+FFFD character, indicating bad data...
for J := 0 to NumChars-1 do begin
if LChars[J] = TIdWideChar($FFFD) then begin
// keep reading...
NumChars := 0;
Break;
end;
end;
if NumChars > 0 then begin
Break;
end;
end;
end;
end;
{$IFDEF STRING_IS_UNICODE}
// RLebeau: if the bytes were decoded into surrogates, the second
// surrogate is lost here, as it can't be returned unless we cache
// it somewhere for the the next ReadChar() call to retreive. Just
// raise an error for now. Users will have to update their code to
// read surrogates differently...
Assert(NumChars = 1);
Result := LChars[0];
{$ELSE}
// RLebeau: since we can only return an AnsiChar here, let's convert
// the decoded characters, surrogates and all, into their Ansi
// representation. This will have the same problem as above if the
// conversion results in a multibyte character sequence...
SetString(LWTmp, PWideChar(LChars), NumChars);
LATmp := ADestEncoding.GetBytes(LWTmp); // convert to Ansi
Assert(Length(LATmp) = 1);
Result := Char(LATmp[0]);
{$ENDIF}
end;
function TIdIOHandler.ReadByte: Byte;
var
LBytes: TIdBytes;
begin
ReadBytes(LBytes, 1, False);
Result := LBytes[0];
end;
function TIdIOHandler.ReadInt32(AConvert: Boolean): Int32;
var
LBytes: TIdBytes;
begin
ReadBytes(LBytes, SizeOf(Int32), False);
Result := BytesToInt32(LBytes);
if AConvert then begin
Result := Int32(GStack.NetworkToHost(UInt32(Result)));
end;
end;
{$I IdDeprecatedImplBugOff.inc}
function TIdIOHandler.ReadLongInt(AConvert: Boolean): Int32;
{$I IdDeprecatedImplBugOn.inc}
{$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
begin
Result := ReadInt32(AConvert);
end;
function TIdIOHandler.ReadInt64(AConvert: boolean): Int64;
var
LBytes: TIdBytes;
{$IFDEF AVOID_URW_ERRORS}
h: Int64;
{$ELSE}
{$IFDEF HAS_TIdUInt64_QuadPart}
h: TIdUInt64;
{$ENDIF}
{$ENDIF}
begin
ReadBytes(LBytes, SizeOf(Int64), False);
Result := BytesToInt64(LBytes);
if AConvert then begin
{$IFDEF AVOID_URW_ERRORS}
// assigning to a local variable to avoid an "Internal error URW533" compiler
// error in Delphi 5, and an "Internal error URW699" compiler error in Delphi
// 6. Later versions seem OK without it...
h := GStack.NetworkToHost(UInt64(Result));
Result := h;
{$ELSE}
{$IFDEF HAS_TIdUInt64_QuadPart}
// assigning to a local variable if UInt64 is not a native type, or if using
// a C++Builder version that has problems with UInt64 parameters...
h.QuadPart := UInt64(AValue);
h := GStack.NetworkToHost(h);
Result := Int64(h.QuadPart);
{$ELSE}
Result := Int64(GStack.NetworkToHost(UInt64(Result)));
{$ENDIF}
{$ENDIF}
end;
end;
function TIdIOHandler.ReadUInt64(AConvert: boolean): TIdUInt64;
var
LBytes: TIdBytes;
begin
ReadBytes(LBytes, SizeOf(TIdUInt64), False);
Result := BytesToUInt64(LBytes);
if AConvert then begin
Result := GStack.NetworkToHost(Result);
end;
end;
function TIdIOHandler.ReadUInt32(AConvert: Boolean): UInt32;
var
LBytes: TIdBytes;
begin
ReadBytes(LBytes, SizeOf(UInt32), False);
Result := BytesToUInt32(LBytes);
if AConvert then begin
Result := GStack.NetworkToHost(Result);
end;
end;
{$I IdDeprecatedImplBugOff.inc}
function TIdIOHandler.ReadLongWord(AConvert: Boolean): UInt32;
{$I IdDeprecatedImplBugOn.inc}
{$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
begin
Result := ReadUInt32(AConvert);
end;
function TIdIOHandler.ReadLn(AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string;
{$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
begin
Result := ReadLn(LF, IdTimeoutDefault, -1, AByteEncoding
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
end;
function TIdIOHandler.ReadLn(ATerminator: string; AByteEncoding: IIdTextEncoding
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string;
{$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
begin
Result := ReadLn(ATerminator, IdTimeoutDefault, -1, AByteEncoding
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
end;
function TIdIOHandler.ReadLn(ATerminator: string; ATimeout: Integer = IdTimeoutDefault;
AMaxLineLength: Integer = -1; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string;
var
LInputBufferSize: Integer;
LStartPos: Integer;
LTermPos: Integer;
LReadLnStartTime: TIdTicks;
LTerm, LResult: TIdBytes;
begin
AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
{$IFDEF STRING_IS_ANSI}
ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
{$ENDIF}
if AMaxLineLength < 0 then begin
AMaxLineLength := MaxLineLength;
end;
// User may pass '' if they need to pass arguments beyond the first.
if ATerminator = '' then begin
ATerminator := LF;
end;
// TODO: encountered an email that was using charset "cp1026", which encodes
// a LF character to byte $25 instead of $0A (and decodes byte $0A to character
// #$8E instead of #$A). To account for that, don't encoding the LF using the
// specified encoding anymore, force the encoding to what it should be. But
// what if UTF-16 is being used?
{
if ATerminator = LF then begin
LTerm := ToBytes(Byte($0A));
end else begin
LTerm := ToBytes(ATerminator, AByteEncoding
{$IFDEF STRING_IS_ANSI, ADestEncoding{$ENDIF
);
end;
}
LTerm := ToBytes(ATerminator, AByteEncoding
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
FReadLnSplit := False;
FReadLnTimedOut := False;
LTermPos := -1;
LStartPos := 0;
LReadLnStartTime := Ticks64;
repeat
LInputBufferSize := FInputBuffer.Size;
if LInputBufferSize > 0 then begin
if LStartPos < LInputBufferSize then begin
LTermPos := FInputBuffer.IndexOf(LTerm, LStartPos);
end else begin
LTermPos := -1;
end;
LStartPos := IndyMax(LInputBufferSize-(Length(LTerm)-1), 0);
end;
// if the line length is limited and terminator is found after the limit or not found and the limit is exceeded
if (AMaxLineLength > 0) and ((LTermPos > AMaxLineLength) or ((LTermPos = -1) and (LStartPos > AMaxLineLength))) then begin
if MaxLineAction = maException then begin
raise EIdReadLnMaxLineLengthExceeded.Create(RSReadLnMaxLineLengthExceeded);
end;
// RLebeau: WARNING - if the line is using multibyte character sequences
// and a sequence staddles the AMaxLineLength boundary, this will chop
// the sequence, producing invalid data!
FReadLnSplit := True;
Result := FInputBuffer.ExtractToString(AMaxLineLength, AByteEncoding
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
Exit;
end
// ReadFromSource blocks - do not call unless we need to
else if LTermPos = -1 then begin
// ReadLn needs to call this as data may exist in the buffer, but no EOL yet disconnected
CheckForDisconnect(True, True);
// Can only return -1 if timeout
FReadLnTimedOut := ReadFromSource(True, ATimeout, False) = -1;
if (not FReadLnTimedOut) and (ATimeout >= 0) then begin
if GetElapsedTicks(LReadLnStartTime) >= UInt32(ATimeout) then begin
FReadLnTimedOut := True;
end;
end;
if FReadLnTimedOut then begin
Result := '';
Exit;
end;
end;
until LTermPos > -1;
// Extract actual data
{
IMPORTANT!!!
When encoding from UTF8 to Unicode or ASCII, you will not always get the same
number of bytes that you input so you may have to recalculate LTermPos since
that was based on the number of bytes in the input stream. If do not do this,
you will probably get an incorrect result or a range check error since the
string is shorter then the original buffer position.
JPM
}
// RLebeau 11/19/08: this is no longer needed as the terminator is encoded to raw bytes now ...
{
Result := FInputBuffer.Extract(LTermPos + Length(ATerminator), AEncoding);
LTermPos := IndyMin(LTermPos, Length(Result));
if (ATerminator = LF) and (LTermPos > 0) then begin
if Result[LTermPos] = CR then begin
Dec(LTermPos);
end;
end;
SetLength(Result, LTermPos);
}
FInputBuffer.ExtractToBytes(LResult, LTermPos + Length(LTerm));
if (ATerminator = LF) and (LTermPos > 0) then begin
if LResult[LTermPos-1] = Ord(CR) then begin
Dec(LTermPos);
end;
end;
Result := BytesToString(LResult, 0, LTermPos, AByteEncoding
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
end;
function TIdIOHandler.ReadLnRFC(var VMsgEnd: Boolean;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string;
{$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
begin
Result := ReadLnRFC(VMsgEnd, LF, '.', AByteEncoding {do not localize}
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
end;
function TIdIOHandler.ReadLnRFC(var VMsgEnd: Boolean; const ALineTerminator: string;
const ADelim: String = '.'; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string;
begin
Result := ReadLn(ALineTerminator, AByteEncoding
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
// Do not use ATerminator since always ends with . (standard)
if Result = ADelim then
begin
VMsgEnd := True;
Exit;
end;
if TextStartsWith(Result, '..') then begin {do not localize}
Delete(Result, 1, 1);
end;
VMsgEnd := False;
end;
function TIdIOHandler.ReadLnSplit(var AWasSplit: Boolean; ATerminator: string = LF;
ATimeout: Integer = IdTimeoutDefault; AMaxLineLength: Integer = -1;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string;
var
FOldAction: TIdMaxLineAction;
begin
FOldAction := MaxLineAction;
MaxLineAction := maSplit;
try
Result := ReadLn(ATerminator, ATimeout, AMaxLineLength, AByteEncoding
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
AWasSplit := FReadLnSplit;
finally
MaxLineAction := FOldAction;
end;
end;
function TIdIOHandler.ReadLnWait(AFailCount: Integer = MaxInt;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string;
var
LAttempts: Integer;
begin
// MtW: this is mostly used when empty lines could be sent.
AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
{$IFDEF STRING_IS_ANSI}
ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
{$ENDIF}
Result := '';
LAttempts := 0;
while LAttempts < AFailCount do
begin
Result := Trim(ReadLn(AByteEncoding
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
));
if Length(Result) > 0 then begin
Exit;
end;
if ReadLnTimedOut then begin
raise EIdReadTimeout.Create(RSReadTimeout);
end;
Inc(LAttempts);
end;
raise EIdReadLnWaitMaxAttemptsExceeded.Create(RSReadLnWaitMaxAttemptsExceeded);
end;
function TIdIOHandler.ReadFromSource(ARaiseExceptionIfDisconnected: Boolean;
ATimeout: Integer; ARaiseExceptionOnTimeout: Boolean): Integer;
var
LByteCount: Integer;
LLastError: Integer;
LBuffer: TIdBytes;
// under ARC, convert a weak reference to a strong reference before working with it
LIntercept: TIdConnectionIntercept;
begin
if ATimeout = IdTimeoutDefault then begin
// MtW: check for 0 too, for compatibility
if (ReadTimeout = IdTimeoutDefault) or (ReadTimeout = 0) then begin
ATimeout := IdTimeoutInfinite;
end else begin
ATimeout := ReadTimeout;
end;
end;
Result := 0;
// Check here as this side may have closed the socket
CheckForDisconnect(ARaiseExceptionIfDisconnected);
if SourceIsAvailable then begin
repeat
LByteCount := 0;
if Readable(ATimeout) then begin
if Opened then begin
// No need to call AntiFreeze, the Readable does that.
if SourceIsAvailable then begin
// TODO: Whey are we reallocating LBuffer every time? This
// should be a one time operation per connection.
// RLebeau: because the Intercept does not allow the buffer
// size to be specified, and the Intercept could potentially
// resize the buffer...
SetLength(LBuffer, RecvBufferSize);
try
LByteCount := ReadDataFromSource(LBuffer);
if LByteCount > 0 then begin
SetLength(LBuffer, LByteCount);
LIntercept := Intercept;
if LIntercept <> nil then begin
LIntercept.Receive(LBuffer);
{$IFDEF USE_OBJECT_ARC}LIntercept := nil;{$ENDIF}
LByteCount := Length(LBuffer);
end;
// Pass through LBuffer first so it can go through Intercept
//TODO: If not intercept, we can skip this step
InputBuffer.Write(LBuffer);
end;
finally
LBuffer := nil;
end;
end
else if ARaiseExceptionIfDisconnected then begin
raise EIdClosedSocket.Create(RSStatusDisconnected);
end;
end
else if ARaiseExceptionIfDisconnected then begin
raise EIdNotConnected.Create(RSNotConnected);
end;
if LByteCount < 0 then
begin
LLastError := CheckForError(LByteCount);
if LLastError = Id_WSAETIMEDOUT then begin
// Timeout
if ARaiseExceptionOnTimeout then begin
raise EIdReadTimeout.Create(RSReadTimeout);
end;
Result := -1;
Break;
end;
FClosedGracefully := True;
Close;
// Do not raise unless all data has been read by the user
if InputBufferIsEmpty and ARaiseExceptionIfDisconnected then begin
RaiseError(LLastError);
end;
LByteCount := 0;
end
else if LByteCount = 0 then begin
FClosedGracefully := True;
end;
// Check here as other side may have closed connection
CheckForDisconnect(ARaiseExceptionIfDisconnected);
Result := LByteCount;
end else begin
// Timeout
if ARaiseExceptionOnTimeout then begin
raise EIdReadTimeout.Create(RSReadTimeout);
end;
Result := -1;
Break;
end;
until (LByteCount <> 0) or (not SourceIsAvailable);
end
else if ARaiseExceptionIfDisconnected then begin
raise EIdNotConnected.Create(RSNotConnected);
end;
end;
function TIdIOHandler.CheckForDataOnSource(ATimeout: Integer = 0): Boolean;
var
LPrevSize: Integer;
begin
Result := False;
// RLebeau - Connected() might read data into the InputBuffer, thus
// leaving no data for ReadFromSource() to receive a second time,
// causing a result of False when it should be True instead. So we
// save the current size of the InputBuffer before calling Connected()
// and then compare it afterwards....
LPrevSize := InputBuffer.Size;
if Connected then begin
// return whether at least 1 byte was received
Result := (InputBuffer.Size > LPrevSize) or (ReadFromSource(False, ATimeout, False) > 0);
end;
end;
procedure TIdIOHandler.Write(AStream: TStream; ASize: TIdStreamSize = 0;
AWriteByteCount: Boolean = FALSE);
var
LBuffer: TIdBytes;
LStreamPos: TIdStreamSize;
LBufSize: Integer;
// LBufferingStarted: Boolean;
begin
if ASize < 0 then begin //"-1" All from current position
LStreamPos := AStream.Position;
ASize := AStream.Size - LStreamPos;
//todo is this step required?
AStream.Position := LStreamPos;
end
else if ASize = 0 then begin //"0" ALL
ASize := AStream.Size;
AStream.Position := 0;
end;
//else ">0" number of bytes
// RLebeau 3/19/2006: DO NOT ENABLE WRITE BUFFERING IN THIS METHOD!
//
// When sending large streams, especially with LargeStream enabled,
// this can easily cause "Out of Memory" errors. It is the caller's
// responsibility to enable/disable write buffering as needed before
// calling one of the Write() methods.
//
// Also, forcing write buffering in this method is having major
// impacts on TIdFTP, TIdFTPServer, and TIdHTTPServer.
if AWriteByteCount then begin
if LargeStream then begin
Write(Int64(ASize));
end else begin
{$IFDEF STREAM_SIZE_64}
if ASize > High(Integer) then begin
raise EIdIOHandlerRequiresLargeStream.Create(RSRequiresLargeStream);
end;
{$ENDIF}
Write(Int32(ASize));
end;
end;
BeginWork(wmWrite, ASize);
try
SetLength(LBuffer, FSendBufferSize);
while ASize > 0 do begin
LBufSize := IndyMin(ASize, Length(LBuffer));
// Do not use ReadBuffer. Some source streams are real time and will not
// return as much data as we request. Kind of like recv()
// NOTE: We use .Size - size must be supported even if real time
LBufSize := TIdStreamHelper.ReadBytes(AStream, LBuffer, LBufSize);
if LBufSize <= 0 then begin
raise EIdNoDataToRead.Create(RSIdNoDataToRead);
end;
Write(LBuffer, LBufSize);
// RLebeau: DoWork() is called in WriteDirect()
//DoWork(wmWrite, LBufSize);
Dec(ASize, LBufSize);
end;
finally
EndWork(wmWrite);
LBuffer := nil;
end;
end;
procedure TIdIOHandler.ReadBytes(var VBuffer: TIdBytes; AByteCount: Integer; AAppend: Boolean = True);
begin
Assert(FInputBuffer<>nil);
if AByteCount > 0 then begin
// Read from stack until we have enough data
while FInputBuffer.Size < AByteCount do begin
// RLebeau: in case the other party disconnects
// after all of the bytes were transmitted ok.
// No need to throw an exception just yet...
if ReadFromSource(False) > 0 then begin
if FInputBuffer.Size >= AByteCount then begin
Break; // we have enough data now
end;
end;
CheckForDisconnect(True, True);
end;
FInputBuffer.ExtractToBytes(VBuffer, AByteCount, AAppend);
end else if AByteCount < 0 then begin
ReadFromSource(False, ReadTimeout, False);
CheckForDisconnect(True, True);
FInputBuffer.ExtractToBytes(VBuffer, -1, AAppend);
end;
end;
procedure TIdIOHandler.WriteLn(AEncoding: IIdTextEncoding = nil);
{$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
begin
{$IFNDEF VCL_6_OR_ABOVE}
// RLebeau: in Delphi 5, explicitly specifying the nil value for the third
// parameter causes a "There is no overloaded version of 'WriteLn' that can
// be called with these arguments" compiler error. Must be a compiler bug,
// because it compiles fine in Delphi 6. The parameter value is nil by default
// anyway, so we don't really need to specify it here at all, but I'm documenting
// this so we know for future reference...
//
WriteLn('', AEncoding);
{$ELSE}
WriteLn('', AEncoding{$IFDEF STRING_IS_ANSI}, nil{$ENDIF});
{$ENDIF}
end;
procedure TIdIOHandler.WriteLn(const AOut: string;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
);
begin
// TODO: RLebeau 1/2/2015: encountered an email that was using charset "cp1026",
// which encodes a LF character to byte $25 instead of $0A (and decodes
// byte $0A to character #$8E instead of #$A). To account for that, don't
// encoding the CRLF using the specified encoding anymore, force the encoding
// to what it should be...
//
// But, what to do if the target encoding is UTF-16?
{
Write(AOut, AByteEncoding{$IFDEF STRING_IS_ANSI, ASrcEncoding{$ENDIF);
Write(EOL, Indy8BitEncoding{$IFDEF STRING_IS_ANSI, Indy8BitEncoding{$ENDIF);
}
// Do as one write so it only makes one call to network
Write(AOut + EOL, AByteEncoding
{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
);
end;
procedure TIdIOHandler.WriteLnRFC(const AOut: string = '';
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
);
begin
if TextStartsWith(AOut, '.') then begin {do not localize}
WriteLn('.' + AOut, AByteEncoding {do not localize}
{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
);
end else begin
WriteLn(AOut, AByteEncoding
{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
);
end;
end;
function TIdIOHandler.Readable(AMSec: Integer): Boolean;
begin
// In case descendant does not override this or other methods but implements the higher level
// methods
Result := False;
end;
procedure TIdIOHandler.SetHost(const AValue: string);
begin
FHost := AValue;
end;
procedure TIdIOHandler.SetPort(AValue: Integer);
begin
FPort := AValue;
end;
function TIdIOHandler.Connected: Boolean;
begin
CheckForDisconnect(False);
Result :=
(
(
// Set when closed properly. Reflects actual socket state.
(not ClosedGracefully)
// Created on Open. Prior to Open ClosedGracefully is still false.
and (FInputBuffer <> nil)
)
// Buffer must be empty. Even if closed, we are "connected" if we still have
// data
or (not InputBufferIsEmpty)
)
and Opened;
end;
// TODO: move this into IdGlobal.pas
procedure AdjustStreamSize(const AStream: TStream; const ASize: TIdStreamSize);
var
LStreamPos: TIdStreamSize;
begin
LStreamPos := AStream.Position;
AStream.Size := ASize;
// Must reset to original value in cases where size changes position
if AStream.Position <> LStreamPos then begin
AStream.Position := LStreamPos;
end;
end;
procedure TIdIOHandler.ReadStream(AStream: TStream; AByteCount: TIdStreamSize;
AReadUntilDisconnect: Boolean);
var
i: Integer;
LBuf: TIdBytes;
LByteCount, LPos: TIdStreamSize;
{$IFNDEF STREAM_SIZE_64}
LTmp: Int64;
{$ENDIF}
const
cSizeUnknown = -1;
begin
Assert(AStream<>nil);
if (AByteCount = cSizeUnknown) and (not AReadUntilDisconnect) then begin
// Read size from connection
if LargeStream then begin
{$IFDEF STREAM_SIZE_64}
LByteCount := ReadInt64;
{$ELSE}
LTmp := ReadInt64;
if LTmp > MaxInt then begin
raise EIdIOHandlerStreamDataTooLarge.Create(RSDataTooLarge);
end;
LByteCount := TIdStreamSize(LTmp);
{$ENDIF}
end else begin
LByteCount := ReadInt32;
end;
end else begin
LByteCount := AByteCount;
end;
// Presize stream if we know the size - this reduces memory/disk allocations to one time
// Have an option for this? user might not want to presize, eg for int64 files
if LByteCount > -1 then begin
LPos := AStream.Position;
if (High(TIdStreamSize) - LPos) < LByteCount then begin
raise EIdIOHandlerStreamDataTooLarge.Create(RSDataTooLarge);
end;
AdjustStreamSize(AStream, LPos + LByteCount);
end;
if (LByteCount <= cSizeUnknown) and (not AReadUntilDisconnect) then begin
AReadUntilDisconnect := True;
end;
if AReadUntilDisconnect then begin
BeginWork(wmRead);
end else begin
BeginWork(wmRead, LByteCount);
end;
try
// If data already exists in the buffer, write it out first.
// should this loop for all data in buffer up to workcount? not just one block?
if FInputBuffer.Size > 0 then begin
if AReadUntilDisconnect then begin
i := FInputBuffer.Size;
end else begin
i := IndyMin(FInputBuffer.Size, LByteCount);
Dec(LByteCount, i);
end;
FInputBuffer.ExtractToStream(AStream, i);
end;
// RLebeau - don't call Connected() here! ReadBytes() already
// does that internally. Calling Connected() here can cause an
// EIdConnClosedGracefully exception that breaks the loop
// prematurely and thus leave unread bytes in the InputBuffer.
// Let the loop catch the exception before exiting...
SetLength(LBuf, RecvBufferSize); // preallocate the buffer
repeat
if AReadUntilDisconnect then begin
i := Length(LBuf);
end else begin
i := IndyMin(LByteCount, Length(LBuf));
if i < 1 then begin
Break;
end;
end;
//TODO: Improve this - dont like the use of the exception handler
//DONE -oAPR: Dont use a string, use a memory buffer or better yet the buffer itself.
try
try
ReadBytes(LBuf, i, False);
except
on E: Exception do begin
// RLebeau - ReadFromSource() inside of ReadBytes()
// could have filled the InputBuffer with more bytes
// than actually requested, so don't extract too
// many bytes here...
i := IndyMin(i, FInputBuffer.Size);
FInputBuffer.ExtractToBytes(LBuf, i, False);
if AReadUntilDisconnect then begin
if E is EIdConnClosedGracefully then begin
Exit;
end
else if E is EIdSocketError then begin
case EIdSocketError(E).LastError of
Id_WSAESHUTDOWN, Id_WSAECONNABORTED, Id_WSAECONNRESET: begin
Exit;
end;
end;
end;
end;
raise;
end;
end;
TIdAntiFreezeBase.DoProcess;
finally
if i > 0 then begin
TIdStreamHelper.Write(AStream, LBuf, i);
if not AReadUntilDisconnect then begin
Dec(LByteCount, i);
end;
end;
end;
until False;
finally
EndWork(wmRead);
if AStream.Size > AStream.Position then begin
AStream.Size := AStream.Position;
end;
LBuf := nil;
end;
end;
procedure TIdIOHandler.Discard(AByteCount: Int64);
var
LSize: Integer;
begin
Assert(AByteCount >= 0);
if AByteCount > 0 then
begin
BeginWork(wmRead, AByteCount);
try
repeat
LSize := iif(AByteCount < MaxInt, Integer(AByteCount), MaxInt);
LSize := IndyMin(LSize, FInputBuffer.Size);
if LSize > 0 then begin
FInputBuffer.Remove(LSize);
Dec(AByteCount, LSize);
if AByteCount < 1 then begin
Break;
end;
end;
// RLebeau: in case the other party disconnects
// after all of the bytes were transmitted ok.
// No need to throw an exception just yet...
if ReadFromSource(False) < 1 then begin
CheckForDisconnect(True, True);
end;
until False;
finally
EndWork(wmRead);
end;
end;
end;
procedure TIdIOHandler.DiscardAll;
begin
BeginWork(wmRead);
try
// If data already exists in the buffer, discard it first.
FInputBuffer.Clear;
// RLebeau - don't call Connected() here! ReadBytes() already
// does that internally. Calling Connected() here can cause an
// EIdConnClosedGracefully exception that breaks the loop
// prematurely and thus leave unread bytes in the InputBuffer.
// Let the loop catch the exception before exiting...
repeat
//TODO: Improve this - dont like the use of the exception handler
try
if ReadFromSource(False) > 0 then begin
FInputBuffer.Clear;
end else begin;
CheckForDisconnect(True, True);
end;
except
on E: Exception do begin
// RLebeau - ReadFromSource() could have filled the
// InputBuffer with more bytes...
FInputBuffer.Clear;
if E is EIdConnClosedGracefully then begin
Break;
end else begin
raise;
end;
end;
end;
TIdAntiFreezeBase.DoProcess;
until False;
finally
EndWork(wmRead);
end;
end;
procedure TIdIOHandler.RaiseConnClosedGracefully;
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;
function TIdIOHandler.InputBufferAsString(AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string;
begin
AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
{$IFDEF STRING_IS_ANSI}
ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
{$ENDIF}
Result := FInputBuffer.ExtractToString(FInputBuffer.Size, AByteEncoding
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
end;
function TIdIOHandler.AllData(AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
): string;
var
LBytes: Integer;
begin
Result := '';
BeginWork(wmRead);
try
if Connected then
begin
try
try
repeat
LBytes := ReadFromSource(False, 250, False);
until LBytes = 0; // -1 on timeout
finally
if not InputBufferIsEmpty then begin
Result := InputBufferAsString(AByteEncoding
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
end;
end;
except end;
end;
finally
EndWork(wmRead);
end;
end;
procedure TIdIOHandler.PerformCapture(const ADest: TObject;
out VLineCount: Integer; const ADelim: string;
AUsesDotTransparency: Boolean; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
);
var
s: string;
LStream: TStream;
LStrings: TStrings;
begin
VLineCount := 0;
AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
{$IFDEF STRING_IS_ANSI}
ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
{$ENDIF}
LStream := nil;
LStrings := nil;
if ADest is TStrings then begin
LStrings := TStrings(ADest);
end
else if ADest is TStream then begin
LStream := TStream(ADest);
end
else begin
raise EIdObjectTypeNotSupported.Create(RSObjectTypeNotSupported);
end;
BeginWork(wmRead);
try
repeat
s := ReadLn(AByteEncoding
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
if s = ADelim then begin
Exit;
end;
// S.G. 6/4/2004: All the consumers to protect themselves against memory allocation attacks
if FMaxCapturedLines > 0 then begin
if VLineCount > FMaxCapturedLines then begin
raise EIdMaxCaptureLineExceeded.Create(RSMaximumNumberOfCaptureLineExceeded);
end;
end;
// For RFC retrieves that use dot transparency
// No length check necessary, if only one byte it will be byte x + #0.
if AUsesDotTransparency then begin
if TextStartsWith(s, '..') then begin
Delete(s, 1, 1);
end;
end;
// Write to output
Inc(VLineCount);
if LStrings <> nil then begin
LStrings.Add(s);
end
else if LStream <> nil then begin
WriteStringToStream(LStream, s+EOL, AByteEncoding
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
end;
until False;
finally
EndWork(wmRead);
end;
end;
function TIdIOHandler.InputLn(const AMask: String = ''; AEcho: Boolean = True;
ATabWidth: Integer = 8; AMaxLineLength: Integer = -1;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; AAnsiEncoding: IIdTextEncoding = nil{$ENDIF}
): String;
var
i: Integer;
LChar: Char;
LTmp: string;
begin
Result := '';
AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
{$IFDEF STRING_IS_ANSI}
AAnsiEncoding := iif(AAnsiEncoding, FDefAnsiEncoding, encOSDefault);
{$ENDIF}
if AMaxLineLength < 0 then begin
AMaxLineLength := MaxLineLength;
end;
repeat
LChar := ReadChar(AByteEncoding
{$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
);
i := Length(Result);
if i <= AMaxLineLength then begin
case LChar of
BACKSPACE:
begin
if i > 0 then begin
SetLength(Result, i - 1);
if AEcho then begin
Write(BACKSPACE + ' ' + BACKSPACE, AByteEncoding
{$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
);
end;
end;
end;
TAB:
begin
if ATabWidth > 0 then begin
i := ATabWidth - (i mod ATabWidth);
LTmp := StringOfChar(' ', i);
Result := Result + LTmp;
if AEcho then begin
Write(LTmp, AByteEncoding
{$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
);
end;
end else begin
Result := Result + LChar;
if AEcho then begin
Write(LChar, AByteEncoding
{$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
);
end;
end;
end;
LF: ;
CR: ;
#27: ; //ESC - currently not supported
else
Result := Result + LChar;
if AEcho then begin
if Length(AMask) = 0 then begin
Write(LChar, AByteEncoding
{$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
);
end else begin
Write(AMask, AByteEncoding
{$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
);
end;
end;
end;
end;
until LChar = LF;
// Remove CR trail
i := Length(Result);
while (i > 0) and CharIsInSet(Result, i, EOL) do begin
Dec(i);
end;
SetLength(Result, i);
if AEcho then begin
WriteLn(AByteEncoding);
end;
end;
//TODO: Add a time out (default to infinite) and event to pass data
//TODO: Add a max size argument as well.
//TODO: Add a case insensitive option
function TIdIOHandler.WaitFor(const AString: string; ARemoveFromBuffer: Boolean = True;
AInclusive: Boolean = False; AByteEncoding: IIdTextEncoding = nil;
ATimeout: Integer = IdTimeoutDefault
{$IFDEF STRING_IS_ANSI}; AAnsiEncoding: IIdTextEncoding = nil{$ENDIF}
): string;
var
LBytes: TIdBytes;
LPos: Integer;
begin
Result := '';
AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
{$IFDEF STRING_IS_ANSI}
AAnsiEncoding := iif(AAnsiEncoding, FDefAnsiEncoding, encOSDefault);
{$ENDIF}
LBytes := ToBytes(AString, AByteEncoding
{$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
);
LPos := 0;
repeat
LPos := InputBuffer.IndexOf(LBytes, LPos);
if LPos <> -1 then begin
if ARemoveFromBuffer and AInclusive then begin
Result := InputBuffer.ExtractToString(LPos+Length(LBytes), AByteEncoding
{$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
);
end else begin
Result := InputBuffer.ExtractToString(LPos, AByteEncoding
{$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
);
if ARemoveFromBuffer then begin
InputBuffer.Remove(Length(LBytes));
end;
if AInclusive then begin
Result := Result + AString;
end;
end;
Exit;
end;
LPos := IndyMax(0, InputBuffer.Size - (Length(LBytes)-1));
ReadFromSource(True, ATimeout, True);
until False;
end;
procedure TIdIOHandler.Capture(ADest: TStream; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
);
{$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
begin
Capture(ADest, '.', True, AByteEncoding {do not localize}
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
end;
procedure TIdIOHandler.Capture(ADest: TStream; out VLineCount: Integer;
const ADelim: string = '.'; AUsesDotTransparency: Boolean = True;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
);
{$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
begin
PerformCapture(ADest, VLineCount, ADelim, AUsesDotTransparency, AByteEncoding
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
end;
procedure TIdIOHandler.Capture(ADest: TStream; ADelim: string;
AUsesDotTransparency: Boolean = True; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
);
var
LLineCount: Integer;
begin
PerformCapture(ADest, LLineCount, '.', AUsesDotTransparency, AByteEncoding {do not localize}
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
end;
procedure TIdIOHandler.Capture(ADest: TStrings; out VLineCount: Integer;
const ADelim: string = '.'; AUsesDotTransparency: Boolean = True;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
);
{$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
begin
PerformCapture(ADest, VLineCount, ADelim, AUsesDotTransparency, AByteEncoding
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
end;
procedure TIdIOHandler.Capture(ADest: TStrings; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
);
var
LLineCount: Integer;
begin
PerformCapture(ADest, LLineCount, '.', True, AByteEncoding {do not localize}
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
end;
procedure TIdIOHandler.Capture(ADest: TStrings; const ADelim: string;
AUsesDotTransparency: Boolean = True; AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
);
var
LLineCount: Integer;
begin
PerformCapture(ADest, LLineCount, ADelim, AUsesDotTransparency, AByteEncoding
{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
);
end;
procedure TIdIOHandler.InputBufferToStream(AStream: TStream; AByteCount: Integer = -1);
{$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
begin
FInputBuffer.ExtractToStream(AStream, AByteCount);
end;
function TIdIOHandler.InputBufferIsEmpty: Boolean;
{$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
begin
Result := FInputBuffer.Size = 0;
end;
procedure TIdIOHandler.Write(const ABuffer: TIdBytes; const ALength: Integer = -1;
const AOffset: Integer = 0);
var
LLength: Integer;
begin
LLength := IndyLength(ABuffer, ALength, AOffset);
if LLength > 0 then begin
if FWriteBuffer = nil then begin
WriteDirect(ABuffer, LLength, AOffset);
end else begin
// Write Buffering is enabled
FWriteBuffer.Write(ABuffer, LLength, AOffset);
if (FWriteBuffer.Size >= WriteBufferThreshold) and (WriteBufferThreshold > 0) then begin
repeat
WriteBufferFlush(WriteBufferThreshold);
until FWriteBuffer.Size < WriteBufferThreshold;
end;
end;
end;
end;
procedure TIdIOHandler.WriteRFCStrings(AStrings: TStrings; AWriteTerminator: Boolean = True;
AByteEncoding: IIdTextEncoding = nil
{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
);
var
i: Integer;
begin
AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
{$IFDEF STRING_IS_ANSI}
ASrcEncoding := iif(ASrcEncoding, FDefAnsiEncoding, encOSDefault);
{$ENDIF}
for i := 0 to AStrings.Count - 1 do begin
WriteLnRFC(AStrings[i], AByteEncoding
{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
);
end;
if AWriteTerminator then begin
WriteLn('.', AByteEncoding
{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
);
end;
end;
function TIdIOHandler.WriteFile(const AFile: String; AEnableTransferFile: Boolean): Int64;
var
//TODO: There is a way in linux to dump a file to a socket as well. use it.
LStream: TStream;
{$IFDEF WIN32_OR_WIN64}
LOldErrorMode : Integer;
{$ENDIF}
begin
Result := 0;
{$IFDEF WIN32_OR_WIN64}
LOldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
{$ENDIF}
if not FileExists(AFile) then begin
raise EIdFileNotFound.CreateFmt(RSFileNotFound, [AFile]);
end;
LStream := TIdReadFileExclusiveStream.Create(AFile);
try
Write(LStream);
Result := LStream.Size;
finally
FreeAndNil(LStream);
end;
{$IFDEF WIN32_OR_WIN64}
finally
SetErrorMode(LOldErrorMode)
end;
{$ENDIF}
end;
function TIdIOHandler.WriteBufferingActive: Boolean;
{$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
begin
Result := FWriteBuffer <> nil;
end;
procedure TIdIOHandler.CloseGracefully;
begin
FClosedGracefully := True
end;
procedure TIdIOHandler.InterceptReceive(var VBuffer: TIdBytes);
var
// under ARC, convert a weak reference to a strong reference before working with it
LIntercept: TIdConnectionIntercept;
begin
LIntercept := Intercept;
if LIntercept <> nil then begin
LIntercept.Receive(VBuffer);
end;
end;
procedure TIdIOHandler.InitComponent;
begin
inherited InitComponent;
FRecvBufferSize := GRecvBufferSizeDefault;
FSendBufferSize := GSendBufferSizeDefault;
FMaxLineLength := IdMaxLineLengthDefault;
FMaxCapturedLines := Id_IOHandler_MaxCapturedLines;
FLargeStream := False;
FReadTimeOut := IdTimeoutDefault;
FInputBuffer := TIdBuffer.Create(BufferRemoveNotify);
FDefStringEncoding := IndyTextEncoding_ASCII;
{$IFDEF STRING_IS_ANSI}
FDefAnsiEncoding := IndyTextEncoding_OSDefault;
{$ENDIF}
end;
procedure TIdIOHandler.WriteBufferFlush;
begin
WriteBufferFlush(-1);
end;
procedure TIdIOHandler.WriteBufferOpen;
begin
WriteBufferOpen(-1);
end;
procedure TIdIOHandler.WriteDirect(const ABuffer: TIdBytes; const ALength: Integer = -1;
const AOffset: Integer = 0);
var
LTemp: TIdBytes;
LPos: Integer;
LSize: Integer;
LByteCount: Integer;
LLastError: Integer;
// under ARC, convert a weak reference to a strong reference before working with it
LIntercept: TIdConnectionIntercept;
begin
// Check if disconnected
CheckForDisconnect(True, True);
LIntercept := Intercept;
if LIntercept <> nil then begin
// TODO: pass offset/size parameters to the Intercept
// so that a copy is no longer needed here
LTemp := ToBytes(ABuffer, ALength, AOffset);
LIntercept.Send(LTemp);
{$IFDEF USE_OBJECT_ARC}LIntercept := nil;{$ENDIF}
LSize := Length(LTemp);
LPos := 0;
end else begin
LTemp := ABuffer;
LSize := IndyLength(LTemp, ALength, AOffset);
LPos := AOffset;
end;
while LSize > 0 do
begin
LByteCount := WriteDataToTarget(LTemp, LPos, LSize);
if LByteCount < 0 then
begin
LLastError := CheckForError(LByteCount);
if LLastError <> Id_WSAETIMEDOUT then begin
FClosedGracefully := True;
Close;
end;
RaiseError(LLastError);
end;
// TODO - Have a AntiFreeze param which allows the send to be split up so that process
// can be called more. Maybe a prop of the connection, MaxSendSize?
TIdAntiFreezeBase.DoProcess(False);
if LByteCount = 0 then begin
FClosedGracefully := True;
end;
// Check if other side disconnected
CheckForDisconnect;
DoWork(wmWrite, LByteCount);
Inc(LPos, LByteCount);
Dec(LSize, LByteCount);
end;
end;
initialization
finalization
FreeAndNil(GIOHandlerClassList)
end.