units/synapse/SynaCode.pas

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