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

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