IdBuffer.pas 32 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046
  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.47 1/24/2005 7:35:54 PM JPMugaas
  18. Fixed CopyTIdIPV6Address.
  19. Rev 1.46 1/17/2005 7:28:44 PM JPMugaas
  20. Added Index parameter to several functions so you can use TIdBuffer in a
  21. random access manner instead of in a sequential manner. This is good for
  22. some fixed-packet or data types.
  23. Added functions for reading and writing various types to TIdBuffer which use
  24. Byte Order functions. This should facilitate a lot of development as this
  25. gets used more.
  26. Rev 1.45 27.08.2004 21:58:18 Andreas Hausladen
  27. Speed optimization ("const" for string parameters)
  28. Rev 1.44 2004.07.03 19:41:34 czhower
  29. UTF8, SaveToStream
  30. Rev 1.43 6/11/2004 8:48:12 AM DSiders
  31. Added "Do not Localize" comments.
  32. Rev 1.42 6/9/04 7:46:26 PM RLebeau
  33. Updated ExtractToBytes() to allocate the output buffer only if the buffer
  34. length is smaller than the requested number of bytes.
  35. Rev 1.41 5/29/04 10:44:58 PM RLebeau
  36. Updated ExtractToBytes() to allocate the output buffer regardless of the
  37. AAppend parameter
  38. Added empty string return value to Extract() when AByteCount <= 0
  39. Rev 1.40 2004.05.20 11:39:06 AM czhower
  40. IdStreamVCL
  41. Rev 1.39 2004.05.10 1:19:18 PM czhower
  42. Removed unneeded code.
  43. Rev 1.38 5/3/2004 12:57:00 PM BGooijen
  44. Fixes for 0-based
  45. Rev 1.37 2004.05.03 11:15:42 AM czhower
  46. Changed Find to IndexOf and made 0 based to be consistent.
  47. Rev 1.36 2004.05.01 4:26:52 PM czhower
  48. Added PeekByte
  49. Rev 1.35 2004.04.16 11:30:26 PM czhower
  50. Size fix to IdBuffer, optimizations, and memory leaks
  51. Rev 1.34 2004.04.08 7:06:44 PM czhower
  52. Peek support.
  53. Rev 1.33 2004.04.08 3:56:24 PM czhower
  54. Fixed bug with Intercept byte count. Also removed Bytes from Buffer.
  55. Rev 1.32 2004.04.08 2:03:34 AM czhower
  56. Fixes to Bytes.
  57. Rev 1.31 2004.04.07 3:59:44 PM czhower
  58. Bug fix for WriteDirect.
  59. Rev 1.30 2004.04.07 3:46:30 PM czhower
  60. Compile fix.
  61. Rev 1.29 4/7/2004 1:02:14 PM BGooijen
  62. when extract* is called with -1 or no parameters all data it extracted
  63. Rev 1.28 2004.03.29 9:58:38 PM czhower
  64. Is now buffered. Now takes 2/3rds the time as before.
  65. Rev 1.27 23/03/2004 18:33:44 CCostelloe
  66. Bug fix: ReadLn returns a previously-read line if FBytes also accessed
  67. in-between (causes MoveHeadToStartIfNecessary to be called)
  68. Rev 1.26 18/03/2004 20:24:26 CCostelloe
  69. Speed improvement by adding FHeadIndex: 10 MB base64 decode reduced from 10
  70. hours to 62 seconds.
  71. Rev 1.25 2004.03.03 11:55:02 AM czhower
  72. IdStream change
  73. Rev 1.24 3/1/04 7:33:12 PM RLebeau
  74. Updated Remove() to call the OnBytesRemoved event handler.
  75. Rev 1.23 2004.02.03 4:17:14 PM czhower
  76. For unit name changes.
  77. Rev 1.22 1/11/2004 5:48:48 PM BGooijen
  78. Added AApend parameter to ExtractToBytes
  79. Rev 1.21 1/7/2004 8:36:32 PM BGooijen
  80. Arguments were in wrong order
  81. Rev 1.20 22/11/2003 10:35:04 PM GGrieve
  82. Reverse copy direction in TIdBuffer.ExtractToStream
  83. Rev 1.19 2003.10.24 10:44:54 AM czhower
  84. IdStream implementation, bug fixes.
  85. Rev 1.18 10/15/2003 1:03:40 PM DSiders
  86. Created resource strings for TIdBuffer.Find exceptions.
  87. Rev 1.17 2003.10.14 1:27:06 PM czhower
  88. Uupdates + Intercept support
  89. Rev 1.16 2003.10.11 5:47:00 PM czhower
  90. -VCL fixes for servers
  91. -Chain suport for servers (Super core)
  92. -Scheduler upgrades
  93. -Full yarn support
  94. Rev 1.15 10/5/2003 10:24:20 PM BGooijen
  95. Changed WriteBytes(var ...) to WriteBytes(const ...)
  96. Rev 1.14 10/3/2003 10:46:38 PM BGooijen
  97. Fixed Range Check Exception, and fixed ExtractToStream
  98. Rev 1.13 2003.10.02 8:29:12 PM czhower
  99. Changed names of byte conversion routines to be more readily understood and
  100. not to conflict with already in use ones.
  101. Rev 1.12 2003.10.02 12:44:58 PM czhower
  102. Comment added
  103. Rev 1.11 10/2/2003 5:23:14 PM GGrieve
  104. make Bytes a public property
  105. Rev 1.10 10/2/2003 5:00:38 PM GGrieve
  106. Fix bug in find - can't find last char
  107. Rev 1.9 2003.10.02 10:37:00 AM czhower
  108. Comments
  109. Rev 1.8 10/2/2003 3:54:06 PM GGrieve
  110. Finish cleaning up - no $IFDEFs but still optimal on both win32 and DontNet
  111. Rev 1.7 10/1/2003 10:58:38 PM BGooijen
  112. Removed unused var
  113. Rev 1.6 10/1/2003 8:15:58 PM BGooijen
  114. Fixed Range Check Error on D7
  115. Rev 1.5 10/1/2003 8:02:22 PM BGooijen
  116. Removed some ifdefs and improved code
  117. Rev 1.4 10/1/2003 10:49:02 PM GGrieve
  118. Rework buffer for Octane Compability
  119. Rev 1.3 2003.10.01 2:30:44 PM czhower
  120. .Net
  121. Rev 1.2 2003.10.01 1:37:32 AM czhower
  122. .Net
  123. Rev 1.1 2003.10.01 1:12:32 AM czhower
  124. .Net
  125. Rev 1.0 2003.09.30 10:33:56 PM czhower
  126. Readd after accidental delete.
  127. Rev 1.14 2003.09.30 10:33:16 PM czhower
  128. Updates
  129. Rev 1.13 2003.07.16 5:05:06 PM czhower
  130. Phase 1 of IdBuffer changes for compat.
  131. Rev 1.12 6/29/2003 10:56:22 PM BGooijen
  132. Removed .Memory from the buffer, and added some extra methods
  133. Rev 1.11 2003.06.25 4:29:06 PM czhower
  134. Free --> FreeAndNil
  135. Rev 1.10 2003.01.17 2:18:36 PM czhower
  136. Rev 1.9 12-14-2002 22:08:24 BGooijen
  137. Changed FMemory to FMemory.Memory in some places
  138. Rev 1.8 12-14-2002 22:02:34 BGooijen
  139. changed Memory to FMemory in some places, to remove some issues
  140. Rev 1.7 12/11/2002 04:27:02 AM JPMugaas
  141. Fixed compiler warning.
  142. Rev 1.6 12/11/2002 03:53:44 AM JPMugaas
  143. Merged the buffer classes.
  144. Rev 1.5 2002.12.07 12:26:18 AM czhower
  145. Rev 1.4 12-6-2002 20:34:06 BGooijen
  146. Now compiles on Delphi 5
  147. Rev 1.3 6/12/2002 11:00:14 AM SGrobety
  148. Rev 1.2 12/5/2002 02:55:44 PM JPMugaas
  149. Added AddStream method for reading a stream into the buffer class.
  150. Rev 1.1 23.11.2002 12:59:48 JBerg
  151. fixed packbuffer
  152. Rev 1.0 11/13/2002 08:38:32 AM JPMugaas
  153. }
  154. unit IdBuffer;
  155. {$I IdCompilerDefines.inc}
  156. {
  157. .Net forces us to perform copies from strings to Bytes so that it can do the
  158. proper unicode and other conversions.
  159. IdBuffer is for storing data we cannot deal with right now and we do not know
  160. the size. It must be optimized for adding to the end, and extracting from the
  161. beginning. First pass we are just making it work, later using bubbling we will
  162. optimize it for such tasks.
  163. The copy is a separate issue and we considered several options. For .net we will
  164. always have to copy data to send or to receive to translate it to binary. For
  165. example if we have a string it must be converted to bytes. This conversion
  166. requires a copy. All strings are Unicode and must be converted to single
  167. bytes by a convertor. This is not limited to strings.
  168. In VCL previously all strings were AnsiString so we used a pointer and just
  169. accessed the memory directly from the string. This avoided the overhead of a
  170. copy.
  171. We have come up with several ideas on how to allow the copy on .net, while
  172. avoiding the copy on VCL to keep the performance benefit. However we must do
  173. it in a single source manner and in a manner that does not impact the code
  174. negatively.
  175. For now for VCL we also do a copy. This has the advantage that Byte arrays are
  176. reference counted and automaticaly handled by Delphi. For example:
  177. WriteBytes(StringToBytes(s));
  178. The array returned by this function will automatically be freed by Delphi.
  179. There are other options that are nearly as transparent but have the additional
  180. overhead of requiring class creation. These classes can be used to copy for .net
  181. and proxy on VCL. It all works very nice and has low memory overhead. The
  182. objects can then be freed by default in methods that accept them.
  183. However after analysis, copy on VCL may not be that bad after all. The copy
  184. only really impacts strings. The overhead to copy strings is minimal and only
  185. used in commands etc. The big transfers come from files, streams, or other.
  186. Such transfers have to be mapped into memory in VCL anyways, and if we map
  187. directly into the byte array instead of the previous classes peformance should
  188. be fine.
  189. In short - copy under VCL should be acceptable if we watch for bottlenecks and
  190. fix them appropriately without having to creat proxy classes. The only problem
  191. remains for transmitting large memory blocks. But if this is done against a
  192. fixed copy buffer the performance hit will be neglible and it is not a common
  193. task to transmit large memory blocks.
  194. For such transfers from streams, etc the user can declare a persistent array
  195. of bytes that is not freed between each call to WriteBytes.
  196. -Kudzu
  197. }
  198. interface
  199. uses
  200. Classes,
  201. IdException,
  202. IdGlobal,
  203. SysUtils;
  204. type
  205. EIdNotEnoughDataInBuffer = class(EIdException);
  206. EIdTooMuchDataInBuffer = class(EIdException); // only 2GB is allowed -
  207. TIdBufferBytesRemoved = procedure(ASender: TObject; ABytes: Integer) of object;
  208. // TIdBuffer is used as an internal buffer to isolate Indy from pointers and
  209. // memory allocations. It also allows optimizations to be kept in a single place.
  210. //
  211. // TIdBuffer is primarily used as a read/write buffer for the communication layer.
  212. TIdBuffer = class(TObject)
  213. private
  214. function GetAsString: string;
  215. protected
  216. FBytes: TIdBytes;
  217. FByteEncoding: IIdTextEncoding;
  218. {$IFDEF STRING_IS_ANSI}
  219. FAnsiEncoding: IIdTextEncoding;
  220. {$ENDIF}
  221. FGrowthFactor: Integer;
  222. FHeadIndex: Integer;
  223. FOnBytesRemoved: TIdBufferBytesRemoved;
  224. FSize: Integer;
  225. //
  226. procedure CheckAdd(AByteCount : Integer; const AIndex : Integer);
  227. procedure CheckByteCount(var VByteCount : Integer; const AIndex : Integer);
  228. function GetCapacity: Integer;
  229. procedure SetCapacity(AValue: Integer);
  230. public
  231. procedure Clear;
  232. constructor Create; overload;
  233. constructor Create(AOnBytesRemoved: TIdBufferBytesRemoved); overload;
  234. constructor Create(AGrowthFactor: Integer); overload;
  235. constructor Create(const ABytes : TIdBytes; const ALength : Integer = -1); overload;
  236. procedure CompactHead(ACanShrink: Boolean = True);
  237. destructor Destroy; override;
  238. {
  239. Most of these now have an AIndex parameter. If that is less than 0,
  240. we are accessing data sequentially. That means, read the data from the HeadIndex
  241. and "remove" the data you read.
  242. If AIndex is 0 or greater, the HeadIndex is disregarded and no deletion is done.
  243. You are just reading from a particular location in a random access manner.
  244. }
  245. // will extract number of bytes and decode as specified
  246. function Extract(AByteCount: Integer = -1; AByteEncoding: IIdTextEncoding = nil
  247. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  248. ): string; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use ExtractToString()'{$ENDIF};{$ENDIF}
  249. function ExtractToString(AByteCount: Integer = -1; AByteEncoding: IIdTextEncoding = nil
  250. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  251. ): string;
  252. // all 3 extract routines append to existing data, if any
  253. procedure ExtractToStream(const AStream: TStream; AByteCount: Integer = -1; const AIndex: Integer = -1);
  254. procedure ExtractToIdBuffer(ABuffer: TIdBuffer; AByteCount: Integer = -1; const AIndex : Integer = -1);
  255. procedure ExtractToBytes(var VBytes: TIdBytes; AByteCount: Integer = -1;
  256. AAppend: Boolean = True; AIndex : Integer = -1);
  257. function ExtractToUInt8(const AIndex : Integer): UInt8;
  258. function ExtractToByte(const AIndex : Integer): UInt8; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use ExtractToUInt8()'{$ENDIF};{$ENDIF}
  259. function ExtractToUInt16(const AIndex : Integer; AConvert: Boolean = True): UInt16;
  260. function ExtractToWord(const AIndex : Integer): UInt16; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use ExtractToUInt16()'{$ENDIF};{$ENDIF}
  261. function ExtractToUInt32(const AIndex : Integer; AConvert: Boolean = True): UInt32;
  262. function ExtractToLongWord(const AIndex : Integer): UInt32; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPRECATED_MSG} 'Use ExtractToUInt32()'{$ENDIF};{$ENDIF}
  263. function ExtractToUInt64(const AIndex : Integer; AConvert: Boolean = True): TIdUInt64;
  264. procedure ExtractToIPv6(const AIndex : Integer; var VAddress: TIdIPv6Address);
  265. function IndexOf(const AByte: Byte; AStartPos: Integer = 0): Integer; overload;
  266. function IndexOf(const ABytes: TIdBytes; AStartPos: Integer = 0): Integer; overload;
  267. function IndexOf(const AString: string; AStartPos: Integer = 0;
  268. AByteEncoding: IIdTextEncoding = nil
  269. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  270. ): Integer; overload;
  271. function PeekByte(AIndex: Integer): Byte;
  272. procedure Remove(AByteCount: Integer);
  273. procedure SaveToStream(const AStream: TStream);
  274. { Most of these now have an ADestIndex parameter. If that is less than 0,
  275. we are writing data sequentially.
  276. If ADestIndex is 0 or greater, you are setting bytes in a particular
  277. location in a random access manner.
  278. }
  279. // Write
  280. procedure Write(const AString: string; AByteEncoding: IIdTextEncoding = nil;
  281. const ADestIndex: Integer = -1
  282. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  283. ); overload;
  284. procedure Write(const ABytes: TIdBytes; const ADestIndex: Integer = -1); overload;
  285. procedure Write(const ABytes: TIdBytes; const ALength, AOffset : Integer; const ADestIndex: Integer = -1); overload;
  286. procedure Write(AStream: TStream; AByteCount: Integer = 0); overload;
  287. procedure Write(const AValue: TIdUInt64; const ADestIndex: Integer = -1); overload;
  288. procedure Write(const AValue: UInt32; const ADestIndex: Integer = -1); overload;
  289. procedure Write(const AValue: UInt16; const ADestIndex: Integer = -1); overload;
  290. procedure Write(const AValue: UInt8; const ADestIndex: Integer = -1); overload;
  291. procedure Write(const AValue: TIdIPv6Address; const ADestIndex: Integer = -1); overload;
  292. //
  293. //Kudzu: I have removed the Bytes property. Do not add it back - it allowed "internal" access
  294. // which caused compacting or internal knowledge. Access via Extract or other such methods
  295. // instead. Bytes could also be easily confused with FBytes internally and cause issues.
  296. //
  297. // Bytes also allowed direct acces without removing which could cause concurrency issues if
  298. // the reference was kept.
  299. //
  300. property Capacity: Integer read GetCapacity write SetCapacity;
  301. property Encoding: IIdTextEncoding read FByteEncoding write FByteEncoding;
  302. {$IFDEF STRING_IS_ANSI}
  303. property AnsiEncoding: IIdTextEncoding read FAnsiEncoding write FAnsiEncoding;
  304. {$ENDIF}
  305. property GrowthFactor: Integer read FGrowthFactor write FGrowthFactor;
  306. property Size: Integer read FSize;
  307. //useful for testing. returns buffer as string without extraction.
  308. property AsString: string read GetAsString;
  309. end;
  310. implementation
  311. uses
  312. IdResourceStringsCore,
  313. IdStream,
  314. IdStack; //needed for byte order functions
  315. procedure TIdBuffer.CheckAdd(AByteCount : Integer; const AIndex : Integer);
  316. begin
  317. if (MaxInt - AByteCount) < (Size + AIndex) then begin
  318. raise EIdTooMuchDataInBuffer.Create(RSTooMuchDataInBuffer);
  319. end;
  320. end;
  321. procedure TIdBuffer.CheckByteCount(var VByteCount : Integer; const AIndex : Integer);
  322. begin
  323. if VByteCount = -1 then begin
  324. VByteCount := Size+AIndex;
  325. end
  326. else if VByteCount > (Size+AIndex) then begin
  327. // TODO: add a resource string
  328. raise EIdNotEnoughDataInBuffer.CreateFmt('%s (%d/%d)', [RSNotEnoughDataInBuffer, VByteCount, Size]); {do not localize}
  329. end;
  330. end;
  331. procedure TIdBuffer.Clear;
  332. begin
  333. SetLength(FBytes, 0);
  334. FHeadIndex := 0;
  335. FSize := Length(FBytes);
  336. end;
  337. constructor TIdBuffer.Create(AGrowthFactor: Integer);
  338. begin
  339. Create;
  340. FGrowthFactor := AGrowthFactor;
  341. end;
  342. constructor TIdBuffer.Create(AOnBytesRemoved: TIdBufferBytesRemoved);
  343. begin
  344. Create;
  345. FOnBytesRemoved := AOnBytesRemoved;
  346. end;
  347. constructor TIdBuffer.Create(const ABytes: TIdBytes; const ALength: Integer);
  348. begin
  349. Create;
  350. if ALength < 0 then
  351. begin
  352. FBytes := ABytes;
  353. FSize := Length(ABytes);
  354. end else
  355. begin
  356. SetLength(FBytes, ALength);
  357. if ALength > 0 then
  358. begin
  359. CopyTIdBytes(ABytes, 0, FBytes, 0, ALength);
  360. FSize := ALength;
  361. end;
  362. end;
  363. end;
  364. destructor TIdBuffer.Destroy;
  365. begin
  366. Clear;
  367. inherited Destroy;
  368. //do only at the last moment
  369. TIdStack.DecUsage;
  370. end;
  371. {$I IdDeprecatedImplBugOff.inc}
  372. function TIdBuffer.Extract(AByteCount: Integer = -1; AByteEncoding: IIdTextEncoding = nil
  373. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  374. ): string;
  375. {$I IdDeprecatedImplBugOn.inc}
  376. {$IFDEF USE_CLASS_INLINE}inline;{$ENDIF}
  377. begin
  378. Result := ExtractToString(AByteCount, AByteEncoding{$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF});
  379. end;
  380. function TIdBuffer.ExtractToString(AByteCount: Integer = -1; AByteEncoding: IIdTextEncoding = nil
  381. {$IFDEF STRING_IS_ANSI}; ADestEncoding: IIdTextEncoding = nil{$ENDIF}
  382. ): string;
  383. var
  384. LBytes: TIdBytes;
  385. begin
  386. if AByteCount < 0 then begin
  387. AByteCount := Size;
  388. end;
  389. if AByteCount > 0 then
  390. begin
  391. if AByteEncoding = nil then begin
  392. AByteEncoding := FByteEncoding;
  393. EnsureEncoding(AByteEncoding);
  394. end;
  395. {$IFDEF STRING_IS_ANSI}
  396. if ADestEncoding = nil then begin
  397. ADestEncoding := FAnsiEncoding;
  398. EnsureEncoding(ADestEncoding, encOSDefault);
  399. end;
  400. {$ENDIF}
  401. // TODO: convert directly from FBytes without allocating a local TIdBytes anymore...
  402. {
  403. CheckByteCount(AByteCount, 0);
  404. try
  405. Result := BytesToString(FBytes, FHeadIndex, AByteCount, AByteEncoding($IFDEF STRING_IS_ANSI), ADestEncoding($ENDIF));
  406. finally
  407. Remove(AByteCount);
  408. end;
  409. }
  410. ExtractToBytes(LBytes, AByteCount);
  411. Result := BytesToString(LBytes, AByteEncoding
  412. {$IFDEF STRING_IS_ANSI}, ADestEncoding{$ENDIF}
  413. );
  414. end else begin
  415. Result := '';
  416. end;
  417. end;
  418. procedure TIdBuffer.ExtractToBytes(var VBytes: TIdBytes; AByteCount: Integer = -1;
  419. AAppend: Boolean = True; AIndex : Integer = -1);
  420. var
  421. LOldSize: Integer;
  422. LIndex : Integer;
  423. begin
  424. if AByteCount < 0 then begin
  425. AByteCount := Size;
  426. end;
  427. LIndex := IndyMax(AIndex, 0);
  428. if AByteCount > 0 then begin
  429. CheckByteCount(AByteCount, LIndex);
  430. if AAppend then begin
  431. LOldSize := Length(VBytes);
  432. SetLength(VBytes, LOldSize + AByteCount);
  433. end else begin
  434. LOldSize := 0;
  435. if Length(VBytes) < AByteCount then begin
  436. SetLength(VBytes, AByteCount);
  437. end;
  438. end;
  439. if AIndex < 0 then
  440. begin
  441. CopyTIdBytes(FBytes, FHeadIndex, VBytes, LOldSize, AByteCount);
  442. Remove(AByteCount);
  443. end else
  444. begin
  445. CopyTIdBytes(FBytes, AIndex, VBytes, LOldSize, AByteCount);
  446. end;
  447. end;
  448. end;
  449. procedure TIdBuffer.ExtractToIdBuffer(ABuffer: TIdBuffer; AByteCount: Integer = -1;
  450. const AIndex: Integer = -1);
  451. var
  452. LBytes: TIdBytes;
  453. begin
  454. if AByteCount < 0 then begin
  455. AByteCount := Size;
  456. end;
  457. //TODO: Optimize this routine to directly copy from one to the other
  458. ExtractToBytes(LBytes, AByteCount, True, AIndex);
  459. ABuffer.Write(LBytes);
  460. end;
  461. procedure TIdBuffer.ExtractToStream(const AStream: TStream; AByteCount: Integer = -1;
  462. const AIndex: Integer = -1);
  463. var
  464. LIndex : Integer;
  465. LBytes : TIdBytes;
  466. begin
  467. if AByteCount < 0 then begin
  468. AByteCount := Size;
  469. end;
  470. LIndex := IndyMax(AIndex, 0);
  471. if AIndex < 0 then
  472. begin
  473. // TODO: remove CompactHead() here and pass FHeadIndex to TIdStreamHelper.Write():
  474. {
  475. CheckByteCount(AByteCount, FHeadIndex);
  476. TIdStreamHelper.Write(AStream, FBytes, AByteCount, FHeadIndex);
  477. Remove(AByteCount);
  478. }
  479. CompactHead;
  480. CheckByteCount(AByteCount, LIndex);
  481. TIdStreamHelper.Write(AStream, FBytes, AByteCount);
  482. Remove(AByteCount);
  483. end else
  484. begin
  485. // TODO: remove CopyTIdBytes() here and pass FBytes and AIndex to TIdStreamHelper.Write():
  486. {
  487. CheckByteCount(AByteCount, LIndex);
  488. TIdStreamHelper.Write(AStream, FBytes, AByteCount, AIndex);
  489. }
  490. CheckByteCount(AByteCount, LIndex);
  491. SetLength(LBytes, AByteCount);
  492. CopyTIdBytes(FBytes, AIndex, LBytes, 0, AByteCount);
  493. TIdStreamHelper.Write(AStream, LBytes, AByteCount);
  494. end;
  495. end;
  496. procedure TIdBuffer.Remove(AByteCount: Integer);
  497. begin
  498. if AByteCount >= Size then begin
  499. Clear;
  500. end else begin
  501. Inc(FHeadIndex, AByteCount);
  502. Dec(FSize, AByteCount);
  503. if FHeadIndex > GrowthFactor then begin
  504. CompactHead;
  505. end;
  506. end;
  507. if Assigned(FOnBytesRemoved) then begin
  508. FOnBytesRemoved(Self, AByteCount);
  509. end;
  510. end;
  511. procedure TIdBuffer.CompactHead(ACanShrink: Boolean = True);
  512. begin
  513. // Only try to compact if needed.
  514. if FHeadIndex > 0 then begin
  515. CopyTIdBytes(FBytes, FHeadIndex, FBytes, 0, Size);
  516. FHeadIndex := 0;
  517. if ACanShrink and ((Capacity - Size - FHeadIndex) > GrowthFactor) then begin
  518. SetLength(FBytes, FHeadIndex + Size + GrowthFactor);
  519. end;
  520. end;
  521. end;
  522. procedure TIdBuffer.Write(const ABytes: TIdBytes; const ADestIndex: Integer = -1);
  523. {$IFDEF USE_CLASS_INLINE}inline;{$ENDIF}
  524. begin
  525. Write(ABytes, Length(ABytes), 0, ADestIndex);
  526. end;
  527. procedure TIdBuffer.Write(AStream: TStream; AByteCount: Integer);
  528. var
  529. LAdded: Integer;
  530. LLength: Integer;
  531. begin
  532. if AByteCount < 0 then begin
  533. // Copy remaining
  534. LAdded := AStream.Size - AStream.Position;
  535. end else if AByteCount = 0 then begin
  536. // Copy all
  537. AStream.Position := 0;
  538. LAdded := AStream.Size;
  539. end else begin
  540. LAdded := IndyMin(AByteCount, AStream.Size - AStream.Position);
  541. end;
  542. if LAdded > 0 then begin
  543. LLength := Size;
  544. CheckAdd(LAdded, 0);
  545. CompactHead;
  546. SetLength(FBytes, LLength + LAdded);
  547. TIdStreamHelper.ReadBytes(AStream, FBytes, LAdded, LLength);
  548. Inc(FSize, LAdded);
  549. end;
  550. end;
  551. function TIdBuffer.IndexOf(const AString: string; AStartPos: Integer = 0;
  552. AByteEncoding: IIdTextEncoding = nil
  553. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  554. ): Integer;
  555. begin
  556. if AByteEncoding = nil then begin
  557. AByteEncoding := FByteEncoding;
  558. end;
  559. {$IFDEF STRING_IS_ANSI}
  560. if ASrcEncoding = nil then begin
  561. ASrcEncoding := FAnsiEncoding;
  562. end;
  563. {$ENDIF}
  564. Result := IndexOf(
  565. ToBytes(AString, AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}),
  566. AStartPos);
  567. end;
  568. function TIdBuffer.IndexOf(const ABytes: TIdBytes; AStartPos: Integer = 0): Integer;
  569. var
  570. i, j, LEnd, BytesLen: Integer;
  571. LFound: Boolean;
  572. begin
  573. Result := -1;
  574. // Dont search if it empty
  575. if Size > 0 then begin
  576. if Length(ABytes) = 0 then begin
  577. raise EIdException.Create(RSBufferMissingTerminator); // TODO: create a new Exception class for this
  578. end;
  579. if (AStartPos < 0) or (AStartPos >= Size) then begin
  580. raise EIdException.Create(RSBufferInvalidStartPos); // TODO: create a new Exception class for this
  581. end;
  582. BytesLen := Length(ABytes);
  583. LEnd := FHeadIndex + Size;
  584. for i := FHeadIndex + AStartPos to LEnd - BytesLen do begin
  585. LFound := True;
  586. for j := 0 to BytesLen - 1 do begin
  587. if (i + j) >= LEnd then begin
  588. Break;
  589. end;
  590. if FBytes[i + j] <> ABytes[j] then begin
  591. LFound := False;
  592. Break;
  593. end;
  594. end;
  595. if LFound then begin
  596. Result := i - FHeadIndex;
  597. Break;
  598. end;
  599. end;
  600. end;
  601. end;
  602. function TIdBuffer.IndexOf(const AByte: Byte; AStartPos: Integer = 0): Integer;
  603. var
  604. i: Integer;
  605. begin
  606. Result := -1;
  607. // Dont search if it empty
  608. if Size > 0 then begin
  609. if (AStartPos < 0) or (AStartPos >= Size) then begin
  610. raise EIdException.Create(RSBufferInvalidStartPos); // TODO: create a new Exception class for this
  611. end;
  612. for i := (FHeadIndex + AStartPos) to (FHeadIndex + Size - 1) do begin
  613. if FBytes[i] = AByte then begin
  614. Result := i - FHeadIndex;
  615. Break;
  616. end;
  617. end;
  618. end;
  619. end;
  620. procedure TIdBuffer.Write(const AString: string; AByteEncoding: IIdTextEncoding = nil;
  621. const ADestIndex : Integer = -1
  622. {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  623. );
  624. begin
  625. if AByteEncoding = nil then begin
  626. AByteEncoding := FByteEncoding;
  627. end;
  628. {$IFDEF STRING_IS_ANSI}
  629. if ASrcEncoding = nil then begin
  630. ASrcEncoding := FAnsiEncoding;
  631. end;
  632. {$ENDIF}
  633. Write(
  634. ToBytes(AString, AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}),
  635. ADestIndex);
  636. end;
  637. function TIdBuffer.GetCapacity: Integer;
  638. begin
  639. Result := Length(FBytes);
  640. end;
  641. procedure TIdBuffer.SetCapacity(AValue: Integer);
  642. begin
  643. if AValue < Size then begin
  644. raise EIdException.Create('Capacity cannot be smaller than Size'); {do not localize} // TODO: add a resource string, and create a new Exception class for this
  645. end;
  646. CompactHead;
  647. SetLength(FBytes, AValue);
  648. end;
  649. constructor TIdBuffer.Create;
  650. begin
  651. inherited Create;
  652. FGrowthFactor := 2048;
  653. Clear;
  654. TIdStack.IncUsage;
  655. end;
  656. function TIdBuffer.PeekByte(AIndex: Integer): Byte;
  657. begin
  658. if Size = 0 then begin
  659. raise EIdException.Create('No bytes in buffer.'); {do not localize} // TODO: add a resource string, and create a new Exception class for this
  660. end;
  661. if (AIndex < 0) or (AIndex >= Size) then begin
  662. raise EIdException.Create('Index out of bounds.'); {do not localize} // TODO: add a resource string, and create a new Exception class for this
  663. end;
  664. Result := FBytes[FHeadIndex + AIndex];
  665. end;
  666. procedure TIdBuffer.SaveToStream(const AStream: TStream);
  667. begin
  668. CompactHead(False);
  669. TIdStreamHelper.Write(AStream, FBytes, Size);
  670. end;
  671. procedure TIdBuffer.ExtractToIPv6(const AIndex: Integer; var VAddress: TIdIPv6Address);
  672. var
  673. LIndex : Integer;
  674. begin
  675. if AIndex < 0 then begin
  676. LIndex := FHeadIndex;
  677. end else begin
  678. LIndex := AIndex;
  679. end;
  680. BytesToIPv6(FBytes, VAddress, LIndex);
  681. VAddress := GStack.NetworkToHost(VAddress);
  682. if AIndex < 0 then begin
  683. Remove(16);
  684. end;
  685. end;
  686. function TIdBuffer.ExtractToUInt64(const AIndex: Integer; AConvert: Boolean = True): TIdUInt64;
  687. var
  688. LIndex : Integer;
  689. begin
  690. if AIndex < 0 then begin
  691. LIndex := FHeadIndex;
  692. end else begin
  693. LIndex := AIndex;
  694. end;
  695. Result := BytesToUInt64(FBytes, LIndex);
  696. if AIndex < 0 then begin
  697. Remove(8);
  698. end;
  699. if AConvert then begin
  700. Result := GStack.NetworkToHost(Result);
  701. end;
  702. end;
  703. function TIdBuffer.ExtractToUInt32(const AIndex: Integer; AConvert: Boolean = True): UInt32;
  704. var
  705. LIndex : Integer;
  706. begin
  707. if AIndex < 0 then begin
  708. LIndex := FHeadIndex;
  709. end else begin
  710. LIndex := AIndex;
  711. end;
  712. Result := BytesToUInt32(FBytes, LIndex);
  713. if AIndex < 0 then begin
  714. Remove(4);
  715. end;
  716. if AConvert then begin
  717. Result := GStack.NetworkToHost(Result);
  718. end;
  719. end;
  720. {$I IdDeprecatedImplBugOff.inc}
  721. function TIdBuffer.ExtractToLongWord(const AIndex: Integer): UInt32;
  722. {$I IdDeprecatedImplBugOn.inc}
  723. {$IFDEF USE_CLASS_INLINE}inline;{$ENDIF}
  724. begin
  725. Result := ExtractToUInt32(AIndex);
  726. end;
  727. function TIdBuffer.ExtractToUInt16(const AIndex: Integer; AConvert: Boolean = True): UInt16;
  728. var
  729. LIndex : Integer;
  730. begin
  731. if AIndex < 0 then begin
  732. LIndex := FHeadIndex;
  733. end else begin
  734. LIndex := AIndex;
  735. end;
  736. Result := BytesToUInt16(FBytes, LIndex);
  737. if AIndex < 0 then begin
  738. Remove(2);
  739. end;
  740. if AConvert then begin
  741. Result := GStack.NetworkToHost(Result);
  742. end;
  743. end;
  744. {$I IdDeprecatedImplBugOff.inc}
  745. function TIdBuffer.ExtractToWord(const AIndex: Integer): UInt16;
  746. {$I IdDeprecatedImplBugOn.inc}
  747. {$IFDEF USE_CLASS_INLINE}inline;{$ENDIF}
  748. begin
  749. Result := ExtractToUInt16(AIndex);
  750. end;
  751. function TIdBuffer.ExtractToUInt8(const AIndex: Integer): UInt8;
  752. var
  753. LIndex : Integer;
  754. begin
  755. if AIndex < 0 then begin
  756. LIndex := FHeadIndex;
  757. end else begin
  758. LIndex := AIndex;
  759. end;
  760. Result := FBytes[LIndex];
  761. if AIndex < 0 then begin
  762. Remove(1);
  763. end;
  764. end;
  765. {$I IdDeprecatedImplBugOff.inc}
  766. function TIdBuffer.ExtractToByte(const AIndex: Integer): UInt8;
  767. {$I IdDeprecatedImplBugOn.inc}
  768. {$IFDEF USE_CLASS_INLINE}inline;{$ENDIF}
  769. begin
  770. Result := ExtractToUInt8(AIndex);
  771. end;
  772. procedure TIdBuffer.Write(const AValue: UInt16; const ADestIndex: Integer);
  773. var
  774. LVal : UInt16;
  775. LIndex : Integer;
  776. begin
  777. if ADestIndex < 0 then
  778. begin
  779. LIndex := FHeadIndex + Size;
  780. SetLength(FBytes, LIndex+2);
  781. end else
  782. begin
  783. LIndex := ADestIndex;
  784. end;
  785. LVal := GStack.HostToNetwork(AValue);
  786. CopyTIdUInt16(LVal, FBytes, LIndex);
  787. if LIndex >= FSize then begin
  788. FSize := LIndex+2;
  789. end;
  790. end;
  791. procedure TIdBuffer.Write(const AValue: UInt8; const ADestIndex: Integer);
  792. var
  793. LIndex : Integer;
  794. begin
  795. if ADestIndex < 0 then
  796. begin
  797. LIndex := FHeadIndex + Size;
  798. SetLength(FBytes, LIndex+1);
  799. end else
  800. begin
  801. LIndex := ADestIndex;
  802. end;
  803. FBytes[LIndex] := AValue;
  804. if LIndex >= FSize then begin
  805. FSize := LIndex+1;
  806. end;
  807. end;
  808. procedure TIdBuffer.Write(const AValue: TIdIPv6Address; const ADestIndex: Integer);
  809. var
  810. LVal : TIdIPv6Address;
  811. LIndex : Integer;
  812. begin
  813. if ADestIndex < 0 then
  814. begin
  815. LIndex := FHeadIndex + Size;
  816. SetLength(FBytes, LIndex + 16);
  817. end else
  818. begin
  819. LIndex := ADestIndex;
  820. end;
  821. LVal := GStack.HostToNetwork(AValue);
  822. CopyTIdIPV6Address(LVal, FBytes, LIndex);
  823. if LIndex >= FSize then begin
  824. FSize := LIndex+16;
  825. end;
  826. end;
  827. procedure TIdBuffer.Write(const AValue: TIdUInt64; const ADestIndex: Integer);
  828. var
  829. LVal: TIdUInt64;
  830. LIndex: Integer;
  831. begin
  832. if ADestIndex < 0 then
  833. begin
  834. LIndex := FHeadIndex + Size;
  835. SetLength(FBytes, LIndex + 8);
  836. end else
  837. begin
  838. LIndex := ADestIndex;
  839. end;
  840. LVal := GStack.HostToNetwork(AValue);
  841. CopyTIdUInt64(LVal, FBytes, LIndex);
  842. if LIndex >= FSize then begin
  843. FSize := LIndex + 8;
  844. end;
  845. end;
  846. procedure TIdBuffer.Write(const AValue: UInt32; const ADestIndex: Integer);
  847. var
  848. LVal : UInt32;
  849. LIndex : Integer;
  850. begin
  851. if ADestIndex < 0 then
  852. begin
  853. LIndex := FHeadIndex + Size;
  854. SetLength(FBytes, LIndex + 4);
  855. end else
  856. begin
  857. LIndex := ADestIndex;
  858. end;
  859. LVal := GStack.HostToNetwork(AValue);
  860. CopyTIdUInt32(LVal, FBytes, LIndex);
  861. if LIndex >= FSize then begin
  862. FSize := LIndex+4;
  863. end;
  864. end;
  865. procedure TIdBuffer.Write(const ABytes: TIdBytes; const ALength, AOffset : Integer;
  866. const ADestIndex: Integer = -1);
  867. var
  868. LByteLength: Integer;
  869. LIndex : Integer;
  870. begin
  871. LByteLength := IndyLength(ABytes, ALength, AOffset);
  872. if LByteLength = 0 then begin
  873. Exit;
  874. end;
  875. LIndex := IndyMax(ADestIndex, 0);
  876. CheckAdd(LByteLength, LIndex);
  877. if Size = 0 then begin
  878. FHeadIndex := 0;
  879. if ADestIndex < 0 then
  880. begin
  881. FBytes := ToBytes(ABytes, LByteLength, AOffset);
  882. FSize := LByteLength;
  883. end else
  884. begin
  885. FSize := ADestIndex + LByteLength;
  886. SetLength(FBytes, FSize);
  887. CopyTIdBytes(ABytes, AOffset, FBytes, ADestIndex, LByteLength);
  888. end;
  889. end
  890. else if ADestIndex < 0 then
  891. begin
  892. CompactHead(False);
  893. if (Capacity - Size - FHeadIndex) < LByteLength then begin
  894. SetLength(FBytes, Size + LByteLength + GrowthFactor);
  895. end;
  896. CopyTIdBytes(ABytes, AOffset, FBytes, FHeadIndex + Size, LByteLength);
  897. Inc(FSize, LByteLength);
  898. end else
  899. begin
  900. CopyTIdBytes(ABytes, AOffset, FBytes, LIndex, LByteLength);
  901. if LIndex >= FSize then begin
  902. FSize := LIndex + LByteLength;
  903. end;
  904. end;
  905. end;
  906. function TIdBuffer.GetAsString: string;
  907. begin
  908. Result := BytesToString(FBytes, FByteEncoding
  909. {$IFDEF STRING_IS_ANSI}, FAnsiEncoding{$ENDIF}
  910. );
  911. end;
  912. end.