1 {==============================================================================|
2 | Project : Ararat Synapse | 002.002.003 |
3 |==============================================================================|
4 | Content: Coding and decoding support |
5 |==============================================================================|
6 | Copyright (c)1999-2013, 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-2013. |
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 {:@abstract(Various encoding and decoding support)}
46 {$IFDEF FPC}
47 {$MODE DELPHI}
48 {$ENDIF}
49 {$Q-}
50 {$R-}
51 {$H+}
52 {$TYPEDADDRESS OFF}
53
54 {$IFDEF CIL}
55 {$DEFINE SYNACODE_NATIVE}
56 {$ENDIF}
57 {$IFDEF FPC_BIG_ENDIAN}
58 {$DEFINE SYNACODE_NATIVE}
59 {$ENDIF}
60
61 {$IFDEF UNICODE}
62 {$WARN IMPLICIT_STRING_CAST OFF}
63 {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
64 {$WARN SUSPICIOUS_TYPECAST OFF}
65 {$ENDIF}
66
67 unit synacode;
68
69 interface
70
71 uses
72 SysUtils;
73
74 type
75 TSpecials = set of AnsiChar;
76
77 const
78
79 SpecialChar: TSpecials =
80 ['=', '(', ')', '[', ']', '<', '>', ':', ';', ',', '@', '/', '?', '\',
81 '"', '_'];
82 NonAsciiChar: TSpecials =
83 [#0..#31, #127..#255];
84 URLFullSpecialChar: TSpecials =
85 [';', '/', '?', ':', '@', '=', '&', '#', '+'];
86 URLSpecialChar: TSpecials =
87 [#$00..#$20, '<', '>', '"', '%', '{', '}', '|', '\', '^', '[', ']', '`', #$7F..#$FF];
88 TableBase64 =
89 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
90 TableBase64mod =
91 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+,=';
92 TableUU =
93 '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
94 TableXX =
95 '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
96 ReTablebase64 =
97 #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40
98 +#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
99 +#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03
100 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F
101 +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40
102 +#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21
103 +#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
104 +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
105 ReTableUU =
106 #$01 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C
107 +#$0D +#$0E +#$0F +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18
108 +#$19 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24
109 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D +#$2E +#$2F +#$30
110 +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
111 +#$3D +#$3E +#$3F +#$00 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
112 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
113 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
114 ReTableXX =
115 #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$40
116 +#$01 +#$40 +#$40 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A
117 +#$0B +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$0C +#$0D +#$0E +#$0F
118 +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$1A +#$1B
119 +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24 +#$25 +#$40 +#$40
120 +#$40 +#$40 +#$40 +#$40 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
121 +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39
122 +#$3A +#$3B +#$3C +#$3D +#$3E +#$3F +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
123
124 {:Decodes triplet encoding with a given character delimiter. It is used for
125 decoding quoted-printable or URL encoding.}
DecodeTripletnull126 function DecodeTriplet(const Value: AnsiString; Delimiter: AnsiChar): AnsiString;
127
128 {:Decodes a string from quoted printable form. (also decodes triplet sequences
129 like '=7F')}
DecodeQuotedPrintablenull130 function DecodeQuotedPrintable(const Value: AnsiString): AnsiString;
131
132 {:Decodes a string of URL encoding. (also decodes triplet sequences like '%7F')}
DecodeURLnull133 function DecodeURL(const Value: AnsiString): AnsiString;
134
135 {:Performs triplet encoding with a given character delimiter. Used for encoding
136 quoted-printable or URL encoding.}
EncodeTripletnull137 function EncodeTriplet(const Value: AnsiString; Delimiter: AnsiChar;
138 Specials: TSpecials): AnsiString;
139
140 {:Encodes a string to triplet quoted printable form. All @link(NonAsciiChar)
141 are encoded.}
EncodeQuotedPrintablenull142 function EncodeQuotedPrintable(const Value: AnsiString): AnsiString;
143
144 {:Encodes a string to triplet quoted printable form. All @link(NonAsciiChar) and
145 @link(SpecialChar) are encoded.}
EncodeSafeQuotedPrintablenull146 function EncodeSafeQuotedPrintable(const Value: AnsiString): AnsiString;
147
148 {:Encodes a string to URL format. Used for encoding data from a form field in
149 HTTP, etc. (Encodes all critical characters including characters used as URL
150 delimiters ('/',':', etc.)}
EncodeURLElementnull151 function EncodeURLElement(const Value: AnsiString): AnsiString;
152
153 {:Encodes a string to URL format. Used to encode critical characters in all
154 URLs.}
EncodeURLnull155 function EncodeURL(const Value: AnsiString): AnsiString;
156
157 {:Decode 4to3 encoding with given table. If some element is not found in table,
158 first item from table is used. This is good for buggy coded items by Microsoft
159 Outlook. This software sometimes using wrong table for UUcode, where is used
160 ' ' instead '`'.}
Decode4to3null161 function Decode4to3(const Value, Table: AnsiString): AnsiString;
162
163 {:Decode 4to3 encoding with given REVERSE table. Using this function with
164 reverse table is much faster then @link(Decode4to3). This function is used
165 internally for Base64, UU or XX decoding.}
Decode4to3Exnull166 function Decode4to3Ex(const Value, Table: AnsiString): AnsiString;
167
168 {:Encode by system 3to4 (used by Base64, UU coding, etc) by given table.}
Encode3to4null169 function Encode3to4(const Value, Table: AnsiString): AnsiString;
170
171 {:Decode string from base64 format.}
DecodeBase64null172 function DecodeBase64(const Value: AnsiString): AnsiString;
173
174 {:Encodes a string to base64 format.}
EncodeBase64null175 function EncodeBase64(const Value: AnsiString): AnsiString;
176
177 {:Decode string from modified base64 format. (used in IMAP, for example.)}
DecodeBase64modnull178 function DecodeBase64mod(const Value: AnsiString): AnsiString;
179
180 {:Encodes a string to modified base64 format. (used in IMAP, for example.)}
EncodeBase64modnull181 function EncodeBase64mod(const Value: AnsiString): AnsiString;
182
183 {:Decodes a string from UUcode format.}
DecodeUUnull184 function DecodeUU(const Value: AnsiString): AnsiString;
185
186 {:encode UUcode. it encode only datas, you must also add header and footer for
187 proper encode.}
EncodeUUnull188 function EncodeUU(const Value: AnsiString): AnsiString;
189
190 {:Decodes a string from XXcode format.}
DecodeXXnull191 function DecodeXX(const Value: AnsiString): AnsiString;
192
193 {:decode line with Yenc code. This code is sometimes used in newsgroups.}
DecodeYEncnull194 function DecodeYEnc(const Value: AnsiString): AnsiString;
195
196 {:Returns a new CRC32 value after adding a new byte of data.}
UpdateCrc32null197 function UpdateCrc32(Value: Byte; Crc32: Integer): Integer;
198
199 {:return CRC32 from a value string.}
Crc32null200 function Crc32(const Value: AnsiString): Integer;
201
202 {:Returns a new CRC16 value after adding a new byte of data.}
UpdateCrc16null203 function UpdateCrc16(Value: Byte; Crc16: Word): Word;
204
205 {:return CRC16 from a value string.}
Crc16null206 function Crc16(const Value: AnsiString): Word;
207
208 {:Returns a binary string with a RSA-MD5 hashing of "Value" string.}
MD5null209 function MD5(const Value: AnsiString): AnsiString;
210
211 {:Returns a binary string with HMAC-MD5 hash.}
HMAC_MD5null212 function HMAC_MD5(Text, Key: AnsiString): AnsiString;
213
214 {:Returns a binary string with a RSA-MD5 hashing of string what is constructed
215 by repeating "value" until length is "Len".}
MD5LongHashnull216 function MD5LongHash(const Value: AnsiString; Len: integer): AnsiString;
217
218 {:Returns a binary string with a SHA-1 hashing of "Value" string.}
SHA1null219 function SHA1(const Value: AnsiString): AnsiString;
220
221 {:Returns a binary string with HMAC-SHA1 hash.}
HMAC_SHA1null222 function HMAC_SHA1(Text, Key: AnsiString): AnsiString;
223
224 {:Returns a binary string with a SHA-1 hashing of string what is constructed
225 by repeating "value" until length is "Len".}
SHA1LongHashnull226 function SHA1LongHash(const Value: AnsiString; Len: integer): AnsiString;
227
228 {:Returns a binary string with a RSA-MD4 hashing of "Value" string.}
MD4null229 function MD4(const Value: AnsiString): AnsiString;
230
231 implementation
232
233 const
234
235 Crc32Tab: array[0..255] of Integer = (
236 Integer($00000000), Integer($77073096), Integer($EE0E612C), Integer($990951BA),
237 Integer($076DC419), Integer($706AF48F), Integer($E963A535), Integer($9E6495A3),
238 Integer($0EDB8832), Integer($79DCB8A4), Integer($E0D5E91E), Integer($97D2D988),
239 Integer($09B64C2B), Integer($7EB17CBD), Integer($E7B82D07), Integer($90BF1D91),
240 Integer($1DB71064), Integer($6AB020F2), Integer($F3B97148), Integer($84BE41DE),
241 Integer($1ADAD47D), Integer($6DDDE4EB), Integer($F4D4B551), Integer($83D385C7),
242 Integer($136C9856), Integer($646BA8C0), Integer($FD62F97A), Integer($8A65C9EC),
243 Integer($14015C4F), Integer($63066CD9), Integer($FA0F3D63), Integer($8D080DF5),
244 Integer($3B6E20C8), Integer($4C69105E), Integer($D56041E4), Integer($A2677172),
245 Integer($3C03E4D1), Integer($4B04D447), Integer($D20D85FD), Integer($A50AB56B),
246 Integer($35B5A8FA), Integer($42B2986C), Integer($DBBBC9D6), Integer($ACBCF940),
247 Integer($32D86CE3), Integer($45DF5C75), Integer($DCD60DCF), Integer($ABD13D59),
248 Integer($26D930AC), Integer($51DE003A), Integer($C8D75180), Integer($BFD06116),
249 Integer($21B4F4B5), Integer($56B3C423), Integer($CFBA9599), Integer($B8BDA50F),
250 Integer($2802B89E), Integer($5F058808), Integer($C60CD9B2), Integer($B10BE924),
251 Integer($2F6F7C87), Integer($58684C11), Integer($C1611DAB), Integer($B6662D3D),
252 Integer($76DC4190), Integer($01DB7106), Integer($98D220BC), Integer($EFD5102A),
253 Integer($71B18589), Integer($06B6B51F), Integer($9FBFE4A5), Integer($E8B8D433),
254 Integer($7807C9A2), Integer($0F00F934), Integer($9609A88E), Integer($E10E9818),
255 Integer($7F6A0DBB), Integer($086D3D2D), Integer($91646C97), Integer($E6635C01),
256 Integer($6B6B51F4), Integer($1C6C6162), Integer($856530D8), Integer($F262004E),
257 Integer($6C0695ED), Integer($1B01A57B), Integer($8208F4C1), Integer($F50FC457),
258 Integer($65B0D9C6), Integer($12B7E950), Integer($8BBEB8EA), Integer($FCB9887C),
259 Integer($62DD1DDF), Integer($15DA2D49), Integer($8CD37CF3), Integer($FBD44C65),
260 Integer($4DB26158), Integer($3AB551CE), Integer($A3BC0074), Integer($D4BB30E2),
261 Integer($4ADFA541), Integer($3DD895D7), Integer($A4D1C46D), Integer($D3D6F4FB),
262 Integer($4369E96A), Integer($346ED9FC), Integer($AD678846), Integer($DA60B8D0),
263 Integer($44042D73), Integer($33031DE5), Integer($AA0A4C5F), Integer($DD0D7CC9),
264 Integer($5005713C), Integer($270241AA), Integer($BE0B1010), Integer($C90C2086),
265 Integer($5768B525), Integer($206F85B3), Integer($B966D409), Integer($CE61E49F),
266 Integer($5EDEF90E), Integer($29D9C998), Integer($B0D09822), Integer($C7D7A8B4),
267 Integer($59B33D17), Integer($2EB40D81), Integer($B7BD5C3B), Integer($C0BA6CAD),
268 Integer($EDB88320), Integer($9ABFB3B6), Integer($03B6E20C), Integer($74B1D29A),
269 Integer($EAD54739), Integer($9DD277AF), Integer($04DB2615), Integer($73DC1683),
270 Integer($E3630B12), Integer($94643B84), Integer($0D6D6A3E), Integer($7A6A5AA8),
271 Integer($E40ECF0B), Integer($9309FF9D), Integer($0A00AE27), Integer($7D079EB1),
272 Integer($F00F9344), Integer($8708A3D2), Integer($1E01F268), Integer($6906C2FE),
273 Integer($F762575D), Integer($806567CB), Integer($196C3671), Integer($6E6B06E7),
274 Integer($FED41B76), Integer($89D32BE0), Integer($10DA7A5A), Integer($67DD4ACC),
275 Integer($F9B9DF6F), Integer($8EBEEFF9), Integer($17B7BE43), Integer($60B08ED5),
276 Integer($D6D6A3E8), Integer($A1D1937E), Integer($38D8C2C4), Integer($4FDFF252),
277 Integer($D1BB67F1), Integer($A6BC5767), Integer($3FB506DD), Integer($48B2364B),
278 Integer($D80D2BDA), Integer($AF0A1B4C), Integer($36034AF6), Integer($41047A60),
279 Integer($DF60EFC3), Integer($A867DF55), Integer($316E8EEF), Integer($4669BE79),
280 Integer($CB61B38C), Integer($BC66831A), Integer($256FD2A0), Integer($5268E236),
281 Integer($CC0C7795), Integer($BB0B4703), Integer($220216B9), Integer($5505262F),
282 Integer($C5BA3BBE), Integer($B2BD0B28), Integer($2BB45A92), Integer($5CB36A04),
283 Integer($C2D7FFA7), Integer($B5D0CF31), Integer($2CD99E8B), Integer($5BDEAE1D),
284 Integer($9B64C2B0), Integer($EC63F226), Integer($756AA39C), Integer($026D930A),
285 Integer($9C0906A9), Integer($EB0E363F), Integer($72076785), Integer($05005713),
286 Integer($95BF4A82), Integer($E2B87A14), Integer($7BB12BAE), Integer($0CB61B38),
287 Integer($92D28E9B), Integer($E5D5BE0D), Integer($7CDCEFB7), Integer($0BDBDF21),
288 Integer($86D3D2D4), Integer($F1D4E242), Integer($68DDB3F8), Integer($1FDA836E),
289 Integer($81BE16CD), Integer($F6B9265B), Integer($6FB077E1), Integer($18B74777),
290 Integer($88085AE6), Integer($FF0F6A70), Integer($66063BCA), Integer($11010B5C),
291 Integer($8F659EFF), Integer($F862AE69), Integer($616BFFD3), Integer($166CCF45),
292 Integer($A00AE278), Integer($D70DD2EE), Integer($4E048354), Integer($3903B3C2),
293 Integer($A7672661), Integer($D06016F7), Integer($4969474D), Integer($3E6E77DB),
294 Integer($AED16A4A), Integer($D9D65ADC), Integer($40DF0B66), Integer($37D83BF0),
295 Integer($A9BCAE53), Integer($DEBB9EC5), Integer($47B2CF7F), Integer($30B5FFE9),
296 Integer($BDBDF21C), Integer($CABAC28A), Integer($53B39330), Integer($24B4A3A6),
297 Integer($BAD03605), Integer($CDD70693), Integer($54DE5729), Integer($23D967BF),
298 Integer($B3667A2E), Integer($C4614AB8), Integer($5D681B02), Integer($2A6F2B94),
299 Integer($B40BBE37), Integer($C30C8EA1), Integer($5A05DF1B), Integer($2D02EF8D)
300 );
301
302 Crc16Tab: array[0..255] of Word = (
303 $0000, $1189, $2312, $329B, $4624, $57AD, $6536, $74BF,
304 $8C48, $9DC1, $AF5A, $BED3, $CA6C, $DBE5, $E97E, $F8F7,
305 $1081, $0108, $3393, $221A, $56A5, $472C, $75B7, $643E,
306 $9CC9, $8D40, $BFDB, $AE52, $DAED, $CB64, $F9FF, $E876,
307 $2102, $308B, $0210, $1399, $6726, $76AF, $4434, $55BD,
308 $AD4A, $BCC3, $8E58, $9FD1, $EB6E, $FAE7, $C87C, $D9F5,
309 $3183, $200A, $1291, $0318, $77A7, $662E, $54B5, $453C,
310 $BDCB, $AC42, $9ED9, $8F50, $FBEF, $EA66, $D8FD, $C974,
311 $4204, $538D, $6116, $709F, $0420, $15A9, $2732, $36BB,
312 $CE4C, $DFC5, $ED5E, $FCD7, $8868, $99E1, $AB7A, $BAF3,
313 $5285, $430C, $7197, $601E, $14A1, $0528, $37B3, $263A,
314 $DECD, $CF44, $FDDF, $EC56, $98E9, $8960, $BBFB, $AA72,
315 $6306, $728F, $4014, $519D, $2522, $34AB, $0630, $17B9,
316 $EF4E, $FEC7, $CC5C, $DDD5, $A96A, $B8E3, $8A78, $9BF1,
317 $7387, $620E, $5095, $411C, $35A3, $242A, $16B1, $0738,
318 $FFCF, $EE46, $DCDD, $CD54, $B9EB, $A862, $9AF9, $8B70,
319 $8408, $9581, $A71A, $B693, $C22C, $D3A5, $E13E, $F0B7,
320 $0840, $19C9, $2B52, $3ADB, $4E64, $5FED, $6D76, $7CFF,
321 $9489, $8500, $B79B, $A612, $D2AD, $C324, $F1BF, $E036,
322 $18C1, $0948, $3BD3, $2A5A, $5EE5, $4F6C, $7DF7, $6C7E,
323 $A50A, $B483, $8618, $9791, $E32E, $F2A7, $C03C, $D1B5,
324 $2942, $38CB, $0A50, $1BD9, $6F66, $7EEF, $4C74, $5DFD,
325 $B58B, $A402, $9699, $8710, $F3AF, $E226, $D0BD, $C134,
326 $39C3, $284A, $1AD1, $0B58, $7FE7, $6E6E, $5CF5, $4D7C,
327 $C60C, $D785, $E51E, $F497, $8028, $91A1, $A33A, $B2B3,
328 $4A44, $5BCD, $6956, $78DF, $0C60, $1DE9, $2F72, $3EFB,
329 $D68D, $C704, $F59F, $E416, $90A9, $8120, $B3BB, $A232,
330 $5AC5, $4B4C, $79D7, $685E, $1CE1, $0D68, $3FF3, $2E7A,
331 $E70E, $F687, $C41C, $D595, $A12A, $B0A3, $8238, $93B1,
332 $6B46, $7ACF, $4854, $59DD, $2D62, $3CEB, $0E70, $1FF9,
333 $F78F, $E606, $D49D, $C514, $B1AB, $A022, $92B9, $8330,
334 $7BC7, $6A4E, $58D5, $495C, $3DE3, $2C6A, $1EF1, $0F78
335 );
336
337 procedure ArrByteToLong(var ArByte: Array of byte; var ArLong: Array of Integer);
338 {$IFDEF SYNACODE_NATIVE}
339 var
340 n: integer;
341 {$ENDIF}
342 begin
343 if (High(ArByte) + 1) > ((High(ArLong) + 1) * 4) then
344 Exit;
345 {$IFDEF SYNACODE_NATIVE}
346 for n := 0 to ((high(ArByte) + 1) div 4) - 1 do
347 ArLong[n] := ArByte[n * 4 + 0]
348 + (ArByte[n * 4 + 1] shl 8)
349 + (ArByte[n * 4 + 2] shl 16)
350 + (ArByte[n * 4 + 3] shl 24);
351 {$ELSE}
352 Move(ArByte[0], ArLong[0], High(ArByte) + 1);
353 {$ENDIF}
354 end;
355
356 procedure ArrLongToByte(var ArLong: Array of Integer; var ArByte: Array of byte);
357 {$IFDEF SYNACODE_NATIVE}
358 var
359 n: integer;
360 {$ENDIF}
361 begin
362 if (High(ArByte) + 1) < ((High(ArLong) + 1) * 4) then
363 Exit;
364 {$IFDEF SYNACODE_NATIVE}
365 for n := 0 to high(ArLong) do
366 begin
367 ArByte[n * 4 + 0] := ArLong[n] and $000000FF;
368 ArByte[n * 4 + 1] := (ArLong[n] shr 8) and $000000FF;
369 ArByte[n * 4 + 2] := (ArLong[n] shr 16) and $000000FF;
370 ArByte[n * 4 + 3] := (ArLong[n] shr 24) and $000000FF;
371 end;
372 {$ELSE}
373 Move(ArLong[0], ArByte[0], High(ArByte) + 1);
374 {$ENDIF}
375 end;
376
377 type
378 TMDCtx = record
379 State: array[0..3] of Integer;
380 Count: array[0..1] of Integer;
381 BufAnsiChar: array[0..63] of Byte;
382 BufLong: array[0..15] of Integer;
383 end;
384 TSHA1Ctx= record
385 Hi, Lo: integer;
386 Buffer: array[0..63] of byte;
387 Index: integer;
388 Hash: array[0..4] of Integer;
389 HashByte: array[0..19] of byte;
390 end;
391
392 TMDTransform = procedure(var Buf: array of LongInt; const Data: array of LongInt);
393
394 {==============================================================================}
395
DecodeTripletnull396 function DecodeTriplet(const Value: AnsiString; Delimiter: AnsiChar): AnsiString;
397 var
398 x, l, lv: Integer;
399 c: AnsiChar;
400 b: Byte;
401 bad: Boolean;
402 begin
403 lv := Length(Value);
404 SetLength(Result, lv);
405 x := 1;
406 l := 1;
407 while x <= lv do
408 begin
409 c := Value[x];
410 Inc(x);
411 if c <> Delimiter then
412 begin
413 Result[l] := c;
414 Inc(l);
415 end
416 else
417 if x < lv then
418 begin
419 Case Value[x] Of
420 #13:
421 if (Value[x + 1] = #10) then
422 Inc(x, 2)
423 else
424 Inc(x);
425 #10:
426 if (Value[x + 1] = #13) then
427 Inc(x, 2)
428 else
429 Inc(x);
430 else
431 begin
432 bad := False;
433 Case Value[x] Of
434 '0'..'9': b := (Byte(Value[x]) - 48) Shl 4;
435 'a'..'f', 'A'..'F': b := ((Byte(Value[x]) And 7) + 9) shl 4;
436 else
437 begin
438 b := 0;
439 bad := True;
440 end;
441 end;
442 Case Value[x + 1] Of
443 '0'..'9': b := b Or (Byte(Value[x + 1]) - 48);
444 'a'..'f', 'A'..'F': b := b Or ((Byte(Value[x + 1]) And 7) + 9);
445 else
446 bad := True;
447 end;
448 if bad then
449 begin
450 Result[l] := c;
451 Inc(l);
452 end
453 else
454 begin
455 Inc(x, 2);
456 Result[l] := AnsiChar(b);
457 Inc(l);
458 end;
459 end;
460 end;
461 end
462 else
463 break;
464 end;
465 Dec(l);
466 SetLength(Result, l);
467 end;
468
469 {==============================================================================}
470
DecodeQuotedPrintablenull471 function DecodeQuotedPrintable(const Value: AnsiString): AnsiString;
472 begin
473 Result := DecodeTriplet(Value, '=');
474 end;
475
476 {==============================================================================}
477
DecodeURLnull478 function DecodeURL(const Value: AnsiString): AnsiString;
479 begin
480 Result := DecodeTriplet(Value, '%');
481 end;
482
483 {==============================================================================}
484
EncodeTripletnull485 function EncodeTriplet(const Value: AnsiString; Delimiter: AnsiChar;
486 Specials: TSpecials): AnsiString;
487 var
488 n, l: Integer;
489 s: AnsiString;
490 c: AnsiChar;
491 begin
492 SetLength(Result, Length(Value) * 3);
493 l := 1;
494 for n := 1 to Length(Value) do
495 begin
496 c := Value[n];
497 if c in Specials then
498 begin
499 Result[l] := Delimiter;
500 Inc(l);
501 s := IntToHex(Ord(c), 2);
502 Result[l] := s[1];
503 Inc(l);
504 Result[l] := s[2];
505 Inc(l);
506 end
507 else
508 begin
509 Result[l] := c;
510 Inc(l);
511 end;
512 end;
513 Dec(l);
514 SetLength(Result, l);
515 end;
516
517 {==============================================================================}
518
EncodeQuotedPrintablenull519 function EncodeQuotedPrintable(const Value: AnsiString): AnsiString;
520 begin
521 Result := EncodeTriplet(Value, '=', ['='] + NonAsciiChar);
522 end;
523
524 {==============================================================================}
525
EncodeSafeQuotedPrintablenull526 function EncodeSafeQuotedPrintable(const Value: AnsiString): AnsiString;
527 begin
528 Result := EncodeTriplet(Value, '=', SpecialChar + NonAsciiChar);
529 end;
530
531 {==============================================================================}
532
EncodeURLElementnull533 function EncodeURLElement(const Value: AnsiString): AnsiString;
534 begin
535 Result := EncodeTriplet(Value, '%', URLSpecialChar + URLFullSpecialChar);
536 end;
537
538 {==============================================================================}
539
EncodeURLnull540 function EncodeURL(const Value: AnsiString): AnsiString;
541 begin
542 Result := EncodeTriplet(Value, '%', URLSpecialChar);
543 end;
544
545 {==============================================================================}
546
Decode4to3null547 function Decode4to3(const Value, Table: AnsiString): AnsiString;
548 var
549 x, y, n, l: Integer;
550 d: array[0..3] of Byte;
551 begin
552 SetLength(Result, Length(Value));
553 x := 1;
554 l := 1;
555 while x <= Length(Value) do
556 begin
557 for n := 0 to 3 do
558 begin
559 if x > Length(Value) then
560 d[n] := 64
561 else
562 begin
563 y := Pos(Value[x], Table);
564 if y < 1 then
565 y := 1;
566 d[n] := y - 1;
567 end;
568 Inc(x);
569 end;
570 Result[l] := AnsiChar((D[0] and $3F) shl 2 + (D[1] and $30) shr 4);
571 Inc(l);
572 if d[2] <> 64 then
573 begin
574 Result[l] := AnsiChar((D[1] and $0F) shl 4 + (D[2] and $3C) shr 2);
575 Inc(l);
576 if d[3] <> 64 then
577 begin
578 Result[l] := AnsiChar((D[2] and $03) shl 6 + (D[3] and $3F));
579 Inc(l);
580 end;
581 end;
582 end;
583 Dec(l);
584 SetLength(Result, l);
585 end;
586
587 {==============================================================================}
Decode4to3Exnull588 function Decode4to3Ex(const Value, Table: AnsiString): AnsiString;
589 var
590 x, y, lv: Integer;
591 d: integer;
592 dl: integer;
593 c: byte;
594 p: integer;
595 begin
596 lv := Length(Value);
597 SetLength(Result, lv);
598 x := 1;
599 dl := 4;
600 d := 0;
601 p := 1;
602 while x <= lv do
603 begin
604 y := Ord(Value[x]);
605 if y in [33..127] then
606 c := Ord(Table[y - 32])
607 else
608 c := 64;
609 Inc(x);
610 if c > 63 then
611 continue;
612 d := (d shl 6) or c;
613 dec(dl);
614 if dl <> 0 then
615 continue;
616 Result[p] := AnsiChar((d shr 16) and $ff);
617 inc(p);
618 Result[p] := AnsiChar((d shr 8) and $ff);
619 inc(p);
620 Result[p] := AnsiChar(d and $ff);
621 inc(p);
622 d := 0;
623 dl := 4;
624 end;
625 case dl of
626 1:
627 begin
628 d := d shr 2;
629 Result[p] := AnsiChar((d shr 8) and $ff);
630 inc(p);
631 Result[p] := AnsiChar(d and $ff);
632 inc(p);
633 end;
634 2:
635 begin
636 d := d shr 4;
637 Result[p] := AnsiChar(d and $ff);
638 inc(p);
639 end;
640 end;
641 SetLength(Result, p - 1);
642 end;
643
644 {==============================================================================}
645
Encode3to4null646 function Encode3to4(const Value, Table: AnsiString): AnsiString;
647 var
648 c: Byte;
649 n, l: Integer;
650 Count: Integer;
651 DOut: array[0..3] of Byte;
652 begin
653 setlength(Result, ((Length(Value) + 2) div 3) * 4);
654 l := 1;
655 Count := 1;
656 while Count <= Length(Value) do
657 begin
658 c := Ord(Value[Count]);
659 Inc(Count);
660 DOut[0] := (c and $FC) shr 2;
661 DOut[1] := (c and $03) shl 4;
662 if Count <= Length(Value) then
663 begin
664 c := Ord(Value[Count]);
665 Inc(Count);
666 DOut[1] := DOut[1] + (c and $F0) shr 4;
667 DOut[2] := (c and $0F) shl 2;
668 if Count <= Length(Value) then
669 begin
670 c := Ord(Value[Count]);
671 Inc(Count);
672 DOut[2] := DOut[2] + (c and $C0) shr 6;
673 DOut[3] := (c and $3F);
674 end
675 else
676 begin
677 DOut[3] := $40;
678 end;
679 end
680 else
681 begin
682 DOut[2] := $40;
683 DOut[3] := $40;
684 end;
685 for n := 0 to 3 do
686 begin
687 if (DOut[n] + 1) <= Length(Table) then
688 begin
689 Result[l] := Table[DOut[n] + 1];
690 Inc(l);
691 end;
692 end;
693 end;
694 SetLength(Result, l - 1);
695 end;
696
697 {==============================================================================}
698
DecodeBase64null699 function DecodeBase64(const Value: AnsiString): AnsiString;
700 begin
701 Result := Decode4to3Ex(Value, ReTableBase64);
702 end;
703
704 {==============================================================================}
705
EncodeBase64null706 function EncodeBase64(const Value: AnsiString): AnsiString;
707 begin
708 Result := Encode3to4(Value, TableBase64);
709 end;
710
711 {==============================================================================}
712
DecodeBase64modnull713 function DecodeBase64mod(const Value: AnsiString): AnsiString;
714 begin
715 Result := Decode4to3(Value, TableBase64mod);
716 end;
717
718 {==============================================================================}
719
EncodeBase64modnull720 function EncodeBase64mod(const Value: AnsiString): AnsiString;
721 begin
722 Result := Encode3to4(Value, TableBase64mod);
723 end;
724
725 {==============================================================================}
726
DecodeUUnull727 function DecodeUU(const Value: AnsiString): AnsiString;
728 var
729 s: AnsiString;
730 uut: AnsiString;
731 x: Integer;
732 begin
733 Result := '';
734 uut := TableUU;
735 s := trim(UpperCase(Value));
736 if s = '' then Exit;
737 if Pos('BEGIN', s) = 1 then
738 Exit;
739 if Pos('END', s) = 1 then
740 Exit;
741 if Pos('TABLE', s) = 1 then
742 Exit; //ignore Table yet (set custom UUT)
743 //begin decoding
744 x := Pos(Value[1], uut) - 1;
745 case (x mod 3) of
746 0: x :=(x div 3)* 4;
747 1: x :=((x div 3) * 4) + 2;
748 2: x :=((x div 3) * 4) + 3;
749 end;
750 //x - lenght UU line
751 s := Copy(Value, 2, x);
752 if s = '' then
753 Exit;
754 s := s + StringOfChar(' ', x - length(s));
755 Result := Decode4to3(s, uut);
756 end;
757
758 {==============================================================================}
759
EncodeUUnull760 function EncodeUU(const Value: AnsiString): AnsiString;
761 begin
762 Result := '';
763 if Length(Value) < Length(TableUU) then
764 Result := TableUU[Length(Value) + 1] + Encode3to4(Value, TableUU);
765 end;
766
767 {==============================================================================}
768
DecodeXXnull769 function DecodeXX(const Value: AnsiString): AnsiString;
770 var
771 s: AnsiString;
772 x: Integer;
773 begin
774 Result := '';
775 s := trim(UpperCase(Value));
776 if s = '' then
777 Exit;
778 if Pos('BEGIN', s) = 1 then
779 Exit;
780 if Pos('END', s) = 1 then
781 Exit;
782 //begin decoding
783 x := Pos(Value[1], TableXX) - 1;
784 case (x mod 3) of
785 0: x :=(x div 3)* 4;
786 1: x :=((x div 3) * 4) + 2;
787 2: x :=((x div 3) * 4) + 3;
788 end;
789 //x - lenght XX line
790 s := Copy(Value, 2, x);
791 if s = '' then
792 Exit;
793 s := s + StringOfChar(' ', x - length(s));
794 Result := Decode4to3(s, TableXX);
795 end;
796
797 {==============================================================================}
798
DecodeYEncnull799 function DecodeYEnc(const Value: AnsiString): AnsiString;
800 var
801 C : Byte;
802 i: integer;
803 begin
804 Result := '';
805 i := 1;
806 while i <= Length(Value) do
807 begin
808 c := Ord(Value[i]);
809 Inc(i);
810 if c = Ord('=') then
811 begin
812 c := Ord(Value[i]);
813 Inc(i);
814 Dec(c, 64);
815 end;
816 Dec(C, 42);
817 Result := Result + AnsiChar(C);
818 end;
819 end;
820
821 {==============================================================================}
822
UpdateCrc32null823 function UpdateCrc32(Value: Byte; Crc32: Integer): Integer;
824 begin
825 Result := (Crc32 shr 8)
826 xor crc32tab[Byte(Value xor (Crc32 and Integer($000000FF)))];
827 end;
828
829 {==============================================================================}
830
Crc32null831 function Crc32(const Value: AnsiString): Integer;
832 var
833 n: Integer;
834 begin
835 Result := Integer($FFFFFFFF);
836 for n := 1 to Length(Value) do
837 Result := UpdateCrc32(Ord(Value[n]), Result);
838 Result := not Result;
839 end;
840
841 {==============================================================================}
842
UpdateCrc16null843 function UpdateCrc16(Value: Byte; Crc16: Word): Word;
844 begin
845 Result := ((Crc16 shr 8) and $00FF) xor
846 crc16tab[Byte(Crc16 xor (Word(Value)) and $00FF)];
847 end;
848
849 {==============================================================================}
850
Crc16null851 function Crc16(const Value: AnsiString): Word;
852 var
853 n: Integer;
854 begin
855 Result := $FFFF;
856 for n := 1 to Length(Value) do
857 Result := UpdateCrc16(Ord(Value[n]), Result);
858 end;
859
860 {==============================================================================}
861
862 procedure MDInit(var MDContext: TMDCtx);
863 var
864 n: integer;
865 begin
866 MDContext.Count[0] := 0;
867 MDContext.Count[1] := 0;
868 for n := 0 to high(MDContext.BufAnsiChar) do
869 MDContext.BufAnsiChar[n] := 0;
870 for n := 0 to high(MDContext.BufLong) do
871 MDContext.BufLong[n] := 0;
872 MDContext.State[0] := Integer($67452301);
873 MDContext.State[1] := Integer($EFCDAB89);
874 MDContext.State[2] := Integer($98BADCFE);
875 MDContext.State[3] := Integer($10325476);
876 end;
877
878 procedure MD5Transform(var Buf: array of LongInt; const Data: array of LongInt);
879 var
880 A, B, C, D: LongInt;
881
882 procedure Round1(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
883 begin
884 Inc(W, (Z xor (X and (Y xor Z))) + Data);
885 W := (W shl S) or (W shr (32 - S));
886 Inc(W, X);
887 end;
888
889 procedure Round2(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
890 begin
891 Inc(W, (Y xor (Z and (X xor Y))) + Data);
892 W := (W shl S) or (W shr (32 - S));
893 Inc(W, X);
894 end;
895
896 procedure Round3(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
897 begin
898 Inc(W, (X xor Y xor Z) + Data);
899 W := (W shl S) or (W shr (32 - S));
900 Inc(W, X);
901 end;
902
903 procedure Round4(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte);
904 begin
905 Inc(W, (Y xor (X or not Z)) + Data);
906 W := (W shl S) or (W shr (32 - S));
907 Inc(W, X);
908 end;
909 begin
910 A := Buf[0];
911 B := Buf[1];
912 C := Buf[2];
913 D := Buf[3];
914
915 Round1(A, B, C, D, Data[0] + Longint($D76AA478), 7);
916 Round1(D, A, B, C, Data[1] + Longint($E8C7B756), 12);
917 Round1(C, D, A, B, Data[2] + Longint($242070DB), 17);
918 Round1(B, C, D, A, Data[3] + Longint($C1BDCEEE), 22);
919 Round1(A, B, C, D, Data[4] + Longint($F57C0FAF), 7);
920 Round1(D, A, B, C, Data[5] + Longint($4787C62A), 12);
921 Round1(C, D, A, B, Data[6] + Longint($A8304613), 17);
922 Round1(B, C, D, A, Data[7] + Longint($FD469501), 22);
923 Round1(A, B, C, D, Data[8] + Longint($698098D8), 7);
924 Round1(D, A, B, C, Data[9] + Longint($8B44F7AF), 12);
925 Round1(C, D, A, B, Data[10] + Longint($FFFF5BB1), 17);
926 Round1(B, C, D, A, Data[11] + Longint($895CD7BE), 22);
927 Round1(A, B, C, D, Data[12] + Longint($6B901122), 7);
928 Round1(D, A, B, C, Data[13] + Longint($FD987193), 12);
929 Round1(C, D, A, B, Data[14] + Longint($A679438E), 17);
930 Round1(B, C, D, A, Data[15] + Longint($49B40821), 22);
931
932 Round2(A, B, C, D, Data[1] + Longint($F61E2562), 5);
933 Round2(D, A, B, C, Data[6] + Longint($C040B340), 9);
934 Round2(C, D, A, B, Data[11] + Longint($265E5A51), 14);
935 Round2(B, C, D, A, Data[0] + Longint($E9B6C7AA), 20);
936 Round2(A, B, C, D, Data[5] + Longint($D62F105D), 5);
937 Round2(D, A, B, C, Data[10] + Longint($02441453), 9);
938 Round2(C, D, A, B, Data[15] + Longint($D8A1E681), 14);
939 Round2(B, C, D, A, Data[4] + Longint($E7D3FBC8), 20);
940 Round2(A, B, C, D, Data[9] + Longint($21E1CDE6), 5);
941 Round2(D, A, B, C, Data[14] + Longint($C33707D6), 9);
942 Round2(C, D, A, B, Data[3] + Longint($F4D50D87), 14);
943 Round2(B, C, D, A, Data[8] + Longint($455A14ED), 20);
944 Round2(A, B, C, D, Data[13] + Longint($A9E3E905), 5);
945 Round2(D, A, B, C, Data[2] + Longint($FCEFA3F8), 9);
946 Round2(C, D, A, B, Data[7] + Longint($676F02D9), 14);
947 Round2(B, C, D, A, Data[12] + Longint($8D2A4C8A), 20);
948
949 Round3(A, B, C, D, Data[5] + Longint($FFFA3942), 4);
950 Round3(D, A, B, C, Data[8] + Longint($8771F681), 11);
951 Round3(C, D, A, B, Data[11] + Longint($6D9D6122), 16);
952 Round3(B, C, D, A, Data[14] + Longint($FDE5380C), 23);
953 Round3(A, B, C, D, Data[1] + Longint($A4BEEA44), 4);
954 Round3(D, A, B, C, Data[4] + Longint($4BDECFA9), 11);
955 Round3(C, D, A, B, Data[7] + Longint($F6BB4B60), 16);
956 Round3(B, C, D, A, Data[10] + Longint($BEBFBC70), 23);
957 Round3(A, B, C, D, Data[13] + Longint($289B7EC6), 4);
958 Round3(D, A, B, C, Data[0] + Longint($EAA127FA), 11);
959 Round3(C, D, A, B, Data[3] + Longint($D4EF3085), 16);
960 Round3(B, C, D, A, Data[6] + Longint($04881D05), 23);
961 Round3(A, B, C, D, Data[9] + Longint($D9D4D039), 4);
962 Round3(D, A, B, C, Data[12] + Longint($E6DB99E5), 11);
963 Round3(C, D, A, B, Data[15] + Longint($1FA27CF8), 16);
964 Round3(B, C, D, A, Data[2] + Longint($C4AC5665), 23);
965
966 Round4(A, B, C, D, Data[0] + Longint($F4292244), 6);
967 Round4(D, A, B, C, Data[7] + Longint($432AFF97), 10);
968 Round4(C, D, A, B, Data[14] + Longint($AB9423A7), 15);
969 Round4(B, C, D, A, Data[5] + Longint($FC93A039), 21);
970 Round4(A, B, C, D, Data[12] + Longint($655B59C3), 6);
971 Round4(D, A, B, C, Data[3] + Longint($8F0CCC92), 10);
972 Round4(C, D, A, B, Data[10] + Longint($FFEFF47D), 15);
973 Round4(B, C, D, A, Data[1] + Longint($85845DD1), 21);
974 Round4(A, B, C, D, Data[8] + Longint($6FA87E4F), 6);
975 Round4(D, A, B, C, Data[15] + Longint($FE2CE6E0), 10);
976 Round4(C, D, A, B, Data[6] + Longint($A3014314), 15);
977 Round4(B, C, D, A, Data[13] + Longint($4E0811A1), 21);
978 Round4(A, B, C, D, Data[4] + Longint($F7537E82), 6);
979 Round4(D, A, B, C, Data[11] + Longint($BD3AF235), 10);
980 Round4(C, D, A, B, Data[2] + Longint($2AD7D2BB), 15);
981 Round4(B, C, D, A, Data[9] + Longint($EB86D391), 21);
982
983 Inc(Buf[0], A);
984 Inc(Buf[1], B);
985 Inc(Buf[2], C);
986 Inc(Buf[3], D);
987 end;
988
989 //fixed by James McAdams
990 procedure MDUpdate(var MDContext: TMDCtx; const Data: AnsiString; transform: TMDTransform);
991 var
992 Index, partLen, InputLen, I: integer;
993 {$IFDEF SYNACODE_NATIVE}
994 n: integer;
995 {$ENDIF}
996 begin
997 InputLen := Length(Data);
998 with MDContext do
999 begin
1000 Index := (Count[0] shr 3) and $3F;
1001 Inc(Count[0], InputLen shl 3);
1002 if Count[0] < (InputLen shl 3) then
1003 Inc(Count[1]);
1004 Inc(Count[1], InputLen shr 29);
1005 partLen := 64 - Index;
1006 if InputLen >= partLen then
1007 begin
1008 ArrLongToByte(BufLong, BufAnsiChar);
1009 {$IFDEF SYNACODE_NATIVE}
1010 for n := 1 to partLen do
1011 BufAnsiChar[index - 1 + n] := Ord(Data[n]);
1012 {$ELSE}
1013 Move(Data[1], BufAnsiChar[Index], partLen);
1014 {$ENDIF}
1015 ArrByteToLong(BufAnsiChar, BufLong);
1016 Transform(State, Buflong);
1017 I := partLen;
1018 while I + 63 < InputLen do
1019 begin
1020 ArrLongToByte(BufLong, BufAnsiChar);
1021 {$IFDEF SYNACODE_NATIVE}
1022 for n := 1 to 64 do
1023 BufAnsiChar[n - 1] := Ord(Data[i + n]);
1024 {$ELSE}
1025 Move(Data[I+1], BufAnsiChar, 64);
1026 {$ENDIF}
1027 ArrByteToLong(BufAnsiChar, BufLong);
1028 Transform(State, Buflong);
1029 inc(I, 64);
1030 end;
1031 Index := 0;
1032 end
1033 else
1034 I := 0;
1035 ArrLongToByte(BufLong, BufAnsiChar);
1036 {$IFDEF SYNACODE_NATIVE}
1037 for n := 1 to InputLen-I do
1038 BufAnsiChar[Index + n - 1] := Ord(Data[i + n]);
1039 {$ELSE}
1040 Move(Data[I+1], BufAnsiChar[Index], InputLen-I);
1041 {$ENDIF}
1042 ArrByteToLong(BufAnsiChar, BufLong);
1043 end
1044 end;
1045
MDFinalnull1046 function MDFinal(var MDContext: TMDCtx; transform: TMDTransform): AnsiString;
1047 var
1048 Cnt: Word;
1049 P: Byte;
1050 digest: array[0..15] of Byte;
1051 i: Integer;
1052 n: integer;
1053 begin
1054 for I := 0 to 15 do
1055 Digest[I] := I + 1;
1056 with MDContext do
1057 begin
1058 Cnt := (Count[0] shr 3) and $3F;
1059 P := Cnt;
1060 BufAnsiChar[P] := $80;
1061 Inc(P);
1062 Cnt := 64 - 1 - Cnt;
1063 if Cnt < 8 then
1064 begin
1065 for n := 0 to cnt - 1 do
1066 BufAnsiChar[P + n] := 0;
1067 ArrByteToLong(BufAnsiChar, BufLong);
1068 // FillChar(BufAnsiChar[P], Cnt, #0);
1069 Transform(State, BufLong);
1070 ArrLongToByte(BufLong, BufAnsiChar);
1071 for n := 0 to 55 do
1072 BufAnsiChar[n] := 0;
1073 ArrByteToLong(BufAnsiChar, BufLong);
1074 // FillChar(BufAnsiChar, 56, #0);
1075 end
1076 else
1077 begin
1078 for n := 0 to Cnt - 8 - 1 do
1079 BufAnsiChar[p + n] := 0;
1080 ArrByteToLong(BufAnsiChar, BufLong);
1081 // FillChar(BufAnsiChar[P], Cnt - 8, #0);
1082 end;
1083 BufLong[14] := Count[0];
1084 BufLong[15] := Count[1];
1085 Transform(State, BufLong);
1086 ArrLongToByte(State, Digest);
1087 // Move(State, Digest, 16);
1088 Result := '';
1089 for i := 0 to 15 do
1090 Result := Result + AnsiChar(digest[i]);
1091 end;
1092 // FillChar(MD5Context, SizeOf(TMD5Ctx), #0)
1093 end;
1094
1095 {==============================================================================}
1096
MD5null1097 function MD5(const Value: AnsiString): AnsiString;
1098 var
1099 MDContext: TMDCtx;
1100 begin
1101 MDInit(MDContext);
1102 MDUpdate(MDContext, Value, @MD5Transform);
1103 Result := MDFinal(MDContext, @MD5Transform);
1104 end;
1105
1106 {==============================================================================}
1107
HMAC_MD5null1108 function HMAC_MD5(Text, Key: AnsiString): AnsiString;
1109 var
1110 ipad, opad, s: AnsiString;
1111 n: Integer;
1112 MDContext: TMDCtx;
1113 begin
1114 if Length(Key) > 64 then
1115 Key := md5(Key);
1116 ipad := StringOfChar(#$36, 64);
1117 opad := StringOfChar(#$5C, 64);
1118 for n := 1 to Length(Key) do
1119 begin
1120 ipad[n] := AnsiChar(Byte(ipad[n]) xor Byte(Key[n]));
1121 opad[n] := AnsiChar(Byte(opad[n]) xor Byte(Key[n]));
1122 end;
1123 MDInit(MDContext);
1124 MDUpdate(MDContext, ipad, @MD5Transform);
1125 MDUpdate(MDContext, Text, @MD5Transform);
1126 s := MDFinal(MDContext, @MD5Transform);
1127 MDInit(MDContext);
1128 MDUpdate(MDContext, opad, @MD5Transform);
1129 MDUpdate(MDContext, s, @MD5Transform);
1130 Result := MDFinal(MDContext, @MD5Transform);
1131 end;
1132
1133 {==============================================================================}
1134
MD5LongHashnull1135 function MD5LongHash(const Value: AnsiString; Len: integer): AnsiString;
1136 var
1137 cnt, rest: integer;
1138 l: integer;
1139 n: integer;
1140 MDContext: TMDCtx;
1141 begin
1142 l := length(Value);
1143 cnt := Len div l;
1144 rest := Len mod l;
1145 MDInit(MDContext);
1146 for n := 1 to cnt do
1147 MDUpdate(MDContext, Value, @MD5Transform);
1148 if rest > 0 then
1149 MDUpdate(MDContext, Copy(Value, 1, rest), @MD5Transform);
1150 Result := MDFinal(MDContext, @MD5Transform);
1151 end;
1152
1153 {==============================================================================}
1154 // SHA1 is based on sources by Dave Barton (davebarton@bigfoot.com)
1155
1156 procedure SHA1init( var SHA1Context: TSHA1Ctx );
1157 var
1158 n: integer;
1159 begin
1160 SHA1Context.Hi := 0;
1161 SHA1Context.Lo := 0;
1162 SHA1Context.Index := 0;
1163 for n := 0 to High(SHA1Context.Buffer) do
1164 SHA1Context.Buffer[n] := 0;
1165 for n := 0 to High(SHA1Context.HashByte) do
1166 SHA1Context.HashByte[n] := 0;
1167 // FillChar(SHA1Context, SizeOf(TSHA1Ctx), #0);
1168 SHA1Context.Hash[0] := integer($67452301);
1169 SHA1Context.Hash[1] := integer($EFCDAB89);
1170 SHA1Context.Hash[2] := integer($98BADCFE);
1171 SHA1Context.Hash[3] := integer($10325476);
1172 SHA1Context.Hash[4] := integer($C3D2E1F0);
1173 end;
1174
1175 //******************************************************************************
RBnull1176 function RB(A: integer): integer;
1177 begin
1178 Result := (A shr 24) or ((A shr 8) and $FF00) or ((A shl 8) and $FF0000) or (A shl 24);
1179 end;
1180
1181 procedure SHA1Compress(var Data: TSHA1Ctx);
1182 var
1183 A, B, C, D, E, T: integer;
1184 W: array[0..79] of integer;
1185 i: integer;
1186 n: integer;
1187
F1null1188 function F1(x, y, z: integer): integer;
1189 begin
1190 Result := z xor (x and (y xor z));
1191 end;
F2null1192 function F2(x, y, z: integer): integer;
1193 begin
1194 Result := x xor y xor z;
1195 end;
F3null1196 function F3(x, y, z: integer): integer;
1197 begin
1198 Result := (x and y) or (z and (x or y));
1199 end;
LRot32null1200 function LRot32(X: integer; c: integer): integer;
1201 begin
1202 result := (x shl c) or (x shr (32 - c));
1203 end;
1204 begin
1205 ArrByteToLong(Data.Buffer, W);
1206 // Move(Data.Buffer, W, Sizeof(Data.Buffer));
1207 for i := 0 to 15 do
1208 W[i] := RB(W[i]);
1209 for i := 16 to 79 do
1210 W[i] := LRot32(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16], 1);
1211 A := Data.Hash[0];
1212 B := Data.Hash[1];
1213 C := Data.Hash[2];
1214 D := Data.Hash[3];
1215 E := Data.Hash[4];
1216 for i := 0 to 19 do
1217 begin
1218 T := LRot32(A, 5) + F1(B, C, D) + E + W[i] + integer($5A827999);
1219 E := D;
1220 D := C;
1221 C := LRot32(B, 30);
1222 B := A;
1223 A := T;
1224 end;
1225 for i := 20 to 39 do
1226 begin
1227 T := LRot32(A, 5) + F2(B, C, D) + E + W[i] + integer($6ED9EBA1);
1228 E := D;
1229 D := C;
1230 C := LRot32(B, 30);
1231 B := A;
1232 A := T;
1233 end;
1234 for i := 40 to 59 do
1235 begin
1236 T := LRot32(A, 5) + F3(B, C, D) + E + W[i] + integer($8F1BBCDC);
1237 E := D;
1238 D := C;
1239 C := LRot32(B, 30);
1240 B := A;
1241 A := T;
1242 end;
1243 for i := 60 to 79 do
1244 begin
1245 T := LRot32(A, 5) + F2(B, C, D) + E + W[i] + integer($CA62C1D6);
1246 E := D;
1247 D := C;
1248 C := LRot32(B, 30);
1249 B := A;
1250 A := T;
1251 end;
1252 Data.Hash[0] := Data.Hash[0] + A;
1253 Data.Hash[1] := Data.Hash[1] + B;
1254 Data.Hash[2] := Data.Hash[2] + C;
1255 Data.Hash[3] := Data.Hash[3] + D;
1256 Data.Hash[4] := Data.Hash[4] + E;
1257 for n := 0 to high(w) do
1258 w[n] := 0;
1259 // FillChar(W, Sizeof(W), 0);
1260 for n := 0 to high(Data.Buffer) do
1261 Data.Buffer[n] := 0;
1262 // FillChar(Data.Buffer, Sizeof(Data.Buffer), 0);
1263 end;
1264
1265 //******************************************************************************
1266 procedure SHA1Update(var Context: TSHA1Ctx; const Data: AnsiString);
1267 var
1268 Len: integer;
1269 n: integer;
1270 i, k: integer;
1271 begin
1272 Len := Length(data);
1273 for k := 0 to 7 do
1274 begin
1275 i := Context.Lo;
1276 Inc(Context.Lo, Len);
1277 if Context.Lo < i then
1278 Inc(Context.Hi);
1279 end;
1280 for n := 1 to len do
1281 begin
1282 Context.Buffer[Context.Index] := byte(Data[n]);
1283 Inc(Context.Index);
1284 if Context.Index = 64 then
1285 begin
1286 Context.Index := 0;
1287 SHA1Compress(Context);
1288 end;
1289 end;
1290 end;
1291
1292 //******************************************************************************
SHA1Finalnull1293 function SHA1Final(var Context: TSHA1Ctx): AnsiString;
1294 type
1295 Pinteger = ^integer;
1296 var
1297 i: integer;
1298 procedure ItoArr(var Ar: Array of byte; I, value: Integer);
1299 begin
1300 Ar[i + 0] := Value and $000000FF;
1301 Ar[i + 1] := (Value shr 8) and $000000FF;
1302 Ar[i + 2] := (Value shr 16) and $000000FF;
1303 Ar[i + 3] := (Value shr 24) and $000000FF;
1304 end;
1305 begin
1306 Context.Buffer[Context.Index] := $80;
1307 if Context.Index >= 56 then
1308 SHA1Compress(Context);
1309 ItoArr(Context.Buffer, 56, RB(Context.Hi));
1310 ItoArr(Context.Buffer, 60, RB(Context.Lo));
1311 // Pinteger(@Context.Buffer[56])^ := RB(Context.Hi);
1312 // Pinteger(@Context.Buffer[60])^ := RB(Context.Lo);
1313 SHA1Compress(Context);
1314 Context.Hash[0] := RB(Context.Hash[0]);
1315 Context.Hash[1] := RB(Context.Hash[1]);
1316 Context.Hash[2] := RB(Context.Hash[2]);
1317 Context.Hash[3] := RB(Context.Hash[3]);
1318 Context.Hash[4] := RB(Context.Hash[4]);
1319 ArrLongToByte(Context.Hash, Context.HashByte);
1320 Result := '';
1321 for i := 0 to 19 do
1322 Result := Result + AnsiChar(Context.HashByte[i]);
1323 end;
1324
SHA1null1325 function SHA1(const Value: AnsiString): AnsiString;
1326 var
1327 SHA1Context: TSHA1Ctx;
1328 begin
1329 SHA1Init(SHA1Context);
1330 SHA1Update(SHA1Context, Value);
1331 Result := SHA1Final(SHA1Context);
1332 end;
1333
1334 {==============================================================================}
1335
HMAC_SHA1null1336 function HMAC_SHA1(Text, Key: AnsiString): AnsiString;
1337 var
1338 ipad, opad, s: AnsiString;
1339 n: Integer;
1340 SHA1Context: TSHA1Ctx;
1341 begin
1342 if Length(Key) > 64 then
1343 Key := SHA1(Key);
1344 ipad := StringOfChar(#$36, 64);
1345 opad := StringOfChar(#$5C, 64);
1346 for n := 1 to Length(Key) do
1347 begin
1348 ipad[n] := AnsiChar(Byte(ipad[n]) xor Byte(Key[n]));
1349 opad[n] := AnsiChar(Byte(opad[n]) xor Byte(Key[n]));
1350 end;
1351 SHA1Init(SHA1Context);
1352 SHA1Update(SHA1Context, ipad);
1353 SHA1Update(SHA1Context, Text);
1354 s := SHA1Final(SHA1Context);
1355 SHA1Init(SHA1Context);
1356 SHA1Update(SHA1Context, opad);
1357 SHA1Update(SHA1Context, s);
1358 Result := SHA1Final(SHA1Context);
1359 end;
1360
1361 {==============================================================================}
1362
SHA1LongHashnull1363 function SHA1LongHash(const Value: AnsiString; Len: integer): AnsiString;
1364 var
1365 cnt, rest: integer;
1366 l: integer;
1367 n: integer;
1368 SHA1Context: TSHA1Ctx;
1369 begin
1370 l := length(Value);
1371 cnt := Len div l;
1372 rest := Len mod l;
1373 SHA1Init(SHA1Context);
1374 for n := 1 to cnt do
1375 SHA1Update(SHA1Context, Value);
1376 if rest > 0 then
1377 SHA1Update(SHA1Context, Copy(Value, 1, rest));
1378 Result := SHA1Final(SHA1Context);
1379 end;
1380
1381 {==============================================================================}
1382
1383 procedure MD4Transform(var Buf: array of LongInt; const Data: array of LongInt);
1384 var
1385 A, B, C, D: LongInt;
LRot32null1386 function LRot32(a, b: longint): longint;
1387 begin
1388 Result:= (a shl b) or (a shr (32 - b));
1389 end;
1390 begin
1391 A := Buf[0];
1392 B := Buf[1];
1393 C := Buf[2];
1394 D := Buf[3];
1395
1396 A:= LRot32(A + (D xor (B and (C xor D))) + Data[ 0], 3);
1397 D:= LRot32(D + (C xor (A and (B xor C))) + Data[ 1], 7);
1398 C:= LRot32(C + (B xor (D and (A xor B))) + Data[ 2], 11);
1399 B:= LRot32(B + (A xor (C and (D xor A))) + Data[ 3], 19);
1400 A:= LRot32(A + (D xor (B and (C xor D))) + Data[ 4], 3);
1401 D:= LRot32(D + (C xor (A and (B xor C))) + Data[ 5], 7);
1402 C:= LRot32(C + (B xor (D and (A xor B))) + Data[ 6], 11);
1403 B:= LRot32(B + (A xor (C and (D xor A))) + Data[ 7], 19);
1404 A:= LRot32(A + (D xor (B and (C xor D))) + Data[ 8], 3);
1405 D:= LRot32(D + (C xor (A and (B xor C))) + Data[ 9], 7);
1406 C:= LRot32(C + (B xor (D and (A xor B))) + Data[10], 11);
1407 B:= LRot32(B + (A xor (C and (D xor A))) + Data[11], 19);
1408 A:= LRot32(A + (D xor (B and (C xor D))) + Data[12], 3);
1409 D:= LRot32(D + (C xor (A and (B xor C))) + Data[13], 7);
1410 C:= LRot32(C + (B xor (D and (A xor B))) + Data[14], 11);
1411 B:= LRot32(B + (A xor (C and (D xor A))) + Data[15], 19);
1412
1413 A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 0] + longint($5a827999), 3);
1414 D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 4] + longint($5a827999), 5);
1415 C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[ 8] + longint($5a827999), 9);
1416 B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[12] + longint($5a827999), 13);
1417 A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 1] + longint($5a827999), 3);
1418 D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 5] + longint($5a827999), 5);
1419 C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[ 9] + longint($5a827999), 9);
1420 B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[13] + longint($5a827999), 13);
1421 A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 2] + longint($5a827999), 3);
1422 D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 6] + longint($5a827999), 5);
1423 C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[10] + longint($5a827999), 9);
1424 B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[14] + longint($5a827999), 13);
1425 A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 3] + longint($5a827999), 3);
1426 D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 7] + longint($5a827999), 5);
1427 C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[11] + longint($5a827999), 9);
1428 B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[15] + longint($5a827999), 13);
1429
1430 A:= LRot32(A + (B xor C xor D) + Data[ 0] + longint($6ed9eba1), 3);
1431 D:= LRot32(D + (A xor B xor C) + Data[ 8] + longint($6ed9eba1), 9);
1432 C:= LRot32(C + (D xor A xor B) + Data[ 4] + longint($6ed9eba1), 11);
1433 B:= LRot32(B + (C xor D xor A) + Data[12] + longint($6ed9eba1), 15);
1434 A:= LRot32(A + (B xor C xor D) + Data[ 2] + longint($6ed9eba1), 3);
1435 D:= LRot32(D + (A xor B xor C) + Data[10] + longint($6ed9eba1), 9);
1436 C:= LRot32(C + (D xor A xor B) + Data[ 6] + longint($6ed9eba1), 11);
1437 B:= LRot32(B + (C xor D xor A) + Data[14] + longint($6ed9eba1), 15);
1438 A:= LRot32(A + (B xor C xor D) + Data[ 1] + longint($6ed9eba1), 3);
1439 D:= LRot32(D + (A xor B xor C) + Data[ 9] + longint($6ed9eba1), 9);
1440 C:= LRot32(C + (D xor A xor B) + Data[ 5] + longint($6ed9eba1), 11);
1441 B:= LRot32(B + (C xor D xor A) + Data[13] + longint($6ed9eba1), 15);
1442 A:= LRot32(A + (B xor C xor D) + Data[ 3] + longint($6ed9eba1), 3);
1443 D:= LRot32(D + (A xor B xor C) + Data[11] + longint($6ed9eba1), 9);
1444 C:= LRot32(C + (D xor A xor B) + Data[ 7] + longint($6ed9eba1), 11);
1445 B:= LRot32(B + (C xor D xor A) + Data[15] + longint($6ed9eba1), 15);
1446
1447 Inc(Buf[0], A);
1448 Inc(Buf[1], B);
1449 Inc(Buf[2], C);
1450 Inc(Buf[3], D);
1451 end;
1452
1453 {==============================================================================}
1454
MD4null1455 function MD4(const Value: AnsiString): AnsiString;
1456 var
1457 MDContext: TMDCtx;
1458 begin
1459 MDInit(MDContext);
1460 MDUpdate(MDContext, Value, @MD4Transform);
1461 Result := MDFinal(MDContext, @MD4Transform);
1462 end;
1463
1464 {==============================================================================}
1465
1466
1467 end.
1468