home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / kompon / d3456 / SYNAPSE.ZIP / source / lib / SynaCode.pas < prev    next >
Pascal/Delphi Source File  |  2002-07-07  |  31KB  |  822 lines
  1. {==============================================================================|
  2. | Project : Delphree - Synapse                                   | 001.005.005 |
  3. |==============================================================================|
  4. | Content: Coding and decoding support                                         |
  5. |==============================================================================|
  6. | Copyright (c)1999-2002, Lukas Gebauer                                        |
  7. | All rights reserved.                                                         |
  8. |                                                                              |
  9. | Redistribution and use in source and binary forms, with or without           |
  10. | modification, are permitted provided that the following conditions are met:  |
  11. |                                                                              |
  12. | Redistributions of source code must retain the above copyright notice, this  |
  13. | list of conditions and the following disclaimer.                             |
  14. |                                                                              |
  15. | Redistributions in binary form must reproduce the above copyright notice,    |
  16. | this list of conditions and the following disclaimer in the documentation    |
  17. | and/or other materials provided with the distribution.                       |
  18. |                                                                              |
  19. | Neither the name of Lukas Gebauer nor the names of its contributors may      |
  20. | be used to endorse or promote products derived from this software without    |
  21. | specific prior written permission.                                           |
  22. |                                                                              |
  23. | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
  24. | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
  25. | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
  26. | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
  27. | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
  28. | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
  29. | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
  30. | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
  31. | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
  32. | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
  33. | DAMAGE.                                                                      |
  34. |==============================================================================|
  35. | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
  36. | Portions created by Lukas Gebauer are Copyright (c)2000-2002.                |
  37. | All Rights Reserved.                                                         |
  38. |==============================================================================|
  39. | Contributor(s):                                                              |
  40. |==============================================================================|
  41. | History: see HISTORY.HTM from distribution package                           |
  42. |          (Found at URL: http://www.ararat.cz/synapse/)                       |
  43. |==============================================================================}
  44.  
  45. {$Q-}
  46. {$WEAKPACKAGEUNIT ON}
  47.  
  48. unit SynaCode;
  49.  
  50. interface
  51.  
  52. uses
  53.   SysUtils;
  54.  
  55. type
  56.   TSpecials = set of Char;
  57.  
  58. const
  59.  
  60.   SpecialChar: TSpecials =
  61.   ['=', '(', ')', '[', ']', '<', '>', ':', ';', '.', ',', '@', '/', '?', '\',
  62.     '"', '_'];
  63.   URLFullSpecialChar: TSpecials =
  64.   [';', '/', '?', ':', '@', '=', '&', '#'];
  65.   URLSpecialChar: TSpecials =
  66.   [#$00..#$20, '_', '<', '>', '"', '%', '{', '}', '|', '\', '^', '~', '[', ']',
  67.     '`', #$7F..#$FF];
  68.   TableBase64 =
  69.     'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
  70.   TableUU =
  71.     '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
  72.   TableXX =
  73.     '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_';
  74.   ReTablebase64 =
  75.     #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40
  76.     +#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
  77.     +#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03
  78.     +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F
  79.     +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40
  80.     +#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21
  81.     +#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
  82.     +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
  83.   ReTableUU =
  84.     #$01 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C
  85.     +#$0D +#$0E +#$0F +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18
  86.     +#$19 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24
  87.     +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D +#$2E +#$2F +#$30
  88.     +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
  89.     +#$3D +#$3E +#$3F +#$00 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
  90.     +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
  91.     +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
  92.   ReTableXX =
  93.     #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$40
  94.     +#$01 +#$40 +#$40 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A
  95.     +#$0B +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$0C +#$0D +#$0E +#$0F
  96.     +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$1A +#$1B
  97.     +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24 +#$25 +#$40 +#$40
  98.     +#$40 +#$40 +#$40 +#$40 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
  99.     +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39
  100.     +#$3A +#$3B +#$3C +#$3D +#$3E +#$3F +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
  101.  
  102. function DecodeTriplet(const Value: string; Delimiter: Char): string;
  103. function DecodeQuotedPrintable(const Value: string): string;
  104. function DecodeURL(const Value: string): string;
  105. function EncodeTriplet(const Value: string; Delimiter: Char;
  106.   Specials: TSpecials): string;
  107. function EncodeQuotedPrintable(const Value: string): string;
  108. function EncodeURLElement(const Value: string): string;
  109. function EncodeURL(const Value: string): string;
  110. function Decode4to3(const Value, Table: string): string;
  111. function Decode4to3Ex(const Value, Table: string): string;
  112. function Encode3to4(const Value, Table: string): string;
  113. function DecodeBase64(const Value: string): string;
  114. function EncodeBase64(const Value: string): string;
  115. function DecodeUU(const Value: string): string;
  116. function DecodeXX(const Value: string): string;
  117. function UpdateCrc32(Value: Byte; Crc32: Integer): Integer;
  118. function Crc32(const Value: string): Integer;
  119. function UpdateCrc16(Value: Byte; Crc16: Word): Word;
  120. function Crc16(const Value: string): Word;
  121. function MD5(const Value: string): string;
  122. function HMAC_MD5(Text, Key: string): string;
  123.  
  124. implementation
  125.  
  126. const
  127.  
  128.   Crc32Tab: array[0..255] of Integer = (
  129.     Integer($00000000), Integer($77073096), Integer($EE0E612C), Integer($990951BA),
  130.     Integer($076DC419), Integer($706AF48F), Integer($E963A535), Integer($9E6495A3),
  131.     Integer($0EDB8832), Integer($79DCB8A4), Integer($E0D5E91E), Integer($97D2D988),
  132.     Integer($09B64C2B), Integer($7EB17CBD), Integer($E7B82D07), Integer($90BF1D91),
  133.     Integer($1DB71064), Integer($6AB020F2), Integer($F3B97148), Integer($84BE41DE),
  134.     Integer($1ADAD47D), Integer($6DDDE4EB), Integer($F4D4B551), Integer($83D385C7),
  135.     Integer($136C9856), Integer($646BA8C0), Integer($FD62F97A), Integer($8A65C9EC),
  136.     Integer($14015C4F), Integer($63066CD9), Integer($FA0F3D63), Integer($8D080DF5),
  137.     Integer($3B6E20C8), Integer($4C69105E), Integer($D56041E4), Integer($A2677172),
  138.     Integer($3C03E4D1), Integer($4B04D447), Integer($D20D85FD), Integer($A50AB56B),
  139.     Integer($35B5A8FA), Integer($42B2986C), Integer($DBBBC9D6), Integer($ACBCF940),
  140.     Integer($32D86CE3), Integer($45DF5C75), Integer($DCD60DCF), Integer($ABD13D59),
  141.     Integer($26D930AC), Integer($51DE003A), Integer($C8D75180), Integer($BFD06116),
  142.     Integer($21B4F4B5), Integer($56B3C423), Integer($CFBA9599), Integer($B8BDA50F),
  143.     Integer($2802B89E), Integer($5F058808), Integer($C60CD9B2), Integer($B10BE924),
  144.     Integer($2F6F7C87), Integer($58684C11), Integer($C1611DAB), Integer($B6662D3D),
  145.     Integer($76DC4190), Integer($01DB7106), Integer($98D220BC), Integer($EFD5102A),
  146.     Integer($71B18589), Integer($06B6B51F), Integer($9FBFE4A5), Integer($E8B8D433),
  147.     Integer($7807C9A2), Integer($0F00F934), Integer($9609A88E), Integer($E10E9818),
  148.     Integer($7F6A0DBB), Integer($086D3D2D), Integer($91646C97), Integer($E6635C01),
  149.     Integer($6B6B51F4), Integer($1C6C6162), Integer($856530D8), Integer($F262004E),
  150.     Integer($6C0695ED), Integer($1B01A57B), Integer($8208F4C1), Integer($F50FC457),
  151.     Integer($65B0D9C6), Integer($12B7E950), Integer($8BBEB8EA), Integer($FCB9887C),
  152.     Integer($62DD1DDF), Integer($15DA2D49), Integer($8CD37CF3), Integer($FBD44C65),
  153.     Integer($4DB26158), Integer($3AB551CE), Integer($A3BC0074), Integer($D4BB30E2),
  154.     Integer($4ADFA541), Integer($3DD895D7), Integer($A4D1C46D), Integer($D3D6F4FB),
  155.     Integer($4369E96A), Integer($346ED9FC), Integer($AD678846), Integer($DA60B8D0),
  156.     Integer($44042D73), Integer($33031DE5), Integer($AA0A4C5F), Integer($DD0D7CC9),
  157.     Integer($5005713C), Integer($270241AA), Integer($BE0B1010), Integer($C90C2086),
  158.     Integer($5768B525), Integer($206F85B3), Integer($B966D409), Integer($CE61E49F),
  159.     Integer($5EDEF90E), Integer($29D9C998), Integer($B0D09822), Integer($C7D7A8B4),
  160.     Integer($59B33D17), Integer($2EB40D81), Integer($B7BD5C3B), Integer($C0BA6CAD),
  161.     Integer($EDB88320), Integer($9ABFB3B6), Integer($03B6E20C), Integer($74B1D29A),
  162.     Integer($EAD54739), Integer($9DD277AF), Integer($04DB2615), Integer($73DC1683),
  163.     Integer($E3630B12), Integer($94643B84), Integer($0D6D6A3E), Integer($7A6A5AA8),
  164.     Integer($E40ECF0B), Integer($9309FF9D), Integer($0A00AE27), Integer($7D079EB1),
  165.     Integer($F00F9344), Integer($8708A3D2), Integer($1E01F268), Integer($6906C2FE),
  166.     Integer($F762575D), Integer($806567CB), Integer($196C3671), Integer($6E6B06E7),
  167.     Integer($FED41B76), Integer($89D32BE0), Integer($10DA7A5A), Integer($67DD4ACC),
  168.     Integer($F9B9DF6F), Integer($8EBEEFF9), Integer($17B7BE43), Integer($60B08ED5),
  169.     Integer($D6D6A3E8), Integer($A1D1937E), Integer($38D8C2C4), Integer($4FDFF252),
  170.     Integer($D1BB67F1), Integer($A6BC5767), Integer($3FB506DD), Integer($48B2364B),
  171.     Integer($D80D2BDA), Integer($AF0A1B4C), Integer($36034AF6), Integer($41047A60),
  172.     Integer($DF60EFC3), Integer($A867DF55), Integer($316E8EEF), Integer($4669BE79),
  173.     Integer($CB61B38C), Integer($BC66831A), Integer($256FD2A0), Integer($5268E236),
  174.     Integer($CC0C7795), Integer($BB0B4703), Integer($220216B9), Integer($5505262F),
  175.     Integer($C5BA3BBE), Integer($B2BD0B28), Integer($2BB45A92), Integer($5CB36A04),
  176.     Integer($C2D7FFA7), Integer($B5D0CF31), Integer($2CD99E8B), Integer($5BDEAE1D),
  177.     Integer($9B64C2B0), Integer($EC63F226), Integer($756AA39C), Integer($026D930A),
  178.     Integer($9C0906A9), Integer($EB0E363F), Integer($72076785), Integer($05005713),
  179.     Integer($95BF4A82), Integer($E2B87A14), Integer($7BB12BAE), Integer($0CB61B38),
  180.     Integer($92D28E9B), Integer($E5D5BE0D), Integer($7CDCEFB7), Integer($0BDBDF21),
  181.     Integer($86D3D2D4), Integer($F1D4E242), Integer($68DDB3F8), Integer($1FDA836E),
  182.     Integer($81BE16CD), Integer($F6B9265B), Integer($6FB077E1), Integer($18B74777),
  183.     Integer($88085AE6), Integer($FF0F6A70), Integer($66063BCA), Integer($11010B5C),
  184.     Integer($8F659EFF), Integer($F862AE69), Integer($616BFFD3), Integer($166CCF45),
  185.     Integer($A00AE278), Integer($D70DD2EE), Integer($4E048354), Integer($3903B3C2),
  186.     Integer($A7672661), Integer($D06016F7), Integer($4969474D), Integer($3E6E77DB),
  187.     Integer($AED16A4A), Integer($D9D65ADC), Integer($40DF0B66), Integer($37D83BF0),
  188.     Integer($A9BCAE53), Integer($DEBB9EC5), Integer($47B2CF7F), Integer($30B5FFE9),
  189.     Integer($BDBDF21C), Integer($CABAC28A), Integer($53B39330), Integer($24B4A3A6),
  190.     Integer($BAD03605), Integer($CDD70693), Integer($54DE5729), Integer($23D967BF),
  191.     Integer($B3667A2E), Integer($C4614AB8), Integer($5D681B02), Integer($2A6F2B94),
  192.     Integer($B40BBE37), Integer($C30C8EA1), Integer($5A05DF1B), Integer($2D02EF8D)
  193.     );
  194.  
  195.   Crc16Tab: array[0..255] of Word = (
  196.     $0000, $1189, $2312, $329B, $4624, $57AD, $6536, $74BF,
  197.     $8C48, $9DC1, $AF5A, $BED3, $CA6C, $DBE5, $E97E, $F8F7,
  198.     $1081, $0108, $3393, $221A, $56A5, $472C, $75B7, $643E,
  199.     $9CC9, $8D40, $BFDB, $AE52, $DAED, $CB64, $F9FF, $E876,
  200.     $2102, $308B, $0210, $1399, $6726, $76AF, $4434, $55BD,
  201.     $AD4A, $BCC3, $8E58, $9FD1, $EB6E, $FAE7, $C87C, $D9F5,
  202.     $3183, $200A, $1291, $0318, $77A7, $662E, $54B5, $453C,
  203.     $BDCB, $AC42, $9ED9, $8F50, $FBEF, $EA66, $D8FD, $C974,
  204.     $4204, $538D, $6116, $709F, $0420, $15A9, $2732, $36BB,
  205.     $CE4C, $DFC5, $ED5E, $FCD7, $8868, $99E1, $AB7A, $BAF3,
  206.     $5285, $430C, $7197, $601E, $14A1, $0528, $37B3, $263A,
  207.     $DECD, $CF44, $FDDF, $EC56, $98E9, $8960, $BBFB, $AA72,
  208.     $6306, $728F, $4014, $519D, $2522, $34AB, $0630, $17B9,
  209.     $EF4E, $FEC7, $CC5C, $DDD5, $A96A, $B8E3, $8A78, $9BF1,
  210.     $7387, $620E, $5095, $411C, $35A3, $242A, $16B1, $0738,
  211.     $FFCF, $EE46, $DCDD, $CD54, $B9EB, $A862, $9AF9, $8B70,
  212.     $8408, $9581, $A71A, $B693, $C22C, $D3A5, $E13E, $F0B7,
  213.     $0840, $19C9, $2B52, $3ADB, $4E64, $5FED, $6D76, $7CFF,
  214.     $9489, $8500, $B79B, $A612, $D2AD, $C324, $F1BF, $E036,
  215.     $18C1, $0948, $3BD3, $2A5A, $5EE5, $4F6C, $7DF7, $6C7E,
  216.     $A50A, $B483, $8618, $9791, $E32E, $F2A7, $C03C, $D1B5,
  217.     $2942, $38CB, $0A50, $1BD9, $6F66, $7EEF, $4C74, $5DFD,
  218.     $B58B, $A402, $9699, $8710, $F3AF, $E226, $D0BD, $C134,
  219.     $39C3, $284A, $1AD1, $0B58, $7FE7, $6E6E, $5CF5, $4D7C,
  220.     $C60C, $D785, $E51E, $F497, $8028, $91A1, $A33A, $B2B3,
  221.     $4A44, $5BCD, $6956, $78DF, $0C60, $1DE9, $2F72, $3EFB,
  222.     $D68D, $C704, $F59F, $E416, $90A9, $8120, $B3BB, $A232,
  223.     $5AC5, $4B4C, $79D7, $685E, $1CE1, $0D68, $3FF3, $2E7A,
  224.     $E70E, $F687, $C41C, $D595, $A12A, $B0A3, $8238, $93B1,
  225.     $6B46, $7ACF, $4854, $59DD, $2D62, $3CEB, $0E70, $1FF9,
  226.     $F78F, $E606, $D49D, $C514, $B1AB, $A022, $92B9, $8330,
  227.     $7BC7, $6A4E, $58D5, $495C, $3DE3, $2C6A, $1EF1, $0F78
  228.     );
  229.  
  230. type
  231.   TMD5Ctx = record
  232.     State: array[0..3] of Integer;
  233.     Count: array[0..1] of Integer;
  234.     case Integer of
  235.       0: (BufChar: array[0..63] of Byte);
  236.       1: (BufLong: array[0..15] of Integer);
  237.   end;
  238.  
  239. {==============================================================================}
  240.  
  241. function DecodeTriplet(const Value: string; Delimiter: Char): string;
  242. var
  243.   x, l: Integer;
  244.   c: Char;
  245.   s: string;
  246. begin
  247.   SetLength(Result, Length(Value));
  248.   x := 1;
  249.   l := 1;
  250.   while x <= Length(Value) do
  251.   begin
  252.     c := Value[x];
  253.     Inc(x);
  254.     if c <> Delimiter then
  255.       Result[l] := c
  256.     else
  257.       if x < Length(Value) then
  258.       begin
  259.         s := Copy(Value, x, 2);
  260.         Inc(x, 2);
  261.         Result[l] := Char(StrToIntDef('$' + s, 32))
  262.       end
  263.       else
  264.         break;
  265.     Inc(l);
  266.   end;
  267.   Dec(l);
  268.   SetLength(Result, l);
  269. end;
  270.  
  271. {==============================================================================}
  272.  
  273. function DecodeQuotedPrintable(const Value: string): string;
  274. begin
  275.   Result := DecodeTriplet(Value, '=');
  276. end;
  277.  
  278. {==============================================================================}
  279.  
  280. function DecodeURL(const Value: string): string;
  281. begin
  282.   Result := DecodeTriplet(Value, '%');
  283. end;
  284.  
  285. {==============================================================================}
  286.  
  287. function EncodeTriplet(const Value: string; Delimiter: Char;
  288.   Specials: TSpecials): string;
  289. var
  290.   n, l: Integer;
  291.   s: string;
  292.   c: char;
  293. begin
  294.   SetLength(Result, Length(Value) * 3);
  295.   l := 1;
  296.   for n := 1 to Length(Value) do
  297.   begin
  298.     c := Value[n];
  299.     if c in Specials then
  300.     begin
  301.       Result[l] := Delimiter;
  302.       Inc(l);
  303.       s := IntToHex(Ord(c), 2);
  304.       Result[l] := s[1];
  305.       Inc(l);
  306.       Result[l] := s[2];
  307.       Inc(l);
  308.     end
  309.     else
  310.     begin
  311.       Result[l] := c;
  312.       Inc(l);
  313.     end;
  314.   end;
  315.   Dec(l);
  316.   SetLength(Result, l);
  317. end;
  318.  
  319. {==============================================================================}
  320.  
  321. function EncodeQuotedPrintable(const Value: string): string;
  322. begin
  323.   Result := EncodeTriplet(Value, '=', SpecialChar +
  324.     [Char(1)..Char(31), Char(128)..Char(255)]);
  325. end;
  326.  
  327. {==============================================================================}
  328.  
  329. function EncodeURLElement(const Value: string): string;
  330. begin
  331.   Result := EncodeTriplet(Value, '%', URLSpecialChar + URLFullSpecialChar);
  332. end;
  333.  
  334. {==============================================================================}
  335.  
  336. function EncodeURL(const Value: string): string;
  337. begin
  338.   Result := EncodeTriplet(Value, '%', URLSpecialChar);
  339. end;
  340.  
  341. {==============================================================================}
  342.  
  343. function Decode4to3(const Value, Table: string): string;
  344. var
  345.   x, y, n, l: Integer;
  346.   d: array[0..3] of Byte;
  347. begin
  348.   SetLength(Result, Length(Value));
  349.   x := 1;
  350.   l := 1;
  351.   while x < Length(Value) do
  352.   begin
  353.     for n := 0 to 3 do
  354.     begin
  355.       if x > Length(Value) then
  356.         d[n] := 64
  357.       else
  358.       begin
  359.         y := Pos(Value[x], Table);
  360.         if y < 1 then
  361.           y := 1;
  362.         d[n] := y - 1;
  363.       end;
  364.       Inc(x);
  365.     end;
  366.     Result[l] := Char((D[0] and $3F) shl 2 + (D[1] and $30) shr 4);
  367.     Inc(l);
  368.     if d[2] <> 64 then
  369.     begin
  370.       Result[l] := Char((D[1] and $0F) shl 4 + (D[2] and $3C) shr 2);
  371.       Inc(l);
  372.       if d[3] <> 64 then
  373.       begin
  374.         Result[l] := Char((D[2] and $03) shl 6 + (D[3] and $3F));
  375.         Inc(l);
  376.       end;
  377.     end;
  378.   end;
  379.   Dec(l);
  380.   SetLength(Result, l);
  381. end;
  382.  
  383. {==============================================================================}
  384.  
  385. function Decode4to3Ex(const Value, Table: string): string;
  386. var
  387.   x, y, n, l: Integer;
  388.   d: array[0..3] of Byte;
  389. begin
  390.   SetLength(Result, Length(Value));
  391.   x := 1;
  392.   l := 1;
  393.   while x < Length(Value) do
  394.   begin
  395.     for n := 0 to 3 do
  396.     begin
  397.       if x > Length(Value) then
  398.         d[n] := 64
  399.       else
  400.       begin
  401.         y := Ord(Value[x]);
  402.         if (y < 33) or (y > 127) then
  403.           d[n] := 64
  404.         else
  405.           d[n] := Ord(Table[y - 32]);
  406.       end;
  407.       Inc(x);
  408.     end;
  409.     Result[l] := Char((D[0] and $3F) shl 2 + (D[1] and $30) shr 4);
  410.     Inc(l);
  411.     if d[2] <> 64 then
  412.     begin
  413.       Result[l] := Char((D[1] and $0F) shl 4 + (D[2] and $3C) shr 2);
  414.       Inc(l);
  415.       if d[3] <> 64 then
  416.       begin
  417.         Result[l] := Char((D[2] and $03) shl 6 + (D[3] and $3F));
  418.         Inc(l);
  419.       end;
  420.     end;
  421.   end;
  422.   Dec(l);
  423.   SetLength(Result, l);
  424. end;
  425.  
  426. {==============================================================================}
  427.  
  428. function Encode3to4(const Value, Table: string): string;
  429. var
  430.   c: Byte;
  431.   n, l: Integer;
  432.   Count: Integer;
  433.   DOut: array[0..3] of Byte;
  434. begin
  435.   setlength(Result, ((Length(Value) + 2) div 3) * 4);
  436.   l := 1;
  437.   Count := 1;
  438.   while Count <= Length(Value) do
  439.   begin
  440.     c := Ord(Value[Count]);
  441.     Inc(Count);
  442.     DOut[0] := (c and $FC) shr 2;
  443.     DOut[1] := (c and $03) shl 4;
  444.     if Count <= Length(Value) then
  445.     begin
  446.       c := Ord(Value[Count]);
  447.       Inc(Count);
  448.       DOut[1] := DOut[1] + (c and $F0) shr 4;
  449.       DOut[2] := (c and $0F) shl 2;
  450.       if Count <= Length(Value) then
  451.       begin
  452.         c := Ord(Value[Count]);
  453.         Inc(Count);
  454.         DOut[2] := DOut[2] + (c and $C0) shr 6;
  455.         DOut[3] := (c and $3F);
  456.       end
  457.       else
  458.       begin
  459.         DOut[3] := $40;
  460.       end;
  461.     end
  462.     else
  463.     begin
  464.       DOut[2] := $40;
  465.       DOut[3] := $40;
  466.     end;
  467.     for n := 0 to 3 do
  468.     begin
  469.       Result[l] := Table[DOut[n] + 1];
  470.       Inc(l);
  471.     end;
  472.   end;
  473. end;
  474.  
  475. {==============================================================================}
  476.  
  477. function DecodeBase64(const Value: string): string;
  478. begin
  479.   Result := Decode4to3Ex(Value, ReTableBase64);
  480. end;
  481.  
  482. {==============================================================================}
  483.  
  484. function EncodeBase64(const Value: string): string;
  485. begin
  486.   Result := Encode3to4(Value, TableBase64);
  487. end;
  488.  
  489. {==============================================================================}
  490.  
  491. function DecodeUU(const Value: string): string;
  492. var
  493.   s: string;
  494.   uut: string;
  495.   x: Integer;
  496. begin
  497.   Result := '';
  498.   uut := TableUU;
  499.   s := trim(UpperCase(Value));
  500.   if s = '' then Exit;
  501.   if Pos('BEGIN', s) = 1 then
  502.     Exit;
  503.   if Pos('END', s) = 1 then
  504.     Exit;
  505.   if Pos('TABLE', s) = 1 then
  506.     Exit; //ignore Table yet (set custom UUT)
  507.   //begin decoding
  508.   x := Pos(Value[1], uut) - 1;
  509.   x := Round((x / 3) * 4);
  510.   //x - lenght UU line
  511.   s := Copy(Value, 2, x);
  512.   if s = '' then
  513.     Exit;
  514.   Result := Decode4to3(s, uut);
  515. end;
  516.  
  517. {==============================================================================}
  518.  
  519. function DecodeXX(const Value: string): string;
  520. var
  521.   s: string;
  522.   x: Integer;
  523. begin
  524.   Result := '';
  525.   s := trim(UpperCase(Value));
  526.   if s = '' then
  527.     Exit;
  528.   if Pos('BEGIN', s) = 1 then
  529.     Exit;
  530.   if Pos('END', s) = 1 then
  531.     Exit;
  532.   //begin decoding
  533.   x := Pos(Value[1], TableXX) - 1;
  534.   x := Round((x / 3) * 4);
  535.   //x - lenght XX line
  536.   s := Copy(Value, 2, x);
  537.   if s = '' then
  538.     Exit;
  539.   Result := Decode4to3(s, TableXX);
  540. end;
  541.  
  542. {==============================================================================}
  543.  
  544. function UpdateCrc32(Value: Byte; Crc32: Integer): Integer;
  545. begin
  546.   Result := ((Crc32 shr 8) and Integer($00FFFFFF)) xor
  547.     crc32tab[Byte(Crc32 xor Integer(Value)) and Integer($000000FF)];
  548. end;
  549.  
  550. {==============================================================================}
  551.  
  552. function Crc32(const Value: string): Integer;
  553. var
  554.   n: Integer;
  555. begin
  556.   Result := Integer($FFFFFFFF);
  557.   for n := 1 to Length(Value) do
  558.     Result := UpdateCrc32(Ord(Value[n]), Result);
  559. end;
  560.  
  561. {==============================================================================}
  562.  
  563. function UpdateCrc16(Value: Byte; Crc16: Word): Word;
  564. begin
  565.   Result := ((Crc16 shr 8) and $00FF) xor
  566.     crc16tab[Byte(Crc16 xor (Word(Value)) and $00FF)];
  567. end;
  568.  
  569. {==============================================================================}
  570.  
  571. function Crc16(const Value: string): Word;
  572. var
  573.   n: Integer;
  574. begin
  575.   Result := $FFFF;
  576.   for n := 1 to Length(Value) do
  577.     Result := UpdateCrc16(Ord(Value[n]), Result);
  578. end;
  579.  
  580. {==============================================================================}
  581.  
  582. procedure MD5Init(var MD5Context: TMD5Ctx);
  583. begin
  584.   FillChar(MD5Context, SizeOf(TMD5Ctx), #0);
  585.   with MD5Context do
  586.   begin
  587.     State[0] := Integer($67452301);
  588.     State[1] := Integer($EFCDAB89);
  589.     State[2] := Integer($98BADCFE);
  590.     State[3] := Integer($10325476);
  591.   end;
  592. end;
  593.  
  594. procedure MD5Transform(var Buf: array of LongInt; const Data: array of LongInt);
  595. var
  596.   A, B, C, D: LongInt;
  597.  
  598.   procedure Round1(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
  599.   begin
  600.     Inc(W, (Z xor (X and (Y xor Z))) + Data);
  601.     W := (W shl S) or (W shr (32 - S));
  602.     Inc(W, X);
  603.   end;
  604.  
  605.   procedure Round2(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
  606.   begin
  607.     Inc(W, (Y xor (Z and (X xor Y))) + Data);
  608.     W := (W shl S) or (W shr (32 - S));
  609.     Inc(W, X);
  610.   end;
  611.  
  612.   procedure Round3(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
  613.   begin
  614.     Inc(W, (X xor Y xor Z) + Data);
  615.     W := (W shl S) or (W shr (32 - S));
  616.     Inc(W, X);
  617.   end;
  618.  
  619.   procedure Round4(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
  620.   begin
  621.     Inc(W, (Y xor (X or not Z)) + Data);
  622.     W := (W shl S) or (W shr (32 - S));
  623.     Inc(W, X);
  624.   end;
  625. begin
  626.   A := Buf[0];
  627.   B := Buf[1];
  628.   C := Buf[2];
  629.   D := Buf[3];
  630.  
  631.   Round1(A, B, C, D, Data[0] + Longint($D76AA478), 7);
  632.   Round1(D, A, B, C, Data[1] + Longint($E8C7B756), 12);
  633.   Round1(C, D, A, B, Data[2] + Longint($242070DB), 17);
  634.   Round1(B, C, D, A, Data[3] + Longint($C1BDCEEE), 22);
  635.   Round1(A, B, C, D, Data[4] + Longint($F57C0FAF), 7);
  636.   Round1(D, A, B, C, Data[5] + Longint($4787C62A), 12);
  637.   Round1(C, D, A, B, Data[6] + Longint($A8304613), 17);
  638.   Round1(B, C, D, A, Data[7] + Longint($FD469501), 22);
  639.   Round1(A, B, C, D, Data[8] + Longint($698098D8), 7);
  640.   Round1(D, A, B, C, Data[9] + Longint($8B44F7AF), 12);
  641.   Round1(C, D, A, B, Data[10] + Longint($FFFF5BB1), 17);
  642.   Round1(B, C, D, A, Data[11] + Longint($895CD7BE), 22);
  643.   Round1(A, B, C, D, Data[12] + Longint($6B901122), 7);
  644.   Round1(D, A, B, C, Data[13] + Longint($FD987193), 12);
  645.   Round1(C, D, A, B, Data[14] + Longint($A679438E), 17);
  646.   Round1(B, C, D, A, Data[15] + Longint($49B40821), 22);
  647.  
  648.   Round2(A, B, C, D, Data[1] + Longint($F61E2562), 5);
  649.   Round2(D, A, B, C, Data[6] + Longint($C040B340), 9);
  650.   Round2(C, D, A, B, Data[11] + Longint($265E5A51), 14);
  651.   Round2(B, C, D, A, Data[0] + Longint($E9B6C7AA), 20);
  652.   Round2(A, B, C, D, Data[5] + Longint($D62F105D), 5);
  653.   Round2(D, A, B, C, Data[10] + Longint($02441453), 9);
  654.   Round2(C, D, A, B, Data[15] + Longint($D8A1E681), 14);
  655.   Round2(B, C, D, A, Data[4] + Longint($E7D3FBC8), 20);
  656.   Round2(A, B, C, D, Data[9] + Longint($21E1CDE6), 5);
  657.   Round2(D, A, B, C, Data[14] + Longint($C33707D6), 9);
  658.   Round2(C, D, A, B, Data[3] + Longint($F4D50D87), 14);
  659.   Round2(B, C, D, A, Data[8] + Longint($455A14ED), 20);
  660.   Round2(A, B, C, D, Data[13] + Longint($A9E3E905), 5);
  661.   Round2(D, A, B, C, Data[2] + Longint($FCEFA3F8), 9);
  662.   Round2(C, D, A, B, Data[7] + Longint($676F02D9), 14);
  663.   Round2(B, C, D, A, Data[12] + Longint($8D2A4C8A), 20);
  664.  
  665.   Round3(A, B, C, D, Data[5] + Longint($FFFA3942), 4);
  666.   Round3(D, A, B, C, Data[8] + Longint($8771F681), 11);
  667.   Round3(C, D, A, B, Data[11] + Longint($6D9D6122), 16);
  668.   Round3(B, C, D, A, Data[14] + Longint($FDE5380C), 23);
  669.   Round3(A, B, C, D, Data[1] + Longint($A4BEEA44), 4);
  670.   Round3(D, A, B, C, Data[4] + Longint($4BDECFA9), 11);
  671.   Round3(C, D, A, B, Data[7] + Longint($F6BB4B60), 16);
  672.   Round3(B, C, D, A, Data[10] + Longint($BEBFBC70), 23);
  673.   Round3(A, B, C, D, Data[13] + Longint($289B7EC6), 4);
  674.   Round3(D, A, B, C, Data[0] + Longint($EAA127FA), 11);
  675.   Round3(C, D, A, B, Data[3] + Longint($D4EF3085), 16);
  676.   Round3(B, C, D, A, Data[6] + Longint($04881D05), 23);
  677.   Round3(A, B, C, D, Data[9] + Longint($D9D4D039), 4);
  678.   Round3(D, A, B, C, Data[12] + Longint($E6DB99E5), 11);
  679.   Round3(C, D, A, B, Data[15] + Longint($1FA27CF8), 16);
  680.   Round3(B, C, D, A, Data[2] + Longint($C4AC5665), 23);
  681.  
  682.   Round4(A, B, C, D, Data[0] + Longint($F4292244), 6);
  683.   Round4(D, A, B, C, Data[7] + Longint($432AFF97), 10);
  684.   Round4(C, D, A, B, Data[14] + Longint($AB9423A7), 15);
  685.   Round4(B, C, D, A, Data[5] + Longint($FC93A039), 21);
  686.   Round4(A, B, C, D, Data[12] + Longint($655B59C3), 6);
  687.   Round4(D, A, B, C, Data[3] + Longint($8F0CCC92), 10);
  688.   Round4(C, D, A, B, Data[10] + Longint($FFEFF47D), 15);
  689.   Round4(B, C, D, A, Data[1] + Longint($85845DD1), 21);
  690.   Round4(A, B, C, D, Data[8] + Longint($6FA87E4F), 6);
  691.   Round4(D, A, B, C, Data[15] + Longint($FE2CE6E0), 10);
  692.   Round4(C, D, A, B, Data[6] + Longint($A3014314), 15);
  693.   Round4(B, C, D, A, Data[13] + Longint($4E0811A1), 21);
  694.   Round4(A, B, C, D, Data[4] + Longint($F7537E82), 6);
  695.   Round4(D, A, B, C, Data[11] + Longint($BD3AF235), 10);
  696.   Round4(C, D, A, B, Data[2] + Longint($2AD7D2BB), 15);
  697.   Round4(B, C, D, A, Data[9] + Longint($EB86D391), 21);
  698.  
  699.   Inc(Buf[0], A);
  700.   Inc(Buf[1], B);
  701.   Inc(Buf[2], C);
  702.   Inc(Buf[3], D);
  703. end;
  704.  
  705. procedure MD5Update(var MD5Context: TMD5Ctx; const Data: string);
  706. var
  707.   Index, t, len: Integer;
  708. begin
  709.   len := Length(Data);
  710.   with MD5Context do
  711.   begin
  712.     T := Count[0];
  713.     Inc(Count[0], Len shl 3);
  714.     if Count[0] < T then
  715.       Inc(Count[1]);
  716.     Inc(Count[1], Len shr 29);
  717.     T := (T shr 3) and $3F;
  718.     Index := 0;
  719.     if T <> 0 then
  720.     begin
  721.       Index := T;
  722.       T := 64 - T;
  723.       if Len < T then
  724.       begin
  725.         Move(Data, Bufchar[Index], Len);
  726.         Exit;
  727.       end;
  728.       Move(Data, Bufchar[Index], T);
  729.       MD5Transform(State, Buflong);
  730.       Dec(Len, T);
  731.       Index := T;
  732.     end;
  733.     while Len >= 64 do
  734.     begin
  735.       Move(Data[Index + 1], Bufchar, 64);
  736.       MD5Transform(State, Buflong);
  737.       Inc(Index, 64);
  738.       Dec(Len, 64);
  739.     end;
  740.     Move(Data[Index + 1], Bufchar, Len);
  741.   end
  742. end;
  743.  
  744. function MD5Final(var MD5Context: TMD5Ctx): string;
  745. var
  746.   Cnt: Word;
  747.   P: Byte;
  748.   digest: array[0..15] of Char;
  749.   i: Integer;
  750. begin
  751.   for I := 0 to 15 do
  752.     Byte(Digest[I]) := I + 1;
  753.   with MD5Context do
  754.   begin
  755.     Cnt := (Count[0] shr 3) and $3F;
  756.     P := Cnt;
  757.     BufChar[P] := $80;
  758.     Inc(P);
  759.     Cnt := 64 - 1 - Cnt;
  760.     if Cnt < 8 then
  761.     begin
  762.       FillChar(BufChar[P], Cnt, #0);
  763.       MD5Transform(State, BufLong);
  764.       FillChar(BufChar, 56, #0);
  765.     end
  766.     else
  767.       FillChar(BufChar[P], Cnt - 8, #0);
  768.     BufLong[14] := Count[0];
  769.     BufLong[15] := Count[1];
  770.     MD5Transform(State, BufLong);
  771.     Move(State, Digest, 16);
  772.     Result := '';
  773.     for i := 0 to 15 do
  774.       Result := Result + Char(digest[i]);
  775.   end;
  776.   FillChar(MD5Context, SizeOf(TMD5Ctx), #0)
  777. end;
  778.  
  779. {==============================================================================}
  780.  
  781. function MD5(const Value: string): string;
  782. var
  783.   MD5Context: TMD5Ctx;
  784. begin
  785.   MD5Init(MD5Context);
  786.   MD5Update(MD5Context, Value);
  787.   Result := MD5Final(MD5Context);
  788. end;
  789.  
  790. {==============================================================================}
  791.  
  792. function HMAC_MD5(Text, Key: string): string;
  793. var
  794.   ipad, opad, s: string;
  795.   n: Integer;
  796.   MD5Context: TMD5Ctx;
  797. begin
  798.   if Length(Key) > 64 then
  799.     Key := md5(Key);
  800.   ipad := '';
  801.   for n := 1 to 64 do
  802.     ipad := ipad + #$36;
  803.   opad := '';
  804.   for n := 1 to 64 do
  805.     opad := opad + #$5C;
  806.   for n := 1 to Length(Key) do
  807.   begin
  808.     ipad[n] := Char(Byte(ipad[n]) xor Byte(Key[n]));
  809.     opad[n] := Char(Byte(opad[n]) xor Byte(Key[n]));
  810.   end;
  811.   MD5Init(MD5Context);
  812.   MD5Update(MD5Context, ipad);
  813.   MD5Update(MD5Context, Text);
  814.   s := MD5Final(MD5Context);
  815.   MD5Init(MD5Context);
  816.   MD5Update(MD5Context, opad);
  817.   MD5Update(MD5Context, s);
  818.   Result := MD5Final(MD5Context);
  819. end;
  820.  
  821. end.
  822.