source: trunk/Demo/Packages/synapse/synacode.pas

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