IdIOHandler.pas 88 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667
  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. procedure EnsureInputBytes(AByteCount: Integer);
  314. protected
  315. FClosedGracefully: Boolean;
  316. FConnectTimeout: Integer;
  317. FDestination: string;
  318. FHost: string;
  319. // IOHandlers typically receive more data than they need to complete each
  320. // request. They store this extra data in InputBuffer for future methods to
  321. // use. InputBuffer is what collects the input and keeps it if the current
  322. // method does not need all of it.
  323. //
  324. FInputBuffer: TIdBuffer;
  325. {$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FIntercept: TIdConnectionIntercept;
  326. FMaxCapturedLines: Integer;
  327. FMaxLineAction: TIdMaxLineAction;
  328. FMaxLineLength: Integer;
  329. FOpened: Boolean;
  330. FPort: Integer;
  331. FReadLnSplit: Boolean;
  332. FReadLnTimedOut: Boolean;
  333. FReadTimeOut: Integer;
  334. //TODO:
  335. FRecvBufferSize: Integer;
  336. FSendBufferSize: Integer;
  337. FWriteBuffer: TIdBuffer;
  338. FWriteBufferThreshold: Integer;
  339. FDefStringEncoding : IIdTextEncoding;
  340. {$IFDEF STRING_IS_ANSI}
  341. FDefAnsiEncoding : IIdTextEncoding;
  342. {$ENDIF}
  343. procedure SetDefStringEncoding(const AEncoding : IIdTextEncoding);
  344. {$IFDEF STRING_IS_ANSI}
  345. procedure SetDefAnsiEncoding(const AEncoding: IIdTextEncoding);
  346. {$ENDIF}
  347. //
  348. procedure BufferRemoveNotify(ASender: TObject; ABytes: Integer);
  349. function GetDestination: string; virtual;
  350. procedure InitComponent; override;
  351. procedure InterceptReceive(var VBuffer: TIdBytes);
  352. {$IFNDEF USE_OBJECT_ARC}
  353. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  354. {$ENDIF}
  355. procedure PerformCapture(const ADest: TObject; out VLineCount: Integer;
  356. const ADelim: string; AUsesDotTransparency: Boolean; AByteEncoding: IIdTextEncoding = nil
  357. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  358. ); virtual;
  359. procedure RaiseConnClosedGracefully;
  360. procedure SetDestination(const AValue: string); virtual;
  361. procedure SetHost(const AValue: string); virtual;
  362. procedure SetPort(AValue: Integer); virtual;
  363. procedure SetIntercept(AValue: TIdConnectionIntercept); virtual;
  364. // This is the main Read function which all other default implementations
  365. // use.
  366. function ReadFromSource(ARaiseExceptionIfDisconnected: Boolean = True;
  367. ATimeout: Integer = IdTimeoutDefault;
  368. ARaiseExceptionOnTimeout: Boolean = True): Integer;
  369. function ReadDataFromSource(var VBuffer: TIdBytes): Integer; virtual; abstract;
  370. function WriteDataToTarget(const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer; virtual; abstract;
  371. function SourceIsAvailable: Boolean; virtual; abstract;
  372. function CheckForError(ALastResult: Integer): Integer; virtual; abstract;
  373. procedure RaiseError(AError: Integer); virtual; abstract;
  374. public
  375. {$IFDEF WORKAROUND_INLINE_CONSTRUCTORS}
  376. constructor Create(AOwner: TComponent); reintroduce; overload;
  377. {$ENDIF}
  378. procedure AfterAccept; virtual;
  379. function Connected: Boolean; virtual;
  380. destructor Destroy; override;
  381. // CheckForDisconnect allows the implementation to check the status of the
  382. // connection at the request of the user or this base class.
  383. procedure CheckForDisconnect(ARaiseExceptionIfDisconnected: Boolean = True;
  384. AIgnoreBuffer: Boolean = False); virtual; abstract;
  385. // Does not wait or raise any exceptions. Just reads whatever data is
  386. // available (if any) into the buffer. Must NOT raise closure exceptions.
  387. // It is used to get avialable data, and check connection status. That is
  388. // it can set status flags about the connection.
  389. function CheckForDataOnSource(ATimeout: Integer = 0): Boolean; virtual;
  390. procedure Close; virtual;
  391. procedure CloseGracefully; virtual;
  392. class function MakeDefaultIOHandler(AOwner: TComponent = nil)
  393. : TIdIOHandler;
  394. class function MakeIOHandler(ABaseType: TIdIOHandlerClass;
  395. AOwner: TComponent = nil): TIdIOHandler;
  396. // Variant of MakeIOHandler() which returns nil if it cannot find a registered IOHandler
  397. class function TryMakeIOHandler(ABaseType: TIdIOHandlerClass;
  398. AOwner: TComponent = nil): TIdIOHandler;
  399. class procedure RegisterIOHandler;
  400. class procedure SetDefaultClass;
  401. function WaitFor(const AString: string; ARemoveFromBuffer: Boolean = True;
  402. AInclusive: Boolean = False; AByteEncoding: IIdTextEncoding = nil;
  403. ATimeout: Integer = IdTimeoutDefault
  404. {$IFDEF STRING_IS_ANSI}; AAnsiEncoding: IIdTextEncoding = nil{$ENDIF}
  405. ): string;
  406. // This is different than WriteDirect. WriteDirect goes
  407. // directly to the network or next level. WriteBuffer allows for buffering
  408. // using WriteBuffers. This should be the only call to WriteDirect
  409. // unless the calls that bypass this are aware of WriteBuffering or are
  410. // intended to bypass it.
  411. procedure Write(const ABuffer: TIdBytes; const ALength: Integer = -1; const AOffset: Integer = 0); overload; virtual;
  412. // This is the main write function which all other default implementations
  413. // use. If default implementations are used, this must be implemented.
  414. procedure WriteDirect(const ABuffer: TIdBytes; const ALength: Integer = -1; const AOffset: Integer = 0);
  415. //
  416. procedure Open; virtual;
  417. function Readable(AMSec: Integer = IdTimeoutDefault): Boolean; virtual;
  418. //
  419. // Optimal Extra Methods
  420. //
  421. // These methods are based on the core methods. While they can be
  422. // overridden, they are so simple that it is rare a more optimal method can
  423. // be implemented. Because of this they are not overrideable.
  424. //
  425. //
  426. // Write Methods
  427. //
  428. // Only the ones that have a hope of being better optimized in descendants
  429. // have been marked virtual
  430. procedure Write(const AOut: string; AByteEncoding: IIdTextEncoding = nil
  431. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  432. ); overload; virtual;
  433. procedure WriteLn(AEncoding: IIdTextEncoding = nil); overload;
  434. procedure WriteLn(const AOut: string; AByteEncoding: IIdTextEncoding = nil
  435. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  436. ); overload; virtual;
  437. procedure WriteLnRFC(const AOut: string = ''; AByteEncoding: IIdTextEncoding = nil
  438. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  439. ); virtual;
  440. procedure Write(AValue: TStrings; AWriteLinesCount: Boolean = False;
  441. AByteEncoding: IIdTextEncoding = nil
  442. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  443. ); overload; virtual;
  444. procedure Write(AValue: Byte); overload;
  445. procedure Write(AValue: Char; AByteEncoding: IIdTextEncoding = nil
  446. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  447. ); overload;
  448. // for iOS64, Delphi's Longint and LongWord are 64bit, so we can't rely on
  449. // Write(Longint) and ReadLongint() being 32bit anymore, for instance when
  450. // sending/reading a TStream with LargeStream=False. So adding new (U)IntX
  451. // methods and deprecating the old ones...
  452. //
  453. procedure Write(AValue: Int16; AConvert: Boolean = True); overload;
  454. procedure Write(AValue: UInt16; AConvert: Boolean = True); overload;
  455. procedure Write(AValue: Int32; AConvert: Boolean = True); overload;
  456. procedure Write(AValue: UInt32; AConvert: Boolean = True); overload;
  457. procedure Write(AValue: Int64; AConvert: Boolean = True); overload;
  458. procedure Write(AValue: TIdUInt64; AConvert: Boolean = True); overload;
  459. //
  460. procedure Write(AStream: TStream; ASize: TIdStreamSize = 0;
  461. AWriteByteCount: Boolean = False); overload; virtual;
  462. procedure WriteRFCStrings(AStrings: TStrings; AWriteTerminator: Boolean = True;
  463. AByteEncoding: IIdTextEncoding = nil
  464. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  465. );
  466. // Not overloaded because it does not have a unique type for source
  467. // and could be easily unresolvable with future additions
  468. function WriteFile(const AFile: String; AEnableTransferFile: Boolean = False): Int64; virtual;
  469. //
  470. // Read methods
  471. //
  472. function AllData(AByteEncoding: IIdTextEncoding = nil
  473. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  474. ): string; virtual;
  475. function InputLn(const AMask: string = ''; AEcho: Boolean = True;
  476. ATabWidth: Integer = 8; AMaxLineLength: Integer = -1;
  477. AByteEncoding: IIdTextEncoding = nil
  478. {$IFDEF STRING_IS_ANSI}; AAnsiEncoding: IIdTextEncoding = nil{$ENDIF}
  479. ): string; virtual;
  480. // Capture
  481. // Not virtual because each calls PerformCapture which is virtual
  482. procedure Capture(ADest: TStream; AByteEncoding: IIdTextEncoding = nil
  483. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  484. ); overload; // .Net overload
  485. procedure Capture(ADest: TStream; ADelim: string;
  486. AUsesDotTransparency: Boolean = True; AByteEncoding: IIdTextEncoding = nil
  487. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  488. ); overload;
  489. procedure Capture(ADest: TStream; out VLineCount: Integer;
  490. const ADelim: string = '.'; AUsesDotTransparency: Boolean = True;
  491. AByteEncoding: IIdTextEncoding = nil
  492. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  493. ); overload;
  494. procedure Capture(ADest: TStrings; AByteEncoding: IIdTextEncoding = nil
  495. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  496. ); overload; // .Net overload
  497. procedure Capture(ADest: TStrings; const ADelim: string;
  498. AUsesDotTransparency: Boolean = True; AByteEncoding: IIdTextEncoding = nil
  499. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  500. ); overload;
  501. procedure Capture(ADest: TStrings; out VLineCount: Integer;
  502. const ADelim: string = '.'; AUsesDotTransparency: Boolean = True;
  503. AByteEncoding: IIdTextEncoding = nil
  504. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  505. ); overload;
  506. //
  507. // Read___
  508. // Cannot overload, compiler cannot overload on return values
  509. //
  510. procedure ReadBytes(var VBuffer: TIdBytes; AByteCount: Integer; AAppend: Boolean = True); virtual;
  511. // ReadLn
  512. function ReadLn(AByteEncoding: IIdTextEncoding = nil
  513. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  514. ): string; overload; // .Net overload
  515. function ReadLn(ATerminator: string; AByteEncoding: IIdTextEncoding
  516. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  517. ): string; overload;
  518. function ReadLn(ATerminator: string; ATimeout: Integer = IdTimeoutDefault;
  519. AMaxLineLength: Integer = -1; AByteEncoding: IIdTextEncoding = nil
  520. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  521. ): string; overload; virtual;
  522. //RLebeau: added for RFC 822 retrieves
  523. function ReadLnRFC(var VMsgEnd: Boolean; AByteEncoding: IIdTextEncoding = nil
  524. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  525. ): string; overload;
  526. function ReadLnRFC(var VMsgEnd: Boolean; const ALineTerminator: string;
  527. const ADelim: string = '.'; AByteEncoding: IIdTextEncoding = nil
  528. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  529. ): string; overload;
  530. function ReadLnWait(AFailCount: Integer = MaxInt;
  531. AByteEncoding: IIdTextEncoding = nil
  532. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  533. ): string; virtual;
  534. // Added for retrieving lines over 16K long}
  535. function ReadLnSplit(var AWasSplit: Boolean; ATerminator: string = LF;
  536. ATimeout: Integer = IdTimeoutDefault; AMaxLineLength: Integer = -1;
  537. AByteEncoding: IIdTextEncoding = nil
  538. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  539. ): string;
  540. // Read - Simple Types
  541. function ReadChar(AByteEncoding: IIdTextEncoding = nil
  542. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  543. ): Char;
  544. function ReadByte: Byte;
  545. function ReadString(ABytes: Integer; AByteEncoding: IIdTextEncoding = nil
  546. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  547. ): string;
  548. // for iOS64, Delphi's Longint and LongWord are changed to 64bit, so we can't
  549. // rely on Write(Longint) and ReadLongint() being 32bit anymore, for instance
  550. // when sending/reading a TStream with LargeStream=False. So adding new (U)IntX
  551. // methods and deprecating the old ones...
  552. //
  553. function ReadInt16(AConvert: Boolean = True): Int16;
  554. function ReadUInt16(AConvert: Boolean = True): UInt16;
  555. function ReadInt32(AConvert: Boolean = True): Int32;
  556. function ReadUInt32(AConvert: Boolean = True): UInt32;
  557. function ReadInt64(AConvert: Boolean = True): Int64;
  558. function ReadUInt64(AConvert: Boolean = True): TIdUInt64;
  559. //
  560. function ReadSmallInt(AConvert: Boolean = True): Int16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use ReadInt16()'{$ENDIF};{$ENDIF}
  561. function ReadWord(AConvert: Boolean = True): UInt16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use ReadUInt16()'{$ENDIF};{$ENDIF}
  562. function ReadLongInt(AConvert: Boolean = True): Int32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use ReadInt32()'{$ENDIF};{$ENDIF}
  563. function ReadLongWord(AConvert: Boolean = True): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use ReadUInt32()'{$ENDIF};{$ENDIF}
  564. //
  565. procedure ReadStream(AStream: TStream; AByteCount: TIdStreamSize = -1;
  566. AReadUntilDisconnect: Boolean = False); virtual;
  567. procedure ReadStrings(ADest: TStrings; AReadLinesCount: Integer = -1;
  568. AByteEncoding: IIdTextEncoding = nil
  569. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  570. );
  571. //
  572. procedure Discard(AByteCount: Int64);
  573. procedure DiscardAll;
  574. //
  575. // WriteBuffering Methods
  576. //
  577. procedure WriteBufferCancel; virtual;
  578. procedure WriteBufferClear; virtual;
  579. procedure WriteBufferClose; virtual;
  580. procedure WriteBufferFlush; overload; //.Net overload
  581. procedure WriteBufferFlush(AByteCount: Integer); overload; virtual;
  582. procedure WriteBufferOpen; overload; //.Net overload
  583. procedure WriteBufferOpen(AThreshold: Integer); overload; virtual;
  584. function WriteBufferingActive: Boolean;
  585. //
  586. // InputBuffer Methods
  587. //
  588. function InputBufferIsEmpty: Boolean;
  589. //
  590. // These two are direct access and do no reading of connection
  591. procedure InputBufferToStream(AStream: TStream; AByteCount: Integer = -1);
  592. function InputBufferAsString(AByteEncoding: IIdTextEncoding = nil
  593. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  594. ): string;
  595. //
  596. // Properties
  597. //
  598. property ConnectTimeout: Integer read FConnectTimeout write FConnectTimeout default 0;
  599. property ClosedGracefully: Boolean read FClosedGracefully;
  600. // TODO: Need to name this consistent. Originally no access was allowed,
  601. // but new model requires it for writing. Will decide after next set
  602. // of changes are complete what to do with Buffer prop.
  603. //
  604. // Is used by SuperCore
  605. property InputBuffer: TIdBuffer read FInputBuffer;
  606. //currently an option, as LargeFile support changes the data format
  607. property LargeStream: Boolean read FLargeStream write FLargeStream;
  608. property MaxCapturedLines: Integer read FMaxCapturedLines write FMaxCapturedLines default Id_IOHandler_MaxCapturedLines;
  609. property Opened: Boolean read FOpened;
  610. property ReadTimeout: Integer read FReadTimeOut write FReadTimeOut default IdTimeoutDefault;
  611. property ReadLnTimedout: Boolean read FReadLnTimedout ;
  612. property WriteBufferThreshold: Integer read FWriteBufferThreshold;
  613. property DefStringEncoding : IIdTextEncoding read FDefStringEncoding write SetDefStringEncoding;
  614. {$IFDEF STRING_IS_ANSI}
  615. property DefAnsiEncoding : IIdTextEncoding read FDefAnsiEncoding write SetDefAnsiEncoding;
  616. {$ENDIF}
  617. //
  618. // Events
  619. //
  620. property OnWork;
  621. property OnWorkBegin;
  622. property OnWorkEnd;
  623. published
  624. property Destination: string read GetDestination write SetDestination;
  625. property Host: string read FHost write SetHost;
  626. property Intercept: TIdConnectionIntercept read FIntercept write SetIntercept;
  627. property MaxLineLength: Integer read FMaxLineLength write FMaxLineLength default IdMaxLineLengthDefault;
  628. property MaxLineAction: TIdMaxLineAction read FMaxLineAction write FMaxLineAction;
  629. property Port: Integer read FPort write SetPort;
  630. // RecvBufferSize is used by some methods that read large amounts of data.
  631. // RecvBufferSize is the amount of data that will be requested at each read
  632. // cycle. RecvBuffer is used to receive then send to the Intercepts, after
  633. // that it goes to InputBuffer
  634. property RecvBufferSize: Integer read FRecvBufferSize write FRecvBufferSize
  635. default GRecvBufferSizeDefault;
  636. // SendBufferSize is used by some methods that have to break apart large
  637. // amounts of data into smaller pieces. This is the buffer size of the
  638. // chunks that it will create and use.
  639. property SendBufferSize: Integer read FSendBufferSize write FSendBufferSize
  640. default GSendBufferSizeDefault;
  641. end;
  642. implementation
  643. uses
  644. //facilitate inlining only.
  645. {$IFDEF DOTNET}
  646. {$IFDEF USE_INLINE}
  647. System.IO,
  648. {$ENDIF}
  649. {$ENDIF}
  650. {$IFDEF WIN32_OR_WIN64}
  651. Windows,
  652. {$ENDIF}
  653. {$IFDEF USE_VCL_POSIX}
  654. {$IFDEF OSX}
  655. Macapi.CoreServices,
  656. {$ENDIF}
  657. {$ENDIF}
  658. {$IFDEF HAS_UNIT_Generics_Collections}
  659. System.Generics.Collections,
  660. {$ENDIF}
  661. IdStack, IdStackConsts, IdResourceStrings,
  662. SysUtils;
  663. type
  664. {$IFDEF HAS_GENERICS_TList}
  665. TIdIOHandlerClassList = TList<TIdIOHandlerClass>;
  666. {$ELSE}
  667. // TODO: flesh out to match TList<TIdIOHandlerClass> for non-Generics compilers
  668. TIdIOHandlerClassList = TList;
  669. {$ENDIF}
  670. var
  671. GIOHandlerClassDefault: TIdIOHandlerClass = nil;
  672. GIOHandlerClassList: TIdIOHandlerClassList = nil;
  673. { TIdIOHandler }
  674. {$IFDEF WORKAROUND_INLINE_CONSTRUCTORS}
  675. constructor TIdIOHandler.Create(AOwner: TComponent);
  676. begin
  677. inherited Create(AOwner);
  678. end;
  679. {$ENDIF}
  680. procedure TIdIOHandler.Close;
  681. //do not do FInputBuffer.Clear; here.
  682. //it breaks reading when remote connection does a disconnect
  683. var
  684. // under ARC, convert a weak reference to a strong reference before working with it
  685. LIntercept: TIdConnectionIntercept;
  686. begin
  687. try
  688. LIntercept := Intercept;
  689. if LIntercept <> nil then begin
  690. LIntercept.Disconnect;
  691. end;
  692. finally
  693. FOpened := False;
  694. WriteBufferClear;
  695. end;
  696. end;
  697. destructor TIdIOHandler.Destroy;
  698. begin
  699. Close;
  700. FreeAndNil(FInputBuffer);
  701. FreeAndNil(FWriteBuffer);
  702. inherited Destroy;
  703. end;
  704. procedure TIdIOHandler.AfterAccept;
  705. begin
  706. //
  707. end;
  708. procedure TIdIOHandler.Open;
  709. begin
  710. FOpened := False;
  711. FClosedGracefully := False;
  712. WriteBufferClear;
  713. FInputBuffer.Clear;
  714. FOpened := True;
  715. end;
  716. // under ARC, all weak references to a freed object get nil'ed automatically
  717. {$IFNDEF USE_OBJECT_ARC}
  718. procedure TIdIOHandler.Notification(AComponent: TComponent; Operation: TOperation);
  719. begin
  720. if (Operation = opRemove) and (AComponent = FIntercept) then begin
  721. FIntercept := nil;
  722. end;
  723. inherited Notification(AComponent, OPeration);
  724. end;
  725. {$ENDIF}
  726. procedure TIdIOHandler.SetIntercept(AValue: TIdConnectionIntercept);
  727. begin
  728. {$IFDEF USE_OBJECT_ARC}
  729. // under ARC, all weak references to a freed object get nil'ed automatically
  730. FIntercept := AValue;
  731. {$ELSE}
  732. if FIntercept <> AValue then begin
  733. // remove self from the Intercept's free notification list
  734. if Assigned(FIntercept) then begin
  735. FIntercept.RemoveFreeNotification(Self);
  736. end;
  737. FIntercept := AValue;
  738. // add self to the Intercept's free notification list
  739. if Assigned(AValue) then begin
  740. AValue.FreeNotification(Self);
  741. end;
  742. end;
  743. {$ENDIF}
  744. end;
  745. class procedure TIdIOHandler.SetDefaultClass;
  746. begin
  747. GIOHandlerClassDefault := Self;
  748. RegisterIOHandler;
  749. end;
  750. procedure TIdIOHandler.SetDefStringEncoding(const AEncoding: IIdTextEncoding);
  751. var
  752. LEncoding: IIdTextEncoding;
  753. begin
  754. if FDefStringEncoding <> AEncoding then
  755. begin
  756. LEncoding := AEncoding;
  757. EnsureEncoding(LEncoding);
  758. FDefStringEncoding := LEncoding;
  759. end;
  760. end;
  761. {$IFDEF STRING_IS_ANSI}
  762. procedure TIdIOHandler.SetDefAnsiEncoding(const AEncoding: IIdTextEncoding);
  763. var
  764. LEncoding: IIdTextEncoding;
  765. begin
  766. if FDefAnsiEncoding <> AEncoding then
  767. begin
  768. LEncoding := AEncoding;
  769. EnsureEncoding(LEncoding, encOSDefault);
  770. FDefAnsiEncoding := LEncoding;
  771. end;
  772. end;
  773. {$ENDIF}
  774. class function TIdIOHandler.MakeDefaultIOHandler(AOwner: TComponent = nil): TIdIOHandler;
  775. begin
  776. Result := GIOHandlerClassDefault.Create(AOwner);
  777. end;
  778. class procedure TIdIOHandler.RegisterIOHandler;
  779. begin
  780. if GIOHandlerClassList = nil then begin
  781. GIOHandlerClassList := TIdIOHandlerClassList.Create;
  782. end;
  783. {$IFNDEF DOTNET_EXCLUDE}
  784. //TODO: Reenable this. Dot net wont allow class references as objects
  785. // Use an array?
  786. if GIOHandlerClassList.IndexOf(Self) = -1 then begin
  787. GIOHandlerClassList.Add(Self);
  788. end;
  789. {$ENDIF}
  790. end;
  791. {
  792. Creates an IOHandler of type ABaseType, or descendant.
  793. }
  794. class function TIdIOHandler.MakeIOHandler(ABaseType: TIdIOHandlerClass;
  795. AOwner: TComponent = nil): TIdIOHandler;
  796. begin
  797. Result := TryMakeIOHandler(ABaseType, AOwner);
  798. if not Assigned(Result) then begin
  799. raise EIdException.CreateFmt(RSIOHandlerTypeNotInstalled, [ABaseType.ClassName]);
  800. end;
  801. end;
  802. class function TIdIOHandler.TryMakeIOHandler(ABaseType: TIdIOHandlerClass;
  803. AOwner: TComponent = nil): TIdIOHandler;
  804. var
  805. i: Integer;
  806. begin
  807. if GIOHandlerClassList <> nil then begin
  808. for i := GIOHandlerClassList.Count - 1 downto 0 do begin
  809. if TIdIOHandlerClass(GIOHandlerClassList[i]).InheritsFrom(ABaseType) then begin
  810. Result := TIdIOHandlerClass(GIOHandlerClassList[i]).Create;
  811. Exit;
  812. end;
  813. end;
  814. end;
  815. Result := nil;
  816. end;
  817. function TIdIOHandler.GetDestination: string;
  818. begin
  819. Result := FDestination;
  820. end;
  821. procedure TIdIOHandler.SetDestination(const AValue: string);
  822. begin
  823. FDestination := AValue;
  824. end;
  825. procedure TIdIOHandler.BufferRemoveNotify(ASender: TObject; ABytes: Integer);
  826. begin
  827. DoWork(wmRead, ABytes);
  828. end;
  829. procedure TIdIOHandler.WriteBufferOpen(AThreshold: Integer);
  830. begin
  831. if FWriteBuffer <> nil then begin
  832. FWriteBuffer.Clear;
  833. end else begin
  834. FWriteBuffer := TIdBuffer.Create;
  835. end;
  836. FWriteBufferThreshold := AThreshold;
  837. end;
  838. procedure TIdIOHandler.WriteBufferClose;
  839. begin
  840. try
  841. WriteBufferFlush;
  842. finally FreeAndNil(FWriteBuffer); end;
  843. end;
  844. procedure TIdIOHandler.WriteBufferFlush(AByteCount: Integer);
  845. var
  846. LBytes: TIdBytes;
  847. begin
  848. if FWriteBuffer <> nil then begin
  849. if FWriteBuffer.Size > 0 then begin
  850. FWriteBuffer.ExtractToBytes(LBytes, AByteCount);
  851. WriteDirect(LBytes);
  852. end;
  853. end;
  854. end;
  855. procedure TIdIOHandler.WriteBufferClear;
  856. begin
  857. if FWriteBuffer <> nil then begin
  858. FWriteBuffer.Clear;
  859. end;
  860. end;
  861. procedure TIdIOHandler.WriteBufferCancel;
  862. begin
  863. WriteBufferClear;
  864. WriteBufferClose;
  865. end;
  866. procedure TIdIOHandler.Write(const AOut: string; AByteEncoding: IIdTextEncoding = nil
  867. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  868. );
  869. begin
  870. if AOut <> '' then begin
  871. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  872. {$IFDEF STRING_IS_ANSI}
  873. ASrcEncoding := iif(ASrcEncoding, FDefAnsiEncoding, encOSDefault);
  874. {$ENDIF}
  875. Write(
  876. ToBytes(AOut, -1, 1, AByteEncoding
  877. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  878. )
  879. );
  880. end;
  881. end;
  882. procedure TIdIOHandler.Write(AValue: Byte);
  883. begin
  884. Write(ToBytes(AValue));
  885. end;
  886. procedure TIdIOHandler.Write(AValue: Char; AByteEncoding: IIdTextEncoding = nil
  887. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  888. );
  889. begin
  890. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  891. {$IFDEF STRING_IS_ANSI}
  892. ASrcEncoding := iif(ASrcEncoding, FDefAnsiEncoding, encOSDefault);
  893. {$ENDIF}
  894. Write(
  895. ToBytes(AValue, AByteEncoding
  896. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  897. )
  898. );
  899. end;
  900. procedure TIdIOHandler.Write(AValue: UInt32; AConvert: Boolean = True);
  901. begin
  902. if AConvert then begin
  903. AValue := GStack.HostToNetwork(AValue);
  904. end;
  905. Write(ToBytes(AValue));
  906. end;
  907. procedure TIdIOHandler.Write(AValue: Int32; AConvert: Boolean = True);
  908. begin
  909. if AConvert then begin
  910. AValue := Int32(GStack.HostToNetwork(UInt32(AValue)));
  911. end;
  912. Write(ToBytes(AValue));
  913. end;
  914. {$IFDEF DCC}
  915. {$IFNDEF VCL_7_OR_ABOVE}
  916. // RLebeau 5/13/2015: The Write(Int64) method produces an "Internal error URW533"
  917. // compiler error in Delphi 5, and an "Internal error URW699" compiler error in
  918. // Delphi 6, so need to use some workarounds for those versions...
  919. {$DEFINE AVOID_URW_ERRORS}
  920. {$ENDIF}
  921. {$ENDIF}
  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. LTemp: Int64;
  935. {$ELSE}
  936. {$IFDEF HAS_TIdUInt64_QuadPart}
  937. var
  938. LTemp: 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. LTemp := GStack.HostToNetwork(UInt64(AValue));
  948. AValue := LTemp;
  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. LTemp.QuadPart := UInt64(AValue);
  954. LTemp := GStack.HostToNetwork(LTemp);
  955. AValue := Int64(LTemp.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. procedure TIdIOHandler.EnsureInputBytes(AByteCount: Integer);
  1020. begin
  1021. Assert(FInputBuffer<>nil);
  1022. if AByteCount > 0 then begin
  1023. // Read from stack until we have enough data
  1024. while InputBuffer.Size < AByteCount do begin
  1025. // RLebeau: in case the other party disconnects
  1026. // after all of the bytes were transmitted ok.
  1027. // No need to throw an exception just yet...
  1028. if ReadFromSource(False) > 0 then begin
  1029. if InputBuffer.Size >= AByteCount then begin
  1030. Break; // we have enough data now
  1031. end;
  1032. end;
  1033. CheckForDisconnect(True, True);
  1034. end;
  1035. end
  1036. else if AByteCount < 0 then begin
  1037. if InputBufferIsEmpty then begin
  1038. // Read whatever data is currently on the stack
  1039. ReadFromSource(False, ReadTimeout, False);
  1040. CheckForDisconnect(True, True);
  1041. end;
  1042. end;
  1043. end;
  1044. function TIdIOHandler.ReadString(ABytes: Integer; AByteEncoding: IIdTextEncoding = nil
  1045. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1046. ): string;
  1047. begin
  1048. if ABytes > 0 then begin
  1049. EnsureInputBytes(ABytes);
  1050. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  1051. {$IFDEF STRING_IS_ANSI}
  1052. ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
  1053. {$ENDIF}
  1054. Result := InputBuffer.ExtractToString(ABytes, AByteEncoding
  1055. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1056. );
  1057. end else begin
  1058. Result := '';
  1059. end;
  1060. end;
  1061. procedure TIdIOHandler.ReadStrings(ADest: TStrings; AReadLinesCount: Integer = -1;
  1062. AByteEncoding: IIdTextEncoding = nil
  1063. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1064. );
  1065. var
  1066. i: Integer;
  1067. begin
  1068. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  1069. {$IFDEF STRING_IS_ANSI}
  1070. ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
  1071. {$ENDIF}
  1072. if AReadLinesCount < 0 then begin
  1073. AReadLinesCount := ReadInt32;
  1074. end;
  1075. ADest.BeginUpdate;
  1076. try
  1077. for i := 0 to AReadLinesCount - 1 do begin
  1078. ADest.Add(ReadLn(AByteEncoding
  1079. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1080. ));
  1081. end;
  1082. finally
  1083. ADest.EndUpdate;
  1084. end;
  1085. end;
  1086. function TIdIOHandler.ReadUInt16(AConvert: Boolean = True): UInt16;
  1087. begin
  1088. EnsureInputBytes(SizeOf(UInt16));
  1089. Result := InputBuffer.ExtractToUInt16(-1, AConvert);
  1090. end;
  1091. {$I IdDeprecatedImplBugOff.inc}
  1092. function TIdIOHandler.ReadWord(AConvert: Boolean = True): UInt16;
  1093. {$I IdDeprecatedImplBugOn.inc}
  1094. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  1095. begin
  1096. Result := ReadUInt16(AConvert);
  1097. end;
  1098. function TIdIOHandler.ReadInt16(AConvert: Boolean = True): Int16;
  1099. begin
  1100. EnsureInputBytes(SizeOf(Int16));
  1101. Result := Int16(InputBuffer.ExtractToUInt16(-1, AConvert));
  1102. end;
  1103. {$I IdDeprecatedImplBugOff.inc}
  1104. function TIdIOHandler.ReadSmallInt(AConvert: Boolean = True): Int16;
  1105. {$I IdDeprecatedImplBugOn.inc}
  1106. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  1107. begin
  1108. Result := ReadInt16(AConvert);
  1109. end;
  1110. function TIdIOHandler.ReadChar(AByteEncoding: IIdTextEncoding = nil
  1111. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1112. ): Char;
  1113. var
  1114. I, J, NumChars, NumBytes: Integer;
  1115. LBytes: TIdBytes;
  1116. {$IFDEF DOTNET}
  1117. LChars: array[0..1] of Char;
  1118. {$ELSE}
  1119. LChars: TIdWideChars;
  1120. {$IFDEF STRING_IS_ANSI}
  1121. LWTmp: TIdUnicodeString;
  1122. LATmp: TIdBytes;
  1123. {$ENDIF}
  1124. {$ENDIF}
  1125. begin
  1126. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  1127. {$IFDEF STRING_IS_ANSI}
  1128. ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
  1129. {$ENDIF}
  1130. // 2 Chars to handle UTF-16 surrogates
  1131. NumBytes := AByteEncoding.GetMaxByteCount(2);
  1132. SetLength(LBytes, NumBytes);
  1133. {$IFNDEF DOTNET}
  1134. SetLength(LChars, 2);
  1135. {$ENDIF}
  1136. NumChars := 0;
  1137. if NumBytes > 0 then
  1138. begin
  1139. for I := 1 to NumBytes do
  1140. begin
  1141. LBytes[I-1] := ReadByte;
  1142. NumChars := AByteEncoding.GetChars(LBytes, 0, I, LChars, 0);
  1143. if NumChars > 0 then begin
  1144. // RLebeau 10/19/2012: when Indy switched to its own UTF-8 implementation
  1145. // to avoid the MB_ERR_INVALID_CHARS flag on Windows, it accidentally broke
  1146. // this loop! Since this is not commonly used, this was not noticed until
  1147. // now. On Windows at least, GetChars() now returns >0 for an invalid
  1148. // sequence, so we have to check if any of the returned characters are the
  1149. // Unicode U+FFFD character, indicating bad data...
  1150. for J := 0 to NumChars-1 do begin
  1151. if LChars[J] = TIdWideChar($FFFD) then begin
  1152. // keep reading...
  1153. NumChars := 0;
  1154. Break;
  1155. end;
  1156. end;
  1157. if NumChars > 0 then begin
  1158. Break;
  1159. end;
  1160. end;
  1161. end;
  1162. end;
  1163. {$IFDEF STRING_IS_UNICODE}
  1164. // RLebeau: if the bytes were decoded into surrogates, the second
  1165. // surrogate is lost here, as it can't be returned unless we cache
  1166. // it somewhere for the the next ReadChar() call to retreive. Just
  1167. // raise an error for now. Users will have to update their code to
  1168. // read surrogates differently...
  1169. Assert(NumChars = 1);
  1170. Result := LChars[0];
  1171. {$ELSE}
  1172. // RLebeau: since we can only return an AnsiChar here, let's convert
  1173. // the decoded characters, surrogates and all, into their Ansi
  1174. // representation. This will have the same problem as above if the
  1175. // conversion results in a multibyte character sequence...
  1176. SetString(LWTmp, PWideChar(LChars), NumChars);
  1177. LATmp := ADestEncoding.GetBytes(LWTmp); // convert to Ansi
  1178. Assert(Length(LATmp) = 1);
  1179. Result := Char(LATmp[0]);
  1180. {$ENDIF}
  1181. end;
  1182. function TIdIOHandler.ReadByte: Byte;
  1183. begin
  1184. EnsureInputBytes(SizeOf(Byte));
  1185. Result := InputBuffer.ExtractToUInt8(-1);
  1186. end;
  1187. function TIdIOHandler.ReadInt32(AConvert: Boolean): Int32;
  1188. begin
  1189. EnsureInputBytes(SizeOf(Int32));
  1190. Result := Int32(InputBuffer.ExtractToUInt32(-1, AConvert));
  1191. end;
  1192. {$I IdDeprecatedImplBugOff.inc}
  1193. function TIdIOHandler.ReadLongInt(AConvert: Boolean): Int32;
  1194. {$I IdDeprecatedImplBugOn.inc}
  1195. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  1196. begin
  1197. Result := ReadInt32(AConvert);
  1198. end;
  1199. function TIdIOHandler.ReadInt64(AConvert: boolean): Int64;
  1200. var
  1201. LTemp: TIdUInt64;
  1202. begin
  1203. EnsureInputBytes(SizeOf(Int64));
  1204. LTemp := InputBuffer.ExtractToUInt64(-1, AConvert);
  1205. Result := Int64(LTemp{$IFDEF HAS_TIdUInt64_QuadPart}.QuadPart{$ENDIF});
  1206. end;
  1207. function TIdIOHandler.ReadUInt64(AConvert: boolean): TIdUInt64;
  1208. begin
  1209. EnsureInputBytes(SizeOf(TIdUInt64));
  1210. Result := InputBuffer.ExtractToUInt64(-1, AConvert);
  1211. end;
  1212. function TIdIOHandler.ReadUInt32(AConvert: Boolean): UInt32;
  1213. begin
  1214. EnsureInputBytes(SizeOf(UInt32));
  1215. Result := InputBuffer.ExtractToUInt32(-1, AConvert);
  1216. end;
  1217. {$I IdDeprecatedImplBugOff.inc}
  1218. function TIdIOHandler.ReadLongWord(AConvert: Boolean): UInt32;
  1219. {$I IdDeprecatedImplBugOn.inc}
  1220. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  1221. begin
  1222. Result := ReadUInt32(AConvert);
  1223. end;
  1224. function TIdIOHandler.ReadLn(AByteEncoding: IIdTextEncoding = nil
  1225. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1226. ): string;
  1227. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  1228. begin
  1229. Result := ReadLn(LF, IdTimeoutDefault, -1, AByteEncoding
  1230. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1231. );
  1232. end;
  1233. function TIdIOHandler.ReadLn(ATerminator: string; AByteEncoding: IIdTextEncoding
  1234. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1235. ): string;
  1236. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  1237. begin
  1238. Result := ReadLn(ATerminator, IdTimeoutDefault, -1, AByteEncoding
  1239. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1240. );
  1241. end;
  1242. function TIdIOHandler.ReadLn(ATerminator: string; ATimeout: Integer = IdTimeoutDefault;
  1243. AMaxLineLength: Integer = -1; AByteEncoding: IIdTextEncoding = nil
  1244. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1245. ): string;
  1246. var
  1247. LInputBufferSize: Integer;
  1248. LStartPos: Integer;
  1249. LTermPos: Integer;
  1250. LReadLnStartTime: TIdTicks;
  1251. LTerm, LResult: TIdBytes;
  1252. begin
  1253. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  1254. {$IFDEF STRING_IS_ANSI}
  1255. ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
  1256. {$ENDIF}
  1257. if AMaxLineLength < 0 then begin
  1258. AMaxLineLength := MaxLineLength;
  1259. end;
  1260. // User may pass '' if they need to pass arguments beyond the first.
  1261. if ATerminator = '' then begin
  1262. ATerminator := LF;
  1263. end;
  1264. // TODO: encountered an email that was using charset "cp1026", which encodes
  1265. // a LF character to byte $25 instead of $0A (and decodes byte $0A to character
  1266. // #$8E instead of #$A). To account for that, don't encoding the LF using the
  1267. // specified encoding anymore, force the encoding to what it should be. But
  1268. // what if UTF-16 is being used?
  1269. {
  1270. if ATerminator = LF then begin
  1271. LTerm := ToBytes(Byte($0A));
  1272. end else begin
  1273. LTerm := ToBytes(ATerminator, AByteEncoding
  1274. {$IFDEF STRING_IS_ANSI, ADestEncoding{$ENDIF
  1275. );
  1276. end;
  1277. }
  1278. LTerm := ToBytes(ATerminator, AByteEncoding
  1279. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1280. );
  1281. FReadLnSplit := False;
  1282. FReadLnTimedOut := False;
  1283. LTermPos := -1;
  1284. LStartPos := 0;
  1285. LReadLnStartTime := Ticks64;
  1286. repeat
  1287. LInputBufferSize := FInputBuffer.Size;
  1288. if LInputBufferSize > 0 then begin
  1289. if LStartPos < LInputBufferSize then begin
  1290. LTermPos := FInputBuffer.IndexOf(LTerm, LStartPos);
  1291. end else begin
  1292. LTermPos := -1;
  1293. end;
  1294. LStartPos := IndyMax(LInputBufferSize-(Length(LTerm)-1), 0);
  1295. end;
  1296. // if the line length is limited and terminator is found after the limit or not found and the limit is exceeded
  1297. if (AMaxLineLength > 0) and ((LTermPos > AMaxLineLength) or ((LTermPos = -1) and (LStartPos > AMaxLineLength))) then begin
  1298. if MaxLineAction = maException then begin
  1299. raise EIdReadLnMaxLineLengthExceeded.Create(RSReadLnMaxLineLengthExceeded);
  1300. end;
  1301. // RLebeau: WARNING - if the line is using multibyte character sequences
  1302. // and a sequence staddles the AMaxLineLength boundary, this will chop
  1303. // the sequence, producing invalid data!
  1304. FReadLnSplit := True;
  1305. Result := FInputBuffer.ExtractToString(AMaxLineLength, AByteEncoding
  1306. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1307. );
  1308. Exit;
  1309. end
  1310. // ReadFromSource blocks - do not call unless we need to
  1311. else if LTermPos = -1 then begin
  1312. // ReadLn needs to call this as data may exist in the buffer, but no EOL yet disconnected
  1313. CheckForDisconnect(True, True);
  1314. // Can only return -1 if timeout
  1315. FReadLnTimedOut := ReadFromSource(True, ATimeout, False) = -1;
  1316. if (not FReadLnTimedOut) and (ATimeout >= 0) then begin
  1317. if GetElapsedTicks(LReadLnStartTime) >= UInt32(ATimeout) then begin
  1318. FReadLnTimedOut := True;
  1319. end;
  1320. end;
  1321. if FReadLnTimedOut then begin
  1322. Result := '';
  1323. Exit;
  1324. end;
  1325. end;
  1326. until LTermPos > -1;
  1327. // Extract actual data
  1328. {
  1329. IMPORTANT!!!
  1330. When encoding from UTF8 to Unicode or ASCII, you will not always get the same
  1331. number of bytes that you input so you may have to recalculate LTermPos since
  1332. that was based on the number of bytes in the input stream. If do not do this,
  1333. you will probably get an incorrect result or a range check error since the
  1334. string is shorter then the original buffer position.
  1335. JPM
  1336. }
  1337. // RLebeau 11/19/08: this is no longer needed as the terminator is encoded to raw bytes now ...
  1338. {
  1339. Result := FInputBuffer.Extract(LTermPos + Length(ATerminator), AEncoding);
  1340. LTermPos := IndyMin(LTermPos, Length(Result));
  1341. if (ATerminator = LF) and (LTermPos > 0) then begin
  1342. if Result[LTermPos] = CR then begin
  1343. Dec(LTermPos);
  1344. end;
  1345. end;
  1346. SetLength(Result, LTermPos);
  1347. }
  1348. FInputBuffer.ExtractToBytes(LResult, LTermPos + Length(LTerm));
  1349. if (ATerminator = LF) and (LTermPos > 0) then begin
  1350. if LResult[LTermPos-1] = Ord(CR) then begin
  1351. Dec(LTermPos);
  1352. end;
  1353. end;
  1354. Result := BytesToString(LResult, 0, LTermPos, AByteEncoding
  1355. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1356. );
  1357. end;
  1358. function TIdIOHandler.ReadLnRFC(var VMsgEnd: Boolean;
  1359. AByteEncoding: IIdTextEncoding = nil
  1360. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1361. ): string;
  1362. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  1363. begin
  1364. Result := ReadLnRFC(VMsgEnd, LF, '.', AByteEncoding {do not localize}
  1365. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1366. );
  1367. end;
  1368. function TIdIOHandler.ReadLnRFC(var VMsgEnd: Boolean; const ALineTerminator: string;
  1369. const ADelim: String = '.'; AByteEncoding: IIdTextEncoding = nil
  1370. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1371. ): string;
  1372. begin
  1373. Result := ReadLn(ALineTerminator, AByteEncoding
  1374. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1375. );
  1376. // Do not use ATerminator since always ends with . (standard)
  1377. if Result = ADelim then
  1378. begin
  1379. VMsgEnd := True;
  1380. Exit;
  1381. end;
  1382. if TextStartsWith(Result, '..') then begin {do not localize}
  1383. Delete(Result, 1, 1);
  1384. end;
  1385. VMsgEnd := False;
  1386. end;
  1387. function TIdIOHandler.ReadLnSplit(var AWasSplit: Boolean; ATerminator: string = LF;
  1388. ATimeout: Integer = IdTimeoutDefault; AMaxLineLength: Integer = -1;
  1389. AByteEncoding: IIdTextEncoding = nil
  1390. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1391. ): string;
  1392. var
  1393. FOldAction: TIdMaxLineAction;
  1394. begin
  1395. FOldAction := MaxLineAction;
  1396. MaxLineAction := maSplit;
  1397. try
  1398. Result := ReadLn(ATerminator, ATimeout, AMaxLineLength, AByteEncoding
  1399. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1400. );
  1401. AWasSplit := FReadLnSplit;
  1402. finally
  1403. MaxLineAction := FOldAction;
  1404. end;
  1405. end;
  1406. function TIdIOHandler.ReadLnWait(AFailCount: Integer = MaxInt;
  1407. AByteEncoding: IIdTextEncoding = nil
  1408. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1409. ): string;
  1410. var
  1411. LAttempts: Integer;
  1412. begin
  1413. // MtW: this is mostly used when empty lines could be sent.
  1414. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  1415. {$IFDEF STRING_IS_ANSI}
  1416. ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
  1417. {$ENDIF}
  1418. Result := '';
  1419. LAttempts := 0;
  1420. while LAttempts < AFailCount do
  1421. begin
  1422. Result := Trim(ReadLn(AByteEncoding
  1423. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1424. ));
  1425. if Length(Result) > 0 then begin
  1426. Exit;
  1427. end;
  1428. if ReadLnTimedOut then begin
  1429. raise EIdReadTimeout.Create(RSReadTimeout);
  1430. end;
  1431. Inc(LAttempts);
  1432. end;
  1433. raise EIdReadLnWaitMaxAttemptsExceeded.Create(RSReadLnWaitMaxAttemptsExceeded);
  1434. end;
  1435. function TIdIOHandler.ReadFromSource(ARaiseExceptionIfDisconnected: Boolean;
  1436. ATimeout: Integer; ARaiseExceptionOnTimeout: Boolean): Integer;
  1437. var
  1438. LByteCount: Integer;
  1439. LLastError: Integer;
  1440. LBuffer: TIdBytes;
  1441. // under ARC, convert a weak reference to a strong reference before working with it
  1442. LIntercept: TIdConnectionIntercept;
  1443. begin
  1444. if ATimeout = IdTimeoutDefault then begin
  1445. // MtW: check for 0 too, for compatibility
  1446. if (ReadTimeout = IdTimeoutDefault) or (ReadTimeout = 0) then begin
  1447. ATimeout := IdTimeoutInfinite;
  1448. end else begin
  1449. ATimeout := ReadTimeout;
  1450. end;
  1451. end;
  1452. Result := 0;
  1453. // Check here as this side may have closed the socket
  1454. CheckForDisconnect(ARaiseExceptionIfDisconnected);
  1455. if SourceIsAvailable then begin
  1456. repeat
  1457. LByteCount := 0;
  1458. // TODO: move the handling of Readable() into ReadDataFromSource() of descendant
  1459. // classes. For a plain socket, it makes sense to check for readability before
  1460. // attempting to read. Or just perform a blocking read w/ timeout applied. But for
  1461. // OpenSSL, you are not really supposed to check for readability first! You are
  1462. // supposed to attempt to read first, and then wait for new data w/ timeout only
  1463. // if OpenSSL explicitly asks you to do so after the read fails...
  1464. if Readable(ATimeout) then begin
  1465. if Opened then begin
  1466. // No need to call AntiFreeze, the Readable does that.
  1467. if SourceIsAvailable then begin
  1468. // TODO: Whey are we reallocating LBuffer every time? This
  1469. // should be a one time operation per connection.
  1470. // RLebeau: because the Intercept does not allow the buffer
  1471. // size to be specified, and the Intercept could potentially
  1472. // resize the buffer...
  1473. SetLength(LBuffer, RecvBufferSize);
  1474. try
  1475. LByteCount := ReadDataFromSource(LBuffer);
  1476. if LByteCount > 0 then begin
  1477. SetLength(LBuffer, LByteCount);
  1478. LIntercept := Intercept;
  1479. if LIntercept <> nil then begin
  1480. LIntercept.Receive(LBuffer);
  1481. {$IFDEF USE_OBJECT_ARC}LIntercept := nil;{$ENDIF}
  1482. LByteCount := Length(LBuffer);
  1483. end;
  1484. // Pass through LBuffer first so it can go through Intercept
  1485. //TODO: If not intercept, we can skip this step
  1486. InputBuffer.Write(LBuffer);
  1487. end;
  1488. finally
  1489. LBuffer := nil;
  1490. end;
  1491. end
  1492. else if ARaiseExceptionIfDisconnected then begin
  1493. raise EIdClosedSocket.Create(RSStatusDisconnected);
  1494. end;
  1495. end
  1496. else if ARaiseExceptionIfDisconnected then begin
  1497. raise EIdNotConnected.Create(RSNotConnected);
  1498. end;
  1499. if LByteCount < 0 then
  1500. begin
  1501. LLastError := CheckForError(LByteCount);
  1502. if LLastError = Id_WSAETIMEDOUT then begin
  1503. // Timeout
  1504. if ARaiseExceptionOnTimeout then begin
  1505. raise EIdReadTimeout.Create(RSReadTimeout);
  1506. end;
  1507. Result := -1;
  1508. Break;
  1509. end;
  1510. FClosedGracefully := True;
  1511. Close;
  1512. // Do not raise unless all data has been read by the user
  1513. if InputBufferIsEmpty and ARaiseExceptionIfDisconnected then begin
  1514. RaiseError(LLastError);
  1515. end;
  1516. LByteCount := 0;
  1517. end
  1518. else if LByteCount = 0 then begin
  1519. FClosedGracefully := True;
  1520. end;
  1521. // Check here as other side may have closed connection
  1522. CheckForDisconnect(ARaiseExceptionIfDisconnected);
  1523. Result := LByteCount;
  1524. end else begin
  1525. // Timeout
  1526. if ARaiseExceptionOnTimeout then begin
  1527. raise EIdReadTimeout.Create(RSReadTimeout);
  1528. end;
  1529. Result := -1;
  1530. Break;
  1531. end;
  1532. until (LByteCount <> 0) or (not SourceIsAvailable);
  1533. end
  1534. else if ARaiseExceptionIfDisconnected then begin
  1535. raise EIdNotConnected.Create(RSNotConnected);
  1536. end;
  1537. end;
  1538. function TIdIOHandler.CheckForDataOnSource(ATimeout: Integer = 0): Boolean;
  1539. var
  1540. LPrevSize: Integer;
  1541. begin
  1542. Result := False;
  1543. // RLebeau - Connected() might read data into the InputBuffer, thus
  1544. // leaving no data for ReadFromSource() to receive a second time,
  1545. // causing a result of False when it should be True instead. So we
  1546. // save the current size of the InputBuffer before calling Connected()
  1547. // and then compare it afterwards....
  1548. LPrevSize := InputBuffer.Size;
  1549. if Connected then begin
  1550. // return whether at least 1 byte was received
  1551. Result := (InputBuffer.Size > LPrevSize) or (ReadFromSource(False, ATimeout, False) > 0);
  1552. end;
  1553. // TODO: since Connected() just calls ReadFromSource() anyway, maybe just
  1554. // call ReadFromSource() by itself and not call Connected() at all?
  1555. // Result := ReadFromSource(False, ATimeout, False) > 0;
  1556. end;
  1557. procedure TIdIOHandler.Write(AStream: TStream; ASize: TIdStreamSize = 0;
  1558. AWriteByteCount: Boolean = FALSE);
  1559. var
  1560. LBuffer: TIdBytes;
  1561. LStreamPos: TIdStreamSize;
  1562. LBufSize: Integer;
  1563. // LBufferingStarted: Boolean;
  1564. begin
  1565. // TODO: when AWriteByteCount is false, don't calculate the Size, just keep
  1566. // sending data until the end of stream is reached. This way, we can send
  1567. // streams that are not able to report accurate Size values...
  1568. if ASize < 0 then begin //"-1" All from current position
  1569. LStreamPos := AStream.Position;
  1570. ASize := AStream.Size - LStreamPos;
  1571. //todo is this step required?
  1572. AStream.Position := LStreamPos;
  1573. end
  1574. else if ASize = 0 then begin //"0" ALL
  1575. ASize := AStream.Size;
  1576. AStream.Position := 0;
  1577. end;
  1578. //else ">0" number of bytes
  1579. // RLebeau 3/19/2006: DO NOT ENABLE WRITE BUFFERING IN THIS METHOD!
  1580. //
  1581. // When sending large streams, especially with LargeStream enabled,
  1582. // this can easily cause "Out of Memory" errors. It is the caller's
  1583. // responsibility to enable/disable write buffering as needed before
  1584. // calling one of the Write() methods.
  1585. //
  1586. // Also, forcing write buffering in this method is having major
  1587. // impacts on TIdFTP, TIdFTPServer, and TIdHTTPServer.
  1588. if AWriteByteCount then begin
  1589. if LargeStream then begin
  1590. Write(Int64(ASize));
  1591. end else begin
  1592. {$IFDEF STREAM_SIZE_64}
  1593. if ASize > High(Integer) then begin
  1594. raise EIdIOHandlerRequiresLargeStream.Create(RSRequiresLargeStream);
  1595. end;
  1596. {$ENDIF}
  1597. Write(Int32(ASize));
  1598. end;
  1599. end;
  1600. BeginWork(wmWrite, ASize);
  1601. try
  1602. SetLength(LBuffer, FSendBufferSize);
  1603. while ASize > 0 do begin
  1604. LBufSize := IndyMin(ASize, Length(LBuffer));
  1605. // Do not use ReadBuffer. Some source streams are real time and will not
  1606. // return as much data as we request. Kind of like recv()
  1607. // NOTE: We use .Size - size must be supported even if real time
  1608. LBufSize := TIdStreamHelper.ReadBytes(AStream, LBuffer, LBufSize);
  1609. if LBufSize <= 0 then begin
  1610. raise EIdNoDataToRead.Create(RSIdNoDataToRead);
  1611. end;
  1612. Write(LBuffer, LBufSize);
  1613. // RLebeau: DoWork() is called in WriteDirect()
  1614. //DoWork(wmWrite, LBufSize);
  1615. Dec(ASize, LBufSize);
  1616. end;
  1617. finally
  1618. EndWork(wmWrite);
  1619. LBuffer := nil;
  1620. end;
  1621. end;
  1622. procedure TIdIOHandler.ReadBytes(var VBuffer: TIdBytes; AByteCount: Integer; AAppend: Boolean = True);
  1623. begin
  1624. EnsureInputBytes(AByteCount);
  1625. InputBuffer.ExtractToBytes(VBuffer, AByteCount, AAppend);
  1626. end;
  1627. procedure TIdIOHandler.WriteLn(AEncoding: IIdTextEncoding = nil);
  1628. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  1629. begin
  1630. {$IFNDEF VCL_6_OR_ABOVE}
  1631. // RLebeau: in Delphi 5, explicitly specifying the nil value for the third
  1632. // parameter causes a "There is no overloaded version of 'WriteLn' that can
  1633. // be called with these arguments" compiler error. Must be a compiler bug,
  1634. // because it compiles fine in Delphi 6. The parameter value is nil by default
  1635. // anyway, so we don't really need to specify it here at all, but I'm documenting
  1636. // this so we know for future reference...
  1637. //
  1638. WriteLn('', AEncoding);
  1639. {$ELSE}
  1640. WriteLn('', AEncoding{$IFDEF STRING_IS_ANSI}, nil{$ENDIF});
  1641. {$ENDIF}
  1642. end;
  1643. procedure TIdIOHandler.WriteLn(const AOut: string;
  1644. AByteEncoding: IIdTextEncoding = nil
  1645. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  1646. );
  1647. begin
  1648. // TODO: RLebeau 1/2/2015: encountered an email that was using charset "cp1026",
  1649. // which encodes a LF character to byte $25 instead of $0A (and decodes
  1650. // byte $0A to character #$8E instead of #$A). To account for that, don't
  1651. // encoding the CRLF using the specified encoding anymore, force the encoding
  1652. // to what it should be...
  1653. //
  1654. // But, what to do if the target encoding is UTF-16?
  1655. {
  1656. Write(AOut, AByteEncoding{$IFDEF STRING_IS_ANSI, ASrcEncoding{$ENDIF);
  1657. Write(EOL, Indy8BitEncoding{$IFDEF STRING_IS_ANSI, Indy8BitEncoding{$ENDIF);
  1658. }
  1659. // Do as one write so it only makes one call to network
  1660. Write(AOut + EOL, AByteEncoding
  1661. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  1662. );
  1663. end;
  1664. procedure TIdIOHandler.WriteLnRFC(const AOut: string = '';
  1665. AByteEncoding: IIdTextEncoding = nil
  1666. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  1667. );
  1668. begin
  1669. if TextStartsWith(AOut, '.') then begin {do not localize}
  1670. WriteLn('.' + AOut, AByteEncoding {do not localize}
  1671. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  1672. );
  1673. end else begin
  1674. WriteLn(AOut, AByteEncoding
  1675. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  1676. );
  1677. end;
  1678. end;
  1679. function TIdIOHandler.Readable(AMSec: Integer): Boolean;
  1680. begin
  1681. // In case descendant does not override this or other methods but implements the higher level
  1682. // methods
  1683. Result := False;
  1684. end;
  1685. procedure TIdIOHandler.SetHost(const AValue: string);
  1686. begin
  1687. FHost := AValue;
  1688. end;
  1689. procedure TIdIOHandler.SetPort(AValue: Integer);
  1690. begin
  1691. FPort := AValue;
  1692. end;
  1693. function TIdIOHandler.Connected: Boolean;
  1694. begin
  1695. CheckForDisconnect(False);
  1696. Result :=
  1697. (
  1698. (
  1699. // Set when closed properly. Reflects actual socket state.
  1700. (not ClosedGracefully)
  1701. // Created on Open. Prior to Open ClosedGracefully is still false.
  1702. and (FInputBuffer <> nil)
  1703. )
  1704. // Buffer must be empty. Even if closed, we are "connected" if we still have
  1705. // data
  1706. or (not InputBufferIsEmpty)
  1707. )
  1708. and Opened;
  1709. end;
  1710. // TODO: move this into IdGlobal.pas
  1711. procedure AdjustStreamSize(const AStream: TStream; const ASize: TIdStreamSize);
  1712. var
  1713. LStreamPos: TIdStreamSize;
  1714. begin
  1715. LStreamPos := AStream.Position;
  1716. AStream.Size := ASize;
  1717. // Must reset to original value in cases where size changes position
  1718. if AStream.Position <> LStreamPos then begin
  1719. AStream.Position := LStreamPos;
  1720. end;
  1721. end;
  1722. procedure TIdIOHandler.ReadStream(AStream: TStream; AByteCount: TIdStreamSize;
  1723. AReadUntilDisconnect: Boolean);
  1724. var
  1725. LByteCount, LPos: TIdStreamSize;
  1726. {$IFNDEF STREAM_SIZE_64}
  1727. LTmp: Int64;
  1728. {$ENDIF}
  1729. procedure CheckInputBufferForData;
  1730. var
  1731. i: Integer;
  1732. begin
  1733. i := FInputBuffer.Size;
  1734. if i > 0 then begin
  1735. if not AReadUntilDisconnect then begin
  1736. i := Integer(IndyMin(TIdStreamSize(i), LByteCount));
  1737. Dec(LByteCount, i);
  1738. end;
  1739. if AStream <> nil then begin
  1740. FInputBuffer.ExtractToStream(AStream, i);
  1741. end else begin
  1742. FInputBuffer.Remove(i);
  1743. end;
  1744. end;
  1745. end;
  1746. const
  1747. cSizeUnknown = -1;
  1748. begin
  1749. if (AByteCount = cSizeUnknown) and (not AReadUntilDisconnect) then begin
  1750. // Read size from connection
  1751. if LargeStream then begin
  1752. {$IFDEF STREAM_SIZE_64}
  1753. LByteCount := ReadInt64;
  1754. {$ELSE}
  1755. // TODO: if the peer is sending more than 2GB of data, don't fail
  1756. // here, just read it all in a loop until finished...
  1757. LTmp := ReadInt64;
  1758. if LTmp > MaxInt then begin
  1759. raise EIdIOHandlerStreamDataTooLarge.Create(RSDataTooLarge);
  1760. end;
  1761. LByteCount := TIdStreamSize(LTmp);
  1762. {$ENDIF}
  1763. end else begin
  1764. LByteCount := ReadInt32;
  1765. end;
  1766. end else begin
  1767. LByteCount := AByteCount;
  1768. end;
  1769. // Presize stream if we know the size - this reduces memory/disk allocations to one time.
  1770. // TODO: need to add an option for this. user might not want to presize here, eg for reading
  1771. // int64 files, or when filling a manually-sized file using multiple threads.
  1772. if (AStream <> nil) and (LByteCount > -1) then begin
  1773. LPos := AStream.Position;
  1774. if (High(TIdStreamSize) - LPos) < LByteCount then begin
  1775. raise EIdIOHandlerStreamDataTooLarge.Create(RSDataTooLarge);
  1776. end;
  1777. AdjustStreamSize(AStream, LPos + LByteCount);
  1778. end;
  1779. if (LByteCount <= cSizeUnknown) and (not AReadUntilDisconnect) then begin
  1780. AReadUntilDisconnect := True;
  1781. end;
  1782. if AReadUntilDisconnect then begin
  1783. BeginWork(wmRead);
  1784. end else begin
  1785. BeginWork(wmRead, LByteCount);
  1786. end;
  1787. try
  1788. // If data already exists in the buffer, write it out first.
  1789. CheckInputBufferForData;
  1790. // RLebeau - don't call Connected() here! It can cause an
  1791. // EIdConnClosedGracefully exception that breaks the loop
  1792. // prematurely and thus leave unread bytes in the InputBuffer.
  1793. // Let the loop handle disconnects before exiting...
  1794. // RLebeau 5/21/2019: rewritting this method to no longer use
  1795. // ReadBytes(), to avoid side-effects of an FMX issue with catching
  1796. // and reraising exceptions here during TIdFTP data transfers on iOS,
  1797. // per this blog:
  1798. //
  1799. // https://www.delphiworlds.com/2013/10/fixing-tidftp-for-ios-devices/
  1800. //
  1801. // Besides, using ReadBytes() with exception handling here was always
  1802. // an ugly hack that we wanted to get rid of anyway, now its gone...
  1803. while AReadUntilDisconnect or (LByteCount > 0) do begin
  1804. try
  1805. // Read from stack to get more data
  1806. if ReadFromSource(not AReadUntilDisconnect) < 1 then begin
  1807. CheckForDisconnect(False);
  1808. Break;
  1809. end;
  1810. TIdAntiFreezeBase.DoProcess;
  1811. finally
  1812. CheckInputBufferForData;
  1813. end;
  1814. end;
  1815. finally
  1816. EndWork(wmRead);
  1817. if AStream <> nil then begin
  1818. if AStream.Size > AStream.Position then begin
  1819. AStream.Size := AStream.Position;
  1820. end;
  1821. end;
  1822. end;
  1823. end;
  1824. procedure TIdIOHandler.Discard(AByteCount: Int64);
  1825. var
  1826. LSize: Integer;
  1827. begin
  1828. Assert(AByteCount >= 0);
  1829. if AByteCount > 0 then
  1830. begin
  1831. BeginWork(wmRead, AByteCount);
  1832. try
  1833. repeat
  1834. LSize := iif(AByteCount < MaxInt, Integer(AByteCount), MaxInt);
  1835. LSize := IndyMin(LSize, FInputBuffer.Size);
  1836. if LSize > 0 then begin
  1837. FInputBuffer.Remove(LSize);
  1838. Dec(AByteCount, LSize);
  1839. if AByteCount < 1 then begin
  1840. Break;
  1841. end;
  1842. end;
  1843. // RLebeau: in case the other party disconnects
  1844. // after all of the bytes were transmitted ok.
  1845. // No need to throw an exception just yet...
  1846. if ReadFromSource(False) < 1 then begin
  1847. CheckForDisconnect(True, True);
  1848. end;
  1849. until False;
  1850. finally
  1851. EndWork(wmRead);
  1852. end;
  1853. end;
  1854. end;
  1855. procedure TIdIOHandler.DiscardAll;
  1856. begin
  1857. BeginWork(wmRead);
  1858. try
  1859. // If data already exists in the buffer, discard it first.
  1860. FInputBuffer.Clear;
  1861. // RLebeau - don't call Connected() here! ReadBytes() already
  1862. // does that internally. Calling Connected() here can cause an
  1863. // EIdConnClosedGracefully exception that breaks the loop
  1864. // prematurely and thus leave unread bytes in the InputBuffer.
  1865. // Let the loop catch the exception before exiting...
  1866. repeat
  1867. //TODO: Improve this - dont like the use of the exception handler
  1868. try
  1869. if ReadFromSource(False) > 0 then begin
  1870. FInputBuffer.Clear;
  1871. end else begin;
  1872. CheckForDisconnect(True, True);
  1873. end;
  1874. except
  1875. on E: Exception do begin
  1876. // RLebeau - ReadFromSource() could have filled the
  1877. // InputBuffer with more bytes...
  1878. FInputBuffer.Clear;
  1879. if E is EIdConnClosedGracefully then begin
  1880. Break;
  1881. end else begin
  1882. raise;
  1883. end;
  1884. end;
  1885. end;
  1886. TIdAntiFreezeBase.DoProcess;
  1887. until False;
  1888. finally
  1889. EndWork(wmRead);
  1890. end;
  1891. end;
  1892. procedure TIdIOHandler.RaiseConnClosedGracefully;
  1893. begin
  1894. (* ************************************************************* //
  1895. ------ If you receive an exception here, please read. ----------
  1896. If this is a SERVER
  1897. -------------------
  1898. The client has disconnected the socket normally and this exception is used to notify the
  1899. server handling code. This exception is normal and will only happen from within the IDE, not
  1900. while your program is running as an EXE. If you do not want to see this, add this exception
  1901. or EIdSilentException to the IDE options as exceptions not to break on.
  1902. From the IDE just hit F9 again and Indy will catch and handle the exception.
  1903. Please see the FAQ and help file for possible further information.
  1904. The FAQ is at http://www.nevrona.com/Indy/FAQ.html
  1905. If this is a CLIENT
  1906. -------------------
  1907. The server side of this connection has disconnected normaly but your client has attempted
  1908. to read or write to the connection. You should trap this error using a try..except.
  1909. Please see the help file for possible further information.
  1910. // ************************************************************* *)
  1911. raise EIdConnClosedGracefully.Create(RSConnectionClosedGracefully);
  1912. end;
  1913. function TIdIOHandler.InputBufferAsString(AByteEncoding: IIdTextEncoding = nil
  1914. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1915. ): string;
  1916. begin
  1917. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  1918. {$IFDEF STRING_IS_ANSI}
  1919. ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
  1920. {$ENDIF}
  1921. Result := FInputBuffer.ExtractToString(FInputBuffer.Size, AByteEncoding
  1922. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1923. );
  1924. end;
  1925. function TIdIOHandler.AllData(AByteEncoding: IIdTextEncoding = nil
  1926. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1927. ): string;
  1928. var
  1929. LBytes: Integer;
  1930. begin
  1931. Result := '';
  1932. BeginWork(wmRead);
  1933. try
  1934. if Connected then
  1935. begin
  1936. try
  1937. try
  1938. repeat
  1939. LBytes := ReadFromSource(False, 250, False);
  1940. until LBytes = 0; // -1 on timeout
  1941. finally
  1942. if not InputBufferIsEmpty then begin
  1943. Result := InputBufferAsString(AByteEncoding
  1944. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1945. );
  1946. end;
  1947. end;
  1948. except end;
  1949. end;
  1950. finally
  1951. EndWork(wmRead);
  1952. end;
  1953. end;
  1954. procedure TIdIOHandler.PerformCapture(const ADest: TObject;
  1955. out VLineCount: Integer; const ADelim: string;
  1956. AUsesDotTransparency: Boolean; AByteEncoding: IIdTextEncoding = nil
  1957. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  1958. );
  1959. var
  1960. s: string;
  1961. LStream: TStream;
  1962. LStrings: TStrings;
  1963. begin
  1964. VLineCount := 0;
  1965. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  1966. {$IFDEF STRING_IS_ANSI}
  1967. ADestEncoding := iif(ADestEncoding, FDefAnsiEncoding, encOSDefault);
  1968. {$ENDIF}
  1969. LStream := nil;
  1970. LStrings := nil;
  1971. if ADest is TStrings then begin
  1972. LStrings := TStrings(ADest);
  1973. end
  1974. else if ADest is TStream then begin
  1975. LStream := TStream(ADest);
  1976. end
  1977. else begin
  1978. raise EIdObjectTypeNotSupported.Create(RSObjectTypeNotSupported);
  1979. end;
  1980. BeginWork(wmRead);
  1981. try
  1982. if LStrings <> nil then begin
  1983. LStrings.BeginUpdate;
  1984. end;
  1985. try
  1986. repeat
  1987. s := ReadLn(AByteEncoding
  1988. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  1989. );
  1990. if s = ADelim then begin
  1991. Exit;
  1992. end;
  1993. // S.G. 6/4/2004: All the consumers to protect themselves against memory allocation attacks
  1994. if FMaxCapturedLines > 0 then begin
  1995. if VLineCount > FMaxCapturedLines then begin
  1996. raise EIdMaxCaptureLineExceeded.Create(RSMaximumNumberOfCaptureLineExceeded);
  1997. end;
  1998. end;
  1999. // For RFC retrieves that use dot transparency
  2000. // No length check necessary, if only one byte it will be byte x + #0.
  2001. if AUsesDotTransparency then begin
  2002. if TextStartsWith(s, '..') then begin
  2003. Delete(s, 1, 1);
  2004. end;
  2005. end;
  2006. // Write to output
  2007. Inc(VLineCount);
  2008. if LStrings <> nil then begin
  2009. LStrings.Add(s);
  2010. end
  2011. else if LStream <> nil then begin
  2012. WriteStringToStream(LStream, s+EOL, AByteEncoding
  2013. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  2014. );
  2015. end;
  2016. until False;
  2017. finally
  2018. if LStrings <> nil then begin
  2019. LStrings.EndUpdate;
  2020. end;
  2021. end;
  2022. finally
  2023. EndWork(wmRead);
  2024. end;
  2025. end;
  2026. function TIdIOHandler.InputLn(const AMask: String = ''; AEcho: Boolean = True;
  2027. ATabWidth: Integer = 8; AMaxLineLength: Integer = -1;
  2028. AByteEncoding: IIdTextEncoding = nil
  2029. {$IFDEF STRING_IS_ANSI}; AAnsiEncoding: IIdTextEncoding = nil{$ENDIF}
  2030. ): String;
  2031. var
  2032. i: Integer;
  2033. LChar: Char;
  2034. LTmp: string;
  2035. begin
  2036. Result := '';
  2037. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  2038. {$IFDEF STRING_IS_ANSI}
  2039. AAnsiEncoding := iif(AAnsiEncoding, FDefAnsiEncoding, encOSDefault);
  2040. {$ENDIF}
  2041. if AMaxLineLength < 0 then begin
  2042. AMaxLineLength := MaxLineLength;
  2043. end;
  2044. repeat
  2045. LChar := ReadChar(AByteEncoding
  2046. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2047. );
  2048. i := Length(Result);
  2049. if i <= AMaxLineLength then begin
  2050. case LChar of
  2051. BACKSPACE:
  2052. begin
  2053. if i > 0 then begin
  2054. SetLength(Result, i - 1);
  2055. if AEcho then begin
  2056. Write(BACKSPACE + ' ' + BACKSPACE, AByteEncoding
  2057. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2058. );
  2059. end;
  2060. end;
  2061. end;
  2062. TAB:
  2063. begin
  2064. if ATabWidth > 0 then begin
  2065. i := ATabWidth - (i mod ATabWidth);
  2066. LTmp := StringOfChar(' ', i);
  2067. Result := Result + LTmp;
  2068. if AEcho then begin
  2069. Write(LTmp, AByteEncoding
  2070. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2071. );
  2072. end;
  2073. end else begin
  2074. Result := Result + LChar;
  2075. if AEcho then begin
  2076. Write(LChar, AByteEncoding
  2077. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2078. );
  2079. end;
  2080. end;
  2081. end;
  2082. LF: ;
  2083. CR: ;
  2084. #27: ; //ESC - currently not supported
  2085. else
  2086. Result := Result + LChar;
  2087. if AEcho then begin
  2088. if Length(AMask) = 0 then begin
  2089. Write(LChar, AByteEncoding
  2090. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2091. );
  2092. end else begin
  2093. Write(AMask, AByteEncoding
  2094. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2095. );
  2096. end;
  2097. end;
  2098. end;
  2099. end;
  2100. until LChar = LF;
  2101. // Remove CR trail
  2102. i := Length(Result);
  2103. while (i > 0) and CharIsInSet(Result, i, EOL) do begin
  2104. Dec(i);
  2105. end;
  2106. SetLength(Result, i);
  2107. if AEcho then begin
  2108. WriteLn(AByteEncoding);
  2109. end;
  2110. end;
  2111. //TODO: Add a time out (default to infinite) and event to pass data
  2112. //TODO: Add a max size argument as well.
  2113. //TODO: Add a case insensitive option
  2114. function TIdIOHandler.WaitFor(const AString: string; ARemoveFromBuffer: Boolean = True;
  2115. AInclusive: Boolean = False; AByteEncoding: IIdTextEncoding = nil;
  2116. ATimeout: Integer = IdTimeoutDefault
  2117. {$IFDEF STRING_IS_ANSI}; AAnsiEncoding: IIdTextEncoding = nil{$ENDIF}
  2118. ): string;
  2119. var
  2120. LBytes: TIdBytes;
  2121. LPos: Integer;
  2122. begin
  2123. Result := '';
  2124. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  2125. {$IFDEF STRING_IS_ANSI}
  2126. AAnsiEncoding := iif(AAnsiEncoding, FDefAnsiEncoding, encOSDefault);
  2127. {$ENDIF}
  2128. LBytes := ToBytes(AString, AByteEncoding
  2129. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2130. );
  2131. LPos := 0;
  2132. repeat
  2133. LPos := InputBuffer.IndexOf(LBytes, LPos);
  2134. if LPos <> -1 then begin
  2135. if ARemoveFromBuffer and AInclusive then begin
  2136. Result := InputBuffer.ExtractToString(LPos+Length(LBytes), AByteEncoding
  2137. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2138. );
  2139. end else begin
  2140. Result := InputBuffer.ExtractToString(LPos, AByteEncoding
  2141. {$IFDEF STRING_IS_ANSI}, AAnsiEncoding{$ENDIF}
  2142. );
  2143. if ARemoveFromBuffer then begin
  2144. InputBuffer.Remove(Length(LBytes));
  2145. end;
  2146. if AInclusive then begin
  2147. Result := Result + AString;
  2148. end;
  2149. end;
  2150. Exit;
  2151. end;
  2152. LPos := IndyMax(0, InputBuffer.Size - (Length(LBytes)-1));
  2153. ReadFromSource(True, ATimeout, True);
  2154. until False;
  2155. end;
  2156. procedure TIdIOHandler.Capture(ADest: TStream; AByteEncoding: IIdTextEncoding = nil
  2157. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  2158. );
  2159. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  2160. begin
  2161. Capture(ADest, '.', True, AByteEncoding {do not localize}
  2162. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  2163. );
  2164. end;
  2165. procedure TIdIOHandler.Capture(ADest: TStream; out VLineCount: Integer;
  2166. const ADelim: string = '.'; AUsesDotTransparency: Boolean = True;
  2167. AByteEncoding: IIdTextEncoding = nil
  2168. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  2169. );
  2170. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  2171. begin
  2172. PerformCapture(ADest, VLineCount, ADelim, AUsesDotTransparency, AByteEncoding
  2173. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  2174. );
  2175. end;
  2176. procedure TIdIOHandler.Capture(ADest: TStream; ADelim: string;
  2177. AUsesDotTransparency: Boolean = True; AByteEncoding: IIdTextEncoding = nil
  2178. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  2179. );
  2180. var
  2181. LLineCount: Integer;
  2182. begin
  2183. PerformCapture(ADest, LLineCount, '.', AUsesDotTransparency, AByteEncoding {do not localize}
  2184. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  2185. );
  2186. end;
  2187. procedure TIdIOHandler.Capture(ADest: TStrings; out VLineCount: Integer;
  2188. const ADelim: string = '.'; AUsesDotTransparency: Boolean = True;
  2189. AByteEncoding: IIdTextEncoding = nil
  2190. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  2191. );
  2192. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  2193. begin
  2194. PerformCapture(ADest, VLineCount, ADelim, AUsesDotTransparency, AByteEncoding
  2195. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  2196. );
  2197. end;
  2198. procedure TIdIOHandler.Capture(ADest: TStrings; AByteEncoding: IIdTextEncoding = nil
  2199. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  2200. );
  2201. var
  2202. LLineCount: Integer;
  2203. begin
  2204. PerformCapture(ADest, LLineCount, '.', True, AByteEncoding {do not localize}
  2205. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  2206. );
  2207. end;
  2208. procedure TIdIOHandler.Capture(ADest: TStrings; const ADelim: string;
  2209. AUsesDotTransparency: Boolean = True; AByteEncoding: IIdTextEncoding = nil
  2210. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  2211. );
  2212. var
  2213. LLineCount: Integer;
  2214. begin
  2215. PerformCapture(ADest, LLineCount, ADelim, AUsesDotTransparency, AByteEncoding
  2216. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  2217. );
  2218. end;
  2219. procedure TIdIOHandler.InputBufferToStream(AStream: TStream; AByteCount: Integer = -1);
  2220. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  2221. begin
  2222. FInputBuffer.ExtractToStream(AStream, AByteCount);
  2223. end;
  2224. function TIdIOHandler.InputBufferIsEmpty: Boolean;
  2225. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  2226. begin
  2227. Result := FInputBuffer.Size = 0;
  2228. end;
  2229. procedure TIdIOHandler.Write(const ABuffer: TIdBytes; const ALength: Integer = -1;
  2230. const AOffset: Integer = 0);
  2231. var
  2232. LLength: Integer;
  2233. begin
  2234. LLength := IndyLength(ABuffer, ALength, AOffset);
  2235. if LLength > 0 then begin
  2236. if FWriteBuffer = nil then begin
  2237. WriteDirect(ABuffer, LLength, AOffset);
  2238. end else begin
  2239. // Write Buffering is enabled
  2240. FWriteBuffer.Write(ABuffer, LLength, AOffset);
  2241. if (FWriteBuffer.Size >= WriteBufferThreshold) and (WriteBufferThreshold > 0) then begin
  2242. repeat
  2243. WriteBufferFlush(WriteBufferThreshold);
  2244. until FWriteBuffer.Size < WriteBufferThreshold;
  2245. end;
  2246. end;
  2247. end;
  2248. end;
  2249. procedure TIdIOHandler.WriteRFCStrings(AStrings: TStrings; AWriteTerminator: Boolean = True;
  2250. AByteEncoding: IIdTextEncoding = nil
  2251. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  2252. );
  2253. var
  2254. i: Integer;
  2255. begin
  2256. AByteEncoding := iif(AByteEncoding, FDefStringEncoding);
  2257. {$IFDEF STRING_IS_ANSI}
  2258. ASrcEncoding := iif(ASrcEncoding, FDefAnsiEncoding, encOSDefault);
  2259. {$ENDIF}
  2260. for i := 0 to AStrings.Count - 1 do begin
  2261. WriteLnRFC(AStrings[i], AByteEncoding
  2262. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  2263. );
  2264. end;
  2265. if AWriteTerminator then begin
  2266. WriteLn('.', AByteEncoding
  2267. {$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}
  2268. );
  2269. end;
  2270. end;
  2271. function TIdIOHandler.WriteFile(const AFile: String; AEnableTransferFile: Boolean): Int64;
  2272. var
  2273. LStream: TStream;
  2274. {$IFDEF WIN32_OR_WIN64}
  2275. LOldErrorMode : Integer;
  2276. {$ENDIF}
  2277. begin
  2278. {$IFDEF WIN32_OR_WIN64}
  2279. LOldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  2280. try
  2281. {$ENDIF}
  2282. if not FileExists(AFile) then begin
  2283. raise EIdFileNotFound.CreateFmt(RSFileNotFound, [AFile]);
  2284. end;
  2285. LStream := TIdReadFileExclusiveStream.Create(AFile);
  2286. try
  2287. Write(LStream);
  2288. Result := LStream.Size;
  2289. finally
  2290. FreeAndNil(LStream);
  2291. end;
  2292. {$IFDEF WIN32_OR_WIN64}
  2293. finally
  2294. SetErrorMode(LOldErrorMode)
  2295. end;
  2296. {$ENDIF}
  2297. end;
  2298. function TIdIOHandler.WriteBufferingActive: Boolean;
  2299. {$IFDEF USE_CLASSINLINE}inline;{$ENDIF}
  2300. begin
  2301. Result := FWriteBuffer <> nil;
  2302. end;
  2303. procedure TIdIOHandler.CloseGracefully;
  2304. begin
  2305. FClosedGracefully := True
  2306. end;
  2307. procedure TIdIOHandler.InterceptReceive(var VBuffer: TIdBytes);
  2308. var
  2309. // under ARC, convert a weak reference to a strong reference before working with it
  2310. LIntercept: TIdConnectionIntercept;
  2311. begin
  2312. LIntercept := Intercept;
  2313. if LIntercept <> nil then begin
  2314. LIntercept.Receive(VBuffer);
  2315. end;
  2316. end;
  2317. procedure TIdIOHandler.InitComponent;
  2318. begin
  2319. inherited InitComponent;
  2320. FRecvBufferSize := GRecvBufferSizeDefault;
  2321. FSendBufferSize := GSendBufferSizeDefault;
  2322. FMaxLineLength := IdMaxLineLengthDefault;
  2323. FMaxCapturedLines := Id_IOHandler_MaxCapturedLines;
  2324. FLargeStream := False;
  2325. FReadTimeOut := IdTimeoutDefault;
  2326. FInputBuffer := TIdBuffer.Create(BufferRemoveNotify);
  2327. FDefStringEncoding := IndyTextEncoding_ASCII; // TODO: use IndyTextEncoding_Default instead...
  2328. {$IFDEF STRING_IS_ANSI}
  2329. FDefAnsiEncoding := IndyTextEncoding_OSDefault;
  2330. {$ENDIF}
  2331. end;
  2332. procedure TIdIOHandler.WriteBufferFlush;
  2333. begin
  2334. WriteBufferFlush(-1);
  2335. end;
  2336. procedure TIdIOHandler.WriteBufferOpen;
  2337. begin
  2338. WriteBufferOpen(-1);
  2339. end;
  2340. procedure TIdIOHandler.WriteDirect(const ABuffer: TIdBytes; const ALength: Integer = -1;
  2341. const AOffset: Integer = 0);
  2342. var
  2343. LTemp: TIdBytes;
  2344. LPos: Integer;
  2345. LSize: Integer;
  2346. LByteCount: Integer;
  2347. LLastError: Integer;
  2348. // under ARC, convert a weak reference to a strong reference before working with it
  2349. LIntercept: TIdConnectionIntercept;
  2350. begin
  2351. // Check if disconnected
  2352. CheckForDisconnect(True, True);
  2353. LIntercept := Intercept;
  2354. if LIntercept <> nil then begin
  2355. // TODO: pass offset/size parameters to the Intercept
  2356. // so that a copy is no longer needed here
  2357. LTemp := ToBytes(ABuffer, ALength, AOffset);
  2358. LIntercept.Send(LTemp);
  2359. {$IFDEF USE_OBJECT_ARC}LIntercept := nil;{$ENDIF}
  2360. LSize := Length(LTemp);
  2361. LPos := 0;
  2362. end else begin
  2363. LTemp := ABuffer;
  2364. LSize := IndyLength(LTemp, ALength, AOffset);
  2365. LPos := AOffset;
  2366. end;
  2367. while LSize > 0 do
  2368. begin
  2369. LByteCount := WriteDataToTarget(LTemp, LPos, LSize);
  2370. if LByteCount < 0 then
  2371. begin
  2372. LLastError := CheckForError(LByteCount);
  2373. if LLastError <> Id_WSAETIMEDOUT then begin
  2374. FClosedGracefully := True;
  2375. Close;
  2376. end;
  2377. RaiseError(LLastError);
  2378. end;
  2379. // TODO - Have a AntiFreeze param which allows the send to be split up so that process
  2380. // can be called more. Maybe a prop of the connection, MaxSendSize?
  2381. TIdAntiFreezeBase.DoProcess(False);
  2382. if LByteCount = 0 then begin
  2383. FClosedGracefully := True;
  2384. end;
  2385. // Check if other side disconnected
  2386. CheckForDisconnect;
  2387. DoWork(wmWrite, LByteCount);
  2388. Inc(LPos, LByteCount);
  2389. Dec(LSize, LByteCount);
  2390. end;
  2391. end;
  2392. initialization
  2393. finalization
  2394. FreeAndNil(GIOHandlerClassList)
  2395. end.