IdIOHandler.pas 89 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718
  1. {
  2. $Project$
  3. $Workfile$
  4. $Revision$
  5. $DateUTC$
  6. $Id$
  7. This file is part of the Indy (Internet Direct) project, and is offered
  8. under the dual-licensing agreement described on the Indy website.
  9. (http://www.indyproject.org/)
  10. Copyright:
  11. (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
  12. }
  13. {
  14. $Log$
  15. }
  16. {
  17. Rev 1.123 2/8/05 5:27:06 PM RLebeau
  18. Bug fix for ReadLn().
  19. Added try..finally block to ReadLnSplit().
  20. Rev 1.122 1/27/05 3:09:30 PM RLebeau
  21. Updated AllData() to call ReadFromSource() directly instead of using
  22. CheckForDataOnSource(), since ReadFromSource() can return a disconnect
  23. conditon. When data is in the InputBuffer, Connected() always return True
  24. even if the socket is actually disconnected.
  25. Rev 1.121 12/21/04 3:21:40 AM RLebeau
  26. Removed compiler warning
  27. Rev 1.120 17/12/2004 17:11:28 ANeillans
  28. Compiler fix
  29. Rev 1.119 12/12/04 2:23:52 PM RLebeau
  30. Added WriteRFCStrings() method
  31. Rev 1.118 12/11/2004 9:04:50 PM DSiders
  32. Fixed comparison error in WaitFor.
  33. Rev 1.117 12/10/04 2:00:24 PM RLebeau
  34. Updated WaitFor() to not return more data than actually needed.
  35. Updated AllData() to not concatenate the Result on every iteration of the
  36. loop.
  37. Rev 1.116 11/29/04 10:37:18 AM RLebeau
  38. Updated write buffering methods to prevent Access Violations when used
  39. incorrectly.
  40. Rev 1.115 11/4/04 12:41:08 PM RLebeau
  41. Bug fix for ReadLn()
  42. Rev 1.114 10/26/2004 8:43:00 PM JPMugaas
  43. Should be more portable with new references to TIdStrings and TIdStringList.
  44. Rev 1.113 27.08.2004 21:58:18 Andreas Hausladen
  45. Speed optimization ("const" for string parameters)
  46. Rev 1.112 8/2/04 5:49:20 PM RLebeau
  47. Moved ConnectTimeout over from TIdIOHandlerSocket
  48. Rev 1.111 2004.08.01 19:36:14 czhower
  49. Code optimization to WriteFile
  50. Rev 1.110 7/24/04 12:53:54 PM RLebeau
  51. Compiler fix for WriteFile()
  52. Rev 1.109 7/23/04 6:39:14 PM RLebeau
  53. Added extra exception handling to WriteFile()
  54. Rev 1.108 7/21/2004 5:45:10 PM JPMugaas
  55. Updated with Remy's change. This should work better and fix a problem with
  56. looping with ReadStream and ReadUntilDisconnect.
  57. Rev 1.107 7/21/2004 12:22:18 PM BGooijen
  58. Reverted back 2 versions
  59. Rev 1.104 6/29/04 12:16:16 PM RLebeau
  60. Updated ReadChar() to call ReadBytes() directly instead of ReadString()
  61. Rev 1.103 6/17/04 3:01:56 PM RLebeau
  62. Changed ReadStream() to not extract too many bytes from the InputBuffer when
  63. an error occurs
  64. Rev 1.102 6/12/04 11:36:44 AM RLebeau
  65. Changed ReadString() to pass the ABytes parameter to ReadBytes() instead of
  66. the LBuf length
  67. Rev 1.100 6/10/2004 6:52:12 PM JPMugaas
  68. Regeneration to fix a bug in the package generator that I created. OOPS!!!
  69. Rev 1.99 6/9/04 7:36:26 PM RLebeau
  70. ReadString() bug fix
  71. Rev 1.98 07/06/2004 20:55:36 CCostelloe
  72. Fix for possible memory leak.
  73. Rev 1.97 5/29/04 10:46:24 PM RLebeau
  74. Updated AllData() to only append values to the result when there is actual
  75. data in the buffer.
  76. Rev 1.96 29/05/2004 21:07:40 CCostelloe
  77. Bug fix (may need more investigation)
  78. Rev 1.95 2004.05.20 1:39:54 PM czhower
  79. Last of the IdStream updates
  80. Rev 1.94 2004.05.20 12:34:22 PM czhower
  81. Removed more non .NET compatible stream read and writes
  82. Rev 1.93 2004.05.20 11:39:02 AM czhower
  83. IdStreamVCL
  84. Rev 1.92 5/3/2004 12:57:00 PM BGooijen
  85. Fixes for 0-based
  86. Rev 1.91 2004.05.03 11:15:44 AM czhower
  87. Changed Find to IndexOf and made 0 based to be consistent.
  88. Rev 1.90 4/24/04 12:40:04 PM RLebeau
  89. Added Write() overload for Char type.
  90. Rev 1.89 4/18/2004 11:58:00 PM BGooijen
  91. ReadBytes with count=-1 reads everything available, ( and waits ReadTimeOut
  92. time for data)
  93. Rev 1.88 4/18/04 2:44:24 PM RLebeau
  94. Read/write support for Int64 values
  95. Rev 1.87 2004.04.18 12:51:58 AM czhower
  96. Big bug fix with server disconnect and several other bug fixed that I found
  97. along the way.
  98. Rev 1.86 2004.04.16 11:30:28 PM czhower
  99. Size fix to IdBuffer, optimizations, and memory leaks
  100. Rev 1.85 2004.04.08 7:06:46 PM czhower
  101. Peek support.
  102. Rev 1.84 2004.04.08 3:56:28 PM czhower
  103. Fixed bug with Intercept byte count. Also removed Bytes from Buffer.
  104. Rev 1.83 2004.04.08 2:08:00 AM czhower
  105. Saved before checkin this time...
  106. Rev 1.82 7/4/2004 4:08:46 PM SGrobety
  107. Re-introduce the IOHandler.MaxCapturedLines property
  108. Rev 1.81 2004.04.07 3:59:46 PM czhower
  109. Bug fix for WriteDirect.
  110. Rev 1.79 2004.03.07 11:48:38 AM czhower
  111. Flushbuffer fix + other minor ones found
  112. Rev 1.78 2004.03.03 11:54:58 AM czhower
  113. IdStream change
  114. Rev 1.77 2004.03.02 2:47:08 PM czhower
  115. .Net overloads
  116. Rev 1.76 2004.03.01 5:12:28 PM czhower
  117. -Bug fix for shutdown of servers when connections still existed (AV)
  118. -Implicit HELP support in CMDserver
  119. -Several command handler bugs
  120. -Additional command handler functionality.
  121. Rev 1.75 2004.02.03 4:16:44 PM czhower
  122. For unit name changes.
  123. Rev 1.74 2004.01.21 9:36:00 PM czhower
  124. .Net overload
  125. Rev 1.73 2004.01.21 12:19:58 AM czhower
  126. .Readln overload for .net
  127. Rev 1.72 2004.01.20 10:03:26 PM czhower
  128. InitComponent
  129. Rev 1.71 1/11/2004 5:51:04 PM BGooijen
  130. Added AApend parameter to ReadBytes
  131. Rev 1.70 12/30/2003 7:17:56 PM BGooijen
  132. .net
  133. Rev 1.69 2003.12.28 1:05:54 PM czhower
  134. .Net changes.
  135. Rev 1.68 2003.12.28 11:53:28 AM czhower
  136. Removed warning in .net.
  137. Rev 1.67 2003.11.29 10:15:30 AM czhower
  138. InternalBuffer --> InputBuffer for consistency.
  139. Rev 1.66 11/23/03 1:46:28 PM RLebeau
  140. Removed "var" specifier from TStrings parameter of ReadStrings().
  141. Rev 1.65 11/4/2003 10:27:56 PM DSiders
  142. Removed exceptions moved to IdException.pas.
  143. Rev 1.64 2003.10.24 10:44:52 AM czhower
  144. IdStream implementation, bug fixes.
  145. Rev 1.63 10/22/03 2:05:40 PM RLebeau
  146. Fix for TIdIOHandler::Write(TStream) where it was not reading the stream into
  147. the TIdBytes correctly.
  148. Rev 1.62 10/19/2003 5:55:44 PM BGooijen
  149. Fixed todo in PerformCapture
  150. Rev 1.61 2003.10.18 12:58:50 PM czhower
  151. Added comment
  152. Rev 1.60 2003.10.18 12:42:04 PM czhower
  153. Intercept.Disconnect is now called
  154. Rev 1.59 10/15/2003 7:39:28 PM DSiders
  155. Added a formatted resource string for the exception raised in
  156. TIdIOHandler.MakeIOHandler.
  157. Rev 1.58 2003.10.14 1:26:50 PM czhower
  158. Uupdates + Intercept support
  159. Rev 1.57 2003.10.11 5:48:22 PM czhower
  160. -VCL fixes for servers
  161. -Chain suport for servers (Super core)
  162. -Scheduler upgrades
  163. -Full yarn support
  164. Rev 1.56 9/10/2003 1:50:38 PM SGrobety
  165. Removed all "const" keywords from boolean parameter interfaces. Might trigger
  166. changes in other units.
  167. Rev 1.55 10/5/2003 10:39:56 PM BGooijen
  168. Write buffering
  169. Rev 1.54 10/4/2003 11:03:12 PM BGooijen
  170. ReadStream, and functions with network ordering
  171. Rev 1.53 10/4/2003 7:10:46 PM BGooijen
  172. ReadXXXXX
  173. Rev 1.52 10/4/2003 3:55:02 PM BGooijen
  174. ReadString, and some Write functions
  175. Rev 1.51 04/10/2003 13:38:32 HHariri
  176. Write(Integer) support
  177. Rev 1.50 10/3/2003 12:09:30 AM BGooijen
  178. DotNet
  179. Rev 1.49 2003.10.02 8:29:14 PM czhower
  180. Changed names of byte conversion routines to be more readily understood and
  181. not to conflict with already in use ones.
  182. Rev 1.48 2003.10.02 1:18:50 PM czhower
  183. Changed read methods to be overloaded and more consistent. Will break some
  184. code, but nearly all code that uses them is Input.
  185. Rev 1.47 2003.10.02 10:16:26 AM czhower
  186. .Net
  187. Rev 1.46 2003.10.01 9:11:16 PM czhower
  188. .Net
  189. Rev 1.45 2003.10.01 2:46:36 PM czhower
  190. .Net
  191. Rev 1.42 2003.10.01 11:16:32 AM czhower
  192. .Net
  193. Rev 1.41 2003.10.01 1:37:34 AM czhower
  194. .Net
  195. Rev 1.40 2003.10.01 1:12:34 AM czhower
  196. .Net
  197. Rev 1.39 2003.09.30 1:22:56 PM czhower
  198. Stack split for DotNet
  199. Rev 1.38 2003.09.18 5:17:58 PM czhower
  200. Implemented OnWork
  201. Rev 1.37 2003.08.21 10:43:42 PM czhower
  202. Fix to ReadStream from Doychin
  203. Rev 1.36 08/08/2003 17:32:26 CCostelloe
  204. Removed "virtual" from function ReadLnSplit
  205. Rev 1.35 07/08/2003 00:25:08 CCostelloe
  206. Function ReadLnSplit added
  207. Rev 1.34 2003.07.17 1:05:12 PM czhower
  208. More IOCP improvements.
  209. Rev 1.33 2003.07.14 11:00:50 PM czhower
  210. More IOCP fixes.
  211. Rev 1.32 2003.07.14 12:54:30 AM czhower
  212. Fixed graceful close detection if it occurs after connect.
  213. Rev 1.31 2003.07.10 7:40:24 PM czhower
  214. Comments
  215. Rev 1.30 2003.07.10 4:34:56 PM czhower
  216. Fixed AV, added some new comments
  217. Rev 1.29 7/1/2003 5:50:44 PM BGooijen
  218. Fixed ReadStream
  219. Rev 1.28 6/30/2003 10:26:08 AM BGooijen
  220. forgot to remove some code regarding to TIdBuffer.Find
  221. Rev 1.27 6/29/2003 10:56:26 PM BGooijen
  222. Removed .Memory from the buffer, and added some extra methods
  223. Rev 1.26 2003.06.25 4:30:00 PM czhower
  224. Temp hack fix for AV problem. Working on real solution now.
  225. Rev 1.25 23/6/2003 22:33:14 GGrieve
  226. fix CheckForDataOnSource - specify timeout
  227. Rev 1.24 23/6/2003 06:46:52 GGrieve
  228. allow block on checkForData
  229. Rev 1.23 6/4/2003 1:07:08 AM BGooijen
  230. changed comment
  231. Rev 1.22 6/3/2003 10:40:34 PM BGooijen
  232. FRecvBuffer bug fixed, it was freed, but never recreated, resulting in an AV
  233. Rev 1.21 2003.06.03 6:28:04 PM czhower
  234. Made check for data virtual
  235. Rev 1.20 2003.06.03 3:43:24 PM czhower
  236. Resolved InputBuffer inconsistency. Added new method and renamed old one.
  237. Rev 1.19 5/25/2003 03:56:04 AM JPMugaas
  238. Updated for unit rename.
  239. Rev 1.18 2003.04.17 11:01:12 PM czhower
  240. Rev 1.17 4/16/2003 3:29:30 PM BGooijen
  241. minor change in ReadBuffer
  242. Rev 1.16 4/1/2003 7:54:24 PM BGooijen
  243. ReadLn default terminator changed to LF
  244. Rev 1.15 3/27/2003 3:24:06 PM BGooijen
  245. MaxLine* is now published
  246. Rev 1.14 2003.03.25 7:42:12 PM czhower
  247. try finally to WriteStrings
  248. Rev 1.13 3/24/2003 11:01:36 PM BGooijen
  249. WriteStrings is now buffered to increase speed
  250. Rev 1.12 3/19/2003 1:02:32 PM BGooijen
  251. changed class function ConstructDefaultIOHandler a little (default parameter)
  252. Rev 1.11 3/13/2003 10:18:16 AM BGooijen
  253. Server side fibers, bug fixes
  254. Rev 1.10 3/5/2003 11:03:06 PM BGooijen
  255. Added Intercept here
  256. Rev 1.9 2/25/2003 11:02:12 PM BGooijen
  257. InputBufferToStream now accepts a bytecount
  258. Rev 1.8 2003.02.25 1:36:00 AM czhower
  259. Rev 1.7 12-28-2002 22:28:16 BGooijen
  260. removed warning, added initialization and finalization part.
  261. Rev 1.6 12-16-2002 20:43:28 BGooijen
  262. Added class function ConstructIOHandler(....), and removed some comments
  263. Rev 1.5 12-15-2002 23:02:38 BGooijen
  264. added SendBufferSize
  265. Rev 1.4 12-15-2002 20:50:32 BGooijen
  266. FSendBufferSize was not initialized
  267. Rev 1.3 12-14-2002 22:14:54 BGooijen
  268. improved method to detect timeouts in ReadLn.
  269. Rev 1.2 12/11/2002 04:09:28 AM JPMugaas
  270. Updated for new API.
  271. Rev 1.1 2002.12.07 12:25:56 AM czhower
  272. Rev 1.0 11/13/2002 08:44:50 AM JPMugaas
  273. }
  274. unit IdIOHandler;
  275. interface
  276. {$I IdCompilerDefines.inc}
  277. uses
  278. Classes,
  279. IdException,
  280. IdAntiFreezeBase, IdBuffer, IdBaseComponent, IdComponent, IdGlobal, IdExceptionCore,
  281. IdIntercept, IdResourceStringsCore, IdStream;
  282. (*$HPPEMIT '#if defined(_VCL_ALIAS_RECORDS)' *)
  283. (*$HPPEMIT '#if !defined(UNICODE)' *)
  284. (*$HPPEMIT '#pragma alias "@Idiohandler@TIdIOHandler@SetPortA$qqri"="@Idiohandler@TIdIOHandler@SetPort$qqri"' *)
  285. (*$HPPEMIT '#else' *)
  286. (*$HPPEMIT '#pragma alias "@Idiohandler@TIdIOHandler@SetPortW$qqri"="@Idiohandler@TIdIOHandler@SetPort$qqri"' *)
  287. (*$HPPEMIT '#endif' *)
  288. (*$HPPEMIT '#endif' *)
  289. const
  290. GRecvBufferSizeDefault = 32 * 1024;
  291. GSendBufferSizeDefault = 32 * 1024;
  292. IdMaxLineLengthDefault = 16 * 1024;
  293. // S.G. 6/4/2004: Maximum number of lines captured
  294. // S.G. 6/4/2004: Default to "unlimited"
  295. Id_IOHandler_MaxCapturedLines = -1;
  296. type
  297. EIdIOHandler = class(EIdException);
  298. EIdIOHandlerRequiresLargeStream = class(EIdIOHandler);
  299. EIdIOHandlerStreamDataTooLarge = class(EIdIOHandler);
  300. TIdIOHandlerClass = class of TIdIOHandler;
  301. {
  302. How does this fit in in the hierarchy against TIdIOHandlerSocket
  303. Destination - Socket - otehr file descendats it
  304. TIdIOHandler should only implement an interface. No default functionality
  305. except very simple read/write functions such as ReadUInt32, etc. Functions
  306. that cannot really be optimized beyond their default implementations.
  307. Some default implementations offer basic non optmized implementations.
  308. Yes, I know this comment conflicts. Its being worked on.
  309. }
  310. TIdIOHandler = class(TIdComponent)
  311. private
  312. FLargeStream: Boolean;
  313. protected
  314. FClosedGracefully: Boolean;
  315. FConnectTimeout: Integer;
  316. FDestination: string;
  317. FHost: string;
  318. // IOHandlers typically receive more data than they need to complete each
  319. // request. They store this extra data in InputBuffer for future methods to
  320. // use. InputBuffer is what collects the input and keeps it if the current
  321. // method does not need all of it.
  322. //
  323. FInputBuffer: TIdBuffer;
  324. {$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FIntercept: TIdConnectionIntercept;
  325. FMaxCapturedLines: Integer;
  326. FMaxLineAction: TIdMaxLineAction;
  327. FMaxLineLength: Integer;
  328. FOpened: Boolean;
  329. FPort: Integer;
  330. FReadLnSplit: Boolean;
  331. FReadLnTimedOut: Boolean;
  332. FReadTimeOut: Integer;
  333. //TODO:
  334. FRecvBufferSize: Integer;
  335. FSendBufferSize: Integer;
  336. FWriteBuffer: TIdBuffer;
  337. FWriteBufferThreshold: Integer;
  338. FDefStringEncoding : IIdTextEncoding;
  339. {$IFDEF STRING_IS_ANSI}
  340. FDefAnsiEncoding : IIdTextEncoding;
  341. {$ENDIF}
  342. procedure SetDefStringEncoding(const AEncoding : IIdTextEncoding);
  343. {$IFDEF STRING_IS_ANSI}
  344. procedure SetDefAnsiEncoding(const AEncoding: IIdTextEncoding);
  345. {$ENDIF}
  346. //
  347. procedure BufferRemoveNotify(ASender: TObject; ABytes: Integer);
  348. function GetDestination: string; virtual;
  349. procedure InitComponent; override;
  350. procedure InterceptReceive(var VBuffer: TIdBytes);
  351. {$IFNDEF USE_OBJECT_ARC}
  352. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  353. {$ENDIF}
  354. procedure PerformCapture(const ADest: TObject; out VLineCount: Integer;
  355. const ADelim: string; AUsesDotTransparency: Boolean; AByteEncoding: IIdTextEncoding = nil
  356. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  357. ); virtual;
  358. procedure RaiseConnClosedGracefully;
  359. procedure SetDestination(const AValue: string); virtual;
  360. procedure SetHost(const AValue: string); virtual;
  361. procedure SetPort(AValue: Integer); virtual;
  362. procedure SetIntercept(AValue: TIdConnectionIntercept); virtual;
  363. // This is the main Read function which all other default implementations
  364. // use.
  365. function ReadFromSource(ARaiseExceptionIfDisconnected: Boolean = True;
  366. ATimeout: Integer = IdTimeoutDefault;
  367. ARaiseExceptionOnTimeout: Boolean = True): Integer;
  368. function ReadDataFromSource(var VBuffer: TIdBytes): Integer; virtual; abstract;
  369. function WriteDataToTarget(const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer; virtual; abstract;
  370. function SourceIsAvailable: Boolean; virtual; abstract;
  371. function CheckForError(ALastResult: Integer): Integer; virtual; abstract;
  372. procedure RaiseError(AError: Integer); virtual; abstract;
  373. public
  374. {$IFDEF WORKAROUND_INLINE_CONSTRUCTORS}
  375. constructor Create(AOwner: TComponent); reintroduce; overload;
  376. {$ENDIF}
  377. procedure AfterAccept; virtual;
  378. function Connected: Boolean; virtual;
  379. destructor Destroy; override;
  380. // CheckForDisconnect allows the implementation to check the status of the
  381. // connection at the request of the user or this base class.
  382. procedure CheckForDisconnect(ARaiseExceptionIfDisconnected: Boolean = True;
  383. AIgnoreBuffer: Boolean = False); virtual; abstract;
  384. // Does not wait or raise any exceptions. Just reads whatever data is
  385. // available (if any) into the buffer. Must NOT raise closure exceptions.
  386. // It is used to get avialable data, and check connection status. That is
  387. // it can set status flags about the connection.
  388. function CheckForDataOnSource(ATimeout: Integer = 0): Boolean; virtual;
  389. procedure Close; virtual;
  390. procedure CloseGracefully; virtual;
  391. class function MakeDefaultIOHandler(AOwner: TComponent = nil)
  392. : TIdIOHandler;
  393. class function MakeIOHandler(ABaseType: TIdIOHandlerClass;
  394. AOwner: TComponent = nil): TIdIOHandler;
  395. // Variant of MakeIOHandler() which returns nil if it cannot find a registered IOHandler
  396. class function TryMakeIOHandler(ABaseType: TIdIOHandlerClass;
  397. AOwner: TComponent = nil): TIdIOHandler;
  398. class procedure RegisterIOHandler;
  399. class procedure SetDefaultClass;
  400. function WaitFor(const AString: string; ARemoveFromBuffer: Boolean = True;
  401. AInclusive: Boolean = False; AByteEncoding: IIdTextEncoding = nil;
  402. ATimeout: Integer = IdTimeoutDefault
  403. {$IFDEF STRING_IS_ANSI}; AAnsiEncoding: IIdTextEncoding = nil{$ENDIF}
  404. ): string;
  405. // This is different than WriteDirect. WriteDirect goes
  406. // directly to the network or next level. WriteBuffer allows for buffering
  407. // using WriteBuffers. This should be the only call to WriteDirect
  408. // unless the calls that bypass this are aware of WriteBuffering or are
  409. // intended to bypass it.
  410. procedure Write(const ABuffer: TIdBytes; const ALength: Integer = -1; const AOffset: Integer = 0); overload; virtual;
  411. // This is the main write function which all other default implementations
  412. // use. If default implementations are used, this must be implemented.
  413. procedure WriteDirect(const ABuffer: TIdBytes; const ALength: Integer = -1; const AOffset: Integer = 0);
  414. //
  415. procedure Open; virtual;
  416. function Readable(AMSec: Integer = IdTimeoutDefault): Boolean; virtual;
  417. //
  418. // Optimal Extra Methods
  419. //
  420. // These methods are based on the core methods. While they can be
  421. // overridden, they are so simple that it is rare a more optimal method can
  422. // be implemented. Because of this they are not overrideable.
  423. //
  424. //
  425. // Write Methods
  426. //
  427. // Only the ones that have a hope of being better optimized in descendants
  428. // have been marked virtual
  429. procedure Write(const AOut: string; AByteEncoding: IIdTextEncoding = nil
  430. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  431. ); overload; virtual;
  432. procedure WriteLn(AEncoding: IIdTextEncoding = nil); overload;
  433. procedure WriteLn(const AOut: string; AByteEncoding: IIdTextEncoding = nil
  434. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  435. ); overload; virtual;
  436. procedure WriteLnRFC(const AOut: string = ''; AByteEncoding: IIdTextEncoding = nil
  437. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  438. ); virtual;
  439. procedure Write(AValue: TStrings; AWriteLinesCount: Boolean = False;
  440. AByteEncoding: IIdTextEncoding = nil
  441. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  442. ); overload; virtual;
  443. procedure Write(AValue: Byte); overload;
  444. procedure Write(AValue: Char; AByteEncoding: IIdTextEncoding = nil
  445. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  446. ); overload;
  447. // for iOS64, Delphi's Longint and LongWord are 64bit, so we can't rely on
  448. // Write(Longint) and ReadLongint() being 32bit anymore, for instance when
  449. // sending/reading a TStream with LargeStream=False. So adding new (U)IntX
  450. // methods and deprecating the old ones...
  451. //
  452. procedure Write(AValue: Int16; AConvert: Boolean = True); overload;
  453. procedure Write(AValue: UInt16; AConvert: Boolean = True); overload;
  454. procedure Write(AValue: Int32; AConvert: Boolean = True); overload;
  455. procedure Write(AValue: UInt32; AConvert: Boolean = True); overload;
  456. procedure Write(AValue: Int64; AConvert: Boolean = True); overload;
  457. procedure Write(AValue: TIdUInt64; AConvert: Boolean = True); overload;
  458. //
  459. procedure Write(AStream: TStream; ASize: TIdStreamSize = 0;
  460. AWriteByteCount: Boolean = False); overload; virtual;
  461. procedure WriteRFCStrings(AStrings: TStrings; AWriteTerminator: Boolean = True;
  462. AByteEncoding: IIdTextEncoding = nil
  463. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  464. );
  465. // Not overloaded because it does not have a unique type for source
  466. // and could be easily unresolvable with future additions
  467. function WriteFile(const AFile: String; AEnableTransferFile: Boolean = False): Int64; virtual;
  468. //
  469. // Read methods
  470. //
  471. function AllData(AByteEncoding: IIdTextEncoding = nil
  472. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  473. ): string; virtual;
  474. function InputLn(const AMask: string = ''; AEcho: Boolean = True;
  475. ATabWidth: Integer = 8; AMaxLineLength: Integer = -1;
  476. AByteEncoding: IIdTextEncoding = nil
  477. {$IFDEF STRING_IS_ANSI}; AAnsiEncoding: IIdTextEncoding = nil{$ENDIF}
  478. ): string; virtual;
  479. // Capture
  480. // Not virtual because each calls PerformCapture which is virtual
  481. procedure Capture(ADest: TStream; AByteEncoding: IIdTextEncoding = nil
  482. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  483. ); overload; // .Net overload
  484. procedure Capture(ADest: TStream; ADelim: string;
  485. AUsesDotTransparency: Boolean = True; AByteEncoding: IIdTextEncoding = nil
  486. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  487. ); overload;
  488. procedure Capture(ADest: TStream; out VLineCount: Integer;
  489. const ADelim: string = '.'; AUsesDotTransparency: Boolean = True;
  490. AByteEncoding: IIdTextEncoding = nil
  491. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  492. ); overload;
  493. procedure Capture(ADest: TStrings; AByteEncoding: IIdTextEncoding = nil
  494. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  495. ); overload; // .Net overload
  496. procedure Capture(ADest: TStrings; const ADelim: string;
  497. AUsesDotTransparency: Boolean = True; AByteEncoding: IIdTextEncoding = nil
  498. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  499. ); overload;
  500. procedure Capture(ADest: TStrings; out VLineCount: Integer;
  501. const ADelim: string = '.'; AUsesDotTransparency: Boolean = True;
  502. AByteEncoding: IIdTextEncoding = nil
  503. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  504. ); overload;
  505. //
  506. // Read___
  507. // Cannot overload, compiler cannot overload on return values
  508. //
  509. procedure ReadBytes(var VBuffer: TIdBytes; AByteCount: Integer; AAppend: Boolean = True); virtual;
  510. // ReadLn
  511. function ReadLn(AByteEncoding: IIdTextEncoding = nil
  512. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  513. ): string; overload; // .Net overload
  514. function ReadLn(ATerminator: string; AByteEncoding: IIdTextEncoding
  515. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  516. ): string; overload;
  517. function ReadLn(ATerminator: string; ATimeout: Integer = IdTimeoutDefault;
  518. AMaxLineLength: Integer = -1; AByteEncoding: IIdTextEncoding = nil
  519. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  520. ): string; overload; virtual;
  521. //RLebeau: added for RFC 822 retrieves
  522. function ReadLnRFC(var VMsgEnd: Boolean; AByteEncoding: IIdTextEncoding = nil
  523. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  524. ): string; overload;
  525. function ReadLnRFC(var VMsgEnd: Boolean; const ALineTerminator: string;
  526. const ADelim: string = '.'; AByteEncoding: IIdTextEncoding = nil
  527. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  528. ): string; overload;
  529. function ReadLnWait(AFailCount: Integer = MaxInt;
  530. AByteEncoding: IIdTextEncoding = nil
  531. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  532. ): string; virtual;
  533. // Added for retrieving lines over 16K long}
  534. function ReadLnSplit(var AWasSplit: Boolean; ATerminator: string = LF;
  535. ATimeout: Integer = IdTimeoutDefault; AMaxLineLength: Integer = -1;
  536. AByteEncoding: IIdTextEncoding = nil
  537. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  538. ): string;
  539. // Read - Simple Types
  540. function ReadChar(AByteEncoding: IIdTextEncoding = nil
  541. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  542. ): Char;
  543. function ReadByte: Byte;
  544. function ReadString(ABytes: Integer; AByteEncoding: IIdTextEncoding = nil
  545. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  546. ): string;
  547. // for iOS64, Delphi's Longint and LongWord are changed to 64bit, so we can't
  548. // rely on Write(Longint) and ReadLongint() being 32bit anymore, for instance
  549. // when sending/reading a TStream with LargeStream=False. So adding new (U)IntX
  550. // methods and deprecating the old ones...
  551. //
  552. function ReadInt16(AConvert: Boolean = True): Int16;
  553. function ReadUInt16(AConvert: Boolean = True): UInt16;
  554. function ReadInt32(AConvert: Boolean = True): Int32;
  555. function ReadUInt32(AConvert: Boolean = True): UInt32;
  556. function ReadInt64(AConvert: Boolean = True): Int64;
  557. function ReadUInt64(AConvert: Boolean = True): TIdUInt64;
  558. //
  559. function ReadSmallInt(AConvert: Boolean = True): Int16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use ReadInt16()'{$ENDIF};{$ENDIF}
  560. function ReadWord(AConvert: Boolean = True): UInt16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use ReadUInt16()'{$ENDIF};{$ENDIF}
  561. function ReadLongInt(AConvert: Boolean = True): Int32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use ReadInt32()'{$ENDIF};{$ENDIF}
  562. function ReadLongWord(AConvert: Boolean = True): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use ReadUInt32()'{$ENDIF};{$ENDIF}
  563. //
  564. procedure ReadStream(AStream: TStream; AByteCount: TIdStreamSize = -1;
  565. AReadUntilDisconnect: Boolean = False); virtual;
  566. procedure ReadStrings(ADest: TStrings; AReadLinesCount: Integer = -1;
  567. AByteEncoding: IIdTextEncoding = nil
  568. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  569. );
  570. //
  571. procedure Discard(AByteCount: Int64);
  572. procedure DiscardAll;
  573. //
  574. // WriteBuffering Methods
  575. //
  576. procedure WriteBufferCancel; virtual;
  577. procedure WriteBufferClear; virtual;
  578. procedure WriteBufferClose; virtual;
  579. procedure WriteBufferFlush; overload; //.Net overload
  580. procedure WriteBufferFlush(AByteCount: Integer); overload; virtual;
  581. procedure WriteBufferOpen; overload; //.Net overload
  582. procedure WriteBufferOpen(AThreshold: Integer); overload; virtual;
  583. function WriteBufferingActive: Boolean;
  584. //
  585. // InputBuffer Methods
  586. //
  587. function InputBufferIsEmpty: Boolean;
  588. //
  589. // These two are direct access and do no reading of connection
  590. procedure InputBufferToStream(AStream: TStream; AByteCount: Integer = -1);
  591. function InputBufferAsString(AByteEncoding: IIdTextEncoding = nil
  592. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  593. ): string;
  594. //
  595. // Properties
  596. //
  597. property ConnectTimeout: Integer read FConnectTimeout write FConnectTimeout default 0;
  598. property ClosedGracefully: Boolean read FClosedGracefully;
  599. // TODO: Need to name this consistent. Originally no access was allowed,
  600. // but new model requires it for writing. Will decide after next set
  601. // of changes are complete what to do with Buffer prop.
  602. //
  603. // Is used by SuperCore
  604. property InputBuffer: TIdBuffer read FInputBuffer;
  605. //currently an option, as LargeFile support changes the data format
  606. property LargeStream: Boolean read FLargeStream write FLargeStream;
  607. property MaxCapturedLines: Integer read FMaxCapturedLines write FMaxCapturedLines default Id_IOHandler_MaxCapturedLines;
  608. property Opened: Boolean read FOpened;
  609. property ReadTimeout: Integer read FReadTimeOut write FReadTimeOut default IdTimeoutDefault;
  610. property ReadLnTimedout: Boolean read FReadLnTimedout ;
  611. property WriteBufferThreshold: Integer read FWriteBufferThreshold;
  612. property DefStringEncoding : IIdTextEncoding read FDefStringEncoding write SetDefStringEncoding;
  613. {$IFDEF STRING_IS_ANSI}
  614. property DefAnsiEncoding : IIdTextEncoding read FDefAnsiEncoding write SetDefAnsiEncoding;
  615. {$ENDIF}
  616. //
  617. // Events
  618. //
  619. property OnWork;
  620. property OnWorkBegin;
  621. property OnWorkEnd;
  622. published
  623. property Destination: string read GetDestination write SetDestination;
  624. property Host: string read FHost write SetHost;
  625. property Intercept: TIdConnectionIntercept read FIntercept write SetIntercept;
  626. property MaxLineLength: Integer read FMaxLineLength write FMaxLineLength default IdMaxLineLengthDefault;
  627. property MaxLineAction: TIdMaxLineAction read FMaxLineAction write FMaxLineAction;
  628. property Port: Integer read FPort write SetPort;
  629. // RecvBufferSize is used by some methods that read large amounts of data.
  630. // RecvBufferSize is the amount of data that will be requested at each read
  631. // cycle. RecvBuffer is used to receive then send to the Intercepts, after
  632. // that it goes to InputBuffer
  633. property RecvBufferSize: Integer read FRecvBufferSize write FRecvBufferSize
  634. default GRecvBufferSizeDefault;
  635. // SendBufferSize is used by some methods that have to break apart large
  636. // amounts of data into smaller pieces. This is the buffer size of the
  637. // chunks that it will create and use.
  638. property SendBufferSize: Integer read FSendBufferSize write FSendBufferSize
  639. default GSendBufferSizeDefault;
  640. end;
  641. implementation
  642. uses
  643. //facilitate inlining only.
  644. {$IFDEF DOTNET}
  645. {$IFDEF USE_INLINE}
  646. System.IO,
  647. {$ENDIF}
  648. {$ENDIF}
  649. {$IFDEF WIN32_OR_WIN64}
  650. Windows,
  651. {$ENDIF}
  652. {$IFDEF USE_VCL_POSIX}
  653. {$IFDEF OSX}
  654. Macapi.CoreServices,
  655. {$ENDIF}
  656. {$ENDIF}
  657. {$IFDEF HAS_UNIT_Generics_Collections}
  658. System.Generics.Collections,
  659. {$ENDIF}
  660. IdStack, IdStackConsts, IdResourceStrings,
  661. SysUtils;
  662. type
  663. {$IFDEF HAS_GENERICS_TList}
  664. TIdIOHandlerClassList = TList<TIdIOHandlerClass>;
  665. {$ELSE}
  666. // TODO: flesh out to match TList<TIdIOHandlerClass> for non-Generics compilers
  667. TIdIOHandlerClassList = TList;
  668. {$ENDIF}
  669. var
  670. GIOHandlerClassDefault: TIdIOHandlerClass = nil;
  671. GIOHandlerClassList: TIdIOHandlerClassList = nil;
  672. {$IFDEF DCC}
  673. {$IFNDEF VCL_7_OR_ABOVE}
  674. // RLebeau 5/13/2015: The Write(Int64) and ReadInt64() methods produce an
  675. // "Internal error URW533" compiler error in Delphi 5, and an "Internal
  676. // error URW699" compiler error in Delphi 6, so need to use some workarounds
  677. // for those versions...
  678. {$DEFINE AVOID_URW_ERRORS}
  679. {$ENDIF}
  680. {$ENDIF}
  681. { TIdIOHandler }
  682. {$IFDEF WORKAROUND_INLINE_CONSTRUCTORS}
  683. constructor TIdIOHandler.Create(AOwner: TComponent);
  684. begin
  685. inherited Create(AOwner);
  686. end;
  687. {$ENDIF}
  688. procedure TIdIOHandler.Close;
  689. //do not do FInputBuffer.Clear; here.
  690. //it breaks reading when remote connection does a disconnect
  691. var
  692. // under ARC, convert a weak reference to a strong reference before working with it
  693. LIntercept: TIdConnectionIntercept;
  694. begin
  695. try
  696. LIntercept := Intercept;
  697. if LIntercept <> nil then begin
  698. LIntercept.Disconnect;
  699. end;
  700. finally
  701. FOpened := False;
  702. WriteBufferClear;
  703. end;
  704. end;
  705. destructor TIdIOHandler.Destroy;
  706. begin
  707. Close;
  708. FreeAndNil(FInputBuffer);
  709. FreeAndNil(FWriteBuffer);
  710. inherited Destroy;
  711. end;
  712. procedure TIdIOHandler.AfterAccept;
  713. begin
  714. //
  715. end;
  716. procedure TIdIOHandler.Open;
  717. begin
  718. FOpened := False;
  719. FClosedGracefully := False;
  720. WriteBufferClear;
  721. FInputBuffer.Clear;
  722. FOpened := True;
  723. end;
  724. // under ARC, all weak references to a freed object get nil'ed automatically
  725. {$IFNDEF USE_OBJECT_ARC}
  726. procedure TIdIOHandler.Notification(AComponent: TComponent; Operation: TOperation);
  727. begin
  728. if (Operation = opRemove) and (AComponent = FIntercept) then begin
  729. FIntercept := nil;
  730. end;
  731. inherited Notification(AComponent, OPeration);
  732. end;
  733. {$ENDIF}
  734. procedure TIdIOHandler.SetIntercept(AValue: TIdConnectionIntercept);
  735. begin
  736. {$IFDEF USE_OBJECT_ARC}
  737. // under ARC, all weak references to a freed object get nil'ed automatically
  738. FIntercept := AValue;
  739. {$ELSE}
  740. if FIntercept <> AValue then begin
  741. // remove self from the Intercept's free notification list
  742. if Assigned(FIntercept) then begin
  743. FIntercept.RemoveFreeNotification(Self);
  744. end;
  745. FIntercept := AValue;
  746. // add self to the Intercept's free notification list
  747. if Assigned(AValue) then begin
  748. AValue.FreeNotification(Self);
  749. end;
  750. end;
  751. {$ENDIF}
  752. end;
  753. class procedure TIdIOHandler.SetDefaultClass;
  754. begin
  755. GIOHandlerClassDefault := Self;
  756. RegisterIOHandler;
  757. end;
  758. procedure TIdIOHandler.SetDefStringEncoding(const AEncoding: IIdTextEncoding);
  759. var
  760. LEncoding: IIdTextEncoding;
  761. begin
  762. if FDefStringEncoding <> AEncoding then
  763. begin
  764. LEncoding := AEncoding;
  765. EnsureEncoding(LEncoding);
  766. FDefStringEncoding := LEncoding;
  767. end;
  768. end;
  769. {$IFDEF STRING_IS_ANSI}
  770. procedure TIdIOHandler.SetDefAnsiEncoding(const AEncoding: IIdTextEncoding);
  771. var
  772. LEncoding: IIdTextEncoding;
  773. begin
  774. if FDefAnsiEncoding <> AEncoding then
  775. begin
  776. LEncoding := AEncoding;
  777. EnsureEncoding(LEncoding, encOSDefault);
  778. FDefAnsiEncoding := LEncoding;
  779. end;
  780. end;
  781. {$ENDIF}
  782. class function TIdIOHandler.MakeDefaultIOHandler(AOwner: TComponent = nil): TIdIOHandler;
  783. begin
  784. Result := GIOHandlerClassDefault.Create(AOwner);
  785. end;
  786. class procedure TIdIOHandler.RegisterIOHandler;
  787. begin
  788. if GIOHandlerClassList = nil then begin
  789. GIOHandlerClassList := TIdIOHandlerClassList.Create;
  790. end;
  791. {$IFNDEF DOTNET_EXCLUDE}
  792. //TODO: Reenable this. Dot net wont allow class references as objects
  793. // Use an array?
  794. if GIOHandlerClassList.IndexOf(Self) = -1 then begin
  795. GIOHandlerClassList.Add(Self);
  796. end;
  797. {$ENDIF}
  798. end;
  799. {
  800. Creates an IOHandler of type ABaseType, or descendant.
  801. }
  802. class function TIdIOHandler.MakeIOHandler(ABaseType: TIdIOHandlerClass;
  803. AOwner: TComponent = nil): TIdIOHandler;
  804. begin
  805. Result := TryMakeIOHandler(ABaseType, AOwner);
  806. if not Assigned(Result) then begin
  807. raise EIdException.CreateFmt(RSIOHandlerTypeNotInstalled, [ABaseType.ClassName]);
  808. end;
  809. end;
  810. class function TIdIOHandler.TryMakeIOHandler(ABaseType: TIdIOHandlerClass;
  811. AOwner: TComponent = nil): TIdIOHandler;
  812. var
  813. i: Integer;
  814. begin
  815. if GIOHandlerClassList <> nil then begin
  816. for i := GIOHandlerClassList.Count - 1 downto 0 do begin
  817. if TIdIOHandlerClass(GIOHandlerClassList[i]).InheritsFrom(ABaseType) then begin
  818. Result := TIdIOHandlerClass(GIOHandlerClassList[i]).Create;
  819. Exit;
  820. end;
  821. end;
  822. end;
  823. Result := nil;
  824. end;
  825. function TIdIOHandler.GetDestination: string;
  826. begin
  827. Result := FDestination;
  828. end;
  829. procedure TIdIOHandler.SetDestination(const AValue: string);
  830. begin
  831. FDestination := AValue;
  832. end;
  833. procedure TIdIOHandler.BufferRemoveNotify(ASender: TObject; ABytes: Integer);
  834. begin
  835. DoWork(wmRead, ABytes);
  836. end;
  837. procedure TIdIOHandler.WriteBufferOpen(AThreshold: Integer);
  838. begin
  839. if FWriteBuffer <> nil then begin
  840. FWriteBuffer.Clear;
  841. end else begin
  842. FWriteBuffer := TIdBuffer.Create;
  843. end;
  844. FWriteBufferThreshold := AThreshold;
  845. end;
  846. procedure TIdIOHandler.WriteBufferClose;
  847. begin
  848. try
  849. WriteBufferFlush;
  850. finally FreeAndNil(FWriteBuffer); end;
  851. end;
  852. procedure TIdIOHandler.WriteBufferFlush(AByteCount: Integer);
  853. var
  854. LBytes: TIdBytes;
  855. begin
  856. if FWriteBuffer <> nil then begin
  857. if FWriteBuffer.Size > 0 then begin
  858. FWriteBuffer.ExtractToBytes(LBytes, AByteCount);
  859. WriteDirect(LBytes);
  860. end;
  861. end;
  862. end;
  863. procedure TIdIOHandler.WriteBufferClear;
  864. begin
  865. if FWriteBuffer <> nil then begin
  866. FWriteBuffer.Clear;
  867. end;
  868. end;
  869. procedure TIdIOHandler.WriteBufferCancel;
  870. begin
  871. WriteBufferClear;
  872. WriteBufferClose;
  873. end;
  874. procedure TIdIOHandler.Write(const AOut: string; AByteEncoding: IIdTextEncoding = nil
  875. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  876. );
  877. begin
  878. if AOut <> '' then begin
  879. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  880. {$IFDEF STRING_IS_ANSI}
  881. ASrcEncoding := iif(ASrcEncoding, FDefAnsiEncoding, encOSDefault);
  882. {$ENDIF}
  883. Write(
  884. ToBytes(AOut, -1, 1, AByteEncoding
  885. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  886. )
  887. );
  888. end;
  889. end;
  890. procedure TIdIOHandler.Write(AValue: Byte);
  891. begin
  892. Write(ToBytes(AValue));
  893. end;
  894. procedure TIdIOHandler.Write(AValue: Char; AByteEncoding: IIdTextEncoding = nil
  895. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  896. );
  897. begin
  898. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  899. {$IFDEF STRING_IS_ANSI}
  900. ASrcEncoding := iif(ASrcEncoding, FDefAnsiEncoding, encOSDefault);
  901. {$ENDIF}
  902. Write(
  903. ToBytes(AValue, AByteEncoding
  904. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  905. )
  906. );
  907. end;
  908. procedure TIdIOHandler.Write(AValue: UInt32; AConvert: Boolean = True);
  909. begin
  910. if AConvert then begin
  911. AValue := GStack.HostToNetwork(AValue);
  912. end;
  913. Write(ToBytes(AValue));
  914. end;
  915. procedure TIdIOHandler.Write(AValue: Int32; AConvert: Boolean = True);
  916. begin
  917. if AConvert then begin
  918. AValue := Int32(GStack.HostToNetwork(UInt32(AValue)));
  919. end;
  920. Write(ToBytes(AValue));
  921. end;
  922. {$IFDEF HAS_UInt64}
  923. {$IFDEF BROKEN_UInt64_HPPEMIT}
  924. {$DEFINE HAS_TIdUInt64_QuadPart}
  925. {$ENDIF}
  926. {$ELSE}
  927. {$IFNDEF HAS_QWord}
  928. {$DEFINE HAS_TIdUInt64_QuadPart}
  929. {$ENDIF}
  930. {$ENDIF}
  931. procedure TIdIOHandler.Write(AValue: Int64; AConvert: Boolean = True);
  932. {$IFDEF AVOID_URW_ERRORS}
  933. var
  934. h: Int64;
  935. {$ELSE}
  936. {$IFDEF HAS_TIdUInt64_QuadPart}
  937. var
  938. h: TIdUInt64;
  939. {$ENDIF}
  940. {$ENDIF}
  941. begin
  942. if AConvert then begin
  943. {$IFDEF AVOID_URW_ERRORS}
  944. // assigning to a local variable to avoid an "Internal error URW533" compiler
  945. // error in Delphi 5, and an "Internal error URW699" compiler error in Delphi
  946. // 6. Later versions seem OK without it...
  947. h := GStack.HostToNetwork(UInt64(AValue));
  948. AValue := h;
  949. {$ELSE}
  950. {$IFDEF HAS_TIdUInt64_QuadPart}
  951. // assigning to a local variable if UInt64 is not a native type, or if using
  952. // a C++Builder version that has problems with UInt64 parameters...
  953. h.QuadPart := UInt64(AValue);
  954. h := GStack.HostToNetwork(h);
  955. AValue := Int64(h.QuadPart);
  956. {$ELSE}
  957. AValue := Int64(GStack.HostToNetwork(UInt64(AValue)));
  958. {$ENDIF}
  959. {$ENDIF}
  960. end;
  961. Write(ToBytes(AValue));
  962. end;
  963. procedure TIdIOHandler.Write(AValue: TIdUInt64; AConvert: Boolean = True);
  964. begin
  965. if AConvert then begin
  966. AValue := GStack.HostToNetwork(AValue);
  967. end;
  968. Write(ToBytes(AValue));
  969. end;
  970. procedure TIdIOHandler.Write(AValue: TStrings; AWriteLinesCount: Boolean = False;
  971. AByteEncoding: IIdTextEncoding = nil
  972. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  973. );
  974. var
  975. i: Integer;
  976. LBufferingStarted: Boolean;
  977. begin
  978. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  979. {$IFDEF STRING_IS_ANSI}
  980. ASrcEncoding := iif(ASrcEncoding, FDefAnsiEncoding, encOSDefault);
  981. {$ENDIF}
  982. LBufferingStarted := not WriteBufferingActive;
  983. if LBufferingStarted then begin
  984. WriteBufferOpen;
  985. end;
  986. try
  987. if AWriteLinesCount then begin
  988. Write(AValue.Count);
  989. end;
  990. for i := 0 to AValue.Count - 1 do begin
  991. WriteLn(AValue.Strings[i], AByteEncoding
  992. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  993. );
  994. end;
  995. if LBufferingStarted then begin
  996. WriteBufferClose;
  997. end;
  998. except
  999. if LBufferingStarted then begin
  1000. WriteBufferCancel;
  1001. end;
  1002. raise;
  1003. end;
  1004. end;
  1005. procedure TIdIOHandler.Write(AValue: UInt16; AConvert: Boolean = True);
  1006. begin
  1007. if AConvert then begin
  1008. AValue := GStack.HostToNetwork(AValue);
  1009. end;
  1010. Write(ToBytes(AValue));
  1011. end;
  1012. procedure TIdIOHandler.Write(AValue: Int16; AConvert: Boolean = True);
  1013. begin
  1014. if AConvert then begin
  1015. AValue := Int16(GStack.HostToNetwork(UInt16(AValue)));
  1016. end;
  1017. Write(ToBytes(AValue));
  1018. end;
  1019. function TIdIOHandler.ReadString(ABytes: Integer; AByteEncoding: IIdTextEncoding = nil
  1020. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1021. ): string;
  1022. var
  1023. LBytes: TIdBytes;
  1024. begin
  1025. if ABytes > 0 then begin
  1026. ReadBytes(LBytes, ABytes, False);
  1027. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  1028. {$IFDEF STRING_IS_ANSI}
  1029. ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
  1030. {$ENDIF}
  1031. Result := BytesToString(LBytes, 0, ABytes, AByteEncoding
  1032. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1033. );
  1034. end else begin
  1035. Result := '';
  1036. end;
  1037. end;
  1038. procedure TIdIOHandler.ReadStrings(ADest: TStrings; AReadLinesCount: Integer = -1;
  1039. AByteEncoding: IIdTextEncoding = nil
  1040. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1041. );
  1042. var
  1043. i: Integer;
  1044. begin
  1045. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  1046. {$IFDEF STRING_IS_ANSI}
  1047. ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
  1048. {$ENDIF}
  1049. if AReadLinesCount < 0 then begin
  1050. AReadLinesCount := ReadInt32;
  1051. end;
  1052. ADest.BeginUpdate;
  1053. try
  1054. for i := 0 to AReadLinesCount - 1 do begin
  1055. ADest.Add(ReadLn(AByteEncoding
  1056. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1057. ));
  1058. end;
  1059. finally
  1060. ADest.EndUpdate;
  1061. end;
  1062. end;
  1063. function TIdIOHandler.ReadUInt16(AConvert: Boolean = True): UInt16;
  1064. var
  1065. LBytes: TIdBytes;
  1066. begin
  1067. ReadBytes(LBytes, SizeOf(UInt16), False);
  1068. Result := BytesToUInt16(LBytes);
  1069. if AConvert then begin
  1070. Result := GStack.NetworkToHost(Result);
  1071. end;
  1072. end;
  1073. {$I IdDeprecatedImplBugOff.inc}
  1074. function TIdIOHandler.ReadWord(AConvert: Boolean = True): UInt16;
  1075. {$I IdDeprecatedImplBugOn.inc}
  1076. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  1077. begin
  1078. Result := ReadUInt16(AConvert);
  1079. end;
  1080. function TIdIOHandler.ReadInt16(AConvert: Boolean = True): Int16;
  1081. var
  1082. LBytes: TIdBytes;
  1083. begin
  1084. ReadBytes(LBytes, SizeOf(Int16), False);
  1085. Result := BytesToInt16(LBytes);
  1086. if AConvert then begin
  1087. Result := Int16(GStack.NetworkToHost(UInt16(Result)));
  1088. end;
  1089. end;
  1090. {$I IdDeprecatedImplBugOff.inc}
  1091. function TIdIOHandler.ReadSmallInt(AConvert: Boolean = True): Int16;
  1092. {$I IdDeprecatedImplBugOn.inc}
  1093. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  1094. begin
  1095. Result := ReadInt16(AConvert);
  1096. end;
  1097. function TIdIOHandler.ReadChar(AByteEncoding: IIdTextEncoding = nil
  1098. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1099. ): Char;
  1100. var
  1101. I, J, NumChars, NumBytes: Integer;
  1102. LBytes: TIdBytes;
  1103. {$IFDEF DOTNET}
  1104. LChars: array[0..1] of Char;
  1105. {$ELSE}
  1106. LChars: TIdWideChars;
  1107. {$IFDEF STRING_IS_ANSI}
  1108. LWTmp: TIdUnicodeString;
  1109. LATmp: TIdBytes;
  1110. {$ENDIF}
  1111. {$ENDIF}
  1112. begin
  1113. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  1114. {$IFDEF STRING_IS_ANSI}
  1115. ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
  1116. {$ENDIF}
  1117. // 2 Chars to handle UTF-16 surrogates
  1118. NumBytes := AByteEncoding.GetMaxByteCount(2);
  1119. SetLength(LBytes, NumBytes);
  1120. {$IFNDEF DOTNET}
  1121. SetLength(LChars, 2);
  1122. {$ENDIF}
  1123. NumChars := 0;
  1124. if NumBytes > 0 then
  1125. begin
  1126. for I := 1 to NumBytes do
  1127. begin
  1128. LBytes[I-1] := ReadByte;
  1129. NumChars := AByteEncoding.GetChars(LBytes, 0, I, LChars, 0);
  1130. if NumChars > 0 then begin
  1131. // RLebeau 10/19/2012: when Indy switched to its own UTF-8 implementation
  1132. // to avoid the MB_ERR_INVALID_CHARS flag on Windows, it accidentally broke
  1133. // this loop! Since this is not commonly used, this was not noticed until
  1134. // now. On Windows at least, GetChars() now returns >0 for an invalid
  1135. // sequence, so we have to check if any of the returned characters are the
  1136. // Unicode U+FFFD character, indicating bad data...
  1137. for J := 0 to NumChars-1 do begin
  1138. if LChars[J] = TIdWideChar($FFFD) then begin
  1139. // keep reading...
  1140. NumChars := 0;
  1141. Break;
  1142. end;
  1143. end;
  1144. if NumChars > 0 then begin
  1145. Break;
  1146. end;
  1147. end;
  1148. end;
  1149. end;
  1150. {$IFDEF STRING_IS_UNICODE}
  1151. // RLebeau: if the bytes were decoded into surrogates, the second
  1152. // surrogate is lost here, as it can't be returned unless we cache
  1153. // it somewhere for the the next ReadChar() call to retreive. Just
  1154. // raise an error for now. Users will have to update their code to
  1155. // read surrogates differently...
  1156. Assert(NumChars = 1);
  1157. Result := LChars[0];
  1158. {$ELSE}
  1159. // RLebeau: since we can only return an AnsiChar here, let's convert
  1160. // the decoded characters, surrogates and all, into their Ansi
  1161. // representation. This will have the same problem as above if the
  1162. // conversion results in a multibyte character sequence...
  1163. SetString(LWTmp, PWideChar(LChars), NumChars);
  1164. LATmp := ADestEncoding.GetBytes(LWTmp); // convert to Ansi
  1165. Assert(Length(LATmp) = 1);
  1166. Result := Char(LATmp[0]);
  1167. {$ENDIF}
  1168. end;
  1169. function TIdIOHandler.ReadByte: Byte;
  1170. var
  1171. LBytes: TIdBytes;
  1172. begin
  1173. ReadBytes(LBytes, 1, False);
  1174. Result := LBytes[0];
  1175. end;
  1176. function TIdIOHandler.ReadInt32(AConvert: Boolean): Int32;
  1177. var
  1178. LBytes: TIdBytes;
  1179. begin
  1180. ReadBytes(LBytes, SizeOf(Int32), False);
  1181. Result := BytesToInt32(LBytes);
  1182. if AConvert then begin
  1183. Result := Int32(GStack.NetworkToHost(UInt32(Result)));
  1184. end;
  1185. end;
  1186. {$I IdDeprecatedImplBugOff.inc}
  1187. function TIdIOHandler.ReadLongInt(AConvert: Boolean): Int32;
  1188. {$I IdDeprecatedImplBugOn.inc}
  1189. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  1190. begin
  1191. Result := ReadInt32(AConvert);
  1192. end;
  1193. function TIdIOHandler.ReadInt64(AConvert: boolean): Int64;
  1194. var
  1195. LBytes: TIdBytes;
  1196. {$IFDEF AVOID_URW_ERRORS}
  1197. h: Int64;
  1198. {$ELSE}
  1199. {$IFDEF HAS_TIdUInt64_QuadPart}
  1200. h: TIdUInt64;
  1201. {$ENDIF}
  1202. {$ENDIF}
  1203. begin
  1204. ReadBytes(LBytes, SizeOf(Int64), False);
  1205. Result := BytesToInt64(LBytes);
  1206. if AConvert then begin
  1207. {$IFDEF AVOID_URW_ERRORS}
  1208. // assigning to a local variable to avoid an "Internal error URW533" compiler
  1209. // error in Delphi 5, and an "Internal error URW699" compiler error in Delphi
  1210. // 6. Later versions seem OK without it...
  1211. h := GStack.NetworkToHost(UInt64(Result));
  1212. Result := h;
  1213. {$ELSE}
  1214. {$IFDEF HAS_TIdUInt64_QuadPart}
  1215. // assigning to a local variable if UInt64 is not a native type, or if using
  1216. // a C++Builder version that has problems with UInt64 parameters...
  1217. h.QuadPart := UInt64(Result);
  1218. h := GStack.NetworkToHost(h);
  1219. Result := Int64(h.QuadPart);
  1220. {$ELSE}
  1221. Result := Int64(GStack.NetworkToHost(UInt64(Result)));
  1222. {$ENDIF}
  1223. {$ENDIF}
  1224. end;
  1225. end;
  1226. function TIdIOHandler.ReadUInt64(AConvert: boolean): TIdUInt64;
  1227. var
  1228. LBytes: TIdBytes;
  1229. begin
  1230. ReadBytes(LBytes, SizeOf(TIdUInt64), False);
  1231. Result := BytesToUInt64(LBytes);
  1232. if AConvert then begin
  1233. Result := GStack.NetworkToHost(Result);
  1234. end;
  1235. end;
  1236. function TIdIOHandler.ReadUInt32(AConvert: Boolean): UInt32;
  1237. var
  1238. LBytes: TIdBytes;
  1239. begin
  1240. ReadBytes(LBytes, SizeOf(UInt32), False);
  1241. Result := BytesToUInt32(LBytes);
  1242. if AConvert then begin
  1243. Result := GStack.NetworkToHost(Result);
  1244. end;
  1245. end;
  1246. {$I IdDeprecatedImplBugOff.inc}
  1247. function TIdIOHandler.ReadLongWord(AConvert: Boolean): UInt32;
  1248. {$I IdDeprecatedImplBugOn.inc}
  1249. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  1250. begin
  1251. Result := ReadUInt32(AConvert);
  1252. end;
  1253. function TIdIOHandler.ReadLn(AByteEncoding: IIdTextEncoding = nil
  1254. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1255. ): string;
  1256. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  1257. begin
  1258. Result := ReadLn(LF, IdTimeoutDefault, -1, AByteEncoding
  1259. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1260. );
  1261. end;
  1262. function TIdIOHandler.ReadLn(ATerminator: string; AByteEncoding: IIdTextEncoding
  1263. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1264. ): string;
  1265. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  1266. begin
  1267. Result := ReadLn(ATerminator, IdTimeoutDefault, -1, AByteEncoding
  1268. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1269. );
  1270. end;
  1271. function TIdIOHandler.ReadLn(ATerminator: string; ATimeout: Integer = IdTimeoutDefault;
  1272. AMaxLineLength: Integer = -1; AByteEncoding: IIdTextEncoding = nil
  1273. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1274. ): string;
  1275. var
  1276. LInputBufferSize: Integer;
  1277. LStartPos: Integer;
  1278. LTermPos: Integer;
  1279. LReadLnStartTime: TIdTicks;
  1280. LTerm, LResult: TIdBytes;
  1281. begin
  1282. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  1283. {$IFDEF STRING_IS_ANSI}
  1284. ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
  1285. {$ENDIF}
  1286. if AMaxLineLength < 0 then begin
  1287. AMaxLineLength := MaxLineLength;
  1288. end;
  1289. // User may pass '' if they need to pass arguments beyond the first.
  1290. if ATerminator = '' then begin
  1291. ATerminator := LF;
  1292. end;
  1293. // TODO: encountered an email that was using charset "cp1026", which encodes
  1294. // a LF character to byte $25 instead of $0A (and decodes byte $0A to character
  1295. // #$8E instead of #$A). To account for that, don't encoding the LF using the
  1296. // specified encoding anymore, force the encoding to what it should be. But
  1297. // what if UTF-16 is being used?
  1298. {
  1299. if ATerminator = LF then begin
  1300. LTerm := ToBytes(Byte($0A));
  1301. end else begin
  1302. LTerm := ToBytes(ATerminator, AByteEncoding
  1303. {$IFDEF STRING_IS_ANSI, ADestEncoding{$ENDIF
  1304. );
  1305. end;
  1306. }
  1307. LTerm := ToBytes(ATerminator, AByteEncoding
  1308. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1309. );
  1310. FReadLnSplit := False;
  1311. FReadLnTimedOut := False;
  1312. LTermPos := -1;
  1313. LStartPos := 0;
  1314. LReadLnStartTime := Ticks64;
  1315. repeat
  1316. LInputBufferSize := FInputBuffer.Size;
  1317. if LInputBufferSize > 0 then begin
  1318. if LStartPos < LInputBufferSize then begin
  1319. LTermPos := FInputBuffer.IndexOf(LTerm, LStartPos);
  1320. end else begin
  1321. LTermPos := -1;
  1322. end;
  1323. LStartPos := IndyMax(LInputBufferSize-(Length(LTerm)-1), 0);
  1324. end;
  1325. // if the line length is limited and terminator is found after the limit or not found and the limit is exceeded
  1326. if (AMaxLineLength > 0) and ((LTermPos > AMaxLineLength) or ((LTermPos = -1) and (LStartPos > AMaxLineLength))) then begin
  1327. if MaxLineAction = maException then begin
  1328. raise EIdReadLnMaxLineLengthExceeded.Create(RSReadLnMaxLineLengthExceeded);
  1329. end;
  1330. // RLebeau: WARNING - if the line is using multibyte character sequences
  1331. // and a sequence staddles the AMaxLineLength boundary, this will chop
  1332. // the sequence, producing invalid data!
  1333. FReadLnSplit := True;
  1334. Result := FInputBuffer.ExtractToString(AMaxLineLength, AByteEncoding
  1335. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1336. );
  1337. Exit;
  1338. end
  1339. // ReadFromSource blocks - do not call unless we need to
  1340. else if LTermPos = -1 then begin
  1341. // ReadLn needs to call this as data may exist in the buffer, but no EOL yet disconnected
  1342. CheckForDisconnect(True, True);
  1343. // Can only return -1 if timeout
  1344. FReadLnTimedOut := ReadFromSource(True, ATimeout, False) = -1;
  1345. if (not FReadLnTimedOut) and (ATimeout >= 0) then begin
  1346. if GetElapsedTicks(LReadLnStartTime) >= UInt32(ATimeout) then begin
  1347. FReadLnTimedOut := True;
  1348. end;
  1349. end;
  1350. if FReadLnTimedOut then begin
  1351. Result := '';
  1352. Exit;
  1353. end;
  1354. end;
  1355. until LTermPos > -1;
  1356. // Extract actual data
  1357. {
  1358. IMPORTANT!!!
  1359. When encoding from UTF8 to Unicode or ASCII, you will not always get the same
  1360. number of bytes that you input so you may have to recalculate LTermPos since
  1361. that was based on the number of bytes in the input stream. If do not do this,
  1362. you will probably get an incorrect result or a range check error since the
  1363. string is shorter then the original buffer position.
  1364. JPM
  1365. }
  1366. // RLebeau 11/19/08: this is no longer needed as the terminator is encoded to raw bytes now ...
  1367. {
  1368. Result := FInputBuffer.Extract(LTermPos + Length(ATerminator), AEncoding);
  1369. LTermPos := IndyMin(LTermPos, Length(Result));
  1370. if (ATerminator = LF) and (LTermPos > 0) then begin
  1371. if Result[LTermPos] = CR then begin
  1372. Dec(LTermPos);
  1373. end;
  1374. end;
  1375. SetLength(Result, LTermPos);
  1376. }
  1377. FInputBuffer.ExtractToBytes(LResult, LTermPos + Length(LTerm));
  1378. if (ATerminator = LF) and (LTermPos > 0) then begin
  1379. if LResult[LTermPos-1] = Ord(CR) then begin
  1380. Dec(LTermPos);
  1381. end;
  1382. end;
  1383. Result := BytesToString(LResult, 0, LTermPos, AByteEncoding
  1384. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1385. );
  1386. end;
  1387. function TIdIOHandler.ReadLnRFC(var VMsgEnd: Boolean;
  1388. AByteEncoding: IIdTextEncoding = nil
  1389. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1390. ): string;
  1391. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  1392. begin
  1393. Result := ReadLnRFC(VMsgEnd, LF, '.', AByteEncoding {do not localize}
  1394. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1395. );
  1396. end;
  1397. function TIdIOHandler.ReadLnRFC(var VMsgEnd: Boolean; const ALineTerminator: string;
  1398. const ADelim: String = '.'; AByteEncoding: IIdTextEncoding = nil
  1399. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1400. ): string;
  1401. begin
  1402. Result := ReadLn(ALineTerminator, AByteEncoding
  1403. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1404. );
  1405. // Do not use ATerminator since always ends with . (standard)
  1406. if Result = ADelim then
  1407. begin
  1408. VMsgEnd := True;
  1409. Exit;
  1410. end;
  1411. if TextStartsWith(Result, '..') then begin {do not localize}
  1412. Delete(Result, 1, 1);
  1413. end;
  1414. VMsgEnd := False;
  1415. end;
  1416. function TIdIOHandler.ReadLnSplit(var AWasSplit: Boolean; ATerminator: string = LF;
  1417. ATimeout: Integer = IdTimeoutDefault; AMaxLineLength: Integer = -1;
  1418. AByteEncoding: IIdTextEncoding = nil
  1419. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1420. ): string;
  1421. var
  1422. FOldAction: TIdMaxLineAction;
  1423. begin
  1424. FOldAction := MaxLineAction;
  1425. MaxLineAction := maSplit;
  1426. try
  1427. Result := ReadLn(ATerminator, ATimeout, AMaxLineLength, AByteEncoding
  1428. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1429. );
  1430. AWasSplit := FReadLnSplit;
  1431. finally
  1432. MaxLineAction := FOldAction;
  1433. end;
  1434. end;
  1435. function TIdIOHandler.ReadLnWait(AFailCount: Integer = MaxInt;
  1436. AByteEncoding: IIdTextEncoding = nil
  1437. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1438. ): string;
  1439. var
  1440. LAttempts: Integer;
  1441. begin
  1442. // MtW: this is mostly used when empty lines could be sent.
  1443. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  1444. {$IFDEF STRING_IS_ANSI}
  1445. ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
  1446. {$ENDIF}
  1447. Result := '';
  1448. LAttempts := 0;
  1449. while LAttempts < AFailCount do
  1450. begin
  1451. Result := Trim(ReadLn(AByteEncoding
  1452. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1453. ));
  1454. if Length(Result) > 0 then begin
  1455. Exit;
  1456. end;
  1457. if ReadLnTimedOut then begin
  1458. raise EIdReadTimeout.Create(RSReadTimeout);
  1459. end;
  1460. Inc(LAttempts);
  1461. end;
  1462. raise EIdReadLnWaitMaxAttemptsExceeded.Create(RSReadLnWaitMaxAttemptsExceeded);
  1463. end;
  1464. function TIdIOHandler.ReadFromSource(ARaiseExceptionIfDisconnected: Boolean;
  1465. ATimeout: Integer; ARaiseExceptionOnTimeout: Boolean): Integer;
  1466. var
  1467. LByteCount: Integer;
  1468. LLastError: Integer;
  1469. LBuffer: TIdBytes;
  1470. // under ARC, convert a weak reference to a strong reference before working with it
  1471. LIntercept: TIdConnectionIntercept;
  1472. begin
  1473. if ATimeout = IdTimeoutDefault then begin
  1474. // MtW: check for 0 too, for compatibility
  1475. if (ReadTimeout = IdTimeoutDefault) or (ReadTimeout = 0) then begin
  1476. ATimeout := IdTimeoutInfinite;
  1477. end else begin
  1478. ATimeout := ReadTimeout;
  1479. end;
  1480. end;
  1481. Result := 0;
  1482. // Check here as this side may have closed the socket
  1483. CheckForDisconnect(ARaiseExceptionIfDisconnected);
  1484. if SourceIsAvailable then begin
  1485. repeat
  1486. LByteCount := 0;
  1487. // TODO: move the handling of Readable() into ReadDataFromSource() of descendant
  1488. // classes. For a plain socket, it makes sense to check for readability before
  1489. // attempting to read. Or just perform a blocking read w/ timeout applied. But for
  1490. // OpenSSL, you are not really supposed to check for readability first! You are
  1491. // supposed to attempt to read first, and then wait for new data w/ timeout only
  1492. // if OpenSSL explicitly asks you to do so after the read fails...
  1493. if Readable(ATimeout) then begin
  1494. if Opened then begin
  1495. // No need to call AntiFreeze, the Readable does that.
  1496. if SourceIsAvailable then begin
  1497. // TODO: Whey are we reallocating LBuffer every time? This
  1498. // should be a one time operation per connection.
  1499. // RLebeau: because the Intercept does not allow the buffer
  1500. // size to be specified, and the Intercept could potentially
  1501. // resize the buffer...
  1502. SetLength(LBuffer, RecvBufferSize);
  1503. try
  1504. LByteCount := ReadDataFromSource(LBuffer);
  1505. if LByteCount > 0 then begin
  1506. SetLength(LBuffer, LByteCount);
  1507. LIntercept := Intercept;
  1508. if LIntercept <> nil then begin
  1509. LIntercept.Receive(LBuffer);
  1510. {$IFDEF USE_OBJECT_ARC}LIntercept := nil;{$ENDIF}
  1511. LByteCount := Length(LBuffer);
  1512. end;
  1513. // Pass through LBuffer first so it can go through Intercept
  1514. //TODO: If not intercept, we can skip this step
  1515. InputBuffer.Write(LBuffer);
  1516. end;
  1517. finally
  1518. LBuffer := nil;
  1519. end;
  1520. end
  1521. else if ARaiseExceptionIfDisconnected then begin
  1522. raise EIdClosedSocket.Create(RSStatusDisconnected);
  1523. end;
  1524. end
  1525. else if ARaiseExceptionIfDisconnected then begin
  1526. raise EIdNotConnected.Create(RSNotConnected);
  1527. end;
  1528. if LByteCount < 0 then
  1529. begin
  1530. LLastError := CheckForError(LByteCount);
  1531. if LLastError = Id_WSAETIMEDOUT then begin
  1532. // Timeout
  1533. if ARaiseExceptionOnTimeout then begin
  1534. raise EIdReadTimeout.Create(RSReadTimeout);
  1535. end;
  1536. Result := -1;
  1537. Break;
  1538. end;
  1539. FClosedGracefully := True;
  1540. Close;
  1541. // Do not raise unless all data has been read by the user
  1542. if InputBufferIsEmpty and ARaiseExceptionIfDisconnected then begin
  1543. RaiseError(LLastError);
  1544. end;
  1545. LByteCount := 0;
  1546. end
  1547. else if LByteCount = 0 then begin
  1548. FClosedGracefully := True;
  1549. end;
  1550. // Check here as other side may have closed connection
  1551. CheckForDisconnect(ARaiseExceptionIfDisconnected);
  1552. Result := LByteCount;
  1553. end else begin
  1554. // Timeout
  1555. if ARaiseExceptionOnTimeout then begin
  1556. raise EIdReadTimeout.Create(RSReadTimeout);
  1557. end;
  1558. Result := -1;
  1559. Break;
  1560. end;
  1561. until (LByteCount <> 0) or (not SourceIsAvailable);
  1562. end
  1563. else if ARaiseExceptionIfDisconnected then begin
  1564. raise EIdNotConnected.Create(RSNotConnected);
  1565. end;
  1566. end;
  1567. function TIdIOHandler.CheckForDataOnSource(ATimeout: Integer = 0): Boolean;
  1568. var
  1569. LPrevSize: Integer;
  1570. begin
  1571. Result := False;
  1572. // RLebeau - Connected() might read data into the InputBuffer, thus
  1573. // leaving no data for ReadFromSource() to receive a second time,
  1574. // causing a result of False when it should be True instead. So we
  1575. // save the current size of the InputBuffer before calling Connected()
  1576. // and then compare it afterwards....
  1577. LPrevSize := InputBuffer.Size;
  1578. if Connected then begin
  1579. // return whether at least 1 byte was received
  1580. Result := (InputBuffer.Size > LPrevSize) or (ReadFromSource(False, ATimeout, False) > 0);
  1581. end;
  1582. // TODO: since Connected() just calls ReadFromSource() anyway, maybe just
  1583. // call ReadFromSource() by itself and not call Connected() at all?
  1584. // Result := ReadFromSource(False, ATimeout, False) > 0;
  1585. end;
  1586. procedure TIdIOHandler.Write(AStream: TStream; ASize: TIdStreamSize = 0;
  1587. AWriteByteCount: Boolean = FALSE);
  1588. var
  1589. LBuffer: TIdBytes;
  1590. LStreamPos: TIdStreamSize;
  1591. LBufSize: Integer;
  1592. // LBufferingStarted: Boolean;
  1593. begin
  1594. // TODO: when AWriteByteCount is false, don't calculate the Size, just keep
  1595. // sending data until the end of stream is reached. This way, we can send
  1596. // streams that are not able to report accurate Size values...
  1597. if ASize < 0 then begin //"-1" All from current position
  1598. LStreamPos := AStream.Position;
  1599. ASize := AStream.Size - LStreamPos;
  1600. //todo is this step required?
  1601. AStream.Position := LStreamPos;
  1602. end
  1603. else if ASize = 0 then begin //"0" ALL
  1604. ASize := AStream.Size;
  1605. AStream.Position := 0;
  1606. end;
  1607. //else ">0" number of bytes
  1608. // RLebeau 3/19/2006: DO NOT ENABLE WRITE BUFFERING IN THIS METHOD!
  1609. //
  1610. // When sending large streams, especially with LargeStream enabled,
  1611. // this can easily cause "Out of Memory" errors. It is the caller's
  1612. // responsibility to enable/disable write buffering as needed before
  1613. // calling one of the Write() methods.
  1614. //
  1615. // Also, forcing write buffering in this method is having major
  1616. // impacts on TIdFTP, TIdFTPServer, and TIdHTTPServer.
  1617. if AWriteByteCount then begin
  1618. if LargeStream then begin
  1619. Write(Int64(ASize));
  1620. end else begin
  1621. {$IFDEF STREAM_SIZE_64}
  1622. if ASize > High(Integer) then begin
  1623. raise EIdIOHandlerRequiresLargeStream.Create(RSRequiresLargeStream);
  1624. end;
  1625. {$ENDIF}
  1626. Write(Int32(ASize));
  1627. end;
  1628. end;
  1629. BeginWork(wmWrite, ASize);
  1630. try
  1631. SetLength(LBuffer, FSendBufferSize);
  1632. while ASize > 0 do begin
  1633. LBufSize := IndyMin(ASize, Length(LBuffer));
  1634. // Do not use ReadBuffer. Some source streams are real time and will not
  1635. // return as much data as we request. Kind of like recv()
  1636. // NOTE: We use .Size - size must be supported even if real time
  1637. LBufSize := TIdStreamHelper.ReadBytes(AStream, LBuffer, LBufSize);
  1638. if LBufSize <= 0 then begin
  1639. raise EIdNoDataToRead.Create(RSIdNoDataToRead);
  1640. end;
  1641. Write(LBuffer, LBufSize);
  1642. // RLebeau: DoWork() is called in WriteDirect()
  1643. //DoWork(wmWrite, LBufSize);
  1644. Dec(ASize, LBufSize);
  1645. end;
  1646. finally
  1647. EndWork(wmWrite);
  1648. LBuffer := nil;
  1649. end;
  1650. end;
  1651. procedure TIdIOHandler.ReadBytes(var VBuffer: TIdBytes; AByteCount: Integer; AAppend: Boolean = True);
  1652. begin
  1653. Assert(FInputBuffer<>nil);
  1654. if AByteCount > 0 then begin
  1655. // Read from stack until we have enough data
  1656. while FInputBuffer.Size < AByteCount do begin
  1657. // RLebeau: in case the other party disconnects
  1658. // after all of the bytes were transmitted ok.
  1659. // No need to throw an exception just yet...
  1660. if ReadFromSource(False) > 0 then begin
  1661. if FInputBuffer.Size >= AByteCount then begin
  1662. Break; // we have enough data now
  1663. end;
  1664. end;
  1665. CheckForDisconnect(True, True);
  1666. end;
  1667. FInputBuffer.ExtractToBytes(VBuffer, AByteCount, AAppend);
  1668. end else if AByteCount < 0 then begin
  1669. // Return whatever data is currently in the InputBuffer
  1670. if InputBufferIsEmpty then begin
  1671. // Read whatever data is currently on the stack
  1672. ReadFromSource(False, ReadTimeout, False);
  1673. CheckForDisconnect(True, True);
  1674. end;
  1675. FInputBuffer.ExtractToBytes(VBuffer, -1, AAppend);
  1676. end;
  1677. end;
  1678. procedure TIdIOHandler.WriteLn(AEncoding: IIdTextEncoding = nil);
  1679. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  1680. begin
  1681. {$IFNDEF VCL_6_OR_ABOVE}
  1682. // RLebeau: in Delphi 5, explicitly specifying the nil value for the third
  1683. // parameter causes a "There is no overloaded version of 'WriteLn' that can
  1684. // be called with these arguments" compiler error. Must be a compiler bug,
  1685. // because it compiles fine in Delphi 6. The parameter value is nil by default
  1686. // anyway, so we don't really need to specify it here at all, but I'm documenting
  1687. // this so we know for future reference...
  1688. //
  1689. WriteLn('', AEncoding);
  1690. {$ELSE}
  1691. WriteLn('', AEncoding{$IFDEF STRING_IS_ANSI}, nil{$ENDIF});
  1692. {$ENDIF}
  1693. end;
  1694. procedure TIdIOHandler.WriteLn(const AOut: string;
  1695. AByteEncoding: IIdTextEncoding = nil
  1696. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  1697. );
  1698. begin
  1699. // TODO: RLebeau 1/2/2015: encountered an email that was using charset "cp1026",
  1700. // which encodes a LF character to byte $25 instead of $0A (and decodes
  1701. // byte $0A to character #$8E instead of #$A). To account for that, don't
  1702. // encoding the CRLF using the specified encoding anymore, force the encoding
  1703. // to what it should be...
  1704. //
  1705. // But, what to do if the target encoding is UTF-16?
  1706. {
  1707. Write(AOut, AByteEncoding{$IFDEF STRING_IS_ANSI, ASrcEncoding{$ENDIF);
  1708. Write(EOL, Indy8BitEncoding{$IFDEF STRING_IS_ANSI, Indy8BitEncoding{$ENDIF);
  1709. }
  1710. // Do as one write so it only makes one call to network
  1711. Write(AOut + EOL, AByteEncoding
  1712. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  1713. );
  1714. end;
  1715. procedure TIdIOHandler.WriteLnRFC(const AOut: string = '';
  1716. AByteEncoding: IIdTextEncoding = nil
  1717. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  1718. );
  1719. begin
  1720. if TextStartsWith(AOut, '.') then begin {do not localize}
  1721. WriteLn('.' + AOut, AByteEncoding {do not localize}
  1722. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  1723. );
  1724. end else begin
  1725. WriteLn(AOut, AByteEncoding
  1726. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  1727. );
  1728. end;
  1729. end;
  1730. function TIdIOHandler.Readable(AMSec: Integer): Boolean;
  1731. begin
  1732. // In case descendant does not override this or other methods but implements the higher level
  1733. // methods
  1734. Result := False;
  1735. end;
  1736. procedure TIdIOHandler.SetHost(const AValue: string);
  1737. begin
  1738. FHost := AValue;
  1739. end;
  1740. procedure TIdIOHandler.SetPort(AValue: Integer);
  1741. begin
  1742. FPort := AValue;
  1743. end;
  1744. function TIdIOHandler.Connected: Boolean;
  1745. begin
  1746. CheckForDisconnect(False);
  1747. Result :=
  1748. (
  1749. (
  1750. // Set when closed properly. Reflects actual socket state.
  1751. (not ClosedGracefully)
  1752. // Created on Open. Prior to Open ClosedGracefully is still false.
  1753. and (FInputBuffer <> nil)
  1754. )
  1755. // Buffer must be empty. Even if closed, we are "connected" if we still have
  1756. // data
  1757. or (not InputBufferIsEmpty)
  1758. )
  1759. and Opened;
  1760. end;
  1761. // TODO: move this into IdGlobal.pas
  1762. procedure AdjustStreamSize(const AStream: TStream; const ASize: TIdStreamSize);
  1763. var
  1764. LStreamPos: TIdStreamSize;
  1765. begin
  1766. LStreamPos := AStream.Position;
  1767. AStream.Size := ASize;
  1768. // Must reset to original value in cases where size changes position
  1769. if AStream.Position <> LStreamPos then begin
  1770. AStream.Position := LStreamPos;
  1771. end;
  1772. end;
  1773. procedure TIdIOHandler.ReadStream(AStream: TStream; AByteCount: TIdStreamSize;
  1774. AReadUntilDisconnect: Boolean);
  1775. var
  1776. LByteCount, LPos: TIdStreamSize;
  1777. {$IFNDEF STREAM_SIZE_64}
  1778. LTmp: Int64;
  1779. {$ENDIF}
  1780. procedure CheckInputBufferForData;
  1781. var
  1782. i: Integer;
  1783. begin
  1784. i := FInputBuffer.Size;
  1785. if i > 0 then begin
  1786. if not AReadUntilDisconnect then begin
  1787. i := IndyMin(FInputBuffer.Size, LByteCount);
  1788. Dec(LByteCount, i);
  1789. end;
  1790. if AStream <> nil then begin
  1791. FInputBuffer.ExtractToStream(AStream, i);
  1792. end else begin
  1793. FInputBuffer.Remove(i);
  1794. end;
  1795. end;
  1796. end;
  1797. const
  1798. cSizeUnknown = -1;
  1799. begin
  1800. if (AByteCount = cSizeUnknown) and (not AReadUntilDisconnect) then begin
  1801. // Read size from connection
  1802. if LargeStream then begin
  1803. {$IFDEF STREAM_SIZE_64}
  1804. LByteCount := ReadInt64;
  1805. {$ELSE}
  1806. // TODO: if the peer is sending more than 2GB of data, don't fail
  1807. // here, just read it all in a loop until finished...
  1808. LTmp := ReadInt64;
  1809. if LTmp > MaxInt then begin
  1810. raise EIdIOHandlerStreamDataTooLarge.Create(RSDataTooLarge);
  1811. end;
  1812. LByteCount := TIdStreamSize(LTmp);
  1813. {$ENDIF}
  1814. end else begin
  1815. LByteCount := ReadInt32;
  1816. end;
  1817. end else begin
  1818. LByteCount := AByteCount;
  1819. end;
  1820. // Presize stream if we know the size - this reduces memory/disk allocations to one time.
  1821. // TODO: need to add an option for this. user might not want to presize here, eg for reading
  1822. // int64 files, or when filling a manually-sized file using multiple threads.
  1823. if (AStream <> nil) and (LByteCount > -1) then begin
  1824. LPos := AStream.Position;
  1825. if (High(TIdStreamSize) - LPos) < LByteCount then begin
  1826. raise EIdIOHandlerStreamDataTooLarge.Create(RSDataTooLarge);
  1827. end;
  1828. AdjustStreamSize(AStream, LPos + LByteCount);
  1829. end;
  1830. if (LByteCount <= cSizeUnknown) and (not AReadUntilDisconnect) then begin
  1831. AReadUntilDisconnect := True;
  1832. end;
  1833. if AReadUntilDisconnect then begin
  1834. BeginWork(wmRead);
  1835. end else begin
  1836. BeginWork(wmRead, LByteCount);
  1837. end;
  1838. try
  1839. // If data already exists in the buffer, write it out first.
  1840. CheckInputBufferForData;
  1841. // RLebeau - don't call Connected() here! It can cause an
  1842. // EIdConnClosedGracefully exception that breaks the loop
  1843. // prematurely and thus leave unread bytes in the InputBuffer.
  1844. // Let the loop handle disconnects before exiting...
  1845. // RLebeau 5/21/2019: rewritting this method to no longer use
  1846. // ReadBytes(), to avoid side-effects of an FMX issue with catching
  1847. // and reraising exceptions here during TIdFTP data transfers on iOS,
  1848. // per this blog:
  1849. //
  1850. // https://www.delphiworlds.com/2013/10/fixing-tidftp-for-ios-devices/
  1851. //
  1852. // Besides, using ReadBytes() with exception handling here was always
  1853. // an ugly hack that we wanted to get rid of anyway, now its gone...
  1854. while AReadUntilDisconnect or (LByteCount > 0) do begin
  1855. try
  1856. // Read from stack to get more data
  1857. if ReadFromSource(not AReadUntilDisconnect) < 1 then begin
  1858. CheckForDisconnect(False);
  1859. Break;
  1860. end;
  1861. TIdAntiFreezeBase.DoProcess;
  1862. finally
  1863. CheckInputBufferForData;
  1864. end;
  1865. end;
  1866. finally
  1867. EndWork(wmRead);
  1868. if AStream <> nil then begin
  1869. if AStream.Size > AStream.Position then begin
  1870. AStream.Size := AStream.Position;
  1871. end;
  1872. end;
  1873. end;
  1874. end;
  1875. procedure TIdIOHandler.Discard(AByteCount: Int64);
  1876. var
  1877. LSize: Integer;
  1878. begin
  1879. Assert(AByteCount >= 0);
  1880. if AByteCount > 0 then
  1881. begin
  1882. BeginWork(wmRead, AByteCount);
  1883. try
  1884. repeat
  1885. LSize := iif(AByteCount < MaxInt, Integer(AByteCount), MaxInt);
  1886. LSize := IndyMin(LSize, FInputBuffer.Size);
  1887. if LSize > 0 then begin
  1888. FInputBuffer.Remove(LSize);
  1889. Dec(AByteCount, LSize);
  1890. if AByteCount < 1 then begin
  1891. Break;
  1892. end;
  1893. end;
  1894. // RLebeau: in case the other party disconnects
  1895. // after all of the bytes were transmitted ok.
  1896. // No need to throw an exception just yet...
  1897. if ReadFromSource(False) < 1 then begin
  1898. CheckForDisconnect(True, True);
  1899. end;
  1900. until False;
  1901. finally
  1902. EndWork(wmRead);
  1903. end;
  1904. end;
  1905. end;
  1906. procedure TIdIOHandler.DiscardAll;
  1907. begin
  1908. BeginWork(wmRead);
  1909. try
  1910. // If data already exists in the buffer, discard it first.
  1911. FInputBuffer.Clear;
  1912. // RLebeau - don't call Connected() here! ReadBytes() already
  1913. // does that internally. Calling Connected() here can cause an
  1914. // EIdConnClosedGracefully exception that breaks the loop
  1915. // prematurely and thus leave unread bytes in the InputBuffer.
  1916. // Let the loop catch the exception before exiting...
  1917. repeat
  1918. //TODO: Improve this - dont like the use of the exception handler
  1919. try
  1920. if ReadFromSource(False) > 0 then begin
  1921. FInputBuffer.Clear;
  1922. end else begin;
  1923. CheckForDisconnect(True, True);
  1924. end;
  1925. except
  1926. on E: Exception do begin
  1927. // RLebeau - ReadFromSource() could have filled the
  1928. // InputBuffer with more bytes...
  1929. FInputBuffer.Clear;
  1930. if E is EIdConnClosedGracefully then begin
  1931. Break;
  1932. end else begin
  1933. raise;
  1934. end;
  1935. end;
  1936. end;
  1937. TIdAntiFreezeBase.DoProcess;
  1938. until False;
  1939. finally
  1940. EndWork(wmRead);
  1941. end;
  1942. end;
  1943. procedure TIdIOHandler.RaiseConnClosedGracefully;
  1944. begin
  1945. (* ************************************************************* //
  1946. ------ If you receive an exception here, please read. ----------
  1947. If this is a SERVER
  1948. -------------------
  1949. The client has disconnected the socket normally and this exception is used to notify the
  1950. server handling code. This exception is normal and will only happen from within the IDE, not
  1951. while your program is running as an EXE. If you do not want to see this, add this exception
  1952. or EIdSilentException to the IDE options as exceptions not to break on.
  1953. From the IDE just hit F9 again and Indy will catch and handle the exception.
  1954. Please see the FAQ and help file for possible further information.
  1955. The FAQ is at http://www.nevrona.com/Indy/FAQ.html
  1956. If this is a CLIENT
  1957. -------------------
  1958. The server side of this connection has disconnected normaly but your client has attempted
  1959. to read or write to the connection. You should trap this error using a try..except.
  1960. Please see the help file for possible further information.
  1961. // ************************************************************* *)
  1962. raise EIdConnClosedGracefully.Create(RSConnectionClosedGracefully);
  1963. end;
  1964. function TIdIOHandler.InputBufferAsString(AByteEncoding: IIdTextEncoding = nil
  1965. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1966. ): string;
  1967. begin
  1968. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  1969. {$IFDEF STRING_IS_ANSI}
  1970. ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
  1971. {$ENDIF}
  1972. Result := FInputBuffer.ExtractToString(FInputBuffer.Size, AByteEncoding
  1973. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1974. );
  1975. end;
  1976. function TIdIOHandler.AllData(AByteEncoding: IIdTextEncoding = nil
  1977. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1978. ): string;
  1979. var
  1980. LBytes: Integer;
  1981. begin
  1982. Result := '';
  1983. BeginWork(wmRead);
  1984. try
  1985. if Connected then
  1986. begin
  1987. try
  1988. try
  1989. repeat
  1990. LBytes := ReadFromSource(False, 250, False);
  1991. until LBytes = 0; // -1 on timeout
  1992. finally
  1993. if not InputBufferIsEmpty then begin
  1994. Result := InputBufferAsString(AByteEncoding
  1995. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1996. );
  1997. end;
  1998. end;
  1999. except end;
  2000. end;
  2001. finally
  2002. EndWork(wmRead);
  2003. end;
  2004. end;
  2005. procedure TIdIOHandler.PerformCapture(const ADest: TObject;
  2006. out VLineCount: Integer; const ADelim: string;
  2007. AUsesDotTransparency: Boolean; AByteEncoding: IIdTextEncoding = nil
  2008. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  2009. );
  2010. var
  2011. s: string;
  2012. LStream: TStream;
  2013. LStrings: TStrings;
  2014. begin
  2015. VLineCount := 0;
  2016. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  2017. {$IFDEF STRING_IS_ANSI}
  2018. ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
  2019. {$ENDIF}
  2020. LStream := nil;
  2021. LStrings := nil;
  2022. if ADest is TStrings then begin
  2023. LStrings := TStrings(ADest);
  2024. end
  2025. else if ADest is TStream then begin
  2026. LStream := TStream(ADest);
  2027. end
  2028. else begin
  2029. raise EIdObjectTypeNotSupported.Create(RSObjectTypeNotSupported);
  2030. end;
  2031. BeginWork(wmRead);
  2032. try
  2033. if LStrings <> nil then begin
  2034. LStrings.BeginUpdate;
  2035. end;
  2036. try
  2037. repeat
  2038. s := ReadLn(AByteEncoding
  2039. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  2040. );
  2041. if s = ADelim then begin
  2042. Exit;
  2043. end;
  2044. // S.G. 6/4/2004: All the consumers to protect themselves against memory allocation attacks
  2045. if FMaxCapturedLines > 0 then begin
  2046. if VLineCount > FMaxCapturedLines then begin
  2047. raise EIdMaxCaptureLineExceeded.Create(RSMaximumNumberOfCaptureLineExceeded);
  2048. end;
  2049. end;
  2050. // For RFC retrieves that use dot transparency
  2051. // No length check necessary, if only one byte it will be byte x + #0.
  2052. if AUsesDotTransparency then begin
  2053. if TextStartsWith(s, '..') then begin
  2054. Delete(s, 1, 1);
  2055. end;
  2056. end;
  2057. // Write to output
  2058. Inc(VLineCount);
  2059. if LStrings <> nil then begin
  2060. LStrings.Add(s);
  2061. end
  2062. else if LStream <> nil then begin
  2063. WriteStringToStream(LStream, s+EOL, AByteEncoding
  2064. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  2065. );
  2066. end;
  2067. until False;
  2068. finally
  2069. if LStrings <> nil then begin
  2070. LStrings.EndUpdate;
  2071. end;
  2072. end;
  2073. finally
  2074. EndWork(wmRead);
  2075. end;
  2076. end;
  2077. function TIdIOHandler.InputLn(const AMask: String = ''; AEcho: Boolean = True;
  2078. ATabWidth: Integer = 8; AMaxLineLength: Integer = -1;
  2079. AByteEncoding: IIdTextEncoding = nil
  2080. {$IFDEF STRING_IS_ANSI}; AAnsiEncoding: IIdTextEncoding = nil{$ENDIF}
  2081. ): String;
  2082. var
  2083. i: Integer;
  2084. LChar: Char;
  2085. LTmp: string;
  2086. begin
  2087. Result := '';
  2088. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  2089. {$IFDEF STRING_IS_ANSI}
  2090. AAnsiEncoding := iif(AAnsiEncoding, FDefAnsiEncoding, encOSDefault);
  2091. {$ENDIF}
  2092. if AMaxLineLength < 0 then begin
  2093. AMaxLineLength := MaxLineLength;
  2094. end;
  2095. repeat
  2096. LChar := ReadChar(AByteEncoding
  2097. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2098. );
  2099. i := Length(Result);
  2100. if i <= AMaxLineLength then begin
  2101. case LChar of
  2102. BACKSPACE:
  2103. begin
  2104. if i > 0 then begin
  2105. SetLength(Result, i - 1);
  2106. if AEcho then begin
  2107. Write(BACKSPACE + ' ' + BACKSPACE, AByteEncoding
  2108. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2109. );
  2110. end;
  2111. end;
  2112. end;
  2113. TAB:
  2114. begin
  2115. if ATabWidth > 0 then begin
  2116. i := ATabWidth - (i mod ATabWidth);
  2117. LTmp := StringOfChar(' ', i);
  2118. Result := Result + LTmp;
  2119. if AEcho then begin
  2120. Write(LTmp, AByteEncoding
  2121. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2122. );
  2123. end;
  2124. end else begin
  2125. Result := Result + LChar;
  2126. if AEcho then begin
  2127. Write(LChar, AByteEncoding
  2128. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2129. );
  2130. end;
  2131. end;
  2132. end;
  2133. LF: ;
  2134. CR: ;
  2135. #27: ; //ESC - currently not supported
  2136. else
  2137. Result := Result + LChar;
  2138. if AEcho then begin
  2139. if Length(AMask) = 0 then begin
  2140. Write(LChar, AByteEncoding
  2141. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2142. );
  2143. end else begin
  2144. Write(AMask, AByteEncoding
  2145. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2146. );
  2147. end;
  2148. end;
  2149. end;
  2150. end;
  2151. until LChar = LF;
  2152. // Remove CR trail
  2153. i := Length(Result);
  2154. while (i > 0) and CharIsInSet(Result, i, EOL) do begin
  2155. Dec(i);
  2156. end;
  2157. SetLength(Result, i);
  2158. if AEcho then begin
  2159. WriteLn(AByteEncoding);
  2160. end;
  2161. end;
  2162. //TODO: Add a time out (default to infinite) and event to pass data
  2163. //TODO: Add a max size argument as well.
  2164. //TODO: Add a case insensitive option
  2165. function TIdIOHandler.WaitFor(const AString: string; ARemoveFromBuffer: Boolean = True;
  2166. AInclusive: Boolean = False; AByteEncoding: IIdTextEncoding = nil;
  2167. ATimeout: Integer = IdTimeoutDefault
  2168. {$IFDEF STRING_IS_ANSI}; AAnsiEncoding: IIdTextEncoding = nil{$ENDIF}
  2169. ): string;
  2170. var
  2171. LBytes: TIdBytes;
  2172. LPos: Integer;
  2173. begin
  2174. Result := '';
  2175. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  2176. {$IFDEF STRING_IS_ANSI}
  2177. AAnsiEncoding := iif(AAnsiEncoding, FDefAnsiEncoding, encOSDefault);
  2178. {$ENDIF}
  2179. LBytes := ToBytes(AString, AByteEncoding
  2180. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2181. );
  2182. LPos := 0;
  2183. repeat
  2184. LPos := InputBuffer.IndexOf(LBytes, LPos);
  2185. if LPos <> -1 then begin
  2186. if ARemoveFromBuffer and AInclusive then begin
  2187. Result := InputBuffer.ExtractToString(LPos+Length(LBytes), AByteEncoding
  2188. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2189. );
  2190. end else begin
  2191. Result := InputBuffer.ExtractToString(LPos, AByteEncoding
  2192. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2193. );
  2194. if ARemoveFromBuffer then begin
  2195. InputBuffer.Remove(Length(LBytes));
  2196. end;
  2197. if AInclusive then begin
  2198. Result := Result + AString;
  2199. end;
  2200. end;
  2201. Exit;
  2202. end;
  2203. LPos := IndyMax(0, InputBuffer.Size - (Length(LBytes)-1));
  2204. ReadFromSource(True, ATimeout, True);
  2205. until False;
  2206. end;
  2207. procedure TIdIOHandler.Capture(ADest: TStream; AByteEncoding: IIdTextEncoding = nil
  2208. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  2209. );
  2210. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  2211. begin
  2212. Capture(ADest, '.', True, AByteEncoding {do not localize}
  2213. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  2214. );
  2215. end;
  2216. procedure TIdIOHandler.Capture(ADest: TStream; out VLineCount: Integer;
  2217. const ADelim: string = '.'; AUsesDotTransparency: Boolean = True;
  2218. AByteEncoding: IIdTextEncoding = nil
  2219. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  2220. );
  2221. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  2222. begin
  2223. PerformCapture(ADest, VLineCount, ADelim, AUsesDotTransparency, AByteEncoding
  2224. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  2225. );
  2226. end;
  2227. procedure TIdIOHandler.Capture(ADest: TStream; ADelim: string;
  2228. AUsesDotTransparency: Boolean = True; AByteEncoding: IIdTextEncoding = nil
  2229. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  2230. );
  2231. var
  2232. LLineCount: Integer;
  2233. begin
  2234. PerformCapture(ADest, LLineCount, '.', AUsesDotTransparency, AByteEncoding {do not localize}
  2235. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  2236. );
  2237. end;
  2238. procedure TIdIOHandler.Capture(ADest: TStrings; out VLineCount: Integer;
  2239. const ADelim: string = '.'; AUsesDotTransparency: Boolean = True;
  2240. AByteEncoding: IIdTextEncoding = nil
  2241. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  2242. );
  2243. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  2244. begin
  2245. PerformCapture(ADest, VLineCount, ADelim, AUsesDotTransparency, AByteEncoding
  2246. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  2247. );
  2248. end;
  2249. procedure TIdIOHandler.Capture(ADest: TStrings; AByteEncoding: IIdTextEncoding = nil
  2250. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  2251. );
  2252. var
  2253. LLineCount: Integer;
  2254. begin
  2255. PerformCapture(ADest, LLineCount, '.', True, AByteEncoding {do not localize}
  2256. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  2257. );
  2258. end;
  2259. procedure TIdIOHandler.Capture(ADest: TStrings; const ADelim: string;
  2260. AUsesDotTransparency: Boolean = True; AByteEncoding: IIdTextEncoding = nil
  2261. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  2262. );
  2263. var
  2264. LLineCount: Integer;
  2265. begin
  2266. PerformCapture(ADest, LLineCount, ADelim, AUsesDotTransparency, AByteEncoding
  2267. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  2268. );
  2269. end;
  2270. procedure TIdIOHandler.InputBufferToStream(AStream: TStream; AByteCount: Integer = -1);
  2271. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  2272. begin
  2273. FInputBuffer.ExtractToStream(AStream, AByteCount);
  2274. end;
  2275. function TIdIOHandler.InputBufferIsEmpty: Boolean;
  2276. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  2277. begin
  2278. Result := FInputBuffer.Size = 0;
  2279. end;
  2280. procedure TIdIOHandler.Write(const ABuffer: TIdBytes; const ALength: Integer = -1;
  2281. const AOffset: Integer = 0);
  2282. var
  2283. LLength: Integer;
  2284. begin
  2285. LLength := IndyLength(ABuffer, ALength, AOffset);
  2286. if LLength > 0 then begin
  2287. if FWriteBuffer = nil then begin
  2288. WriteDirect(ABuffer, LLength, AOffset);
  2289. end else begin
  2290. // Write Buffering is enabled
  2291. FWriteBuffer.Write(ABuffer, LLength, AOffset);
  2292. if (FWriteBuffer.Size >= WriteBufferThreshold) and (WriteBufferThreshold > 0) then begin
  2293. repeat
  2294. WriteBufferFlush(WriteBufferThreshold);
  2295. until FWriteBuffer.Size < WriteBufferThreshold;
  2296. end;
  2297. end;
  2298. end;
  2299. end;
  2300. procedure TIdIOHandler.WriteRFCStrings(AStrings: TStrings; AWriteTerminator: Boolean = True;
  2301. AByteEncoding: IIdTextEncoding = nil
  2302. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  2303. );
  2304. var
  2305. i: Integer;
  2306. begin
  2307. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  2308. {$IFDEF STRING_IS_ANSI}
  2309. ASrcEncoding := iif(ASrcEncoding, FDefAnsiEncoding, encOSDefault);
  2310. {$ENDIF}
  2311. for i := 0 to AStrings.Count - 1 do begin
  2312. WriteLnRFC(AStrings[i], AByteEncoding
  2313. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  2314. );
  2315. end;
  2316. if AWriteTerminator then begin
  2317. WriteLn('.', AByteEncoding
  2318. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  2319. );
  2320. end;
  2321. end;
  2322. function TIdIOHandler.WriteFile(const AFile: String; AEnableTransferFile: Boolean): Int64;
  2323. var
  2324. LStream: TStream;
  2325. {$IFDEF WIN32_OR_WIN64}
  2326. LOldErrorMode : Integer;
  2327. {$ENDIF}
  2328. begin
  2329. Result := 0;
  2330. {$IFDEF WIN32_OR_WIN64}
  2331. LOldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  2332. try
  2333. {$ENDIF}
  2334. if not FileExists(AFile) then begin
  2335. raise EIdFileNotFound.CreateFmt(RSFileNotFound, [AFile]);
  2336. end;
  2337. LStream := TIdReadFileExclusiveStream.Create(AFile);
  2338. try
  2339. Write(LStream);
  2340. Result := LStream.Size;
  2341. finally
  2342. FreeAndNil(LStream);
  2343. end;
  2344. {$IFDEF WIN32_OR_WIN64}
  2345. finally
  2346. SetErrorMode(LOldErrorMode)
  2347. end;
  2348. {$ENDIF}
  2349. end;
  2350. function TIdIOHandler.WriteBufferingActive: Boolean;
  2351. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  2352. begin
  2353. Result := FWriteBuffer <> nil;
  2354. end;
  2355. procedure TIdIOHandler.CloseGracefully;
  2356. begin
  2357. FClosedGracefully := True
  2358. end;
  2359. procedure TIdIOHandler.InterceptReceive(var VBuffer: TIdBytes);
  2360. var
  2361. // under ARC, convert a weak reference to a strong reference before working with it
  2362. LIntercept: TIdConnectionIntercept;
  2363. begin
  2364. LIntercept := Intercept;
  2365. if LIntercept <> nil then begin
  2366. LIntercept.Receive(VBuffer);
  2367. end;
  2368. end;
  2369. procedure TIdIOHandler.InitComponent;
  2370. begin
  2371. inherited InitComponent;
  2372. FRecvBufferSize := GRecvBufferSizeDefault;
  2373. FSendBufferSize := GSendBufferSizeDefault;
  2374. FMaxLineLength := IdMaxLineLengthDefault;
  2375. FMaxCapturedLines := Id_IOHandler_MaxCapturedLines;
  2376. FLargeStream := False;
  2377. FReadTimeOut := IdTimeoutDefault;
  2378. FInputBuffer := TIdBuffer.Create(BufferRemoveNotify);
  2379. FDefStringEncoding := IndyTextEncoding_ASCII;
  2380. {$IFDEF STRING_IS_ANSI}
  2381. FDefAnsiEncoding := IndyTextEncoding_OSDefault;
  2382. {$ENDIF}
  2383. end;
  2384. procedure TIdIOHandler.WriteBufferFlush;
  2385. begin
  2386. WriteBufferFlush(-1);
  2387. end;
  2388. procedure TIdIOHandler.WriteBufferOpen;
  2389. begin
  2390. WriteBufferOpen(-1);
  2391. end;
  2392. procedure TIdIOHandler.WriteDirect(const ABuffer: TIdBytes; const ALength: Integer = -1;
  2393. const AOffset: Integer = 0);
  2394. var
  2395. LTemp: TIdBytes;
  2396. LPos: Integer;
  2397. LSize: Integer;
  2398. LByteCount: Integer;
  2399. LLastError: Integer;
  2400. // under ARC, convert a weak reference to a strong reference before working with it
  2401. LIntercept: TIdConnectionIntercept;
  2402. begin
  2403. // Check if disconnected
  2404. CheckForDisconnect(True, True);
  2405. LIntercept := Intercept;
  2406. if LIntercept <> nil then begin
  2407. // TODO: pass offset/size parameters to the Intercept
  2408. // so that a copy is no longer needed here
  2409. LTemp := ToBytes(ABuffer, ALength, AOffset);
  2410. LIntercept.Send(LTemp);
  2411. {$IFDEF USE_OBJECT_ARC}LIntercept := nil;{$ENDIF}
  2412. LSize := Length(LTemp);
  2413. LPos := 0;
  2414. end else begin
  2415. LTemp := ABuffer;
  2416. LSize := IndyLength(LTemp, ALength, AOffset);
  2417. LPos := AOffset;
  2418. end;
  2419. while LSize > 0 do
  2420. begin
  2421. LByteCount := WriteDataToTarget(LTemp, LPos, LSize);
  2422. if LByteCount < 0 then
  2423. begin
  2424. LLastError := CheckForError(LByteCount);
  2425. if LLastError <> Id_WSAETIMEDOUT then begin
  2426. FClosedGracefully := True;
  2427. Close;
  2428. end;
  2429. RaiseError(LLastError);
  2430. end;
  2431. // TODO - Have a AntiFreeze param which allows the send to be split up so that process
  2432. // can be called more. Maybe a prop of the connection, MaxSendSize?
  2433. TIdAntiFreezeBase.DoProcess(False);
  2434. if LByteCount = 0 then begin
  2435. FClosedGracefully := True;
  2436. end;
  2437. // Check if other side disconnected
  2438. CheckForDisconnect;
  2439. DoWork(wmWrite, LByteCount);
  2440. Inc(LPos, LByteCount);
  2441. Dec(LSize, LByteCount);
  2442. end;
  2443. end;
  2444. initialization
  2445. finalization
  2446. FreeAndNil(GIOHandlerClassList)
  2447. end.