IdTCPConnection.pas 48 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471
  1. { $HDR$}
  2. {**********************************************************************}
  3. { Unit archived using Team Coherence }
  4. { Team Coherence is Copyright 2002 by Quality Software Components }
  5. { }
  6. { For further information / comments, visit our WEB site at }
  7. { http://www.TeamCoherence.com }
  8. {**********************************************************************}
  9. {}
  10. { $Log: 10365: IdTCPConnection.pas
  11. {
  12. { Rev 1.13 5/29/04 12:53:12 AM RLebeau
  13. { Updated WriteBuffer() to call TIdAntiFreezeBase.DoProcess() after
  14. { GStack.CheckForSocketError() rather than before
  15. }
  16. {
  17. { Rev 1.12 4/24/04 12:42:24 PM RLebeau
  18. { Added WriteChar() method
  19. }
  20. {
  21. { Rev 1.11 4/22/04 10:23:16 AM RLebeau
  22. { Bug fix for SetIOHandler() not updating the FSocket member correctly.
  23. { (reintroduced in Rev 1.8)
  24. }
  25. {
  26. { Rev 1.10 2004.04.22 5:01:20 PM czhower
  27. { Bug fix with persistent IOHandlers.
  28. }
  29. {
  30. { Rev 1.9 2004.04.22 4:11:20 PM czhower
  31. { Compile error fix.
  32. }
  33. {
  34. { Rev 1.8 2004.04.22 3:26:30 PM czhower
  35. { Small clean up.
  36. }
  37. {
  38. { Rev 1.7 2/27/04 1:34:10 PM RLebeau
  39. { Bug fix for SetIOHandler() not updating the FSocket member correctly.
  40. }
  41. {
  42. { Rev 1.6 2004.02.26 7:00:48 PM czhower
  43. { BBG: TIdPeerThread loses IOHandler
  44. }
  45. {
  46. { Rev 1.5 2/10/04 12:06:40 AM RLebeau
  47. { Updated to set the Socket property to nil whenever the IOHandler is freed.
  48. }
  49. {
  50. { Rev 1.4 1/29/04 9:28:30 PM RLebeau
  51. { Added setter method for Greeting property
  52. }
  53. {
  54. { Rev 1.3 11/23/03 1:43:44 PM RLebeau
  55. { Removed "var" specifier from TStrings parameter of ReadStrings().
  56. }
  57. {
  58. { Rev 1.2 14.8.2003 ã. 13:03:14 DBondzhev
  59. { Only input buffer should be transfered to the output stream in ReadStream and
  60. { this should happen in any case
  61. }
  62. {
  63. Rev 1.1 4/17/2003 4:58:38 PM BGooijen
  64. cleaned up CheckForDisconnect a little
  65. }
  66. {
  67. { Rev 1.0 2002.11.12 10:55:02 PM czhower
  68. }
  69. unit IdTCPConnection;
  70. interface
  71. {
  72. 2002-04-12 - Andrew P.Rybin
  73. - ReadLn bugfix and optimization
  74. 2002-01-20 - Chad Z. Hower a.k.a Kudzu
  75. -WriteBuffer change was not correct. Removed. Need info on original problem to fix properly.
  76. -Modified ReadLnWait
  77. 2002-01-19 - Grahame Grieve
  78. - Fix to WriteBuffer to accept -1 from the stack.
  79. Also fixed to clean up FWriteBuffer if connection lost.
  80. 2002-01-19 - Chad Z. Hower a.k.a Kudzu
  81. -Fix to ReadLn
  82. 2002-01-16 - Andrew P.Rybin
  83. -ReadStream optimization, TIdManagedBuffer new
  84. 2002-01-03 - Chad Z. Hower a.k.a Kudzu
  85. -Added MaxLineAction
  86. -Added ReadLnSplit
  87. 2001-12-27 - Chad Z. Hower a.k.a Kudzu
  88. -Changes and bug fixes to InputLn
  89. -Modifed how buffering works
  90. -Added property InputBuffer
  91. -Moved some things to TIdBuffer
  92. -Modified ReadLn
  93. -Added LineCount to Capture
  94. 2001-12-25 - Andrew P.Rybin
  95. -MaxLineLength,ReadLn,InputLn and Merry Christmas!
  96. Original Author and Maintainer:
  97. -Chad Z. Hower a.k.a Kudzu
  98. }
  99. uses
  100. Classes,
  101. IdException, IdComponent, IdGlobal, IdSocketHandle, IdIntercept, IdIOHandler, IdRFCReply,
  102. IdIOHandlerSocket;
  103. const
  104. GRecvBufferSizeDefault = 32 * 1024;
  105. GSendBufferSizeDefault = 32 * 1024;
  106. IdMaxLineLengthDefault = 16 * 1024;
  107. IdInBufCacheSizeDefault = 32 * 1024; //TIdManagedBuffer.PackReadedSize
  108. IdDefTimeout = 0;
  109. type
  110. TIdBufferBytesRemoved = procedure(ASender: TObject; const ABytes: Integer) of object;
  111. //DONE 5 -cBeta!!! -oAPR: Make this a buffered stream for more efficiency.
  112. TIdSimpleBuffer = class(TMemoryStream)
  113. protected
  114. FOnBytesRemoved: TIdBufferBytesRemoved;
  115. public
  116. constructor Create(AOnBytesRemoved: TIdBufferBytesRemoved = nil); reintroduce;
  117. function Extract(const AByteCount: Integer): string; virtual;
  118. procedure Remove(const AByteCount: integer); virtual;
  119. end; //TIdSimpleBuffer
  120. TIdManagedBuffer = class(TIdSimpleBuffer)
  121. protected
  122. FPackReadedSize: Integer;
  123. FReadedSize: Integer;
  124. procedure SetPackReadedSize(const Value: Integer);
  125. public
  126. constructor Create(AOnBytesRemoved: TIdBufferBytesRemoved = nil);
  127. procedure Clear; //also clear "Readed"
  128. function Extract(const AByteCount: Integer): string; override; //since Memory is not virtual
  129. function Memory: Pointer; //ptr to not readed data
  130. procedure PackBuffer; //clear "Readed"
  131. procedure Remove(const AByteCount: integer); override;
  132. function Seek(Offset: Longint; Origin: Word): Longint; override;
  133. //
  134. property PackReadedSize: Integer read FPackReadedSize write SetPackReadedSize default IdInBufCacheSizeDefault;
  135. end; //TIdManagedBuffer
  136. TIdTCPConnection = class(TIdComponent)
  137. protected
  138. FASCIIFilter: boolean;
  139. // TODO - Change the "move" functions to read write functinos. Get as much as possible down
  140. // to just TStream so we can replace it easily
  141. FClosedGracefully: Boolean;
  142. FGreeting: TIdRFCReply;
  143. FFreeIOHandlerOnDisconnect: Boolean;
  144. FInputBuffer: TIdManagedBuffer;
  145. FIntercept: TIdConnectionIntercept;
  146. FIOHandler: TIdIOHandler;
  147. FLastCmdResult: TIdRFCReply;
  148. FMaxLineAction: TIdMaxLineAction;
  149. FMaxLineLength: Integer;
  150. FOnDisconnected: TNotifyEvent;
  151. FReadLnSplit: Boolean;
  152. FReadLnTimedOut: Boolean;
  153. FReadTimeout: Integer;
  154. FRecvBufferSize: Integer;
  155. FRecvBuffer: TIdSimpleBuffer; // To be used by ReadFromStack only
  156. FSendBufferSize: Integer;
  157. FSocket: TIdIOHandlerSocket;
  158. FWriteBuffer: TIdSimpleBuffer;
  159. FWriteBufferThreshhold: Integer;
  160. //
  161. procedure BufferRemoveNotify(ASender: TObject; const ABytes: Integer);
  162. procedure DoOnDisconnected; virtual;
  163. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  164. procedure PerformCapture(ADest: TObject; out VLineCount: Integer; const ADelim: string;
  165. const AIsRFCMessage: Boolean);
  166. procedure ResetConnection; virtual;
  167. procedure SetGreeting(AValue: TIdRFCReply);
  168. procedure SetIntercept(AValue: TIdConnectionIntercept);
  169. procedure SetIOHandler(AValue: TIdIOHandler);
  170. public
  171. function AllData: string; virtual;
  172. procedure CancelWriteBuffer;
  173. procedure Capture(ADest: TStream; const ADelim: string = '.';
  174. const AIsRFCMessage: Boolean = True); overload;
  175. procedure Capture(ADest: TStream; out VLineCount: Integer; const ADelim: string = '.';
  176. const AIsRFCMessage: Boolean = True); overload;
  177. procedure Capture(ADest: TStrings; const ADelim: string = '.';
  178. const AIsRFCMessage: Boolean = True); overload;
  179. procedure Capture(ADest: TStrings; out VLineCount: Integer; const ADelim: string = '.';
  180. const AIsRFCMessage: Boolean = True); overload;
  181. procedure CheckForDisconnect(const ARaiseExceptionIfDisconnected: boolean = true;
  182. const AIgnoreBuffer: boolean = false); virtual;
  183. procedure CheckForGracefulDisconnect(const ARaiseExceptionIfDisconnected: Boolean = True);
  184. virtual;
  185. function CheckResponse(const AResponse: SmallInt; const AAllowedResponses: array of SmallInt)
  186. : SmallInt; virtual;
  187. procedure ClearWriteBuffer;
  188. procedure CloseWriteBuffer;
  189. function Connected: Boolean; virtual;
  190. constructor Create(AOwner: TComponent); override;
  191. function CurrentReadBuffer: string;
  192. destructor Destroy; override;
  193. procedure Disconnect; virtual;
  194. procedure DisconnectSocket; virtual;
  195. procedure FlushWriteBuffer(const AByteCount: Integer = -1);
  196. procedure GetInternalResponse;
  197. function GetResponse(const AAllowedResponses: array of SmallInt): SmallInt; overload; virtual;
  198. function GetResponse(const AAllowedResponse: SmallInt): SmallInt; overload;
  199. property Greeting: TIdRFCReply read FGreeting write SetGreeting;
  200. function InputLn(const AMask: string = ''; AEcho: Boolean = True; ATabWidth: Integer = 8;
  201. AMaxLineLength: Integer = -1): string;
  202. procedure OpenWriteBuffer(const AThreshhold: Integer = -1);
  203. // RaiseExceptionForCmdResult - Overload necesary as a exception as a default param doesnt work
  204. procedure RaiseExceptionForLastCmdResult; overload; virtual;
  205. procedure RaiseExceptionForLastCmdResult(AException: TClassIdException); overload; virtual;
  206. procedure ReadBuffer(var ABuffer; const AByteCount: Longint);
  207. function ReadCardinal(const AConvert: boolean = true): Cardinal;
  208. function ReadChar: Char;
  209. // ReadFromStack must be only call to Recv
  210. function ReadFromStack(const ARaiseExceptionIfDisconnected: Boolean = True;
  211. ATimeout: Integer = IdTimeoutDefault;
  212. const ARaiseExceptionOnTimeout: Boolean = True): Integer; virtual;
  213. function ReadInteger(const AConvert: boolean = true): Integer;
  214. function ReadLn(ATerminator: string = LF;
  215. const ATimeout: Integer = IdTimeoutDefault; AMaxLineLength: Integer = -1): string; virtual;
  216. function ReadLnWait(AFailCount: Integer = MaxInt): string;
  217. function ReadSmallInt(const AConvert: boolean = true): SmallInt;
  218. procedure ReadStream(AStream: TStream; AByteCount: LongInt = -1;
  219. const AReadUntilDisconnect: boolean = false);
  220. function ReadString(const ABytes: Integer): string;
  221. procedure ReadStrings(ADest: TStrings; AReadLinesCount: Integer = -1);
  222. function SendCmd(const AOut: string; const AResponse: SmallInt = -1): SmallInt; overload;
  223. function SendCmd(const AOut: string; const AResponse: array of SmallInt): SmallInt; overload; virtual;
  224. function WaitFor(const AString: string): string;
  225. procedure Write(const AOut: string); virtual;
  226. // WriteBuffer must be the ONLY call to SEND - all data goes thru this method
  227. procedure WriteBuffer(const ABuffer; AByteCount: Longint; const AWriteNow: Boolean = False);
  228. procedure WriteCardinal(AValue: Cardinal; const AConvert: Boolean = True);
  229. procedure WriteChar(AValue: Char);
  230. procedure WriteHeader(AHeader: TStrings);
  231. procedure WriteInteger(AValue: Integer; const AConvert: Boolean = True);
  232. procedure WriteLn(const AOut: string = ''); virtual;
  233. procedure WriteRFCReply(AReply: TIdRFCReply);
  234. procedure WriteRFCStrings(AStrings: TStrings);
  235. procedure WriteSmallInt(AValue: SmallInt; const AConvert: Boolean = True);
  236. procedure WriteStream(AStream: TStream; const AAll: Boolean = True;
  237. const AWriteByteCount: Boolean = False; const ASize: Integer = 0); virtual;
  238. procedure WriteStrings(AValue: TStrings; const AWriteLinesCount: Boolean = False);
  239. function WriteFile(const AFile: string; const AEnableTransferFile: Boolean = False): Cardinal; virtual;
  240. //
  241. property ClosedGracefully: Boolean read FClosedGracefully;
  242. property InputBuffer: TIdManagedBuffer read FInputBuffer;
  243. property LastCmdResult: TIdRFCReply read FLastCmdResult;
  244. property ReadLnSplit: Boolean read FReadLnSplit;
  245. property ReadLnTimedOut: Boolean read FReadLnTimedOut;
  246. property Socket: TIdIOHandlerSocket read FSocket;
  247. published
  248. property ASCIIFilter: boolean read FASCIIFilter write FASCIIFilter default False;
  249. property Intercept: TIdConnectionIntercept read FIntercept write SetIntercept;
  250. property IOHandler: TIdIOHandler read FIOHandler write SetIOHandler;
  251. property MaxLineLength: Integer read FMaxLineLength write FMaxLineLength default IdMaxLineLengthDefault;
  252. property MaxLineAction: TIdMaxLineAction read FMaxLineAction write FMaxLineAction;
  253. property ReadTimeout: Integer read FReadTimeout write FReadTimeout default IdDefTimeout;
  254. property RecvBufferSize: Integer read FRecvBufferSize write FRecvBufferSize
  255. default GRecvBufferSizeDefault;
  256. property SendBufferSize: Integer read FSendBufferSize write FSendBufferSize
  257. default GSendBufferSizeDefault;
  258. // Events
  259. property OnDisconnected: TNotifyEvent read FOnDisconnected write FOnDisconnected;
  260. property OnWork;
  261. property OnWorkBegin;
  262. property OnWorkEnd;
  263. end;
  264. EIdTCPConnectionError = class(EIdException);
  265. EIdObjectTypeNotSupported = class(EIdTCPConnectionError);
  266. EIdNotEnoughDataInBuffer = class(EIdTCPConnectionError);
  267. EIdInterceptPropIsNil = class(EIdTCPConnectionError);
  268. EIdInterceptPropInvalid = class(EIdTCPConnectionError);
  269. EIdIOHandlerPropInvalid = class(EIdTCPConnectionError);
  270. EIdNoDataToRead = class(EIdTCPConnectionError);
  271. EIdNotConnected = class(EIdTCPConnectionError);
  272. EIdFileNotFound = class(EIdTCPConnectionError);
  273. implementation
  274. uses
  275. IdAntiFreezeBase, IdStack, IdStackConsts, IdStream, IdResourceStrings,
  276. SysUtils;
  277. function TIdTCPConnection.AllData: string;
  278. begin
  279. BeginWork(wmRead); try
  280. Result := '';
  281. while Connected do begin
  282. Result := Result + CurrentReadBuffer;
  283. end;
  284. finally EndWork(wmRead); end;
  285. end;
  286. procedure TIdTCPConnection.PerformCapture(ADest: TObject; out VLineCount: Integer;
  287. const ADelim: string; const AIsRFCMessage: Boolean);
  288. const
  289. wDoublePoint = ord('.') shl 8 + ord('.');
  290. type
  291. PWord = ^Word;
  292. var
  293. s: string;
  294. begin
  295. VLineCount := 0;
  296. BeginWork(wmRead); try
  297. repeat
  298. s := ReadLn;
  299. if s = ADelim then begin
  300. Exit;
  301. end;
  302. // For RFC 822 retrieves
  303. // No length check necessary, if only one byte it will be byte x + #0.
  304. if AIsRFCMessage and (PWord(PChar(S))^ = wDoublePoint) then begin
  305. Delete(s, 1, 1);
  306. end;
  307. // Write to output
  308. Inc(VLineCount);
  309. if ADest is TStrings then begin
  310. TStrings(ADest).Add(s);
  311. end else if ADest is TStream then begin
  312. TIdStream(ADest).WriteLn(s);
  313. end else if ADest <> nil then begin
  314. raise EIdObjectTypeNotSupported.Create(RSObjectTypeNotSupported);
  315. end;
  316. until False;
  317. finally EndWork(wmRead); end;
  318. end;
  319. procedure TIdTCPConnection.CheckForDisconnect(const ARaiseExceptionIfDisconnected: Boolean = True;
  320. const AIgnoreBuffer: Boolean = False);
  321. var
  322. LDisconnected: Boolean;
  323. begin
  324. LDisconnected := False;
  325. // ClosedGracefully // Server disconnected
  326. // IOHandler = nil // Client disconnected
  327. if (IOHandler <> nil) then begin
  328. if ClosedGracefully then begin
  329. if IOHandler.Connected then begin
  330. DisconnectSocket;
  331. // Call event handlers to inform the user program that we were disconnected
  332. DoStatus(hsDisconnected);
  333. DoOnDisconnected;
  334. end;
  335. LDisconnected := True;
  336. end else begin
  337. LDisconnected := not IOHandler.Connected;
  338. end;
  339. end;
  340. if LDisconnected then begin
  341. // Do not raise unless all data has been read by the user
  342. if ((InputBuffer.Size = 0) or AIgnoreBuffer) and ARaiseExceptionIfDisconnected then begin
  343. (* ************************************************************* //
  344. ------ If you receive an exception here, please read. ----------
  345. If this is a SERVER
  346. -------------------
  347. The client has disconnected the socket normally and this exception is used to notify the
  348. server handling code. This exception is normal and will only happen from within the IDE, not
  349. while your program is running as an EXE. If you do not want to see this, add this exception
  350. or EIdSilentException to the IDE options as exceptions not to break on.
  351. From the IDE just hit F9 again and Indy will catch and handle the exception.
  352. Please see the FAQ and help file for possible further information.
  353. The FAQ is at http://www.nevrona.com/Indy/FAQ.html
  354. If this is a CLIENT
  355. -------------------
  356. The server side of this connection has disconnected normaly but your client has attempted
  357. to read or write to the connection. You should trap this error using a try..except.
  358. Please see the help file for possible further information.
  359. // ************************************************************* *)
  360. raise EIdConnClosedGracefully.Create(RSConnectionClosedGracefully);
  361. end;
  362. end;
  363. end;
  364. function TIdTCPConnection.Connected: Boolean;
  365. begin
  366. CheckForDisconnect(False);
  367. Result := IOHandler <> nil;
  368. if Result then begin
  369. Result := IOHandler.Connected;
  370. end;
  371. end;
  372. constructor TIdTCPConnection.Create(AOwner: TComponent);
  373. begin
  374. inherited Create(AOwner);
  375. FReadTimeout := IdDefTimeout;
  376. FGreeting := TIdRFCReply.Create(nil);
  377. FLastCmdResult := TIdRFCReply.Create(nil);
  378. FRecvBuffer := TIdSimpleBuffer.Create;
  379. RecvBufferSize := GRecvBufferSizeDefault;
  380. FSendBufferSize := GSendBufferSizeDefault;
  381. FInputBuffer := TIdManagedBuffer.Create(BufferRemoveNotify);
  382. FMaxLineLength := IdMaxLineLengthDefault;
  383. end;
  384. function TIdTCPConnection.CurrentReadBuffer: string;
  385. begin
  386. Result := '';
  387. if Connected then begin
  388. ReadFromStack(False);
  389. end;
  390. Result := InputBuffer.Extract(InputBuffer.Size);
  391. end;
  392. destructor TIdTCPConnection.Destroy;
  393. begin
  394. // DisconnectSocket closes IOHandler etc. Dont call Disconnect - Disconnect may be override and
  395. // try to read/write to the socket.
  396. DisconnectSocket;
  397. // Because DisconnectSocket does not free the IOHandler we have to do it here.
  398. SetIOHandler(nil);
  399. FreeAndNil(FInputBuffer);
  400. FreeAndNil(FRecvBuffer);
  401. FreeAndNil(FLastCmdResult);
  402. FreeAndNil(FGreeting);
  403. inherited Destroy;
  404. end;
  405. procedure TIdTCPConnection.Disconnect;
  406. var
  407. LConnected: boolean;
  408. begin
  409. {
  410. there are a few possible situations here:
  411. 1) we are still connected, then everything works as before,
  412. status disconnecting, then disconnect, status disconnected
  413. 2) we are not connected, and this is just some "rogue" call to
  414. disconnect(), then nothing happens
  415. 3) we are not connected, because ClosedGracefully, then
  416. LConnected will be false, but the implicit call to
  417. CheckForDisconnect (inside Connected) will call the events
  418. }
  419. LConnected := Connected;
  420. if LConnected then begin
  421. DoStatus(hsDisconnecting);
  422. DisconnectSocket;
  423. end;
  424. // NOT in DisconnectSocket. DisconnectSocket is used to kick ReadFromStack and others
  425. // out of their blocking calls and they rely on the binding after that
  426. //
  427. // Disconnect is on the end of the client. Client may be reconnected and want to use the
  428. // same IOHandler. Thus we only set it to nil if we do want to free it.
  429. if FFreeIOHandlerOnDisconnect then begin
  430. SetIOHandler(nil);
  431. end;
  432. {
  433. if FFreeIOHandlerOnDisconnect then begin
  434. FreeAndNil(FIOHandler);
  435. FFreeIOHandlerOnDisconnect := False;
  436. end;
  437. }
  438. if LConnected then begin
  439. DoOnDisconnected;
  440. DoStatus(hsDisconnected);
  441. end;
  442. end;
  443. procedure TIdTCPConnection.DoOnDisconnected;
  444. begin
  445. if Assigned(OnDisconnected) then begin
  446. OnDisconnected(Self);
  447. end;
  448. end;
  449. function TIdTCPConnection.GetResponse(const AAllowedResponses: array of SmallInt): SmallInt;
  450. begin
  451. GetInternalResponse;
  452. Result := CheckResponse(LastCmdResult.NumericCode, AAllowedResponses);
  453. end;
  454. procedure TIdTCPConnection.RaiseExceptionForLastCmdResult(AException: TClassIdException);
  455. begin
  456. raise AException.Create(LastCmdResult.Text.Text);
  457. end;
  458. procedure TIdTCPConnection.RaiseExceptionForLastCmdResult;
  459. begin
  460. raise EIdProtocolReplyError.CreateError(LastCmdResult.NumericCode, LastCmdResult.Text.Text);
  461. end;
  462. procedure TIdTCPConnection.ReadBuffer(var ABuffer; const AByteCount: Integer);
  463. begin
  464. if (AByteCount > 0) and (@ABuffer <> nil) then begin
  465. // Read from stack until we have enough data
  466. while (InputBuffer.Size < AByteCount) do begin
  467. ReadFromStack;
  468. CheckForDisconnect(True, True);
  469. end;
  470. // Copy it to the callers buffer
  471. Move(InputBuffer.Memory^, ABuffer, AByteCount);
  472. // Remove used data from buffer
  473. InputBuffer.Remove(AByteCount);
  474. end;
  475. end;
  476. function TIdTCPConnection.ReadFromStack(const ARaiseExceptionIfDisconnected: Boolean = True;
  477. ATimeout: Integer = IdTimeoutDefault; const ARaiseExceptionOnTimeout: Boolean = True): Integer;
  478. // Reads any data in tcp/ip buffer and puts it into Indy buffer
  479. // This must be the ONLY raw read from Winsock routine
  480. // This must be the ONLY call to RECV - all data goes thru this method
  481. var
  482. i: Integer;
  483. LByteCount: Integer;
  484. begin
  485. if ATimeout = IdTimeoutDefault then begin
  486. if ReadTimeOut = 0 then begin
  487. ATimeout := IdTimeoutInfinite;
  488. end else begin
  489. ATimeout := FReadTimeout;
  490. end;
  491. end;
  492. Result := 0;
  493. // Check here as this side may have closed the socket
  494. CheckForDisconnect(ARaiseExceptionIfDisconnected);
  495. if Connected then begin
  496. LByteCount := 0;
  497. repeat
  498. if IOHandler.Readable(ATimeout) then begin
  499. if Assigned(FRecvBuffer) and Assigned(IOHandler) then begin //APR: disconnect from other thread
  500. FRecvBuffer.Size := RecvBufferSize;
  501. // No need to call AntiFreeze, the Readable does that.
  502. LByteCount := IOHandler.Recv(FRecvBuffer.Memory^, FRecvBuffer.Size);
  503. end else begin
  504. LByteCount := 0;
  505. if ARaiseExceptionIfDisconnected then
  506. raise EIdNotConnected.Create(RSNotConnected);
  507. end;
  508. FClosedGracefully := LByteCount = 0;
  509. if not ClosedGracefully then begin
  510. if GStack.CheckForSocketError(LByteCount, [Id_WSAESHUTDOWN, Id_WSAECONNABORTED]) then begin
  511. LByteCount := 0;
  512. DisconnectSocket;
  513. // Do not raise unless all data has been read by the user
  514. if InputBuffer.Size = 0 then begin
  515. GStack.RaiseSocketError(GStack.LastError);
  516. end;
  517. end;
  518. // InputBuffer.Size is modified above
  519. if LByteCount > 0 then begin
  520. FRecvBuffer.Size := LByteCount;
  521. if Assigned(Intercept) then begin
  522. FRecvBuffer.Position := 0;
  523. Intercept.Receive(FRecvBuffer);
  524. LByteCount := FRecvBuffer.Size;
  525. end;
  526. if ASCIIFilter then begin
  527. for i := 1 to FRecvBuffer.Size do begin
  528. PChar(FRecvBuffer.Memory)[i] := Chr(Ord(PChar(FRecvBuffer.Memory)[i]) and $7F);
  529. end;
  530. end;
  531. FInputBuffer.Seek(0, soFromEnd);
  532. FInputBuffer.WriteBuffer(FRecvBuffer.Memory^, FRecvBuffer.Size);
  533. end;
  534. end;
  535. // Check here as other side may have closed connection
  536. CheckForDisconnect(ARaiseExceptionIfDisconnected);
  537. Result := LByteCount;
  538. end else begin
  539. // Timeout
  540. if ARaiseExceptionOnTimeout then begin
  541. raise EIdReadTimeout.Create(RSReadTimeout);
  542. end;
  543. Result := -1;
  544. Break;
  545. end;
  546. until (LByteCount <> 0) or (Connected = False);
  547. end else begin
  548. if ARaiseExceptionIfDisconnected then begin
  549. raise EIdNotConnected.Create(RSNotConnected);
  550. end;
  551. end;
  552. end;
  553. function TIdTCPConnection.ReadInteger(const AConvert: boolean = true): Integer;
  554. begin
  555. ReadBuffer(Result, SizeOf(Result));
  556. if AConvert then begin
  557. Result := Integer(GStack.WSNToHL(LongWord(Result)));
  558. end;
  559. end;
  560. function TIdTCPConnection.ReadLn(ATerminator: string = LF;
  561. const ATimeout: Integer = IdTimeoutDefault; AMaxLineLength: Integer = -1): string;
  562. var
  563. LInputBufferSize: Integer;
  564. LSize: Integer;
  565. LTermPos: Integer;
  566. begin
  567. if AMaxLineLength = -1 then begin
  568. AMaxLineLength := MaxLineLength;
  569. end;
  570. // User may pass '' if they need to pass arguments beyond the first.
  571. if Length(ATerminator) = 0 then begin
  572. ATerminator := LF;
  573. end;
  574. FReadLnSplit := False;
  575. FReadLnTimedOut := False;
  576. LTermPos := 0;
  577. LSize := 0;
  578. repeat
  579. LInputBufferSize := InputBuffer.Size;
  580. if LInputBufferSize > 0 then begin
  581. LTermPos :=
  582. MemoryPos(ATerminator, PChar(InputBuffer.Memory) + LSize, LInputBufferSize - LSize);
  583. if LTermPos > 0 then begin
  584. LTermPos := LTermPos + LSize;
  585. end;
  586. LSize := LInputBufferSize;
  587. end; //if
  588. if (LTermPos - 1 > AMaxLineLength) and (AMaxLineLength <> 0) then begin
  589. if MaxLineAction = maException then begin
  590. raise EIdReadLnMaxLineLengthExceeded.Create(RSReadLnMaxLineLengthExceeded);
  591. end else begin
  592. FReadLnSplit := True;
  593. Result := InputBuffer.Extract(AMaxLineLength);
  594. Exit;
  595. end;
  596. // ReadFromStack blocks - do not call unless we need to
  597. end else if LTermPos = 0 then begin
  598. if (LSize > AMaxLineLength) and (AMaxLineLength <> 0) then begin
  599. if MaxLineAction = maException then begin
  600. raise EIdReadLnMaxLineLengthExceeded.Create(RSReadLnMaxLineLengthExceeded);
  601. end else begin
  602. FReadLnSplit := True;
  603. Result := InputBuffer.Extract(AMaxLineLength);
  604. Exit;
  605. end;
  606. end;
  607. // ReadLn needs to call this as data may exist in the buffer, but no EOL yet disconnected
  608. CheckForDisconnect(True, True);
  609. // Can only return -1 if timeout
  610. FReadLnTimedOut := ReadFromStack(True, ATimeout, ATimeout = IdTimeoutDefault) = -1;
  611. if ReadLnTimedout then begin
  612. Result := '';
  613. Exit;
  614. end;
  615. end;
  616. until LTermPos > 0;
  617. Dec(LTermPos); // Strip terminators (string len w/o first terminator char)
  618. Result := InputBuffer.Extract(LTermPos + Length(ATerminator)); // Extract actual data
  619. if (ATerminator = LF) and (LTermPos > 0) and (Result[LTermPos] = CR) then begin
  620. SetLength(Result, LTermPos - 1);
  621. end else begin
  622. SetLength(Result, LTermPos);
  623. end;
  624. end; //ReadLn
  625. function TIdTCPConnection.ReadLnWait(AFailCount: Integer = MaxInt): string;
  626. var
  627. LAttempts: Integer;
  628. begin
  629. Result := '';
  630. LAttempts := 0;
  631. while (Length(Result) = 0) and (LAttempts < AFailCount) do begin
  632. Inc(LAttempts);
  633. Result := Trim(ReadLn);
  634. end;
  635. end; //ReadLnWait
  636. procedure TIdTCPConnection.ReadStream(AStream: TStream; AByteCount: Integer = -1;
  637. const AReadUntilDisconnect: Boolean = False);
  638. var
  639. i: Integer;
  640. LBuf: packed array of Byte;
  641. LBufSize: Integer;
  642. LWorkCount: Integer;
  643. procedure AdjustStreamSize(AStream: TStream; const ASize: integer);
  644. var
  645. LStreamPos: LongInt;
  646. begin
  647. LStreamPos := AStream.Position;
  648. AStream.Size := ASize;
  649. // Must reset to original size as in some cases size changes position
  650. if AStream.Position <> LStreamPos then begin
  651. AStream.Position := LStreamPos;
  652. end;
  653. end;
  654. begin
  655. if (AByteCount < 0) and (not AReadUntilDisconnect) then begin
  656. // Read size from connection
  657. AByteCount := ReadInteger;
  658. end;
  659. // Presize stream if we know the size - this reduces memory/disk allocations to one time
  660. if AByteCount > -1 then begin
  661. AdjustStreamSize(AStream, AStream.Position + AByteCount);
  662. end;
  663. if AReadUntilDisconnect then begin
  664. LWorkCount := High(LWorkCount);
  665. BeginWork(wmRead);
  666. end else begin
  667. LWorkCount := AByteCount;
  668. BeginWork(wmRead, LWorkCount);
  669. end;
  670. try
  671. // If data already exists in the buffer, write it out first.
  672. if InputBuffer.Size > 0 then begin
  673. i := Min(InputBuffer.Size, LWorkCount);
  674. if i > 0 then begin
  675. InputBuffer.Position := 0;
  676. AStream.CopyFrom(InputBuffer, i);
  677. InputBuffer.Remove(i);
  678. Dec(LWorkCount, i);
  679. end else if LWorkCount < 0 then begin
  680. InputBuffer.Position := 0;
  681. AStream.CopyFrom(InputBuffer, 0);
  682. InputBuffer.Clear;
  683. end;
  684. end;
  685. LBufSize := Min(LWorkCount, RecvBufferSize);
  686. SetLength(LBuf, LBufSize);
  687. // RLebeau - don't call Connected() here! ReadBuffer() already
  688. // does that internally. Calling Connected() here can cause an
  689. // EIdConnClosedGracefully exception that breaks the loop
  690. // prematurely and thus leave unread bytes in the InputBuffer.
  691. // Let the loop catch the exception before exiting...
  692. while {Connected and} (LWorkCount > 0) do begin
  693. i := Min(LWorkCount, LBufSize);
  694. //TODO: Improve this - dont like the use of the exception handler
  695. //DONE -oAPR: Dont use a string, use a memory buffer or better yet the buffer itself.
  696. try
  697. try
  698. ReadBuffer(LBuf[0], i);
  699. except
  700. on E: Exception do begin
  701. // RLebeau - ReadFromStack() inside of ReadBuffer()
  702. // could have filled the InputBuffer with more bytes
  703. // than actually requested, so don't extract too
  704. // many bytes here...
  705. i := Min(i, InputBuffer.Size);
  706. Move(InputBuffer.Memory^, LBuf[0], i);
  707. InputBuffer.Remove(i);
  708. if (E is EIdConnClosedGracefully) and AReadUntilDisconnect then begin
  709. Break;
  710. end else begin
  711. raise;
  712. end;
  713. end;
  714. end;
  715. finally
  716. if i > 0 then begin
  717. AStream.WriteBuffer(LBuf[0], i);
  718. Dec(LWorkCount, i);
  719. end;
  720. end;
  721. end;
  722. finally
  723. EndWork(wmRead);
  724. if AStream.Size > AStream.Position then begin
  725. AStream.Size := AStream.Position;
  726. end;
  727. LBuf := nil;
  728. end;
  729. end;
  730. procedure TIdTCPConnection.ResetConnection;
  731. begin
  732. InputBuffer.Clear;
  733. FClosedGracefully := False;
  734. end;
  735. function TIdTCPConnection.SendCmd(const AOut: string; const AResponse: array of SmallInt): SmallInt;
  736. begin
  737. WriteLn(AOut);
  738. Result := GetResponse(AResponse);
  739. end;
  740. procedure TIdTCPConnection.Notification(AComponent: TComponent; Operation: TOperation);
  741. begin
  742. inherited Notification(AComponent, OPeration);
  743. if (Operation = opRemove) then begin
  744. if (AComponent = FIntercept) then begin
  745. FIntercept := nil;
  746. end;
  747. if (AComponent = FIOHandler) then begin
  748. FIOHandler := nil;
  749. FSocket := nil;
  750. end;
  751. end;
  752. end;
  753. procedure TIdTCPConnection.SetGreeting(AValue: TIdRFCReply);
  754. begin
  755. FGreeting.Assign(AValue);
  756. end;
  757. procedure TIdTCPConnection.SetIntercept(AValue: TIdConnectionIntercept);
  758. begin
  759. FIntercept := AValue;
  760. // add self to the Intercept's free notification list
  761. if Assigned(FIntercept) then begin
  762. FIntercept.FreeNotification(Self);
  763. end;
  764. end;
  765. procedure TIdTCPConnection.SetIOHandler(AValue: TIdIOHandler);
  766. begin
  767. if (FIOHandler <> nil) and FFreeIOHandlerOnDisconnect then begin
  768. FreeAndNil(FIOHandler); // Clear the existing IOHandler
  769. FFreeIOHandlerOnDisconnect := False;
  770. end;
  771. if (AValue <> nil) then begin
  772. if (AValue is TIdIOHandlerSocket) then begin
  773. FSocket := TIdIOHandlerSocket(AValue);
  774. end else begin
  775. FSocket := nil;
  776. end;
  777. end else begin
  778. FSocket := nil;
  779. end;
  780. FIOHandler := AValue;
  781. // add self to the IOHandler's free notification list
  782. if FIOHandler <> nil then begin
  783. FIOHandler.FreeNotification(Self);
  784. end;
  785. end;
  786. procedure TIdTCPConnection.Write(const AOut: string);
  787. var
  788. LOutLen: Integer;
  789. begin
  790. LOutLen := Length(AOut);
  791. if LOutLen > 0 then begin
  792. WriteBuffer(Pointer(AOut)^, LOutLen);
  793. end;
  794. end; //Write
  795. procedure TIdTCPConnection.WriteBuffer(const ABuffer; AByteCount: Integer;
  796. const AWriteNow: boolean = false);
  797. var
  798. LBuffer: TIdSimpleBuffer;
  799. nPos, nByteCount: Integer;
  800. begin
  801. if (AByteCount > 0) and (@ABuffer <> nil) then begin
  802. // Check if disconnected
  803. CheckForDisconnect(True, True);
  804. if Connected then begin
  805. if (FWriteBuffer = nil) or AWriteNow then begin
  806. LBuffer := TIdSimpleBuffer.Create; try
  807. LBuffer.WriteBuffer(ABuffer, AByteCount);
  808. if Assigned(Intercept) then begin
  809. LBuffer.Position := 0;
  810. Intercept.Send(LBuffer);
  811. AByteCount := LBuffer.Size;
  812. end;
  813. nPos := 1;
  814. repeat
  815. nByteCount := IOHandler.Send(PChar(LBuffer.Memory)[nPos - 1], LBuffer.Size - nPos + 1);
  816. FClosedGracefully := nByteCount = 0;
  817. // Check if other side disconnected
  818. CheckForDisconnect;
  819. // Check to see if the error signifies disconnection
  820. if GStack.CheckForSocketError(nByteCount, [ID_WSAESHUTDOWN, Id_WSAECONNABORTED, Id_WSAECONNRESET]) then begin
  821. DisconnectSocket;
  822. GStack.RaiseSocketError(GStack.LastError);
  823. end;
  824. // TODO - Have a AntiFreeze param which allows the send to be split up so that process
  825. // can be called more. Maybe a prop of the connection, MaxSendSize?
  826. TIdAntiFreezeBase.DoProcess(False);
  827. DoWork(wmWrite, nByteCount);
  828. nPos := nPos + nByteCount;
  829. until nPos > AByteCount;
  830. finally FreeAndNil(LBuffer); end;
  831. // Write Buffering is enabled
  832. end else begin
  833. FWriteBuffer.WriteBuffer(ABuffer, AByteCount);
  834. if (FWriteBuffer.Size >= FWriteBufferThreshhold) and (FWriteBufferThreshhold > 0) then begin
  835. // TODO: Maybe? instead of flushing - Write until buffer is smaller than Threshold.
  836. // That is do at least one physical send.
  837. FlushWriteBuffer(FWriteBufferThreshhold);
  838. end;
  839. end;
  840. end
  841. else
  842. begin
  843. raise EIdNotConnected.Create(RSNotConnected);
  844. end;
  845. end;
  846. end;
  847. procedure TIdTCPConnection.WriteChar(AValue: Char);
  848. begin
  849. WriteBuffer(AValue, SizeOf(AValue));
  850. end;
  851. function TIdTCPConnection.WriteFile(const AFile: string; const AEnableTransferFile: boolean = False): Cardinal;
  852. var
  853. //TODO: There is a way in linux to dump a file to a socket as well. use it.
  854. LFileStream: TFileStream;
  855. begin
  856. if FileExists(AFile) then begin
  857. if Assigned(GServeFileProc) and (Intercept = nil) and AEnableTransferFile
  858. and (Socket <> nil) then begin
  859. Result := GServeFileProc(Socket.Binding.Handle, AFile);
  860. end else begin
  861. LFileStream := TFileStream.Create(AFile, fmOpenRead or fmShareDenyWrite);
  862. try
  863. WriteStream(LFileStream); //ALL Stream, no bcnt
  864. Result := LFileStream.Size;
  865. finally LFileStream.free; end;
  866. end;
  867. end else begin
  868. raise EIdFileNotFound.Create(Format(RSFileNotFound, [AFile]));
  869. end;
  870. end;
  871. procedure TIdTCPConnection.WriteHeader(AHeader: TStrings);
  872. var
  873. i: Integer;
  874. begin
  875. for i := 0 to AHeader.Count - 1 do begin
  876. // No ReplaceAll flag - we only want to replace the first one
  877. WriteLn(StringReplace(AHeader[i], '=', ': ', []));
  878. end;
  879. WriteLn('');
  880. end;
  881. procedure TIdTCPConnection.WriteInteger(AValue: Integer; const AConvert: Boolean = True);
  882. begin
  883. if AConvert then begin
  884. AValue := Integer(GStack.WSHToNl(LongWord(AValue)));
  885. end;
  886. WriteBuffer(AValue, SizeOf(AValue));
  887. end;
  888. procedure TIdTCPConnection.WriteLn(const AOut: string = '');
  889. begin
  890. Write(AOut + EOL);
  891. end;
  892. procedure TIdTCPConnection.WriteStream(AStream: TStream; const AAll: boolean = true;
  893. const AWriteByteCount: Boolean = False; const ASize: Integer = 0);
  894. var
  895. LBuffer: TMemoryStream;
  896. LSize: Integer;
  897. LStreamEnd: Integer;
  898. // LBufferingStarted: Boolean;
  899. begin
  900. if AAll then begin
  901. AStream.Position := 0;
  902. end;
  903. // This is copied to a local var because accessing .Size is very inefficient
  904. if ASize = 0 then begin
  905. LStreamEnd := AStream.Size;
  906. end else begin
  907. LStreamEnd := ASize + AStream.Position;
  908. end;
  909. LSize := LStreamEnd - AStream.Position;
  910. // RLebeau 3/20/2006: DO NOT ENABLE WRITE BUFFERING IN THIS METHOD!
  911. //
  912. // When sending large streams, this can easily cause "Out of Memory" errors.
  913. // It is the caller's responsibility to enable/disable write buffering as
  914. // needed before calling one of the Write...() methods.
  915. //
  916. // Also, forcing write buffering in this method has major impacts on
  917. // TIdFTP, TIdFTPServer, and TIdHTTPServer.
  918. {
  919. LBufferingStarted := FWriteBuffer = nil;
  920. if LBufferingStarted then
  921. begin
  922. OpenWriteBuffer;
  923. end;
  924. try
  925. }
  926. LBuffer := TMemoryStream.Create; try
  927. if AWriteByteCount then begin
  928. WriteInteger(LSize);
  929. end;
  930. BeginWork(wmWrite, LSize); try
  931. LBuffer.Size := FSendBufferSize;
  932. repeat
  933. LSize := Min(LStreamEnd - AStream.Position, LBuffer.Size);
  934. if LSize = 0 then begin
  935. Break;
  936. end;
  937. // Do not use ReadBuffer. Some source streams are real time and will not
  938. // return as much data as we request. Kind of like recv()
  939. // NOTE: We use .Size - size must be supported even if real time
  940. LSize := AStream.Read(LBuffer.Memory^, LSize);
  941. if LSize = 0 then begin
  942. raise EIdNoDataToRead.Create(RSIdNoDataToRead);
  943. end;
  944. WriteBuffer(LBuffer.Memory^, LSize);
  945. until False;
  946. finally EndWork(wmWrite); end;
  947. finally FreeAndNil(LBuffer); end;
  948. {
  949. if LBufferingStarted then
  950. begin
  951. CloseWriteBuffer;
  952. end;
  953. except
  954. on E: Exception do
  955. begin
  956. if LBufferingStarted then
  957. begin
  958. CancelWriteBuffer;
  959. end;
  960. raise;
  961. end;
  962. end;
  963. }
  964. end;
  965. procedure TIdTCPConnection.WriteStrings(AValue: TStrings; const AWriteLinesCount: Boolean = False);
  966. var
  967. i: Integer;
  968. begin
  969. if AWriteLinesCount then begin
  970. WriteInteger(AValue.Count);
  971. end;
  972. for i := 0 to AValue.Count - 1 do begin
  973. WriteLn(AValue.Strings[i]);
  974. end;
  975. end;
  976. function TIdTCPConnection.SendCmd(const AOut: string; const AResponse: SmallInt): SmallInt;
  977. begin
  978. if AResponse = -1 then begin
  979. Result := SendCmd(AOut, []);
  980. end else begin
  981. Result := SendCmd(AOut, [AResponse]);
  982. end;
  983. end;
  984. procedure TIdTCPConnection.DisconnectSocket;
  985. begin
  986. if IOHandler <> nil then begin
  987. // In design time don't use properties which point to other compoenents
  988. if not (csDesigning in ComponentState) then begin
  989. if Assigned(Intercept) then begin
  990. Intercept.Disconnect;
  991. end;
  992. IOHandler.Close;
  993. end;
  994. end;
  995. end;
  996. procedure TIdTCPConnection.OpenWriteBuffer(const AThreshhold: Integer = -1);
  997. begin
  998. if FWriteBuffer = nil then begin
  999. FWriteBuffer := TIdSimpleBuffer.Create;
  1000. end else begin
  1001. FWriteBuffer.Clear;
  1002. end;
  1003. FWriteBufferThreshhold := AThreshhold;
  1004. end;
  1005. procedure TIdTCPConnection.CloseWriteBuffer;
  1006. begin
  1007. if FWriteBuffer <> nil then begin
  1008. try
  1009. FlushWriteBuffer;
  1010. finally
  1011. FreeAndNil(FWriteBuffer);
  1012. end;
  1013. end;
  1014. end;
  1015. procedure TIdTCPConnection.FlushWriteBuffer(const AByteCount: Integer = -1);
  1016. begin
  1017. if (FWriteBuffer <> nil) and (FWriteBuffer.Size > 0) then begin
  1018. if (AByteCount = -1) or (FWriteBuffer.Size < AByteCount) then begin
  1019. WriteBuffer(PChar(FWriteBuffer.Memory)[0], FWriteBuffer.Size, True);
  1020. ClearWriteBuffer;
  1021. end else begin
  1022. WriteBuffer(PChar(FWriteBuffer.Memory)[0], AByteCount, True);
  1023. FWriteBuffer.Remove(AByteCount);
  1024. end;
  1025. end;
  1026. end;
  1027. procedure TIdTCPConnection.ClearWriteBuffer;
  1028. begin
  1029. if FWriteBuffer <> nil then begin
  1030. FWriteBuffer.Clear;
  1031. end;
  1032. end;
  1033. function TIdTCPConnection.InputLn(const AMask: string = ''; AEcho: Boolean = True;
  1034. ATabWidth: Integer = 8; AMaxLineLength: Integer = -1): string;
  1035. var
  1036. i: Integer;
  1037. LChar: Char;
  1038. LTmp: string;
  1039. begin
  1040. if AMaxLineLength = -1 then begin
  1041. AMaxLineLength := MaxLineLength;
  1042. end;
  1043. Result := '';
  1044. repeat
  1045. LChar := ReadChar;
  1046. i := Length(Result);
  1047. if i <= AMaxLineLength then begin
  1048. case LChar of
  1049. BACKSPACE:
  1050. begin
  1051. if i > 0 then begin
  1052. SetLength(Result, i - 1);
  1053. if AEcho then begin
  1054. Write(BACKSPACE + ' ' + BACKSPACE);
  1055. end;
  1056. end;
  1057. end;
  1058. TAB:
  1059. begin
  1060. if ATabWidth > 0 then begin
  1061. i := ATabWidth - (i mod ATabWidth);
  1062. LTmp := StringOfChar(' ', i);
  1063. Result := Result + LTmp;
  1064. if AEcho then begin
  1065. Write(LTmp);
  1066. end;
  1067. end else begin
  1068. Result := Result + LChar;
  1069. if AEcho then begin
  1070. Write(LChar);
  1071. end;
  1072. end;
  1073. end;
  1074. LF: ;
  1075. CR: ;
  1076. #27: ; //ESC - currently not supported
  1077. else
  1078. Result := Result + LChar;
  1079. if AEcho then begin
  1080. if Length(AMask) = 0 then begin
  1081. Write(LChar);
  1082. end else begin
  1083. Write(AMask);
  1084. end;
  1085. end;
  1086. end;
  1087. end;
  1088. until LChar = LF;
  1089. // Remove CR trail
  1090. i := Length(Result);
  1091. while (i > 0) and (Result[i] in [CR, LF]) do begin
  1092. Dec(i);
  1093. end;
  1094. SetLength(Result, i);
  1095. if AEcho then begin
  1096. WriteLn;
  1097. end;
  1098. end;
  1099. function TIdTCPConnection.ReadString(const ABytes: Integer): string;
  1100. begin
  1101. SetLength(result, ABytes);
  1102. if ABytes > 0 then begin
  1103. ReadBuffer(result[1], Length(result));
  1104. end;
  1105. end;
  1106. procedure TIdTCPConnection.ReadStrings(ADest: TStrings; AReadLinesCount: Integer = -1);
  1107. var
  1108. i: Integer;
  1109. begin
  1110. if AReadLinesCount <= 0 then begin
  1111. AReadLinesCount := ReadInteger;
  1112. end;
  1113. for i := 0 to AReadLinesCount - 1 do begin
  1114. ADest.Add(ReadLn);
  1115. end;
  1116. end;
  1117. procedure TIdTCPConnection.CancelWriteBuffer;
  1118. begin
  1119. ClearWriteBuffer;
  1120. CloseWriteBuffer;
  1121. end;
  1122. function TIdTCPConnection.ReadSmallInt(const AConvert: boolean = true): SmallInt;
  1123. begin
  1124. ReadBuffer(Result, SizeOf(Result));
  1125. if AConvert then begin
  1126. Result := SmallInt(GStack.WSNToHs(Word(Result)));
  1127. end;
  1128. end;
  1129. procedure TIdTCPConnection.WriteSmallInt(AValue: SmallInt; const AConvert: boolean = true);
  1130. begin
  1131. if AConvert then begin
  1132. AValue := SmallInt(GStack.WSHToNs(Word(AValue)));
  1133. end;
  1134. WriteBuffer(AValue, SizeOf(AValue));
  1135. end;
  1136. procedure TIdTCPConnection.CheckForGracefulDisconnect(const ARaiseExceptionIfDisconnected: boolean);
  1137. begin
  1138. ReadFromStack(ARaiseExceptionIfDisconnected, 1, False);
  1139. end;
  1140. { TIdBuffer }
  1141. constructor TIdSimpleBuffer.Create(AOnBytesRemoved: TIdBufferBytesRemoved);
  1142. begin
  1143. inherited Create;
  1144. FOnBytesRemoved := AOnBytesRemoved;
  1145. end;
  1146. function TIdSimpleBuffer.Extract(const AByteCount: Integer): string;
  1147. begin
  1148. if AByteCount > Size then begin
  1149. raise EIdNotEnoughDataInBuffer.Create(RSNotEnoughDataInBuffer);
  1150. end;
  1151. SetString(Result, PChar(Memory), AByteCount);
  1152. Remove(AByteCount);
  1153. end;
  1154. procedure TIdSimpleBuffer.Remove(const AByteCount: integer);
  1155. begin
  1156. if AByteCount > Size then begin
  1157. raise EIdNotEnoughDataInBuffer.Create(RSNotEnoughDataInBuffer);
  1158. end;
  1159. if AByteCount = Size then begin
  1160. Clear;
  1161. end else begin
  1162. Move(PChar(Memory)[AByteCount], PChar(Memory)[0], Size - AByteCount);
  1163. SetSize(Size - AByteCount);
  1164. end;
  1165. if Assigned(FOnBytesRemoved) then begin
  1166. FOnBytesRemoved(Self, AByteCount);
  1167. end;
  1168. end;
  1169. function TIdTCPConnection.WaitFor(const AString: string): string;
  1170. //TODO: Add a time out (default to infinite) and event to pass data
  1171. //TODO: Add a max size argument as well.
  1172. //TODO: Add a case insensitive option
  1173. //TODO: Bug - returns too much data. Should only return up to search string adn not including
  1174. // and leave the rest in the buffer.
  1175. begin
  1176. Result := '';
  1177. // NOTE: AnsiPos should be used here, but AnsiPos has problems if result has any #0 in it,
  1178. // which is often the case. So currently this function is not MBCS compliant and should
  1179. // not be used in MBCS environments. However this function should only be used on incoming
  1180. // TCP text data as it is 7 bit.
  1181. while Pos(AString, Result) = 0 do begin
  1182. Result := Result + CurrentReadBuffer;
  1183. CheckForDisconnect;
  1184. end;
  1185. end;
  1186. function TIdTCPConnection.ReadCardinal(const AConvert: boolean): Cardinal;
  1187. begin
  1188. ReadBuffer(Result, SizeOf(Result));
  1189. if AConvert then begin
  1190. Result := GStack.WSNToHL(Result);
  1191. end;
  1192. end;
  1193. procedure TIdTCPConnection.WriteCardinal(AValue: Cardinal; const AConvert: boolean);
  1194. begin
  1195. if AConvert then begin
  1196. AValue := GStack.WSHToNl(AValue);
  1197. end;
  1198. WriteBuffer(AValue, SizeOf(AValue));
  1199. end;
  1200. function TIdTCPConnection.CheckResponse(const AResponse: SmallInt;
  1201. const AAllowedResponses: array of SmallInt): SmallInt;
  1202. var
  1203. i: Integer;
  1204. LResponseFound: Boolean;
  1205. begin
  1206. if High(AAllowedResponses) > -1 then begin
  1207. LResponseFound := False;
  1208. for i := Low(AAllowedResponses) to High(AAllowedResponses) do begin
  1209. if AResponse = AAllowedResponses[i] then begin
  1210. LResponseFound := True;
  1211. Break;
  1212. end;
  1213. end;
  1214. if not LResponseFound then begin
  1215. RaiseExceptionForLastCmdResult;
  1216. end;
  1217. end;
  1218. Result := AResponse;
  1219. end;
  1220. procedure TIdTCPConnection.GetInternalResponse;
  1221. var
  1222. LLine: string;
  1223. LResponse: TStringList;
  1224. LTerm: string;
  1225. begin
  1226. LResponse := TStringList.Create; try
  1227. LLine := ReadLnWait;
  1228. LResponse.Add(LLine);
  1229. if Length(LLine) > 3 then begin
  1230. if LLine[4] = '-' then begin // Multi line response coming
  1231. LTerm := Copy(LLine, 1, 3) + ' ';
  1232. {We keep reading lines until we encounter either a line such as "250" or "250 Read"}
  1233. repeat
  1234. LLine := ReadLnWait;
  1235. LResponse.Add(LLine);
  1236. until (Length(LLine) < 4) or (AnsiSameText(Copy(LLine, 1, 4), LTerm));
  1237. end;
  1238. end;
  1239. FLastCmdResult.ParseResponse(LResponse);
  1240. finally FreeAndNil(LResponse); end;
  1241. end;
  1242. procedure TIdTCPConnection.WriteRFCReply(AReply: TIdRFCReply);
  1243. begin
  1244. if AReply.ReplyExists then begin
  1245. Write(AReply.GenerateReply);
  1246. end;
  1247. end;
  1248. procedure TIdTCPConnection.WriteRFCStrings(AStrings: TStrings);
  1249. var
  1250. i: Integer;
  1251. begin
  1252. for i := 0 to AStrings.Count - 1 do begin
  1253. if Copy(AStrings[i], 1, 1) = '.' then begin
  1254. WriteLn('.' + AStrings[i]);
  1255. end else begin
  1256. WriteLn(AStrings[i]);
  1257. end;
  1258. end;
  1259. WriteLn('.');
  1260. end;
  1261. function TIdTCPConnection.GetResponse(const AAllowedResponse: SmallInt): SmallInt;
  1262. begin
  1263. Result := GetResponse([AAllowedResponse]);
  1264. end;
  1265. procedure TIdTCPConnection.Capture(ADest: TStream; const ADelim: string;
  1266. const AIsRFCMessage: Boolean);
  1267. var
  1268. LLineCount: Integer;
  1269. begin
  1270. PerformCapture(ADest, LLineCount, ADelim, AIsRFCMessage);
  1271. end;
  1272. procedure TIdTCPConnection.Capture(ADest: TStrings; const ADelim: string;
  1273. const AIsRFCMessage: Boolean);
  1274. var
  1275. LLineCount: Integer;
  1276. begin
  1277. PerformCapture(ADest, LLineCount, ADelim, AIsRFCMessage);
  1278. end;
  1279. function TIdTCPConnection.ReadChar: Char;
  1280. begin
  1281. ReadBuffer(Result, SizeOf(Result));
  1282. end;
  1283. procedure TIdTCPConnection.Capture(ADest: TStream; out VLineCount: Integer;
  1284. const ADelim: string; const AIsRFCMessage: Boolean);
  1285. begin
  1286. PerformCapture(ADest, VLineCount, ADelim, AIsRFCMessage);
  1287. end;
  1288. procedure TIdTCPConnection.Capture(ADest: TStrings; out VLineCount: Integer; const ADelim: string;
  1289. const AIsRFCMessage: Boolean);
  1290. begin
  1291. PerformCapture(ADest, VLineCount, ADelim, AIsRFCMessage);
  1292. end;
  1293. procedure TIdTCPConnection.BufferRemoveNotify(ASender: TObject; const ABytes: Integer);
  1294. begin
  1295. DoWork(wmRead, ABytes);
  1296. end;
  1297. { TIdManagedBuffer }
  1298. procedure TIdManagedBuffer.Clear;
  1299. begin
  1300. inherited Clear;
  1301. FReadedSize := 0;
  1302. end; //
  1303. constructor TIdManagedBuffer.Create(AOnBytesRemoved: TIdBufferBytesRemoved);
  1304. begin
  1305. inherited;
  1306. FPackReadedSize := IdInBufCacheSizeDefault;
  1307. end; //
  1308. function TIdManagedBuffer.Extract(const AByteCount: Integer): string;
  1309. begin
  1310. if AByteCount > Size then begin
  1311. raise EIdNotEnoughDataInBuffer.Create(RSNotEnoughDataInBuffer);
  1312. end;
  1313. SetString(Result, PChar(Memory), AByteCount);
  1314. Remove(AByteCount);
  1315. end; //TIdManagedBuffer.Extract
  1316. function TIdManagedBuffer.Memory: Pointer;
  1317. begin
  1318. Result := Pointer(Integer(inherited Memory) + FReadedSize);
  1319. end; //Memory
  1320. procedure TIdManagedBuffer.PackBuffer;
  1321. begin
  1322. if FReadedSize > 0 then begin
  1323. Move(Pointer(Integer(inherited Memory) + FReadedSize)^, inherited Memory^, Size);
  1324. SetSize(Size); //set REAL size to fresh size
  1325. FReadedSize := 0;
  1326. end;
  1327. end; //TIdManagedBuffer.PackBuffer
  1328. procedure TIdManagedBuffer.Remove(const AByteCount: integer);
  1329. begin
  1330. if AByteCount > Size then begin
  1331. raise EIdNotEnoughDataInBuffer.Create(RSNotEnoughDataInBuffer);
  1332. end else if AByteCount = Size then begin
  1333. Clear;
  1334. end else begin
  1335. FReadedSize := FReadedSize + AByteCount;
  1336. if FReadedSize >= PackReadedSize then begin
  1337. PackBuffer;
  1338. end;
  1339. end;
  1340. if Assigned(FOnBytesRemoved) then begin
  1341. FOnBytesRemoved(Self, AByteCount);
  1342. end;
  1343. end;
  1344. function TIdManagedBuffer.Seek(Offset: Integer; Origin: Word): Longint;
  1345. begin //note: FPosition is TRUE, FSize is TRUE
  1346. case Origin of
  1347. soFromBeginning:
  1348. begin
  1349. Result := inherited Seek(Offset + FReadedSize, soFromBeginning) - FReadedSize;
  1350. end;
  1351. else //soFromCurrent,soFromEnd:
  1352. Result := inherited Seek(Offset, Origin) - FReadedSize;
  1353. end;
  1354. end; //TIdManagedBuffer.Seek
  1355. procedure TIdManagedBuffer.SetPackReadedSize(const Value: Integer);
  1356. begin
  1357. if Value > 0 then begin
  1358. FPackReadedSize := Value;
  1359. end
  1360. else begin
  1361. FPackReadedSize := IdInBufCacheSizeDefault;
  1362. end;
  1363. end; //
  1364. end.