Download fixed idcoder3to4.pas

  1. { $HDR$}
  2. {**********************************************************************}
  3. { Unit archived using Team Coherence }
  4. { Team Coherence is Copyright 2002 by Quality Software Components }
  5. { }
  6. { For further information / comments, visit our WEB site at }
  7. { http://www.TeamCoherence.com }
  8. {**********************************************************************}
  9. {}
  10. { $Log: 13754: IdCoder3to4.pas
  11. {
  12. { Rev 1.30 15.09.2004 22:38:22 Andreas Hausladen
  13. { Added "Delphi 7.1 compiler warning bug" fix code
  14. }
  15. {
  16. { Rev 1.29 27.08.2004 22:03:22 Andreas Hausladen
  17. { Optimized encoders
  18. { speed optimization ("const" for string parameters)
  19. }
  20. {
  21. { Rev 1.28 7/8/04 5:09:04 PM RLebeau
  22. { Updated Encode() to remove use of local TIdBytes variable
  23. }
  24. {
  25. { Rev 1.27 2004.05.20 1:39:20 PM czhower
  26. { Last of the IdStream updates
  27. }
  28. {
  29. { Rev 1.26 2004.05.20 11:37:08 AM czhower
  30. { IdStreamVCL
  31. }
  32. {
  33. { Rev 1.25 2004.05.20 11:13:12 AM czhower
  34. { More IdStream conversions
  35. }
  36. {
  37. { Rev 1.24 2004.05.19 3:06:54 PM czhower
  38. { IdStream / .NET fix
  39. }
  40. {
  41. { Rev 1.23 2004.03.12 7:54:18 PM czhower
  42. { Removed old commented out code.
  43. }
  44. {
  45. { Rev 1.22 11/03/2004 22:36:14 CCostelloe
  46. { Bug fix (1 to 3 spurious extra characters at the end of UUE encoded messages,
  47. { see comment starting CC3.
  48. }
  49. {
  50. { Rev 1.21 2004.02.03 5:44:56 PM czhower
  51. { Name changes
  52. }
  53. {
  54. { Rev 1.20 28/1/2004 6:22:16 PM SGrobety
  55. { Removed base 64 encoding stream length check is stream size was provided
  56. }
  57. {
  58. { Rev 1.19 16/01/2004 17:47:48 CCostelloe
  59. { Restructured slightly to allow IdCoderBinHex4 reuse some of its code
  60. }
  61. {
  62. { Rev 1.18 02/01/2004 20:59:28 CCostelloe
  63. { Fixed bugs to get ported code to work in Delphi 7 (changes marked CC2)
  64. }
  65. {
  66. { Rev 1.17 11/10/2003 7:54:14 PM BGooijen
  67. { Did all todo's ( TStream to TIdStream mainly )
  68. }
  69. {
  70. { Rev 1.16 2003.10.24 10:43:02 AM czhower
  71. { TIdSTream to dos
  72. }
  73. {
  74. { Rev 1.15 22/10/2003 12:25:36 HHariri
  75. { Stephanes changes
  76. }
  77. {
  78. Rev 1.14 10/16/2003 11:10:18 PM DSiders
  79. Added localization comments, whitespace.
  80. }
  81. {
  82. { Rev 1.13 2003.10.11 10:00:12 PM czhower
  83. { Compiles again
  84. }
  85. {
  86. { Rev 1.12 10/5/2003 4:31:02 PM GGrieve
  87. { use ToBytes for Cardinal to Bytes conversion
  88. }
  89. {
  90. { Rev 1.11 10/4/2003 9:12:18 PM GGrieve
  91. { DotNet
  92. }
  93. {
  94. { Rev 1.10 2003.06.24 12:02:10 AM czhower
  95. { Coders now decode properly again.
  96. }
  97. {
  98. { Rev 1.9 2003.06.23 10:53:16 PM czhower
  99. { Removed unused overriden methods.
  100. }
  101. {
  102. { Rev 1.8 2003.06.13 6:57:10 PM czhower
  103. { Speed improvement
  104. }
  105. {
  106. { Rev 1.7 2003.06.13 3:41:18 PM czhower
  107. { Optimizaitions.
  108. }
  109. {
  110. { Rev 1.6 2003.06.13 2:24:08 PM czhower
  111. { Speed improvement
  112. }
  113. {
  114. { Rev 1.5 10/6/2003 5:37:02 PM SGrobety
  115. { Bug fix in decoders.
  116. }
  117. {
  118. { Rev 1.4 6/6/2003 4:50:30 PM SGrobety
  119. { Reworked the 3to4decoder for performance and stability.
  120. { Note that encoders haven't been touched. Will come later. Another problem:
  121. { input is ALWAYS a string. Should be a TStream.
  122. {
  123. { 1/ Fix: added filtering for #13,#10 and #32 to the decoding mechanism.
  124. { 2/ Optimization: Speed the decoding by a factor 7-10 AND added filtering ;)
  125. { Could still do better by using a pointer and a stiding window by a factor 2-3.
  126. { 3/ Improvement: instead of writing everything to the output stream, there is
  127. { an internal buffer of 4k. It should speed things up when working on large
  128. { data (no large chunk of memory pre-allocated while keeping a decent perf by
  129. { not requiring every byte to be written separately).
  130. }
  131. {
  132. { Rev 1.3 28/05/2003 10:06:56 CCostelloe
  133. { StripCRLFs changes stripped out at the request of Chad
  134. }
  135. {
  136. { Rev 1.2 20/05/2003 02:01:00 CCostelloe
  137. }
  138. {
  139. { Rev 1.1 20/05/2003 01:44:12 CCostelloe
  140. { Bug fix: decoder code altered to ensure that any CRLFs inserted by an MTA are
  141. { removed
  142. }
  143. {
  144. { Rev 1.0 11/14/2002 02:14:36 PM JPMugaas
  145. }
  146. unit IdCoder3to4;
  147.  
  148. interface
  149.  
  150. uses
  151. Classes,
  152. IdCoder, IdGlobal, IdStreamRandomAccess;
  153.  
  154. type
  155. TIdDecodeTable = array[1..127] of Byte;
  156.  
  157. TIdEncoder3to4 = class(TIdEncoder)
  158. protected
  159. FCodingTable: string;
  160. FFillChar: Char;
  161. function EncodeIdBytes(ABuffer: TIdBytes): TIdBytes;
  162. public
  163. function Encode(ASrcStream: TIdStreamRandomAccess;
  164. const ABytes: Integer = MaxInt): string; override;
  165. //procedure EncodeUnit(const AIn1, AIn2, AIn3: Byte; var VOut: TIdBytes);
  166. published
  167. property CodingTable: string read FCodingTable;
  168. property FillChar: Char read FFillChar write FFillChar;
  169. end;
  170.  
  171. TIdEncoder3to4Class = class of TIdEncoder3to4;
  172.  
  173. TIdDecoder4to3 = class(TIdDecoder)
  174. protected
  175. FCodingTable: string;
  176. FDecodeTable: TIdDecodeTable;
  177. FFillChar: Char;
  178. function InternalDecode(const LIn: TIdBytes; const AStartPos: Integer = 1; const ABytes: Integer = -1): TIdBytes;
  179. public
  180. class procedure ConstructDecodeTable(const ACodingTable: string;
  181. var ADecodeArray: TIdDecodeTable);
  182. procedure Decode(const AIn: string; const AStartPos: Integer = 1;
  183. const ABytes: Integer = -1); override;
  184. published
  185. property FillChar: Char read FFillChar write FFillChar;
  186. end;
  187.  
  188. implementation
  189.  
  190. uses
  191. WStrUtils,
  192. IdException, IdResourceStrings,
  193. SysUtils;
  194.  
  195. { TIdDecoder4to3 }
  196.  
  197. class procedure TIdDecoder4to3.ConstructDecodeTable(const ACodingTable: string;
  198. var ADecodeArray: TIdDecodeTable);
  199. var
  200. i: integer;
  201. begin
  202. //TODO: See if we can find an efficient way, or maybe an option to see if the requested
  203. //decode char is valid, that is it returns a 255 from the DecodeTable, or at maybe
  204. //check its presence in the encode table.
  205. for i := Low(ADecodeArray) to High(ADecodeArray) do begin
  206. ADecodeArray[i] := 255;
  207. end;
  208. for i := 1 to Length(ACodingTable) do begin
  209. ADecodeArray[Ord(ACodingTable[i])] := i - 1;
  210. end;
  211. end;
  212.  
  213. procedure TIdDecoder4to3.Decode(const AIn: string; const AStartPos: Integer = 1; const ABytes: Integer = -1);
  214. var
  215. LIn: TIdBytes;
  216. LOut: TIdBytes;
  217. begin
  218. if AIn <> '' then begin
  219. if ((length(AIn) mod 4) <> 0) or ContainsAltChars(AIn) then exit;
  220. SetLength(LIn, 0); // Delphi 7.1 first edition warning bug
  221. SetLength(LOut, 0); // Delphi 7.1 first edition warning bug
  222. LIn := ToBytes(AIn); // if in dotnet, convert to serialisable format
  223. LOut := InternalDecode(LIn, AStartPos, ABytes);
  224. // Write out data to stream
  225. FStream.Write(LOut);
  226. end;
  227. end;
  228.  
  229. function TIdDecoder4to3.InternalDecode(const LIn: TIdBytes; const AStartPos: Integer = 1; const ABytes: Integer = -1): TIdBytes;
  230. const
  231. LInBytesLen = 4;
  232. var
  233. LEmptyBytes: Integer;
  234. LInBytes: array[0..LInBytesLen - 1] of Byte;
  235. LWorkBytes: TIdBytes;
  236. LOutPos: Integer;
  237. LOutSize: Integer;
  238. LInLimit: Integer;
  239. LInPos: Integer;
  240. LWhole: Cardinal;
  241. LFillChar: Char; // local copy of FFillChar
  242. begin
  243. LFillChar := FillChar;
  244. SetLength(LWorkBytes, 4);
  245.  
  246. //TODO: Change output to a TMemoryStream
  247. LEmptyBytes := 0;
  248. // Presize output buffer
  249. //CC2, bugfix: was LOutPos := 1;
  250. LOutPos := 0;
  251. if ABytes = -1 then begin
  252. //LOutSize := (Length(AIn) div 4) * 3;
  253. LOutSize := (Length(LIn) div 4) * 3;
  254. end else begin
  255. // Need to make sure we have space as we always write out 3 and then trim
  256. // because it requires less checking in the loop
  257. if ABytes mod 3 > 0 then begin
  258. LOutSize := (ABytes div 3) * 3 + 3;
  259. end else begin
  260. LOutSize := ABytes;
  261. end;
  262. end;
  263. SetLength(Result, LOutSize);
  264. //
  265. LInPos := AStartPos;
  266. // +1 because LInPos is 1 based
  267. LInLimit := Length(LIn) - LInBytesLen + 1;
  268. while LInPos <= LInLimit do begin
  269. // Read 4 bytes in for processing
  270. //CC2 bugfix: was CopyTIdBytes(LIn, LInPos, LInBytes, 0, LInBytesLen);
  271. //CopyTIdBytes(LIn, LInPos-1, LInBytes, 0, LInBytesLen);
  272. // Faster than CopyTIdBytes
  273. LInBytes[0] := LIn[LInPos - 1];
  274. LInBytes[1] := LIn[LInPos - 1 + 1];
  275. LInBytes[2] := LIn[LInPos - 1 + 2];
  276. LInBytes[3] := LIn[LInPos - 1 + 3];
  277. // Inc pointer
  278. Inc(LInPos, LInBytesLen);
  279. // Reduce to 3 bytes
  280. LWhole :=
  281. (FDecodeTable[LInBytes[0]] shl 18)
  282. or (FDecodeTable[LInBytes[1]] shl 12)
  283. or (FDecodeTable[LInBytes[2]] shl 6)
  284. or FDecodeTable[LInBytes[3]];
  285. ToBytesF(LWorkBytes, LWhole);
  286.  
  287. //TODO: Temp - Change the above to reconstruct in our order if possible
  288. // Then we can call a move on all 3 bytes
  289. Result[LOutPos] := LWorkBytes[2];
  290. Result[LOutPos + 1] := LWorkBytes[1];
  291. Result[LOutPos + 2] := LWorkBytes[0];
  292. Inc(LOutPos, 3);
  293. // If we dont know how many bytes we need to watch for fill chars. MIME
  294. // is this way.
  295. //
  296. // In best case, the end is not before the end of the input, but the input
  297. // may be right padded with spaces, or even contain the EOL chars.
  298. //
  299. // Because of this we watch for early ends beyond what we originally
  300. // estimated.
  301. if ABytes = -1 then begin
  302. // Must check 3 before 4, if 3 is FillChar, 4 will also be FillChar
  303. if LInBytes[2] = ord(LFillChar) then begin
  304. LEmptyBytes := 2;
  305. Break;
  306. end else if LInBytes[3] = ord(LFillChar) then begin
  307. LEmptyBytes := 1;
  308. Break;
  309. end;
  310. // But with 00E's, we have a length signal for each line so we know
  311. end else if LOutPos > ABytes then begin
  312. LEmptyBytes := LOutPos - ABytes;
  313. Break;
  314. end;
  315. end;
  316. if LEmptyBytes > 0 then
  317. SetLength(Result, LOutSize - LEmptyBytes);
  318. end;
  319.  
  320. { TIdEncoder3to4 }
  321.  
  322. function TIdEncoder3to4.Encode(ASrcStream: TIdStreamRandomAccess; const ABytes: Integer = MaxInt): string;
  323. //TODO: Make this more efficient. Profile it to test, but maybe make single
  324. // calls to ReadBuffer then pull from memory
  325. var
  326. LBuffer: TIdBytes;
  327. LBufSize: Integer;
  328. begin
  329. //CC2: generated "never used" hint: LIn3 := 0;
  330. // SG 28.01.04: removed that check: it's only there to "optimize" the output strin
  331. // SG 28.01.04: and creates more trouble than it solves.
  332. // if (ABytes <> MaxInt) and ((ABytes mod 3) > 0) then begin
  333. // raise EIdException.Create(RSUnevenSizeInEncodeStream);
  334. // end;
  335.  
  336. // No no - this will read the whole thing into memory and what if its MBs?
  337. // need to load it in smaller buffered chunks MaxInt is WAY too big....
  338. LBufSize := Min(ASrcStream.Size - ASrcStream.Position, ABytes);
  339. if LBufSize > 0 then begin
  340. SetLength(LBuffer, LBufSize);
  341. ASrcStream.ReadBytes(LBuffer, LBufSize);
  342. Result := BytesToString(EncodeIdBytes(LBuffer));
  343. end else begin
  344. Result := '';
  345. end;
  346. end;
  347.  
  348. function TIdEncoder3to4.EncodeIdBytes(ABuffer: TIdBytes): TIdBytes;
  349. var
  350. LOutSize: Integer;
  351. LLen: integer;
  352. LPos: Integer;
  353. LBufSize: Integer;
  354. LBufDataLen: Integer;
  355. LIn1, LIn2, LIn3: Byte;
  356. LSize: Integer;
  357. LUnit: array[0..3] of Byte; // TIdBytes;
  358. begin
  359. LBufSize := Length(ABuffer);
  360. LOutSize := ((LBufSize + 2) div 3) * 4;
  361. SetLength(Result, LOutSize); // we know that the string will grow by 4/3 adjusted to 3 boundary
  362. //SetLength(LUnit, 4);
  363. LLen := 0;
  364. LPos := 0;
  365.  
  366. // S.G. 21/10/2003: Copy the relevant bytes into the temporary buffer.
  367. // S.G. 21/10/2003: Record the data length and force exit loop when necessary
  368. while (LPos <= LBufSize) do
  369. begin
  370. LBufDataLen := LBufSize - LPos;
  371. if LBufDataLen > 3 then
  372. begin
  373. LIn1 := ABuffer[LPos];
  374. LIn2 := ABuffer[LPos + 1];
  375. LIn3 := ABuffer[LPos + 2];
  376. LSize := 3;
  377. inc(LPos, 3);
  378. end
  379. else
  380. begin
  381. if LBufDataLen > 2 then
  382. begin
  383. LIn1 := ABuffer[LPos];
  384. LIn2 := ABuffer[LPos + 1];
  385. LIn3 := ABuffer[LPos + 2];
  386. LSize := 3;
  387. LPos := LBufSize + 1; // Make sure we break at end of loop
  388. end
  389. else
  390. begin
  391. if LBufDataLen > 1 then
  392. begin
  393. LIn1 := ABuffer[LPos];
  394. LIn2 := ABuffer[LPos + 1];
  395. LIn3 := 0;
  396. LSize := 2;
  397. LPos := LBufSize + 1; // Make sure we break at end of loop
  398. end
  399. else
  400. begin
  401. LIn1 := ABuffer[LPos];
  402. LIn2 := 0;
  403. LIn3 := 0;
  404. LSize := 1;
  405. LPos := LBufSize + 1; // Make sure we break at end of loop
  406. end;
  407. end;
  408. end;
  409.  
  410. //EncodeUnit(LIn1, LIn2, LIn3, LUnit);
  411. // inline
  412. LUnit[0] := Ord(FCodingTable[((LIn1 shr 2) and 63) + 1]);
  413. LUnit[1] := Ord(FCodingTable[(((LIn1 shl 4) or (LIn2 shr 4)) and 63) + 1]);
  414. LUnit[2] := Ord(FCodingTable[(((LIn2 shl 2) or (LIn3 shr 6)) and 63) + 1]);
  415. LUnit[3] := Ord(FCodingTable[(Ord(LIn3) and 63) + 1]);
  416.  
  417. assert(LLen + 4 <= length(Result),
  418. 'TIdEncoder3to4.Encode: Calculated length exceeded (expected ' + {do not localize}
  419. inttostr(4 * trunc((LBufSize + 2) / 3)) +
  420. ', about to go ' + {do not localize}
  421. inttostr(LLen + 4) +
  422. ' at offset ' + {do not localize}
  423. inttostr(LPos) +
  424. ' of ' + {do not localize}
  425. inttostr(LBufSize));
  426.  
  427. //CopyTIdBytes(LUnit, 0, Result, LLen, 4);
  428. Result[LLen] := LUnit[0];
  429. Result[LLen + 1] := LUnit[1];
  430. Result[LLen + 2] := LUnit[2];
  431. Result[LLen + 3] := LUnit[3];
  432. inc(LLen, 4);
  433.  
  434. if LSize < 3 then begin
  435. Result[LLen - 1] := ord(FillChar);
  436. if LSize = 1 then begin
  437. Result[LLen - 2] := ord(FillChar);
  438. end;
  439. end;
  440. end;
  441.  
  442. assert(LLen = (4 * trunc((LBufSize + 2) / 3)),
  443. 'TIdEncoder3to4.Encode: Calculated length not met (expected ' + {do not localize}
  444. inttostr(4 * trunc((LBufSize + 2) / 3)) +
  445. ', finished at ' + {do not localize}
  446. inttostr(LLen + 4) +
  447. ', Bufsize = ' + {do not localize}
  448. inttostr(LBufSize));
  449. end;
  450.  
  451. (*procedure TIdEncoder3to4.EncodeUnit(const AIn1, AIn2, AIn3: Byte; var VOut: TIdBytes);
  452. begin
  453. SetLength(VOut, 4);
  454. VOut[0] := Ord(FCodingTable[((AIn1 shr 2) and 63) + 1]);
  455. VOut[1] := Ord(FCodingTable[(((AIn1 shl 4) or (AIn2 shr 4)) and 63) + 1]);
  456. VOut[2] := Ord(FCodingTable[(((AIn2 shl 2) or (AIn3 shr 6)) and 63) + 1]);
  457. VOut[3] := Ord(FCodingTable[(Ord(AIn3) and 63) + 1]);
  458. end;*)
  459.  
  460. end.
  461.