diff options
Diffstat (limited to 'compat')
| -rw-r--r-- | compat/COPYING.FPC | 25 | ||||
| -rw-r--r-- | compat/crc.pas | 231 | ||||
| -rw-r--r-- | compat/md5.pas | 711 |
3 files changed, 0 insertions, 967 deletions
diff --git a/compat/COPYING.FPC b/compat/COPYING.FPC deleted file mode 100644 index 675669f..0000000 --- a/compat/COPYING.FPC +++ /dev/null @@ -1,25 +0,0 @@ -This is the file COPYING.FPC, it applies to the Free Pascal Run-Time Library -(RTL) and packages (packages) distributed by members of the Free Pascal -Development Team. - -The source code of the Free Pascal Runtime Libraries and packages are -distributed under the Library GNU General Public License -(see the file COPYING) with the following modification: - -As a special exception, the copyright holders of this library give you -permission to link this library with independent modules to produce an -executable, regardless of the license terms of these independent modules, -and to copy and distribute the resulting executable under terms of your choice, -provided that you also meet, for each linked independent module, the terms -and conditions of the license of that module. An independent module is a module -which is not derived from or based on this library. If you modify this -library, you may extend this exception to your version of the library, but you are -not obligated to do so. If you do not wish to do so, delete this exception -statement from your version. - -If you didn't receive a copy of the file COPYING, contact: - Free Software Foundation - 675 Mass Ave - Cambridge, MA 02139 - USA - diff --git a/compat/crc.pas b/compat/crc.pas deleted file mode 100644 index b3a479d..0000000 --- a/compat/crc.pas +++ /dev/null @@ -1,231 +0,0 @@ -unit crc; - -{ - crc32.c -- compute the CRC-32 of a data stream - Copyright (C) 1995-1998 Mark Adler - - Pascal tranlastion - Copyright (C) 1998 by Jacques Nomssi Nzali - For conditions of distribution and use, see copyright notice in readme.txt -} - -interface - -function crc32(crc : cardinal; buf : Pbyte; len : cardinal) : cardinal; - -{ Update a running crc with the bytes buf[0..len-1] and return the updated - crc. If buf is NULL, this function returns the required initial value - for the crc. Pre- and post-conditioning (one's complement) is performed - within this function so it shouldn't be done by the application. - Usage example: - - var - crc : cardinal; - begin - crc := crc32(0, nil, 0); - - while (read_buffer(buffer, length) <> EOF) do - crc := crc32(crc, buffer, length); - - if (crc <> original_crc) then error(); - end; - -} - -function get_crc_table : Pcardinal; { can be used by asm versions of crc32() } - - -implementation - -{$IFDEF DYNAMIC_CRC_TABLE} - -{local} -const - crc_table_empty : boolean = TRUE; -{local} -var - crc_table : array[0..256-1] of uLongf; - - -{ - Generate a table for a byte-wise 32-bit CRC calculation on the polynomial: - x^32+x^26+x^23+x^22+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x+1. - - Polynomials over GF(2) are represented in binary, one bit per coefficient, - with the lowest powers in the most significant bit. Then adding polynomials - is just exclusive-or, and multiplying a polynomial by x is a right shift by - one. If we call the above polynomial p, and represent a byte as the - polynomial q, also with the lowest power in the most significant bit (so the - byte 0xb1 is the polynomial x^7+x^3+x+1), then the CRC is (q*x^32) mod p, - where a mod b means the remainder after dividing a by b. - - This calculation is done using the shift-register method of multiplying and - taking the remainder. The register is initialized to zero, and for each - incoming bit, x^32 is added mod p to the register if the bit is a one (where - x^32 mod p is p+x^32 = x^26+...+1), and the register is multiplied mod p by - x (which is shifting right by one and adding x^32 mod p if the bit shifted - out is a one). We start with the highest power (least significant bit) of - q and repeat for all eight bits of q. - - The table is simply the CRC of all possible eight bit values. This is all - the information needed to generate CRC's on data a byte at a time for all - combinations of CRC register values and incoming bytes. -} -{local} -procedure make_crc_table; -var - c : cardinal; - n,k : integer; - poly : cardinal; { polynomial exclusive-or pattern } - -const - { terms of polynomial defining this crc (except x^32): } - p: array [0..13] of Byte = (0,1,2,4,5,7,8,10,11,12,16,22,23,26); - -begin - { make exclusive-or pattern from polynomial ($EDB88320) } - poly := longint(0); - for n := 0 to (sizeof(p) div sizeof(Byte))-1 do - poly := poly or (longint(1) shl (31 - p[n])); - - for n := 0 to 255 do - begin - c := cardinal(n); - for k := 0 to 7 do - begin - if (c and 1) <> 0 then - c := poly xor (c shr 1) - else - c := (c shr 1); - end; - crc_table[n] := c; - end; - crc_table_empty := FALSE; -end; - -{$ELSE} - -{ ======================================================================== - Table of CRC-32's of all single-byte values (made by make_crc_table) } - -{local} -const - crc_table : array[0..256-1] of cardinal = ( - $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, - $706af48f, $e963a535, $9e6495a3, $0edb8832, $79dcb8a4, - $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, - $90bf1d91, $1db71064, $6ab020f2, $f3b97148, $84be41de, - $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7, $136c9856, - $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, - $fa0f3d63, $8d080df5, $3b6e20c8, $4c69105e, $d56041e4, - $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b, - $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3, - $45df5c75, $dcd60dcf, $abd13d59, $26d930ac, $51de003a, - $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, - $b8bda50f, $2802b89e, $5f058808, $c60cd9b2, $b10be924, - $2f6f7c87, $58684c11, $c1611dab, $b6662d3d, $76dc4190, - $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f, - $9fbfe4a5, $e8b8d433, $7807c9a2, $0f00f934, $9609a88e, - $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01, - $6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, - $1b01a57b, $8208f4c1, $f50fc457, $65b0d9c6, $12b7e950, - $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, - $fbd44c65, $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, - $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb, $4369e96a, - $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, - $aa0a4c5f, $dd0d7cc9, $5005713c, $270241aa, $be0b1010, - $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f, - $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, - $2eb40d81, $b7bd5c3b, $c0ba6cad, $edb88320, $9abfb3b6, - $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615, - $73dc1683, $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, - $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1, $f00f9344, - $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb, - $196c3671, $6e6b06e7, $fed41b76, $89d32be0, $10da7a5a, - $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5, - $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, - $a6bc5767, $3fb506dd, $48b2364b, $d80d2bda, $af0a1b4c, - $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef, - $4669be79, $cb61b38c, $bc66831a, $256fd2a0, $5268e236, - $cc0c7795, $bb0b4703, $220216b9, $5505262f, $c5ba3bbe, - $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, - $2cd99e8b, $5bdeae1d, $9b64c2b0, $ec63f226, $756aa39c, - $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713, - $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, - $e5d5be0d, $7cdcefb7, $0bdbdf21, $86d3d2d4, $f1d4e242, - $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, - $18b74777, $88085ae6, $ff0f6a70, $66063bca, $11010b5c, - $8f659eff, $f862ae69, $616bffd3, $166ccf45, $a00ae278, - $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, - $4969474d, $3e6e77db, $aed16a4a, $d9d65adc, $40df0b66, - $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9, - $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, - $cdd70693, $54de5729, $23d967bf, $b3667a2e, $c4614ab8, - $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b, - $2d02ef8d); - -{$ENDIF} - -{ ========================================================================= - This function can be used by asm versions of crc32() } - -function get_crc_table : {const} Pcardinal; -begin -{$ifdef DYNAMIC_CRC_TABLE} - if (crc_table_empty) then - make_crc_table; -{$endif} - get_crc_table := {const} Pcardinal(@crc_table); -end; - -{ ========================================================================= } - -function crc32 (crc : cardinal; buf : Pbyte; len : cardinal): cardinal; -begin - if (buf = nil) then - crc32 := 0 - else - begin - -{$IFDEF DYNAMIC_CRC_TABLE} - if crc_table_empty then - make_crc_table; -{$ENDIF} - - crc := crc xor cardinal($ffffffff); - while (len >= 8) do - begin - {DO8(buf)} - crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); - inc(buf); - crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); - inc(buf); - crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); - inc(buf); - crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); - inc(buf); - crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); - inc(buf); - crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); - inc(buf); - crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); - inc(buf); - crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); - inc(buf); - - dec(len, 8); - end; - if (len <> 0) then - repeat - {DO1(buf)} - crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); - inc(buf); - - dec(len); - until (len = 0); - crc32 := crc xor cardinal($ffffffff); - end; -end; - - -end.
\ No newline at end of file diff --git a/compat/md5.pas b/compat/md5.pas deleted file mode 100644 index dfcaae5..0000000 --- a/compat/md5.pas +++ /dev/null @@ -1,711 +0,0 @@ -{ - This file is part of the Free Pascal packages. - Copyright (c) 1999-2006 by the Free Pascal development team - - Kylix port by Tomas Bzatek - - Implements a MD2 digest algorithm (RFC 1319) - Implements a MD4 digest algorithm (RFC 1320) - Implements a MD5 digest algorithm (RFC 1321) - - See the file COPYING.FPC, included in this distribution, - for details about the copyright. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - - **********************************************************************} - -unit md5; - -{$h+} -{$R-} -{$Q-} - -interface - - -(****************************************************************************** - * types and constants - ******************************************************************************) - -const - MDDefBufSize = 1024; - -type - TMDVersion = ( - MD_VERSION_2, - MD_VERSION_4, - MD_VERSION_5 - ); - - PMDDigest = ^TMDDigest; - TMDDigest = array[0..15] of Byte; - - PMD2Digset = PMDDigest; - TMD2Digest = TMDDigest; - - PMD4Digset = PMDDigest; - TMD4Digest = TMDDigest; - - PMD5Digset = PMDDigest; - TMD5Digest = TMDDigest; - - PMDContext = ^TMDContext; - TMDContext = record - Version : TMDVersion; - Align : Cardinal; - State : array[0..3] of Cardinal; - BufCnt : Int64; - Buffer : array[0..63] of Byte; - case Integer of - 0: (Length : Cardinal); - 1: (Checksum : array[0..15] of Byte); - end; - - PMD2Context = PMDContext; - TMD2Context = TMDContext; - - PMD4Context = PMDContext; - TMD4Context = TMDContext; - - PMD5Context = PMDContext; - TMD5Context = TMDContext; - - -(****************************************************************************** - * Core raw functions - ******************************************************************************) - -procedure MDInit(var Context: TMDContext; const Version: TMDVersion); -procedure MDUpdate(var Context: TMDContext; var Buf; const BufLen: Cardinal); -procedure MDFinal(var Context: TMDContext; var Digest: TMDDigest); - - -(****************************************************************************** - * Auxilary functions - ******************************************************************************) - -function MDString(const S: String; const Version: TMDVersion): TMDDigest; -function MDBuffer(var Buf; const BufLen: Cardinal; const Version: TMDVersion): TMDDigest; -function MDFile(const Filename: String; const Version: TMDVersion; const Bufsize: Cardinal = MDDefBufSize): TMDDigest; - - -(****************************************************************************** - * Helper functions - ******************************************************************************) - -function MDPrint(const Digest: TMDDigest): String; -function MDMatch(const Digest1, Digest2: TMDDigest): Boolean; - - -(****************************************************************************** - * Dedicated raw functions - ******************************************************************************) - -procedure MD2Init(var Context: TMD2Context); -procedure MD2Update(var Context: TMD2Context; var Buf; const BufLen: Cardinal); -procedure MD2Final(var Context: TMD2Context; var Digest: TMD2Digest); - -procedure MD4Init(var Context: TMD4Context); -procedure MD4Update(var Context: TMD4Context; var Buf; const BufLen: Cardinal); -procedure MD4Final(var Context: TMD4Context; var Digest: TMD4Digest); - -procedure MD5Init(var Context: TMD5Context); -procedure MD5Update(var Context: TMD5Context; var Buf; const BufLen: Cardinal); -procedure MD5Final(var Context: TMD5Context; var Digest: TMD5Digest); - - -(****************************************************************************** - * Dedicated auxilary functions - ******************************************************************************) - -function MD2String(const S: String): TMD2Digest; -function MD2Buffer(var Buf; const BufLen: Cardinal): TMD2Digest; -function MD2File(const Filename: String; const Bufsize: Cardinal = MDDefBufSize): TMD2Digest; - -function MD4String(const S: String): TMD4Digest; -function MD4Buffer(var Buf; const BufLen: Cardinal): TMD4Digest; -function MD4File(const Filename: String; const Bufsize: Cardinal = MDDefBufSize): TMD4Digest; - -function MD5String(const S: String): TMD5Digest; -function MD5Buffer(var Buf; const BufLen: Cardinal): TMD5Digest; -function MD5File(const Filename: String; const Bufsize: Cardinal = MDDefBufSize): TMD5Digest; - - - -(****************************************************************************** - * Dedicated helper functions - ******************************************************************************) - -function MD2Print(const Digest: TMD2Digest): String; -function MD2Match(const Digest1, Digest2: TMD2Digest): Boolean; - -function MD4Print(const Digest: TMD4Digest): String; -function MD4Match(const Digest1, Digest2: TMD4Digest): Boolean; - -function MD5Print(const Digest: TMD5Digest): String; -function MD5Match(const Digest1, Digest2: TMD5Digest): Boolean; - -implementation - - -uses SysUtils; - -function rol(x: Cardinal; n: Byte): Cardinal; -begin - Result := (x shl n) or (x shr (32 - n)); -end; - -const - HexTbl : array[0..15] of char='0123456789ABCDEF'; - -function hexstr(val : longint;cnt : byte) : shortstring; -var - i : longint; -begin - hexstr[0]:=char(cnt); - for i:=cnt downto 1 do - begin - hexstr[i]:=hextbl[val and $f]; - val:=val shr 4; - end; -end; - - -// inverts the bytes of (Count div 4) cardinals from source to target. -procedure Invert(Source, Dest: Pointer; Count: Cardinal); -var - S: Cardinal; - T: PCardinal; - I: Cardinal; -begin - S := Cardinal(Source); - T := Dest; - for I := 1 to (Count div 4) do - begin - T^ := PByte(S)^ or (PByte(S + 1)^ shl 8) or (PByte(S + 2)^ shl 16) or (PByte(S + 3)^ shl 24); - inc(S,4); - inc(T); - end; -end; - - -procedure MD2Transform(var Context: TMDContext; Buffer: Pointer); -const - PI_SUBST: array[0..255] of Byte = ( - 41, 46, 67, 201, 162, 216, 124, 1, 61, 54, 84, 161, 236, 240, 6, - 19, 98, 167, 5, 243, 192, 199, 115, 140, 152, 147, 43, 217, 188, - 76, 130, 202, 30, 155, 87, 60, 253, 212, 224, 22, 103, 66, 111, 24, - 138, 23, 229, 18, 190, 78, 196, 214, 218, 158, 222, 73, 160, 251, - 245, 142, 187, 47, 238, 122, 169, 104, 121, 145, 21, 178, 7, 63, - 148, 194, 16, 137, 11, 34, 95, 33, 128, 127, 93, 154, 90, 144, 50, - 39, 53, 62, 204, 231, 191, 247, 151, 3, 255, 25, 48, 179, 72, 165, - 181, 209, 215, 94, 146, 42, 172, 86, 170, 198, 79, 184, 56, 210, - 150, 164, 125, 182, 118, 252, 107, 226, 156, 116, 4, 241, 69, 157, - 112, 89, 100, 113, 135, 32, 134, 91, 207, 101, 230, 45, 168, 2, 27, - 96, 37, 173, 174, 176, 185, 246, 28, 70, 97, 105, 52, 64, 126, 15, - 85, 71, 163, 35, 221, 81, 175, 58, 195, 92, 249, 206, 186, 197, - 234, 38, 44, 83, 13, 110, 133, 40, 132, 9, 211, 223, 205, 244, 65, - 129, 77, 82, 106, 220, 55, 200, 108, 193, 171, 250, 36, 225, 123, - 8, 12, 189, 177, 74, 120, 136, 149, 139, 227, 99, 232, 109, 233, - 203, 213, 254, 59, 0, 29, 57, 242, 239, 183, 14, 102, 88, 208, 228, - 166, 119, 114, 248, 235, 117, 75, 10, 49, 68, 80, 180, 143, 237, - 31, 26, 219, 153, 141, 51, 159, 17, 131, 20 -); -var - i: Cardinal; - j: Cardinal; - t: Cardinal; - x: array[0..47] of Byte; -begin - { Form encryption block from state, block, state ^ block } - Move(Context.State, x[0], 16); - Move(Buffer^, x[16], 16); - for i := 0 to 15 do - x[i+32] := PByte(Cardinal(@Context.State) + i)^ xor PByte(Cardinal(Buffer) + i)^; - - { Encrypt block (18 rounds) } - t := 0; - for i := 0 to 17 do - begin - for j := 0 to 47 do - begin - x[j] := x[j] xor PI_SUBST[t]; - t := x[j]; - end; - t := (t + i) and $FF; - end; - - { Save new state } - Move(x[0], Context.State, 16); - - { Update checksum } - t := Context.Checksum[15]; - for i := 0 to 15 do - begin - Context.Checksum[i] := Context.Checksum[i] xor PI_SUBST[PByte(Cardinal(Buffer) + i)^ xor t]; - t := Context.Checksum[i]; - end; - - { Zeroize sensitive information. } - FillChar(x, Sizeof(x), 0); -end; - - -procedure MD4Transform(var Context: TMDContext; Buffer: Pointer); - - procedure R1(var a: Cardinal; b,c,d,x: Cardinal; s: Byte); - // F(x,y,z) = (x and y) or ((not x) and z) - begin - a := rol(a + {F(b,c,d)}((b and c) or ((not b) and d)) + x, s); - end; - - procedure R2(var a: Cardinal; b,c,d,x: Cardinal; s: Byte); - // G(x,y,z) = (x and y) or (x and z) or (y and z); - begin - a := rol(a + {G(b,c,d)}((b and c) or (b and d) or (c and d)) + x + $5A827999, s); - end; - - procedure R3(var a: Cardinal; b,c,d,x: Cardinal; s: Byte); - // H(x,y,z) = x xor y xor z - begin - a := rol(a + {H(b,c,d)}(b xor c xor d) + x + $6ED9EBA1, s); - end; - -var - a, b, c, d: Cardinal; - Block: array[0..15] of Cardinal; -begin - Invert(Buffer, @Block, 64); - a := Context.State[0]; - b := Context.State[1]; - c := Context.State[2]; - d := Context.State[3]; - - // Round 1 - R1(a,b,c,d,Block[0], 3); R1(d,a,b,c,Block[1], 7); R1(c,d,a,b,Block[2], 11); R1(b,c,d,a,Block[3], 19); - R1(a,b,c,d,Block[4], 3); R1(d,a,b,c,Block[5], 7); R1(c,d,a,b,Block[6], 11); R1(b,c,d,a,Block[7], 19); - R1(a,b,c,d,Block[8], 3); R1(d,a,b,c,Block[9], 7); R1(c,d,a,b,Block[10],11); R1(b,c,d,a,Block[11],19); - R1(a,b,c,d,Block[12], 3); R1(d,a,b,c,Block[13], 7); R1(c,d,a,b,Block[14],11); R1(b,c,d,a,Block[15],19); - - // Round 2 - R2(a,b,c,d,Block[0], 3); R2(d,a,b,c,Block[4], 5); R2(c,d,a,b,Block[8], 9); R2(b,c,d,a,Block[12],13); - R2(a,b,c,d,Block[1], 3); R2(d,a,b,c,Block[5], 5); R2(c,d,a,b,Block[9], 9); R2(b,c,d,a,Block[13],13); - R2(a,b,c,d,Block[2], 3); R2(d,a,b,c,Block[6], 5); R2(c,d,a,b,Block[10], 9); R2(b,c,d,a,Block[14],13); - R2(a,b,c,d,Block[3], 3); R2(d,a,b,c,Block[7], 5); R2(c,d,a,b,Block[11], 9); R2(b,c,d,a,Block[15],13); - - // Round 3 - R3(a,b,c,d,Block[0], 3); R3(d,a,b,c,Block[8], 9); R3(c,d,a,b,Block[4], 11); R3(b,c,d,a,Block[12],15); - R3(a,b,c,d,Block[2], 3); R3(d,a,b,c,Block[10], 9); R3(c,d,a,b,Block[6], 11); R3(b,c,d,a,Block[14],15); - R3(a,b,c,d,Block[1], 3); R3(d,a,b,c,Block[9], 9); R3(c,d,a,b,Block[5], 11); R3(b,c,d,a,Block[13],15); - R3(a,b,c,d,Block[3], 3); R3(d,a,b,c,Block[11], 9); R3(c,d,a,b,Block[7], 11); R3(b,c,d,a,Block[15],15); - - inc(Context.State[0], a); - inc(Context.State[1], b); - inc(Context.State[2], c); - inc(Context.State[3], d); - inc(Context.Length,64); -end; - - -procedure MD5Transform(var Context: TMDContext; Buffer: Pointer); - - procedure R1(var a: Cardinal; b,c,d,x: Cardinal; s: Byte; ac: Cardinal); - // F(x,y,z) = (x and y) or ((not x) and z) - begin - a := b + rol(a + {F(b,c,d)}((b and c) or ((not b) and d)) + x + ac, s); - end; - - procedure R2(var a: Cardinal; b,c,d,x: Cardinal; s: Byte; ac: Cardinal); - // G(x,y,z) = (x and z) or (y and (not z)) - begin - a := b + rol(a + {G(b,c,d)}((b and d) or (c and (not d))) + x + ac, s); - end; - - procedure R3(var a: Cardinal; b,c,d,x: Cardinal; s: Byte; ac: Cardinal); - // H(x,y,z) = x xor y xor z; - begin - a := b + rol(a + {H(b,c,d)}(b xor c xor d) + x + ac, s); - end; - - procedure R4(var a: Cardinal; b,c,d,x: Cardinal; s: Byte; ac: Cardinal); - // I(x,y,z) = y xor (x or (not z)); - begin - a := b + rol(a + {I(b,c,d)}(c xor (b or (not d))) + x + ac, s); - end; - -var - a, b, c, d: Cardinal; - Block: array[0..15] of Cardinal; -begin - Invert(Buffer, @Block, 64); - a := Context.State[0]; - b := Context.State[1]; - c := Context.State[2]; - d := Context.State[3]; - - // Round 1 - R1(a,b,c,d,Block[0] , 7,$d76aa478); R1(d,a,b,c,Block[1] ,12,$e8c7b756); R1(c,d,a,b,Block[2] ,17,$242070db); R1(b,c,d,a,Block[3] ,22,$c1bdceee); - R1(a,b,c,d,Block[4] , 7,$f57c0faf); R1(d,a,b,c,Block[5] ,12,$4787c62a); R1(c,d,a,b,Block[6] ,17,$a8304613); R1(b,c,d,a,Block[7] ,22,$fd469501); - R1(a,b,c,d,Block[8] , 7,$698098d8); R1(d,a,b,c,Block[9] ,12,$8b44f7af); R1(c,d,a,b,Block[10],17,$ffff5bb1); R1(b,c,d,a,Block[11],22,$895cd7be); - R1(a,b,c,d,Block[12], 7,$6b901122); R1(d,a,b,c,Block[13],12,$fd987193); R1(c,d,a,b,Block[14],17,$a679438e); R1(b,c,d,a,Block[15],22,$49b40821); - - // Round 2 - R2(a,b,c,d,Block[1] , 5,$f61e2562); R2(d,a,b,c,Block[6] , 9,$c040b340); R2(c,d,a,b,Block[11],14,$265e5a51); R2(b,c,d,a,Block[0] ,20,$e9b6c7aa); - R2(a,b,c,d,Block[5] , 5,$d62f105d); R2(d,a,b,c,Block[10], 9,$02441453); R2(c,d,a,b,Block[15],14,$d8a1e681); R2(b,c,d,a,Block[4] ,20,$e7d3fbc8); - R2(a,b,c,d,Block[9] , 5,$21e1cde6); R2(d,a,b,c,Block[14], 9,$c33707d6); R2(c,d,a,b,Block[3] ,14,$f4d50d87); R2(b,c,d,a,Block[8] ,20,$455a14ed); - R2(a,b,c,d,Block[13], 5,$a9e3e905); R2(d,a,b,c,Block[2] , 9,$fcefa3f8); R2(c,d,a,b,Block[7] ,14,$676f02d9); R2(b,c,d,a,Block[12],20,$8d2a4c8a); - - // Round 3 - R3(a,b,c,d,Block[5] , 4,$fffa3942); R3(d,a,b,c,Block[8] ,11,$8771f681); R3(c,d,a,b,Block[11],16,$6d9d6122); R3(b,c,d,a,Block[14],23,$fde5380c); - R3(a,b,c,d,Block[1] , 4,$a4beea44); R3(d,a,b,c,Block[4] ,11,$4bdecfa9); R3(c,d,a,b,Block[7] ,16,$f6bb4b60); R3(b,c,d,a,Block[10],23,$bebfbc70); - R3(a,b,c,d,Block[13], 4,$289b7ec6); R3(d,a,b,c,Block[0] ,11,$eaa127fa); R3(c,d,a,b,Block[3] ,16,$d4ef3085); R3(b,c,d,a,Block[6] ,23,$04881d05); - R3(a,b,c,d,Block[9] , 4,$d9d4d039); R3(d,a,b,c,Block[12],11,$e6db99e5); R3(c,d,a,b,Block[15],16,$1fa27cf8); R3(b,c,d,a,Block[2] ,23,$c4ac5665); - - // Round 4 - R4(a,b,c,d,Block[0] , 6,$f4292244); R4(d,a,b,c,Block[7] ,10,$432aff97); R4(c,d,a,b,Block[14],15,$ab9423a7); R4(b,c,d,a,Block[5] ,21,$fc93a039); - R4(a,b,c,d,Block[12], 6,$655b59c3); R4(d,a,b,c,Block[3] ,10,$8f0ccc92); R4(c,d,a,b,Block[10],15,$ffeff47d); R4(b,c,d,a,Block[1] ,21,$85845dd1); - R4(a,b,c,d,Block[8] , 6,$6fa87e4f); R4(d,a,b,c,Block[15],10,$fe2ce6e0); R4(c,d,a,b,Block[6] ,15,$a3014314); R4(b,c,d,a,Block[13],21,$4e0811a1); - R4(a,b,c,d,Block[4] , 6,$f7537e82); R4(d,a,b,c,Block[11],10,$bd3af235); R4(c,d,a,b,Block[2] ,15,$2ad7d2bb); R4(b,c,d,a,Block[9] ,21,$eb86d391); - - inc(Context.State[0],a); - inc(Context.State[1],b); - inc(Context.State[2],c); - inc(Context.State[3],d); - inc(Context.Length,64); -end; - - -procedure MDInit(var Context: TMDContext; const Version: TMDVersion); -begin - FillChar(Context, Sizeof(TMDContext), 0); - Context.Version := Version; - - case Version of - - MD_VERSION_4, MD_VERSION_5: - begin - Context.Align := 64; - Context.State[0] := $67452301; - Context.State[1] := $efcdab89; - Context.State[2] := $98badcfe; - Context.State[3] := $10325476; - Context.Length := 0; - Context.BufCnt := 0; - end; - - MD_VERSION_2: - begin - Context.Align := 16; - end; - - end; -end; - - -procedure MDUpdate(var Context: TMDContext; var Buf; const BufLen: Cardinal); -var - Align: Cardinal; - Src: Pointer; - Num: Cardinal; -begin - if BufLen = 0 then - Exit; - - Align := Context.Align; - Src := @Buf; - Num := 0; - - // 1. Transform existing data in buffer - if Context.BufCnt > 0 then - begin - // 1.1 Try to fill buffer to "Align" bytes - Num := Align - Context.BufCnt; - if Num > BufLen then - Num := BufLen; - - Move(Src^, Context.Buffer[Context.BufCnt], Num); - Context.BufCnt := Context.BufCnt + Num; - Src := Pointer(Cardinal(Src) + Num); - - // 1.2 If buffer contains "Align" bytes, transform it - if Context.BufCnt = Align then - begin - case Context.Version of - MD_VERSION_2: MD2Transform(Context, @Context.Buffer); - MD_VERSION_4: MD4Transform(Context, @Context.Buffer); - MD_VERSION_5: MD5Transform(Context, @Context.Buffer); - end; - Context.BufCnt := 0; - end; - end; - - // 2. Transform "Align"-Byte blocks of Buf - Num := BufLen - Num; - while Num >= Align do - begin - case Context.Version of - MD_VERSION_2: MD2Transform(Context, Src); - MD_VERSION_4: MD4Transform(Context, Src); - MD_VERSION_5: MD5Transform(Context, Src); - end; - Src := Pointer(Cardinal(Src) + Align); - Num := Num - Align; - end; - - // 3. If there's a block smaller than "Align" Bytes left, add it to buffer - if Num > 0 then - begin - Context.BufCnt := Num; - Move(Src^, Context.Buffer, Num); - end; -end; - - -procedure MDFinal(var Context: TMDContext; var Digest: TMDDigest); -const -{$ifdef FPC_BIG_ENDIAN} - PADDING_MD45: array[0..15] of Cardinal = ($80000000,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); -{$else FPC_BIG_ENDIAN} - PADDING_MD45: array[0..15] of Cardinal = ($80,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); -{$endif FPC_BIG_ENDIAN} -var - Length: Int64; - Pads: Cardinal; - padding: array[0..15] of Cardinal; - i: integer; -begin - for i := 0 to 15 do - padding[i] := PADDING_MD45[i]; - case Context.Version of - - MD_VERSION_4, MD_VERSION_5: - begin - // 1. Compute length of the whole stream in bits - Length := 8 * (Context.Length + Context.BufCnt); - - // 2. Append padding bits - if Context.BufCnt >= 56 then - Pads := 120 - Context.BufCnt - else - Pads := 56 - Context.BufCnt; - MDUpdate(Context, padding, Pads); - - // 3. Append length of the stream -// Length := NtoLE(Length); - MDUpdate(Context, Length, 8); - - // 4. Invert state to digest - Invert(@Context.State, @Digest, 16); - end; - - MD_VERSION_2: - begin - Pads := 16 - Context.BufCnt; - Length := {NtoLE(}Int64(Pads){)}; - while Pads > 0 do - begin - MDUpdate(Context, Length, 1); - Dec(Pads); - end; - MDUpdate(Context, Context.Checksum, 16); - Move(Context.State, Digest, 16); - end; - - end; - - FillChar(Context, SizeOf(TMDContext), 0); -end; - -function MDString(const S: String; const Version: TMDVersion): TMDDigest; -var - Context: TMDContext; -begin - MDInit(Context, Version); - MDUpdate(Context, PChar(S)^, length(S)); - MDFinal(Context, Result); -end; - -function MDBuffer(var Buf; const BufLen: Cardinal; const Version: TMDVersion): TMDDigest; -var - Context: TMDContext; -begin - MDInit(Context, Version); - MDUpdate(Context, buf, buflen); - MDFinal(Context, Result); -end; - -function MDFile(const Filename: String; const Version: TMDVersion; const BufSize: Cardinal): TMDDigest; -var - F: File; - Buf: Pchar; - Context: TMDContext; - Count: Cardinal; - ofm: Longint; -begin - MDInit(Context, Version); - - Assign(F, Filename); - {$i-} - ofm := FileMode; - FileMode := 0; - Reset(F, 1); - {$i+} - - if IOResult = 0 then - begin - GetMem(Buf, BufSize); - repeat - BlockRead(F, Buf^, Bufsize, Count); - if Count > 0 then - MDUpdate(Context, Buf^, Count); - until Count < BufSize; - FreeMem(Buf, BufSize); - Close(F); - end; - - MDFinal(Context, Result); - FileMode := ofm; -end; - -function MDPrint(const Digest: TMDDigest): String; -var - I: Byte; -begin - Result := ''; - for I := 0 to 15 do - Result := Result + HexStr(Digest[i],2); - Result := LowerCase(Result); -end; - -function MDMatch(const Digest1, Digest2: TMDDigest): Boolean; -var - A: array[0..3] of Cardinal absolute Digest1; - B: array[0..3] of Cardinal absolute Digest2; -begin - Result := (A[0] = B[0]) and (A[1] = B[1]) and (A[2] = B[2]) and (A[3] = B[3]); -end; - -procedure MD2Init(var Context: TMD2Context); -begin - MDInit(Context, MD_VERSION_2); -end; - -procedure MD2Update(var Context: TMD2Context; var Buf; const BufLen: Cardinal); -begin - MDUpdate(Context, Buf, BufLen); -end; - -procedure MD2Final(var Context: TMD2Context; var Digest: TMD2Digest); -begin - MDFinal(Context, Digest); -end; - -procedure MD4Init(var Context: TMD4Context); -begin - MDInit(Context, MD_VERSION_4); -end; - -procedure MD4Update(var Context: TMD4Context; var Buf; const BufLen: Cardinal); -begin - MDUpdate(Context, Buf, BufLen); -end; - -procedure MD4Final(var Context: TMD4Context; var Digest: TMD4Digest); -begin - MDFinal(Context, Digest); -end; - -procedure MD5Init(var Context: TMD5Context); -begin - MDInit(Context, MD_VERSION_5); -end; - -procedure MD5Update(var Context: TMD5Context; var Buf; const BufLen: Cardinal); -begin - MDUpdate(Context, Buf, BufLen); -end; - -procedure MD5Final(var Context: TMD5Context; var Digest: TMD5Digest); -begin - MDFinal(Context, Digest); -end; - -function MD2String(const S: String): TMD2Digest; -begin - Result := MDString(S, MD_VERSION_2); -end; - -function MD2Buffer(var Buf; const BufLen: Cardinal): TMD2Digest; -begin - Result := MDBuffer(Buf, BufLen, MD_VERSION_2); -end; - -function MD2File(const Filename: String; const Bufsize: Cardinal): TMD2Digest; -begin - Result := MDFile(Filename, MD_VERSION_2, Bufsize); -end; - -function MD4String(const S: String): TMD4Digest; -begin - Result := MDString(S, MD_VERSION_4); -end; - -function MD4Buffer(var Buf; const BufLen: Cardinal): TMD4Digest; -begin - Result := MDBuffer(Buf, BufLen, MD_VERSION_4); -end; - -function MD4File(const Filename: String; const Bufsize: Cardinal): TMD4Digest; -begin - Result := MDFile(Filename, MD_VERSION_4, Bufsize); -end; - -function MD5String(const S: String): TMD5Digest; -begin - Result := MDString(S, MD_VERSION_5); -end; - -function MD5Buffer(var Buf; const BufLen: Cardinal): TMD5Digest; -begin - Result := MDBuffer(Buf, BufLen, MD_VERSION_5); -end; - -function MD5File(const Filename: String; const Bufsize: Cardinal): TMD5Digest; -begin - Result := MDFile(Filename, MD_VERSION_5, Bufsize); -end; - -function MD2Print(const Digest: TMD2Digest): String; -begin - Result := MDPrint(Digest); -end; - -function MD2Match(const Digest1, Digest2: TMD2Digest): Boolean; -begin - Result := MDMatch(Digest1, Digest2); -end; - -function MD4Print(const Digest: TMD4Digest): String; -begin - Result := MDPrint(Digest); -end; - -function MD4Match(const Digest1, Digest2: TMD4Digest): Boolean; -begin - Result := MDMatch(Digest1, Digest2); -end; - -function MD5Print(const Digest: TMD5Digest): String; -begin - Result := MDPrint(Digest); -end; - -function MD5Match(const Digest1, Digest2: TMD5Digest): Boolean; -begin - Result := MDMatch(Digest1, Digest2); -end; - -end. |