IdIOHandler.pas 88 KB

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