| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471 |
- { $HDR$}
- {**********************************************************************}
- { Unit archived using Team Coherence }
- { Team Coherence is Copyright 2002 by Quality Software Components }
- { }
- { For further information / comments, visit our WEB site at }
- { http://www.TeamCoherence.com }
- {**********************************************************************}
- {}
- { $Log: 10365: IdTCPConnection.pas
- {
- { Rev 1.13 5/29/04 12:53:12 AM RLebeau
- { Updated WriteBuffer() to call TIdAntiFreezeBase.DoProcess() after
- { GStack.CheckForSocketError() rather than before
- }
- {
- { Rev 1.12 4/24/04 12:42:24 PM RLebeau
- { Added WriteChar() method
- }
- {
- { Rev 1.11 4/22/04 10:23:16 AM RLebeau
- { Bug fix for SetIOHandler() not updating the FSocket member correctly.
- { (reintroduced in Rev 1.8)
- }
- {
- { Rev 1.10 2004.04.22 5:01:20 PM czhower
- { Bug fix with persistent IOHandlers.
- }
- {
- { Rev 1.9 2004.04.22 4:11:20 PM czhower
- { Compile error fix.
- }
- {
- { Rev 1.8 2004.04.22 3:26:30 PM czhower
- { Small clean up.
- }
- {
- { Rev 1.7 2/27/04 1:34:10 PM RLebeau
- { Bug fix for SetIOHandler() not updating the FSocket member correctly.
- }
- {
- { Rev 1.6 2004.02.26 7:00:48 PM czhower
- { BBG: TIdPeerThread loses IOHandler
- }
- {
- { Rev 1.5 2/10/04 12:06:40 AM RLebeau
- { Updated to set the Socket property to nil whenever the IOHandler is freed.
- }
- {
- { Rev 1.4 1/29/04 9:28:30 PM RLebeau
- { Added setter method for Greeting property
- }
- {
- { Rev 1.3 11/23/03 1:43:44 PM RLebeau
- { Removed "var" specifier from TStrings parameter of ReadStrings().
- }
- {
- { Rev 1.2 14.8.2003 ã. 13:03:14 DBondzhev
- { Only input buffer should be transfered to the output stream in ReadStream and
- { this should happen in any case
- }
- {
- Rev 1.1 4/17/2003 4:58:38 PM BGooijen
- cleaned up CheckForDisconnect a little
- }
- {
- { Rev 1.0 2002.11.12 10:55:02 PM czhower
- }
- unit IdTCPConnection;
- interface
- {
- 2002-04-12 - Andrew P.Rybin
- - ReadLn bugfix and optimization
- 2002-01-20 - Chad Z. Hower a.k.a Kudzu
- -WriteBuffer change was not correct. Removed. Need info on original problem to fix properly.
- -Modified ReadLnWait
- 2002-01-19 - Grahame Grieve
- - Fix to WriteBuffer to accept -1 from the stack.
- Also fixed to clean up FWriteBuffer if connection lost.
- 2002-01-19 - Chad Z. Hower a.k.a Kudzu
- -Fix to ReadLn
- 2002-01-16 - Andrew P.Rybin
- -ReadStream optimization, TIdManagedBuffer new
- 2002-01-03 - Chad Z. Hower a.k.a Kudzu
- -Added MaxLineAction
- -Added ReadLnSplit
- 2001-12-27 - Chad Z. Hower a.k.a Kudzu
- -Changes and bug fixes to InputLn
- -Modifed how buffering works
- -Added property InputBuffer
- -Moved some things to TIdBuffer
- -Modified ReadLn
- -Added LineCount to Capture
- 2001-12-25 - Andrew P.Rybin
- -MaxLineLength,ReadLn,InputLn and Merry Christmas!
- Original Author and Maintainer:
- -Chad Z. Hower a.k.a Kudzu
- }
- uses
- Classes,
- IdException, IdComponent, IdGlobal, IdSocketHandle, IdIntercept, IdIOHandler, IdRFCReply,
- IdIOHandlerSocket;
- const
- GRecvBufferSizeDefault = 32 * 1024;
- GSendBufferSizeDefault = 32 * 1024;
- IdMaxLineLengthDefault = 16 * 1024;
- IdInBufCacheSizeDefault = 32 * 1024; //TIdManagedBuffer.PackReadedSize
- IdDefTimeout = 0;
- type
- TIdBufferBytesRemoved = procedure(ASender: TObject; const ABytes: Integer) of object;
- //DONE 5 -cBeta!!! -oAPR: Make this a buffered stream for more efficiency.
- TIdSimpleBuffer = class(TMemoryStream)
- protected
- FOnBytesRemoved: TIdBufferBytesRemoved;
- public
- constructor Create(AOnBytesRemoved: TIdBufferBytesRemoved = nil); reintroduce;
- function Extract(const AByteCount: Integer): string; virtual;
- procedure Remove(const AByteCount: integer); virtual;
- end; //TIdSimpleBuffer
- TIdManagedBuffer = class(TIdSimpleBuffer)
- protected
- FPackReadedSize: Integer;
- FReadedSize: Integer;
- procedure SetPackReadedSize(const Value: Integer);
- public
- constructor Create(AOnBytesRemoved: TIdBufferBytesRemoved = nil);
- procedure Clear; //also clear "Readed"
- function Extract(const AByteCount: Integer): string; override; //since Memory is not virtual
- function Memory: Pointer; //ptr to not readed data
- procedure PackBuffer; //clear "Readed"
- procedure Remove(const AByteCount: integer); override;
- function Seek(Offset: Longint; Origin: Word): Longint; override;
- //
- property PackReadedSize: Integer read FPackReadedSize write SetPackReadedSize default IdInBufCacheSizeDefault;
- end; //TIdManagedBuffer
- TIdTCPConnection = class(TIdComponent)
- protected
- FASCIIFilter: boolean;
- // TODO - Change the "move" functions to read write functinos. Get as much as possible down
- // to just TStream so we can replace it easily
- FClosedGracefully: Boolean;
- FGreeting: TIdRFCReply;
- FFreeIOHandlerOnDisconnect: Boolean;
- FInputBuffer: TIdManagedBuffer;
- FIntercept: TIdConnectionIntercept;
- FIOHandler: TIdIOHandler;
- FLastCmdResult: TIdRFCReply;
- FMaxLineAction: TIdMaxLineAction;
- FMaxLineLength: Integer;
- FOnDisconnected: TNotifyEvent;
- FReadLnSplit: Boolean;
- FReadLnTimedOut: Boolean;
- FReadTimeout: Integer;
- FRecvBufferSize: Integer;
- FRecvBuffer: TIdSimpleBuffer; // To be used by ReadFromStack only
- FSendBufferSize: Integer;
- FSocket: TIdIOHandlerSocket;
- FWriteBuffer: TIdSimpleBuffer;
- FWriteBufferThreshhold: Integer;
- //
- procedure BufferRemoveNotify(ASender: TObject; const ABytes: Integer);
- procedure DoOnDisconnected; virtual;
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- procedure PerformCapture(ADest: TObject; out VLineCount: Integer; const ADelim: string;
- const AIsRFCMessage: Boolean);
- procedure ResetConnection; virtual;
- procedure SetGreeting(AValue: TIdRFCReply);
- procedure SetIntercept(AValue: TIdConnectionIntercept);
- procedure SetIOHandler(AValue: TIdIOHandler);
- public
- function AllData: string; virtual;
- procedure CancelWriteBuffer;
- procedure Capture(ADest: TStream; const ADelim: string = '.';
- const AIsRFCMessage: Boolean = True); overload;
- procedure Capture(ADest: TStream; out VLineCount: Integer; const ADelim: string = '.';
- const AIsRFCMessage: Boolean = True); overload;
- procedure Capture(ADest: TStrings; const ADelim: string = '.';
- const AIsRFCMessage: Boolean = True); overload;
- procedure Capture(ADest: TStrings; out VLineCount: Integer; const ADelim: string = '.';
- const AIsRFCMessage: Boolean = True); overload;
- procedure CheckForDisconnect(const ARaiseExceptionIfDisconnected: boolean = true;
- const AIgnoreBuffer: boolean = false); virtual;
- procedure CheckForGracefulDisconnect(const ARaiseExceptionIfDisconnected: Boolean = True);
- virtual;
- function CheckResponse(const AResponse: SmallInt; const AAllowedResponses: array of SmallInt)
- : SmallInt; virtual;
- procedure ClearWriteBuffer;
- procedure CloseWriteBuffer;
- function Connected: Boolean; virtual;
- constructor Create(AOwner: TComponent); override;
- function CurrentReadBuffer: string;
- destructor Destroy; override;
- procedure Disconnect; virtual;
- procedure DisconnectSocket; virtual;
- procedure FlushWriteBuffer(const AByteCount: Integer = -1);
- procedure GetInternalResponse;
- function GetResponse(const AAllowedResponses: array of SmallInt): SmallInt; overload; virtual;
- function GetResponse(const AAllowedResponse: SmallInt): SmallInt; overload;
- property Greeting: TIdRFCReply read FGreeting write SetGreeting;
- function InputLn(const AMask: string = ''; AEcho: Boolean = True; ATabWidth: Integer = 8;
- AMaxLineLength: Integer = -1): string;
- procedure OpenWriteBuffer(const AThreshhold: Integer = -1);
- // RaiseExceptionForCmdResult - Overload necesary as a exception as a default param doesnt work
- procedure RaiseExceptionForLastCmdResult; overload; virtual;
- procedure RaiseExceptionForLastCmdResult(AException: TClassIdException); overload; virtual;
- procedure ReadBuffer(var ABuffer; const AByteCount: Longint);
- function ReadCardinal(const AConvert: boolean = true): Cardinal;
- function ReadChar: Char;
- // ReadFromStack must be only call to Recv
- function ReadFromStack(const ARaiseExceptionIfDisconnected: Boolean = True;
- ATimeout: Integer = IdTimeoutDefault;
- const ARaiseExceptionOnTimeout: Boolean = True): Integer; virtual;
- function ReadInteger(const AConvert: boolean = true): Integer;
- function ReadLn(ATerminator: string = LF;
- const ATimeout: Integer = IdTimeoutDefault; AMaxLineLength: Integer = -1): string; virtual;
- function ReadLnWait(AFailCount: Integer = MaxInt): string;
- function ReadSmallInt(const AConvert: boolean = true): SmallInt;
- procedure ReadStream(AStream: TStream; AByteCount: LongInt = -1;
- const AReadUntilDisconnect: boolean = false);
- function ReadString(const ABytes: Integer): string;
- procedure ReadStrings(ADest: TStrings; AReadLinesCount: Integer = -1);
- function SendCmd(const AOut: string; const AResponse: SmallInt = -1): SmallInt; overload;
- function SendCmd(const AOut: string; const AResponse: array of SmallInt): SmallInt; overload; virtual;
- function WaitFor(const AString: string): string;
- procedure Write(const AOut: string); virtual;
- // WriteBuffer must be the ONLY call to SEND - all data goes thru this method
- procedure WriteBuffer(const ABuffer; AByteCount: Longint; const AWriteNow: Boolean = False);
- procedure WriteCardinal(AValue: Cardinal; const AConvert: Boolean = True);
- procedure WriteChar(AValue: Char);
- procedure WriteHeader(AHeader: TStrings);
- procedure WriteInteger(AValue: Integer; const AConvert: Boolean = True);
- procedure WriteLn(const AOut: string = ''); virtual;
- procedure WriteRFCReply(AReply: TIdRFCReply);
- procedure WriteRFCStrings(AStrings: TStrings);
- procedure WriteSmallInt(AValue: SmallInt; const AConvert: Boolean = True);
- procedure WriteStream(AStream: TStream; const AAll: Boolean = True;
- const AWriteByteCount: Boolean = False; const ASize: Integer = 0); virtual;
- procedure WriteStrings(AValue: TStrings; const AWriteLinesCount: Boolean = False);
- function WriteFile(const AFile: string; const AEnableTransferFile: Boolean = False): Cardinal; virtual;
- //
- property ClosedGracefully: Boolean read FClosedGracefully;
- property InputBuffer: TIdManagedBuffer read FInputBuffer;
- property LastCmdResult: TIdRFCReply read FLastCmdResult;
- property ReadLnSplit: Boolean read FReadLnSplit;
- property ReadLnTimedOut: Boolean read FReadLnTimedOut;
- property Socket: TIdIOHandlerSocket read FSocket;
- published
- property ASCIIFilter: boolean read FASCIIFilter write FASCIIFilter default False;
- property Intercept: TIdConnectionIntercept read FIntercept write SetIntercept;
- property IOHandler: TIdIOHandler read FIOHandler write SetIOHandler;
- property MaxLineLength: Integer read FMaxLineLength write FMaxLineLength default IdMaxLineLengthDefault;
- property MaxLineAction: TIdMaxLineAction read FMaxLineAction write FMaxLineAction;
- property ReadTimeout: Integer read FReadTimeout write FReadTimeout default IdDefTimeout;
- property RecvBufferSize: Integer read FRecvBufferSize write FRecvBufferSize
- default GRecvBufferSizeDefault;
- property SendBufferSize: Integer read FSendBufferSize write FSendBufferSize
- default GSendBufferSizeDefault;
- // Events
- property OnDisconnected: TNotifyEvent read FOnDisconnected write FOnDisconnected;
- property OnWork;
- property OnWorkBegin;
- property OnWorkEnd;
- end;
- EIdTCPConnectionError = class(EIdException);
- EIdObjectTypeNotSupported = class(EIdTCPConnectionError);
- EIdNotEnoughDataInBuffer = class(EIdTCPConnectionError);
- EIdInterceptPropIsNil = class(EIdTCPConnectionError);
- EIdInterceptPropInvalid = class(EIdTCPConnectionError);
- EIdIOHandlerPropInvalid = class(EIdTCPConnectionError);
- EIdNoDataToRead = class(EIdTCPConnectionError);
- EIdNotConnected = class(EIdTCPConnectionError);
- EIdFileNotFound = class(EIdTCPConnectionError);
- implementation
- uses
- IdAntiFreezeBase, IdStack, IdStackConsts, IdStream, IdResourceStrings,
- SysUtils;
- function TIdTCPConnection.AllData: string;
- begin
- BeginWork(wmRead); try
- Result := '';
- while Connected do begin
- Result := Result + CurrentReadBuffer;
- end;
- finally EndWork(wmRead); end;
- end;
- procedure TIdTCPConnection.PerformCapture(ADest: TObject; out VLineCount: Integer;
- const ADelim: string; const AIsRFCMessage: Boolean);
- const
- wDoublePoint = ord('.') shl 8 + ord('.');
- type
- PWord = ^Word;
- var
- s: string;
- begin
- VLineCount := 0;
- BeginWork(wmRead); try
- repeat
- s := ReadLn;
- if s = ADelim then begin
- Exit;
- end;
- // For RFC 822 retrieves
- // No length check necessary, if only one byte it will be byte x + #0.
- if AIsRFCMessage and (PWord(PChar(S))^ = wDoublePoint) then begin
- Delete(s, 1, 1);
- end;
- // Write to output
- Inc(VLineCount);
- if ADest is TStrings then begin
- TStrings(ADest).Add(s);
- end else if ADest is TStream then begin
- TIdStream(ADest).WriteLn(s);
- end else if ADest <> nil then begin
- raise EIdObjectTypeNotSupported.Create(RSObjectTypeNotSupported);
- end;
- until False;
- finally EndWork(wmRead); end;
- end;
- procedure TIdTCPConnection.CheckForDisconnect(const ARaiseExceptionIfDisconnected: Boolean = True;
- const AIgnoreBuffer: Boolean = False);
- var
- LDisconnected: Boolean;
- begin
- LDisconnected := False;
- // ClosedGracefully // Server disconnected
- // IOHandler = nil // Client disconnected
- if (IOHandler <> nil) then begin
- if ClosedGracefully then begin
- if IOHandler.Connected then begin
- DisconnectSocket;
- // Call event handlers to inform the user program that we were disconnected
- DoStatus(hsDisconnected);
- DoOnDisconnected;
- end;
- LDisconnected := True;
- end else begin
- LDisconnected := not IOHandler.Connected;
- end;
- end;
- if LDisconnected then begin
- // Do not raise unless all data has been read by the user
- if ((InputBuffer.Size = 0) or AIgnoreBuffer) and ARaiseExceptionIfDisconnected then begin
- (* ************************************************************* //
- ------ If you receive an exception here, please read. ----------
- If this is a SERVER
- -------------------
- The client has disconnected the socket normally and this exception is used to notify the
- server handling code. This exception is normal and will only happen from within the IDE, not
- while your program is running as an EXE. If you do not want to see this, add this exception
- or EIdSilentException to the IDE options as exceptions not to break on.
- From the IDE just hit F9 again and Indy will catch and handle the exception.
- Please see the FAQ and help file for possible further information.
- The FAQ is at http://www.nevrona.com/Indy/FAQ.html
- If this is a CLIENT
- -------------------
- The server side of this connection has disconnected normaly but your client has attempted
- to read or write to the connection. You should trap this error using a try..except.
- Please see the help file for possible further information.
- // ************************************************************* *)
- raise EIdConnClosedGracefully.Create(RSConnectionClosedGracefully);
- end;
- end;
- end;
- function TIdTCPConnection.Connected: Boolean;
- begin
- CheckForDisconnect(False);
- Result := IOHandler <> nil;
- if Result then begin
- Result := IOHandler.Connected;
- end;
- end;
- constructor TIdTCPConnection.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FReadTimeout := IdDefTimeout;
- FGreeting := TIdRFCReply.Create(nil);
- FLastCmdResult := TIdRFCReply.Create(nil);
- FRecvBuffer := TIdSimpleBuffer.Create;
- RecvBufferSize := GRecvBufferSizeDefault;
- FSendBufferSize := GSendBufferSizeDefault;
- FInputBuffer := TIdManagedBuffer.Create(BufferRemoveNotify);
- FMaxLineLength := IdMaxLineLengthDefault;
- end;
- function TIdTCPConnection.CurrentReadBuffer: string;
- begin
- Result := '';
- if Connected then begin
- ReadFromStack(False);
- end;
- Result := InputBuffer.Extract(InputBuffer.Size);
- end;
- destructor TIdTCPConnection.Destroy;
- begin
- // DisconnectSocket closes IOHandler etc. Dont call Disconnect - Disconnect may be override and
- // try to read/write to the socket.
- DisconnectSocket;
- // Because DisconnectSocket does not free the IOHandler we have to do it here.
- SetIOHandler(nil);
- FreeAndNil(FInputBuffer);
- FreeAndNil(FRecvBuffer);
- FreeAndNil(FLastCmdResult);
- FreeAndNil(FGreeting);
- inherited Destroy;
- end;
- procedure TIdTCPConnection.Disconnect;
- var
- LConnected: boolean;
- begin
- {
- there are a few possible situations here:
- 1) we are still connected, then everything works as before,
- status disconnecting, then disconnect, status disconnected
- 2) we are not connected, and this is just some "rogue" call to
- disconnect(), then nothing happens
- 3) we are not connected, because ClosedGracefully, then
- LConnected will be false, but the implicit call to
- CheckForDisconnect (inside Connected) will call the events
- }
- LConnected := Connected;
- if LConnected then begin
- DoStatus(hsDisconnecting);
- DisconnectSocket;
- end;
- // NOT in DisconnectSocket. DisconnectSocket is used to kick ReadFromStack and others
- // out of their blocking calls and they rely on the binding after that
- //
- // Disconnect is on the end of the client. Client may be reconnected and want to use the
- // same IOHandler. Thus we only set it to nil if we do want to free it.
- if FFreeIOHandlerOnDisconnect then begin
- SetIOHandler(nil);
- end;
- {
- if FFreeIOHandlerOnDisconnect then begin
- FreeAndNil(FIOHandler);
- FFreeIOHandlerOnDisconnect := False;
- end;
- }
- if LConnected then begin
- DoOnDisconnected;
- DoStatus(hsDisconnected);
- end;
- end;
- procedure TIdTCPConnection.DoOnDisconnected;
- begin
- if Assigned(OnDisconnected) then begin
- OnDisconnected(Self);
- end;
- end;
- function TIdTCPConnection.GetResponse(const AAllowedResponses: array of SmallInt): SmallInt;
- begin
- GetInternalResponse;
- Result := CheckResponse(LastCmdResult.NumericCode, AAllowedResponses);
- end;
- procedure TIdTCPConnection.RaiseExceptionForLastCmdResult(AException: TClassIdException);
- begin
- raise AException.Create(LastCmdResult.Text.Text);
- end;
- procedure TIdTCPConnection.RaiseExceptionForLastCmdResult;
- begin
- raise EIdProtocolReplyError.CreateError(LastCmdResult.NumericCode, LastCmdResult.Text.Text);
- end;
- procedure TIdTCPConnection.ReadBuffer(var ABuffer; const AByteCount: Integer);
- begin
- if (AByteCount > 0) and (@ABuffer <> nil) then begin
- // Read from stack until we have enough data
- while (InputBuffer.Size < AByteCount) do begin
- ReadFromStack;
- CheckForDisconnect(True, True);
- end;
- // Copy it to the callers buffer
- Move(InputBuffer.Memory^, ABuffer, AByteCount);
- // Remove used data from buffer
- InputBuffer.Remove(AByteCount);
- end;
- end;
- function TIdTCPConnection.ReadFromStack(const ARaiseExceptionIfDisconnected: Boolean = True;
- ATimeout: Integer = IdTimeoutDefault; const ARaiseExceptionOnTimeout: Boolean = True): Integer;
- // Reads any data in tcp/ip buffer and puts it into Indy buffer
- // This must be the ONLY raw read from Winsock routine
- // This must be the ONLY call to RECV - all data goes thru this method
- var
- i: Integer;
- LByteCount: Integer;
- begin
- if ATimeout = IdTimeoutDefault then begin
- if ReadTimeOut = 0 then begin
- ATimeout := IdTimeoutInfinite;
- end else begin
- ATimeout := FReadTimeout;
- end;
- end;
- Result := 0;
- // Check here as this side may have closed the socket
- CheckForDisconnect(ARaiseExceptionIfDisconnected);
- if Connected then begin
- LByteCount := 0;
- repeat
- if IOHandler.Readable(ATimeout) then begin
- if Assigned(FRecvBuffer) and Assigned(IOHandler) then begin //APR: disconnect from other thread
- FRecvBuffer.Size := RecvBufferSize;
- // No need to call AntiFreeze, the Readable does that.
- LByteCount := IOHandler.Recv(FRecvBuffer.Memory^, FRecvBuffer.Size);
- end else begin
- LByteCount := 0;
- if ARaiseExceptionIfDisconnected then
- raise EIdNotConnected.Create(RSNotConnected);
- end;
- FClosedGracefully := LByteCount = 0;
- if not ClosedGracefully then begin
- if GStack.CheckForSocketError(LByteCount, [Id_WSAESHUTDOWN, Id_WSAECONNABORTED]) then begin
- LByteCount := 0;
- DisconnectSocket;
- // Do not raise unless all data has been read by the user
- if InputBuffer.Size = 0 then begin
- GStack.RaiseSocketError(GStack.LastError);
- end;
- end;
- // InputBuffer.Size is modified above
- if LByteCount > 0 then begin
- FRecvBuffer.Size := LByteCount;
- if Assigned(Intercept) then begin
- FRecvBuffer.Position := 0;
- Intercept.Receive(FRecvBuffer);
- LByteCount := FRecvBuffer.Size;
- end;
- if ASCIIFilter then begin
- for i := 1 to FRecvBuffer.Size do begin
- PChar(FRecvBuffer.Memory)[i] := Chr(Ord(PChar(FRecvBuffer.Memory)[i]) and $7F);
- end;
- end;
- FInputBuffer.Seek(0, soFromEnd);
- FInputBuffer.WriteBuffer(FRecvBuffer.Memory^, FRecvBuffer.Size);
- end;
- 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 (Connected = False);
- end else begin
- if ARaiseExceptionIfDisconnected then begin
- raise EIdNotConnected.Create(RSNotConnected);
- end;
- end;
- end;
- function TIdTCPConnection.ReadInteger(const AConvert: boolean = true): Integer;
- begin
- ReadBuffer(Result, SizeOf(Result));
- if AConvert then begin
- Result := Integer(GStack.WSNToHL(LongWord(Result)));
- end;
- end;
- function TIdTCPConnection.ReadLn(ATerminator: string = LF;
- const ATimeout: Integer = IdTimeoutDefault; AMaxLineLength: Integer = -1): string;
- var
- LInputBufferSize: Integer;
- LSize: Integer;
- LTermPos: Integer;
- begin
- if AMaxLineLength = -1 then begin
- AMaxLineLength := MaxLineLength;
- end;
- // User may pass '' if they need to pass arguments beyond the first.
- if Length(ATerminator) = 0 then begin
- ATerminator := LF;
- end;
- FReadLnSplit := False;
- FReadLnTimedOut := False;
- LTermPos := 0;
- LSize := 0;
- repeat
- LInputBufferSize := InputBuffer.Size;
- if LInputBufferSize > 0 then begin
- LTermPos :=
- MemoryPos(ATerminator, PChar(InputBuffer.Memory) + LSize, LInputBufferSize - LSize);
- if LTermPos > 0 then begin
- LTermPos := LTermPos + LSize;
- end;
- LSize := LInputBufferSize;
- end; //if
- if (LTermPos - 1 > AMaxLineLength) and (AMaxLineLength <> 0) then begin
- if MaxLineAction = maException then begin
- raise EIdReadLnMaxLineLengthExceeded.Create(RSReadLnMaxLineLengthExceeded);
- end else begin
- FReadLnSplit := True;
- Result := InputBuffer.Extract(AMaxLineLength);
- Exit;
- end;
- // ReadFromStack blocks - do not call unless we need to
- end else if LTermPos = 0 then begin
- if (LSize > AMaxLineLength) and (AMaxLineLength <> 0) then begin
- if MaxLineAction = maException then begin
- raise EIdReadLnMaxLineLengthExceeded.Create(RSReadLnMaxLineLengthExceeded);
- end else begin
- FReadLnSplit := True;
- Result := InputBuffer.Extract(AMaxLineLength);
- Exit;
- end;
- end;
- // 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 := ReadFromStack(True, ATimeout, ATimeout = IdTimeoutDefault) = -1;
- if ReadLnTimedout then begin
- Result := '';
- Exit;
- end;
- end;
- until LTermPos > 0;
- Dec(LTermPos); // Strip terminators (string len w/o first terminator char)
- Result := InputBuffer.Extract(LTermPos + Length(ATerminator)); // Extract actual data
- if (ATerminator = LF) and (LTermPos > 0) and (Result[LTermPos] = CR) then begin
- SetLength(Result, LTermPos - 1);
- end else begin
- SetLength(Result, LTermPos);
- end;
- end; //ReadLn
- function TIdTCPConnection.ReadLnWait(AFailCount: Integer = MaxInt): string;
- var
- LAttempts: Integer;
- begin
- Result := '';
- LAttempts := 0;
- while (Length(Result) = 0) and (LAttempts < AFailCount) do begin
- Inc(LAttempts);
- Result := Trim(ReadLn);
- end;
- end; //ReadLnWait
- procedure TIdTCPConnection.ReadStream(AStream: TStream; AByteCount: Integer = -1;
- const AReadUntilDisconnect: Boolean = False);
- var
- i: Integer;
- LBuf: packed array of Byte;
- LBufSize: Integer;
- LWorkCount: Integer;
- procedure AdjustStreamSize(AStream: TStream; const ASize: integer);
- var
- LStreamPos: LongInt;
- begin
- LStreamPos := AStream.Position;
- AStream.Size := ASize;
- // Must reset to original size as in some cases size changes position
- if AStream.Position <> LStreamPos then begin
- AStream.Position := LStreamPos;
- end;
- end;
- begin
- if (AByteCount < 0) and (not AReadUntilDisconnect) then begin
- // Read size from connection
- AByteCount := ReadInteger;
- end;
- // Presize stream if we know the size - this reduces memory/disk allocations to one time
- if AByteCount > -1 then begin
- AdjustStreamSize(AStream, AStream.Position + AByteCount);
- end;
- if AReadUntilDisconnect then begin
- LWorkCount := High(LWorkCount);
- BeginWork(wmRead);
- end else begin
- LWorkCount := AByteCount;
- BeginWork(wmRead, LWorkCount);
- end;
- try
- // If data already exists in the buffer, write it out first.
- if InputBuffer.Size > 0 then begin
- i := Min(InputBuffer.Size, LWorkCount);
- if i > 0 then begin
- InputBuffer.Position := 0;
- AStream.CopyFrom(InputBuffer, i);
- InputBuffer.Remove(i);
- Dec(LWorkCount, i);
- end else if LWorkCount < 0 then begin
- InputBuffer.Position := 0;
- AStream.CopyFrom(InputBuffer, 0);
- InputBuffer.Clear;
- end;
- end;
- LBufSize := Min(LWorkCount, RecvBufferSize);
- SetLength(LBuf, LBufSize);
- // RLebeau - don't call Connected() here! ReadBuffer() 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...
- while {Connected and} (LWorkCount > 0) do begin
- i := Min(LWorkCount, LBufSize);
- //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
- ReadBuffer(LBuf[0], i);
- except
- on E: Exception do begin
- // RLebeau - ReadFromStack() inside of ReadBuffer()
- // could have filled the InputBuffer with more bytes
- // than actually requested, so don't extract too
- // many bytes here...
- i := Min(i, InputBuffer.Size);
- Move(InputBuffer.Memory^, LBuf[0], i);
- InputBuffer.Remove(i);
- if (E is EIdConnClosedGracefully) and AReadUntilDisconnect then begin
- Break;
- end else begin
- raise;
- end;
- end;
- end;
- finally
- if i > 0 then begin
- AStream.WriteBuffer(LBuf[0], i);
- Dec(LWorkCount, i);
- end;
- end;
- end;
- finally
- EndWork(wmRead);
- if AStream.Size > AStream.Position then begin
- AStream.Size := AStream.Position;
- end;
- LBuf := nil;
- end;
- end;
- procedure TIdTCPConnection.ResetConnection;
- begin
- InputBuffer.Clear;
- FClosedGracefully := False;
- end;
- function TIdTCPConnection.SendCmd(const AOut: string; const AResponse: array of SmallInt): SmallInt;
- begin
- WriteLn(AOut);
- Result := GetResponse(AResponse);
- end;
- procedure TIdTCPConnection.Notification(AComponent: TComponent; Operation: TOperation);
- begin
- inherited Notification(AComponent, OPeration);
- if (Operation = opRemove) then begin
- if (AComponent = FIntercept) then begin
- FIntercept := nil;
- end;
- if (AComponent = FIOHandler) then begin
- FIOHandler := nil;
- FSocket := nil;
- end;
- end;
- end;
- procedure TIdTCPConnection.SetGreeting(AValue: TIdRFCReply);
- begin
- FGreeting.Assign(AValue);
- end;
- procedure TIdTCPConnection.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;
- procedure TIdTCPConnection.SetIOHandler(AValue: TIdIOHandler);
- begin
- if (FIOHandler <> nil) and FFreeIOHandlerOnDisconnect then begin
- FreeAndNil(FIOHandler); // Clear the existing IOHandler
- FFreeIOHandlerOnDisconnect := False;
- end;
- if (AValue <> nil) then begin
- if (AValue is TIdIOHandlerSocket) then begin
- FSocket := TIdIOHandlerSocket(AValue);
- end else begin
- FSocket := nil;
- end;
- end else begin
- FSocket := nil;
- end;
- FIOHandler := AValue;
- // add self to the IOHandler's free notification list
- if FIOHandler <> nil then begin
- FIOHandler.FreeNotification(Self);
- end;
- end;
- procedure TIdTCPConnection.Write(const AOut: string);
- var
- LOutLen: Integer;
- begin
- LOutLen := Length(AOut);
- if LOutLen > 0 then begin
- WriteBuffer(Pointer(AOut)^, LOutLen);
- end;
- end; //Write
- procedure TIdTCPConnection.WriteBuffer(const ABuffer; AByteCount: Integer;
- const AWriteNow: boolean = false);
- var
- LBuffer: TIdSimpleBuffer;
- nPos, nByteCount: Integer;
- begin
- if (AByteCount > 0) and (@ABuffer <> nil) then begin
- // Check if disconnected
- CheckForDisconnect(True, True);
- if Connected then begin
- if (FWriteBuffer = nil) or AWriteNow then begin
- LBuffer := TIdSimpleBuffer.Create; try
- LBuffer.WriteBuffer(ABuffer, AByteCount);
- if Assigned(Intercept) then begin
- LBuffer.Position := 0;
- Intercept.Send(LBuffer);
- AByteCount := LBuffer.Size;
- end;
- nPos := 1;
- repeat
- nByteCount := IOHandler.Send(PChar(LBuffer.Memory)[nPos - 1], LBuffer.Size - nPos + 1);
- FClosedGracefully := nByteCount = 0;
- // Check if other side disconnected
- CheckForDisconnect;
- // Check to see if the error signifies disconnection
- if GStack.CheckForSocketError(nByteCount, [ID_WSAESHUTDOWN, Id_WSAECONNABORTED, Id_WSAECONNRESET]) then begin
- DisconnectSocket;
- GStack.RaiseSocketError(GStack.LastError);
- 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);
- DoWork(wmWrite, nByteCount);
- nPos := nPos + nByteCount;
- until nPos > AByteCount;
- finally FreeAndNil(LBuffer); end;
- // Write Buffering is enabled
- end else begin
- FWriteBuffer.WriteBuffer(ABuffer, AByteCount);
- if (FWriteBuffer.Size >= FWriteBufferThreshhold) and (FWriteBufferThreshhold > 0) then begin
- // TODO: Maybe? instead of flushing - Write until buffer is smaller than Threshold.
- // That is do at least one physical send.
- FlushWriteBuffer(FWriteBufferThreshhold);
- end;
- end;
- end
- else
- begin
- raise EIdNotConnected.Create(RSNotConnected);
- end;
- end;
- end;
- procedure TIdTCPConnection.WriteChar(AValue: Char);
- begin
- WriteBuffer(AValue, SizeOf(AValue));
- end;
- function TIdTCPConnection.WriteFile(const AFile: string; const AEnableTransferFile: boolean = False): Cardinal;
- var
- //TODO: There is a way in linux to dump a file to a socket as well. use it.
- LFileStream: TFileStream;
- begin
- if FileExists(AFile) then begin
- if Assigned(GServeFileProc) and (Intercept = nil) and AEnableTransferFile
- and (Socket <> nil) then begin
- Result := GServeFileProc(Socket.Binding.Handle, AFile);
- end else begin
- LFileStream := TFileStream.Create(AFile, fmOpenRead or fmShareDenyWrite);
- try
- WriteStream(LFileStream); //ALL Stream, no bcnt
- Result := LFileStream.Size;
- finally LFileStream.free; end;
- end;
- end else begin
- raise EIdFileNotFound.Create(Format(RSFileNotFound, [AFile]));
- end;
- end;
- procedure TIdTCPConnection.WriteHeader(AHeader: TStrings);
- var
- i: Integer;
- begin
- for i := 0 to AHeader.Count - 1 do begin
- // No ReplaceAll flag - we only want to replace the first one
- WriteLn(StringReplace(AHeader[i], '=', ': ', []));
- end;
- WriteLn('');
- end;
- procedure TIdTCPConnection.WriteInteger(AValue: Integer; const AConvert: Boolean = True);
- begin
- if AConvert then begin
- AValue := Integer(GStack.WSHToNl(LongWord(AValue)));
- end;
- WriteBuffer(AValue, SizeOf(AValue));
- end;
- procedure TIdTCPConnection.WriteLn(const AOut: string = '');
- begin
- Write(AOut + EOL);
- end;
- procedure TIdTCPConnection.WriteStream(AStream: TStream; const AAll: boolean = true;
- const AWriteByteCount: Boolean = False; const ASize: Integer = 0);
- var
- LBuffer: TMemoryStream;
- LSize: Integer;
- LStreamEnd: Integer;
- // LBufferingStarted: Boolean;
- begin
- if AAll then begin
- AStream.Position := 0;
- end;
- // This is copied to a local var because accessing .Size is very inefficient
- if ASize = 0 then begin
- LStreamEnd := AStream.Size;
- end else begin
- LStreamEnd := ASize + AStream.Position;
- end;
- LSize := LStreamEnd - AStream.Position;
- // RLebeau 3/20/2006: DO NOT ENABLE WRITE BUFFERING IN THIS METHOD!
- //
- // When sending large streams, 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 has major impacts on
- // TIdFTP, TIdFTPServer, and TIdHTTPServer.
- {
- LBufferingStarted := FWriteBuffer = nil;
- if LBufferingStarted then
- begin
- OpenWriteBuffer;
- end;
- try
- }
- LBuffer := TMemoryStream.Create; try
- if AWriteByteCount then begin
- WriteInteger(LSize);
- end;
- BeginWork(wmWrite, LSize); try
- LBuffer.Size := FSendBufferSize;
- repeat
- LSize := Min(LStreamEnd - AStream.Position, LBuffer.Size);
- if LSize = 0 then begin
- Break;
- end;
- // 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
- LSize := AStream.Read(LBuffer.Memory^, LSize);
- if LSize = 0 then begin
- raise EIdNoDataToRead.Create(RSIdNoDataToRead);
- end;
- WriteBuffer(LBuffer.Memory^, LSize);
- until False;
- finally EndWork(wmWrite); end;
- finally FreeAndNil(LBuffer); end;
- {
- if LBufferingStarted then
- begin
- CloseWriteBuffer;
- end;
- except
- on E: Exception do
- begin
- if LBufferingStarted then
- begin
- CancelWriteBuffer;
- end;
- raise;
- end;
- end;
- }
- end;
- procedure TIdTCPConnection.WriteStrings(AValue: TStrings; const AWriteLinesCount: Boolean = False);
- var
- i: Integer;
- begin
- if AWriteLinesCount then begin
- WriteInteger(AValue.Count);
- end;
- for i := 0 to AValue.Count - 1 do begin
- WriteLn(AValue.Strings[i]);
- end;
- end;
- function TIdTCPConnection.SendCmd(const AOut: string; const AResponse: SmallInt): SmallInt;
- begin
- if AResponse = -1 then begin
- Result := SendCmd(AOut, []);
- end else begin
- Result := SendCmd(AOut, [AResponse]);
- end;
- end;
- procedure TIdTCPConnection.DisconnectSocket;
- begin
- if IOHandler <> nil then begin
- // In design time don't use properties which point to other compoenents
- if not (csDesigning in ComponentState) then begin
- if Assigned(Intercept) then begin
- Intercept.Disconnect;
- end;
- IOHandler.Close;
- end;
- end;
- end;
- procedure TIdTCPConnection.OpenWriteBuffer(const AThreshhold: Integer = -1);
- begin
- if FWriteBuffer = nil then begin
- FWriteBuffer := TIdSimpleBuffer.Create;
- end else begin
- FWriteBuffer.Clear;
- end;
- FWriteBufferThreshhold := AThreshhold;
- end;
- procedure TIdTCPConnection.CloseWriteBuffer;
- begin
- if FWriteBuffer <> nil then begin
- try
- FlushWriteBuffer;
- finally
- FreeAndNil(FWriteBuffer);
- end;
- end;
- end;
- procedure TIdTCPConnection.FlushWriteBuffer(const AByteCount: Integer = -1);
- begin
- if (FWriteBuffer <> nil) and (FWriteBuffer.Size > 0) then begin
- if (AByteCount = -1) or (FWriteBuffer.Size < AByteCount) then begin
- WriteBuffer(PChar(FWriteBuffer.Memory)[0], FWriteBuffer.Size, True);
- ClearWriteBuffer;
- end else begin
- WriteBuffer(PChar(FWriteBuffer.Memory)[0], AByteCount, True);
- FWriteBuffer.Remove(AByteCount);
- end;
- end;
- end;
- procedure TIdTCPConnection.ClearWriteBuffer;
- begin
- if FWriteBuffer <> nil then begin
- FWriteBuffer.Clear;
- end;
- end;
- function TIdTCPConnection.InputLn(const AMask: string = ''; AEcho: Boolean = True;
- ATabWidth: Integer = 8; AMaxLineLength: Integer = -1): string;
- var
- i: Integer;
- LChar: Char;
- LTmp: string;
- begin
- if AMaxLineLength = -1 then begin
- AMaxLineLength := MaxLineLength;
- end;
- Result := '';
- repeat
- LChar := ReadChar;
- 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);
- 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);
- end;
- end else begin
- Result := Result + LChar;
- if AEcho then begin
- Write(LChar);
- 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);
- end else begin
- Write(AMask);
- end;
- end;
- end;
- end;
- until LChar = LF;
- // Remove CR trail
- i := Length(Result);
- while (i > 0) and (Result[i] in [CR, LF]) do begin
- Dec(i);
- end;
- SetLength(Result, i);
- if AEcho then begin
- WriteLn;
- end;
- end;
- function TIdTCPConnection.ReadString(const ABytes: Integer): string;
- begin
- SetLength(result, ABytes);
- if ABytes > 0 then begin
- ReadBuffer(result[1], Length(result));
- end;
- end;
- procedure TIdTCPConnection.ReadStrings(ADest: TStrings; AReadLinesCount: Integer = -1);
- var
- i: Integer;
- begin
- if AReadLinesCount <= 0 then begin
- AReadLinesCount := ReadInteger;
- end;
- for i := 0 to AReadLinesCount - 1 do begin
- ADest.Add(ReadLn);
- end;
- end;
- procedure TIdTCPConnection.CancelWriteBuffer;
- begin
- ClearWriteBuffer;
- CloseWriteBuffer;
- end;
- function TIdTCPConnection.ReadSmallInt(const AConvert: boolean = true): SmallInt;
- begin
- ReadBuffer(Result, SizeOf(Result));
- if AConvert then begin
- Result := SmallInt(GStack.WSNToHs(Word(Result)));
- end;
- end;
- procedure TIdTCPConnection.WriteSmallInt(AValue: SmallInt; const AConvert: boolean = true);
- begin
- if AConvert then begin
- AValue := SmallInt(GStack.WSHToNs(Word(AValue)));
- end;
- WriteBuffer(AValue, SizeOf(AValue));
- end;
- procedure TIdTCPConnection.CheckForGracefulDisconnect(const ARaiseExceptionIfDisconnected: boolean);
- begin
- ReadFromStack(ARaiseExceptionIfDisconnected, 1, False);
- end;
- { TIdBuffer }
- constructor TIdSimpleBuffer.Create(AOnBytesRemoved: TIdBufferBytesRemoved);
- begin
- inherited Create;
- FOnBytesRemoved := AOnBytesRemoved;
- end;
- function TIdSimpleBuffer.Extract(const AByteCount: Integer): string;
- begin
- if AByteCount > Size then begin
- raise EIdNotEnoughDataInBuffer.Create(RSNotEnoughDataInBuffer);
- end;
- SetString(Result, PChar(Memory), AByteCount);
- Remove(AByteCount);
- end;
- procedure TIdSimpleBuffer.Remove(const AByteCount: integer);
- begin
- if AByteCount > Size then begin
- raise EIdNotEnoughDataInBuffer.Create(RSNotEnoughDataInBuffer);
- end;
- if AByteCount = Size then begin
- Clear;
- end else begin
- Move(PChar(Memory)[AByteCount], PChar(Memory)[0], Size - AByteCount);
- SetSize(Size - AByteCount);
- end;
- if Assigned(FOnBytesRemoved) then begin
- FOnBytesRemoved(Self, AByteCount);
- end;
- end;
- function TIdTCPConnection.WaitFor(const AString: string): string;
- //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
- //TODO: Bug - returns too much data. Should only return up to search string adn not including
- // and leave the rest in the buffer.
- begin
- Result := '';
- // NOTE: AnsiPos should be used here, but AnsiPos has problems if result has any #0 in it,
- // which is often the case. So currently this function is not MBCS compliant and should
- // not be used in MBCS environments. However this function should only be used on incoming
- // TCP text data as it is 7 bit.
- while Pos(AString, Result) = 0 do begin
- Result := Result + CurrentReadBuffer;
- CheckForDisconnect;
- end;
- end;
- function TIdTCPConnection.ReadCardinal(const AConvert: boolean): Cardinal;
- begin
- ReadBuffer(Result, SizeOf(Result));
- if AConvert then begin
- Result := GStack.WSNToHL(Result);
- end;
- end;
- procedure TIdTCPConnection.WriteCardinal(AValue: Cardinal; const AConvert: boolean);
- begin
- if AConvert then begin
- AValue := GStack.WSHToNl(AValue);
- end;
- WriteBuffer(AValue, SizeOf(AValue));
- end;
- function TIdTCPConnection.CheckResponse(const AResponse: SmallInt;
- const AAllowedResponses: array of SmallInt): SmallInt;
- var
- i: Integer;
- LResponseFound: Boolean;
- begin
- if High(AAllowedResponses) > -1 then begin
- LResponseFound := False;
- for i := Low(AAllowedResponses) to High(AAllowedResponses) do begin
- if AResponse = AAllowedResponses[i] then begin
- LResponseFound := True;
- Break;
- end;
- end;
- if not LResponseFound then begin
- RaiseExceptionForLastCmdResult;
- end;
- end;
- Result := AResponse;
- end;
- procedure TIdTCPConnection.GetInternalResponse;
- var
- LLine: string;
- LResponse: TStringList;
- LTerm: string;
- begin
- LResponse := TStringList.Create; try
- LLine := ReadLnWait;
- LResponse.Add(LLine);
- if Length(LLine) > 3 then begin
- if LLine[4] = '-' then begin // Multi line response coming
- LTerm := Copy(LLine, 1, 3) + ' ';
- {We keep reading lines until we encounter either a line such as "250" or "250 Read"}
- repeat
- LLine := ReadLnWait;
- LResponse.Add(LLine);
- until (Length(LLine) < 4) or (AnsiSameText(Copy(LLine, 1, 4), LTerm));
- end;
- end;
- FLastCmdResult.ParseResponse(LResponse);
- finally FreeAndNil(LResponse); end;
- end;
- procedure TIdTCPConnection.WriteRFCReply(AReply: TIdRFCReply);
- begin
- if AReply.ReplyExists then begin
- Write(AReply.GenerateReply);
- end;
- end;
- procedure TIdTCPConnection.WriteRFCStrings(AStrings: TStrings);
- var
- i: Integer;
- begin
- for i := 0 to AStrings.Count - 1 do begin
- if Copy(AStrings[i], 1, 1) = '.' then begin
- WriteLn('.' + AStrings[i]);
- end else begin
- WriteLn(AStrings[i]);
- end;
- end;
- WriteLn('.');
- end;
- function TIdTCPConnection.GetResponse(const AAllowedResponse: SmallInt): SmallInt;
- begin
- Result := GetResponse([AAllowedResponse]);
- end;
- procedure TIdTCPConnection.Capture(ADest: TStream; const ADelim: string;
- const AIsRFCMessage: Boolean);
- var
- LLineCount: Integer;
- begin
- PerformCapture(ADest, LLineCount, ADelim, AIsRFCMessage);
- end;
- procedure TIdTCPConnection.Capture(ADest: TStrings; const ADelim: string;
- const AIsRFCMessage: Boolean);
- var
- LLineCount: Integer;
- begin
- PerformCapture(ADest, LLineCount, ADelim, AIsRFCMessage);
- end;
- function TIdTCPConnection.ReadChar: Char;
- begin
- ReadBuffer(Result, SizeOf(Result));
- end;
- procedure TIdTCPConnection.Capture(ADest: TStream; out VLineCount: Integer;
- const ADelim: string; const AIsRFCMessage: Boolean);
- begin
- PerformCapture(ADest, VLineCount, ADelim, AIsRFCMessage);
- end;
- procedure TIdTCPConnection.Capture(ADest: TStrings; out VLineCount: Integer; const ADelim: string;
- const AIsRFCMessage: Boolean);
- begin
- PerformCapture(ADest, VLineCount, ADelim, AIsRFCMessage);
- end;
- procedure TIdTCPConnection.BufferRemoveNotify(ASender: TObject; const ABytes: Integer);
- begin
- DoWork(wmRead, ABytes);
- end;
- { TIdManagedBuffer }
- procedure TIdManagedBuffer.Clear;
- begin
- inherited Clear;
- FReadedSize := 0;
- end; //
- constructor TIdManagedBuffer.Create(AOnBytesRemoved: TIdBufferBytesRemoved);
- begin
- inherited;
- FPackReadedSize := IdInBufCacheSizeDefault;
- end; //
- function TIdManagedBuffer.Extract(const AByteCount: Integer): string;
- begin
- if AByteCount > Size then begin
- raise EIdNotEnoughDataInBuffer.Create(RSNotEnoughDataInBuffer);
- end;
- SetString(Result, PChar(Memory), AByteCount);
- Remove(AByteCount);
- end; //TIdManagedBuffer.Extract
- function TIdManagedBuffer.Memory: Pointer;
- begin
- Result := Pointer(Integer(inherited Memory) + FReadedSize);
- end; //Memory
- procedure TIdManagedBuffer.PackBuffer;
- begin
- if FReadedSize > 0 then begin
- Move(Pointer(Integer(inherited Memory) + FReadedSize)^, inherited Memory^, Size);
- SetSize(Size); //set REAL size to fresh size
- FReadedSize := 0;
- end;
- end; //TIdManagedBuffer.PackBuffer
- procedure TIdManagedBuffer.Remove(const AByteCount: integer);
- begin
- if AByteCount > Size then begin
- raise EIdNotEnoughDataInBuffer.Create(RSNotEnoughDataInBuffer);
- end else if AByteCount = Size then begin
- Clear;
- end else begin
- FReadedSize := FReadedSize + AByteCount;
- if FReadedSize >= PackReadedSize then begin
- PackBuffer;
- end;
- end;
- if Assigned(FOnBytesRemoved) then begin
- FOnBytesRemoved(Self, AByteCount);
- end;
- end;
- function TIdManagedBuffer.Seek(Offset: Integer; Origin: Word): Longint;
- begin //note: FPosition is TRUE, FSize is TRUE
- case Origin of
- soFromBeginning:
- begin
- Result := inherited Seek(Offset + FReadedSize, soFromBeginning) - FReadedSize;
- end;
- else //soFromCurrent,soFromEnd:
- Result := inherited Seek(Offset, Origin) - FReadedSize;
- end;
- end; //TIdManagedBuffer.Seek
- procedure TIdManagedBuffer.SetPackReadedSize(const Value: Integer);
- begin
- if Value > 0 then begin
- FPackReadedSize := Value;
- end
- else begin
- FPackReadedSize := IdInBufCacheSizeDefault;
- end;
- end; //
- end.
|