function crcexecute(pcstring : string) : string ; forward;var
gnkey : integer;
gnsalt : integer;{------------------------------------------------------------------------------}
implementationconst
null_string = '';const crctable : array [0..255] of longword =(
$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
);{------------------------------------------------------------------------------}
function crcexecute(pcstring : string) : string ;
var
nx : integer;
ncrcval : longword;
begin
ncrcval := 0;
for nx := 1 to length( pcstring ) do
ncrcval := crctable[byte(ncrcval xor byte(pcstring[nx]))] xor (( ncrcval shr 8 ) and $00ffffff );
result := lowercase( inttohex( ncrcval, 8 ));
end;{------------------------------------------------------------------------------}
end.
gnkey : integer;
gnsalt : integer;{------------------------------------------------------------------------------}
implementationconst
null_string = '';const crctable : array [0..255] of longword =(
$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
);{------------------------------------------------------------------------------}
function crcexecute(pcstring : string) : string ;
var
nx : integer;
ncrcval : longword;
begin
ncrcval := 0;
for nx := 1 to length( pcstring ) do
ncrcval := crctable[byte(ncrcval xor byte(pcstring[nx]))] xor (( ncrcval shr 8 ) and $00ffffff );
result := lowercase( inttohex( ncrcval, 8 ));
end;{------------------------------------------------------------------------------}
end.
CONST Table: Array[0..255] of LongInt = ($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);
TYPE buffer = Array[1..65521] of byte; {largest buffer that can be allocated on heap }
VAR i: WORD;
q: ^buffer;
PROCEDURE CalcCRC32 (p: pointer; nbyte: Word; Var CRCvalue: LongInt);
{The following is a little cryptic (but executes very quickly). The algorithm is as follows:
1. exclusive-or the input byte with the low-order portion of the CRC register to get an INDEX
2. shift the CRC register eight bits to the right
3. exclusive-or the CRC register with the contents of Table[INDEX]
4. repeat steps 1 through 3 for all bytes}
Var i: Word;
Begin q := p; For i := 1 to nBYTE do CRCvalue := (CRCvalue SHR 8) XOR Table[ q^[i] XOR (CRCvalue AND $000000FF) ]
End {CalcCRC32};
PROCEDURE CalcFileCRC32 (FromName: String; Var CRCvalue: LongInt; Var IOBuffer: pointer; BufferSize: Word; Var TotalBytes: LongInt; Var error: WORD);
Var BytesRead: integer; FromFile : File;
Begin FileMode := 0; {Turbo default is 2 for R/W; 0 is for R/O} CRCValue := $FFFFFFFF; Assign(FromFile,FromName);
{$I-} Reset(FromFile,1); {$I+} Error := IOResult;
If error = 0 Then
begin TotalBytes := 0;
Repeat BlockRead (FromFile,IOBuffer^,BufferSize,BytesRead);
CalcCRC32 (IOBuffer,BytesRead,CRCvalue); Inc(TotalBytes, BytesRead)
Until BytesRead = 0;
Close(FromFile)
End;
CRCvalue := NOT CRCvalue
End {CalcFileCRC32};
//////////////////////////////////////////////////////////////
UNIT CRC32; {CRC32 calculates a cyclic redundancy code (CRC), known as CRC-32, using
a byte-wise algorithm. (C) Copyright 1989, 1995-1996 Earl F. Glynn, Overland Park, KS.
All Rights Reserved. This UNIT was derived from the CRCT FORTRAN 77 program given in
"Byte-wise CRC Calculations" by Aram Perez in IEEE Micro, June 1983,
pp. 40-50. The constants here are for the CRC-32 generator polynomial,
as defined in the Microsoft Systems Journal, March 1995, pp. 107-108 This CRC algorithm emphasizes speed at the expense of the 512 element
lookup table.}INTERFACE PROCEDURE CalcCRC32 (p: pointer; nbyte: WORD; VAR CRCvalue: LongInt);
PROCEDURE CalcFileCRC32 (FromName: STRING; VAR CRCvalue: LongInt;
VAR IOBuffer: pointer; BufferSize: WORD; VAR TotalBytes: LongInt;
VAR error: WORD);IMPLEMENTATION CONST
table: ARRAY[0..255] OF LongInt =
($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,
$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);
TYPE
buffer = ARRAY[1..65521] OF BYTE; {largest buffer that can be}
{allocated on heap }
VAR
i: WORD;
q: ^buffer; PROCEDURE CalcCRC32 (p: pointer; nbyte: WORD; VAR CRCvalue: LongInt);
{The following is a little cryptic (but executes very quickly).
The algorithm is as follows:
1. exclusive-or the input byte with the low-order portion of
the CRC register to get an INDEX
2. shift the CRC register eight bits to the right
3. exclusive-or the CRC register with the contents of
Table[INDEX]
4. repeat steps 1 through 3 for all bytes}
BEGIN
q := p;
FOR i := 1 TO nBYTE DO
CRCvalue := (CRCvalue SHR 8) XOR
Table[ q^[i] XOR (CRCvalue AND $000000FF) ]
END {CalcCRC32};
PROCEDURE CalcFileCRC32 (FromName: STRING; VAR CRCvalue: LongInt;
VAR IOBuffer: pointer; BufferSize: WORD; VAR TotalBytes: LongInt;
VAR error: WORD);
VAR
BytesRead: WORD;
FromFile : FILE;
i : WORD;
BEGIN
FileMode := 0; {Turbo default is 2 for R/W; 0 is for R/O}
CRCValue := $FFFFFFFF;
ASSIGN (FromFile,FromName);
{$I-} RESET (FromFile,1); {$I+}
error := IOResult;
IF error = 0
THEN BEGIN
TotalBytes := 0; REPEAT
BlockRead (FromFile,IOBuffer^,BufferSize,BytesRead);
CalcCRC32 (IOBuffer,BytesRead,CRCvalue);
INC (TotalBytes, BytesRead)
UNTIL BytesRead = 0;
CLOSE (FromFile)
END;
CRCvalue := NOT CRCvalue
END {CalcFileCRC32};END {CRC}.
{ This unit provides three speed-optimized functions to }
{ compute (or continue computation of) a Cyclic Redundency }
{ Check (CRC). Applicable to XModem protocol (16-bit CRC), }
{ SEA's "ARC" utility, PKZip (32-bit CRC) and many others }
{ compatible software. }
{ Please see TESTCRC.DPR for example. }
{*************************************************************}
{ Each function takes three parameters: }
{ }
{ InitCRC - The initial CRC value. This may be the }
{ recommended initialization value if this is the first or }
{ only block to be checked, or this may be a previously }
{ computed CRC value if this is a continuation. }
{ XModem and ARC usually starts with zero (0), 32 bit crc }
{ starts with all bits on ($FFFFFFFF). }
{ }
{ Buffer - An untyped parameter (Pointer^) specifying the }
{ beginning of the memory area to be checked. }
{ }
{ Length - A word indicating the length of the memory area to }
{ be checked. If Length is zero, the function returns the }
{ value of InitCRC. }
{ }
{ The function result is the updated CRC. }
{*************************************************************}unit CRC;interfacefunction UpdateCRC16(InitCRC: Word; var Buffer;
Length: {$IFDEF Win32} LongInt {$ELSE} Word {$ENDIF}): Word;
{ I believe this is the CRC used by the XModem protocol.
The transmitting end should initialize with zero, UpdateCRC16 for
the block, Continue the UpdateCRC16 for two nulls, and append the
result (hi order byte first) to the transmitted block. The receiver
should initialize with zero and UpdateCRC16 for the received block
including the two byte CRC. The result will be zero (why?) if there
were no transmission errors. (I have not tested this function with
an actual XModem implementation, though I did verify the behavior
just described. See TESTCRC.DPR.) }function UpdateCRCArc(InitCRC: Word; var Buffer;
Length: {$IFDEF Win32} LongInt {$ELSE} Word {$ENDIF}): Word;
{ This function computes the CRC used by SEA's ARC utility.
Initialize with zero.}function UpdateCRC32(InitCRC: LongInt; var Buffer;
{$IFDEF Win32} Length: LongInt {$ELSE} Length: Word {$ENDIF}): LongInt;
{ This function computes the CRC used by PKZIP and Forsberg's ZModem.
Initialize with high-values ($FFFFFFFF), and finish by inverting
allbits (Not). }function FileCRC16(FileName: String; var CRC16: Word): Boolean; { Return True if ok }
function FileCRCArc(FileName: String; var CRCArc: Word): Boolean; { Return True if ok }
function FileCRC32(FileName: String; var CRC32: LongInt): Boolean; { Return True if ok }implementationconst
CrcArcTab: Array[0..$FF] of Word =
($00000, $0C0C1, $0C181, $00140, $0C301, $003C0, $00280, $0C241,
$0C601, $006C0, $00780, $0C741, $00500, $0C5C1, $0C481, $00440,
$0CC01, $00CC0, $00D80, $0CD41, $00F00, $0CFC1, $0CE81, $00E40,
$00A00, $0CAC1, $0CB81, $00B40, $0C901, $009C0, $00880, $0C841,
$0D801, $018C0, $01980, $0D941, $01B00, $0DBC1, $0DA81, $01A40,
$01E00, $0DEC1, $0DF81, $01F40, $0DD01, $01DC0, $01C80, $0DC41,
$01400, $0D4C1, $0D581, $01540, $0D701, $017C0, $01680, $0D641,
$0D201, $012C0, $01380, $0D341, $01100, $0D1C1, $0D081, $01040,
$0F001, $030C0, $03180, $0F141, $03300, $0F3C1, $0F281, $03240,
$03600, $0F6C1, $0F781, $03740, $0F501, $035C0, $03480, $0F441,
$03C00, $0FCC1, $0FD81, $03D40, $0FF01, $03FC0, $03E80, $0FE41,
$0FA01, $03AC0, $03B80, $0FB41, $03900, $0F9C1, $0F881, $03840,
$02800, $0E8C1, $0E981, $02940, $0EB01, $02BC0, $02A80, $0EA41,
$0EE01, $02EC0, $02F80, $0EF41, $02D00, $0EDC1, $0EC81, $02C40,
$0E401, $024C0, $02580, $0E541, $02700, $0E7C1, $0E681, $02640,
$02200, $0E2C1, $0E381, $02340, $0E101, $021C0, $02080, $0E041,
$0A001, $060C0, $06180, $0A141, $06300, $0A3C1, $0A281, $06240,
$06600, $0A6C1, $0A781, $06740, $0A501, $065C0, $06480, $0A441,
$06C00, $0ACC1, $0AD81, $06D40, $0AF01, $06FC0, $06E80, $0AE41,
$0AA01, $06AC0, $06B80, $0AB41, $06900, $0A9C1, $0A881, $06840,
$07800, $0B8C1, $0B981, $07940, $0BB01, $07BC0, $07A80, $0BA41,
$0BE01, $07EC0, $07F80, $0BF41, $07D00, $0BDC1, $0BC81, $07C40,
$0B401, $074C0, $07580, $0B541, $07700, $0B7C1, $0B681, $07640,
$07200, $0B2C1, $0B381, $07340, $0B101, $071C0, $07080, $0B041,
$05000, $090C1, $09181, $05140, $09301, $053C0, $05280, $09241,
$09601, $056C0, $05780, $09741, $05500, $095C1, $09481, $05440,
$09C01, $05CC0, $05D80, $09D41, $05F00, $09FC1, $09E81, $05E40,
$05A00, $09AC1, $09B81, $05B40, $09901, $059C0, $05880, $09841,
$08801, $048C0, $04980, $08941, $04B00, $08BC1, $08A81, $04A40,
$04E00, $08EC1, $08F81, $04F40, $08D01, $04DC0, $04C80, $08C41,
$04400, $084C1, $08581, $04540, $08701, $047C0, $04680, $08641,
$08201, $042C0, $04380, $08341, $04100, $081C1, $08081, $04040); Crc16Tab: Array[0..$FF] of Word =
($00000, $01021, $02042, $03063, $04084, $050a5, $060c6, $070e7,
$08108, $09129, $0a14a, $0b16b, $0c18c, $0d1ad, $0e1ce, $0f1ef,
$01231, $00210, $03273, $02252, $052b5, $04294, $072f7, $062d6,
$09339, $08318, $0b37b, $0a35a, $0d3bd, $0c39c, $0f3ff, $0e3de,
$02462, $03443, $00420, $01401, $064e6, $074c7, $044a4, $05485,
$0a56a, $0b54b, $08528, $09509, $0e5ee, $0f5cf, $0c5ac, $0d58d,
$03653, $02672, $01611, $00630, $076d7, $066f6, $05695, $046b4,
$0b75b, $0a77a, $09719, $08738, $0f7df, $0e7fe, $0d79d, $0c7bc,
$048c4, $058e5, $06886, $078a7, $00840, $01861, $02802, $03823,
$0c9cc, $0d9ed, $0e98e, $0f9af, $08948, $09969, $0a90a, $0b92b,
$05af5, $04ad4, $07ab7, $06a96, $01a71, $00a50, $03a33, $02a12,
$0dbfd, $0cbdc, $0fbbf, $0eb9e, $09b79, $08b58, $0bb3b, $0ab1a,
$06ca6, $07c87, $04ce4, $05cc5, $02c22, $03c03, $00c60, $01c41,
$0edae, $0fd8f, $0cdec, $0ddcd, $0ad2a, $0bd0b, $08d68, $09d49,
$07e97, $06eb6, $05ed5, $04ef4, $03e13, $02e32, $01e51, $00e70,
$0ff9f, $0efbe, $0dfdd, $0cffc, $0bf1b, $0af3a, $09f59, $08f78,
$09188, $081a9, $0b1ca, $0a1eb, $0d10c, $0c12d, $0f14e, $0e16f,
$01080, $000a1, $030c2, $020e3, $05004, $04025, $07046, $06067,
$083b9, $09398, $0a3fb, $0b3da, $0c33d, $0d31c, $0e37f, $0f35e,
$002b1, $01290, $022f3, $032d2, $04235, $05214, $06277, $07256,
$0b5ea, $0a5cb, $095a8, $08589, $0f56e, $0e54f, $0d52c, $0c50d,
$034e2, $024c3, $014a0, $00481, $07466, $06447, $05424, $04405,
$0a7db, $0b7fa, $08799, $097b8, $0e75f, $0f77e, $0c71d, $0d73c,
$026d3, $036f2, $00691, $016b0, $06657, $07676, $04615, $05634,
$0d94c, $0c96d, $0f90e, $0e92f, $099c8, $089e9, $0b98a, $0a9ab,
$05844, $04865, $07806, $06827, $018c0, $008e1, $03882, $028a3,
$0cb7d, $0db5c, $0eb3f, $0fb1e, $08bf9, $09bd8, $0abbb, $0bb9a,
$04a75, $05a54, $06a37, $07a16, $00af1, $01ad0, $02ab3, $03a92,
$0fd2e, $0ed0f, $0dd6c, $0cd4d, $0bdaa, $0ad8b, $09de8, $08dc9,
$07c26, $06c07, $05c64, $04c45, $03ca2, $02c83, $01ce0, $00cc1,
$0ef1f, $0ff3e, $0cf5d, $0df7c, $0af9b, $0bfba, $08fd9, $09ff8,
$06e17, $07e36, $04e55, $05e74, $02e93, $03eb2, $00ed1, $01ef0);
($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);function UpdateCRC16(InitCRC: Word; var Buffer;
Length: {$IFDEF Win32} LongInt {$ELSE} Word {$ENDIF}): Word;
begin
asm
{$IFDEF Win32}
push esi
push edi
push eax
push ebx
push ecx
push edx
lea edi, Crc16Tab
mov esi, Buffer
mov ax, InitCrc
mov ecx, Length
or ecx, ecx
jz @@done
@@loop:
xor ebx, ebx
mov bl, ah
mov ah, al
lodsb
shl bx, 1
add ebx, edi
xor ax, [ebx]
loop @@loop
@@done:
mov Result, ax
pop edx
pop ecx
pop ebx
pop eax
pop edi
pop esi
{$ELSE}
lea di, Crc16Tab
push ds
pop es
push ds
lds si, Buffer
mov ax, InitCrc
mov cx, Length
or cx, cx
jz @@done
@@loop:
xor bx, bx
mov bl, ah
mov ah, al
lodsb
shl bx, 1
xor ax, es:[di + bx]
loop @@loop
pop ds
@@done:
mov Result, ax
{$ENDIF}
end;
end;function UpdateCRCArc(InitCRC: Word; var Buffer;
Length: {$IFDEF Win32} LongInt {$ELSE} Word {$ENDIF}): Word;
begin
asm
{$IFDEF Win32}
push esi
push edi
push eax
push ebx
push ecx
push edx
lea edi, CrcArcTab
mov esi, Buffer
mov ax, InitCrc
mov ecx, Length
or ecx, ecx
jz @@done
@@loop:
xor ebx, ebx
mov bl, al
lodsb
xor bl, al
shl bx, 1
add ebx, edi
mov bx, [ebx]
xor bl, ah
mov ax, bx
loop @@loop
@@done:
mov Result, ax
pop edx
pop ecx
pop ebx
pop eax
pop edi
pop esi
{$ELSE}
lea di, CrcArcTab
push ds
pop es
push ds
lds si, Buffer
mov ax, InitCrc
mov cx, Length
or cx, cx
jz @@done
@@loop:
xor bx, bx
mov bl, al
lodsb
xor bl, al
shl bx, 1
mov bx, es:[di + bx]
xor bl, ah
mov ax, bx
loop @@loop
pop ds
@@done:
mov Result, ax
{$ENDIF}
end;
end;function UpdateCRC32(InitCRC: LongInt; var Buffer;
{$IFDEF Win32} Length: LongInt {$ELSE} Length: Word {$ENDIF}): LongInt;
begin
asm
{$IFDEF Win32}
push esi
push edi
push eax
push ebx
push ecx
push edx
lea edi, Crc32Tab
mov esi, Buffer
mov ax, word ptr InitCRC
mov dx, word ptr InitCRC + 2
mov ecx, Length
or ecx, ecx
jz @@done
@@loop:
xor ebx, ebx
mov bl, al
lodsb
xor bl, al
mov al, ah
mov ah, dl
mov dl, dh
xor dh, dh
shl bx, 1
shl bx, 1
add ebx, edi
xor ax, [ebx]
xor dx, [ebx + 2]
loop @@loop
@@done:
mov word ptr Result, ax
mov word ptr Result + 2, dx
pop edx
pop ecx
pop ebx
pop eax
pop edi
pop esi
{$ELSE}
push ds
pop es
push ds
lea di, CRC32Tab
lds si, Buffer
mov ax, word ptr InitCRC
mov dx, word ptr InitCRC + 2
mov cx, Length
or cx, cx
jz @@done
@@loop:
xor bh, bh
mov bl, al
lodsb
xor bl, al
mov al, ah
mov ah, dl
mov dl, dh
xor dh, dh
shl bx, 1
shl bx, 1
xor ax, es:[di + bx]
xor dx, es:[di + bx + 2]
loop @@loop
@@done:
pop ds
mov word ptr Result, ax
mov word ptr Result + 2, dx
{$ENDIF}
end;
end;function FileCRC16(FileName: String; var CRC16: Word): Boolean; { Return True if ok }
var
f: File;
p: Pointer;
FSize: LongInt;
{$IFNDEF Win32}
tmp: Word;
{$ENDIF}
begin
{$I+}
unit CRC32Verify;interfaceuses
Windows, Messages, SysUtils, Classes, Forms;CONST
table: ARRAY[0..255] OF DWORD =
($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); // Use CalcCRC32 as a procedure so CRCValue can be passed in but
// also returned. This allows multiple calls to CalcCRC32 for
// the "same" CRC-32 calculation.type TProgressEvent=Procedure (Sender:TObject; Progress :integer; Error:dword; var Continue:boolean) of object;type
TCRC = class(TComponent)
private
{ Private declarations }
FProgressBlockSize:word;
FContinue,InProgress:boolean;
FProgressEvent:TProgressEvent;
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure CheckCRC(P: Pointer; ByteCount: DWORD; VAR CRCValue: DWORD);
// The following is a little cryptic (but executes very quickly).
// The algorithm is as follows:
// 1. exclusive-or the input byte with the low-order byte of
// the CRC register to get an INDEX
// 2. shift the CRC register eight bits to the right
// 3. exclusive-or the CRC register with the contents of
// Table[INDEX]
// 4. repeat steps 1 through 3 for all bytes;
function CheckFileCRC(FileName: string):DWord;
function CheckStringCRC(Str:String):DWord;
published
{ Published declarations }
property ProgressBlockSize:word read FProgressBlockSize write FProgressBlockSize default 4096;
property OnProgress:TProgressEvent read FProgressEvent write FProgressEvent;
end;procedure Register;implementationprocedure Register;
begin
RegisterComponents('Samples', [TCRC]);
end;{ TCRC }procedure TCRC.CheckCRC(P: Pointer; ByteCount: DWORD; var CRCValue: DWORD);
VAR
i: DWORD;
q: ^BYTE;
BEGIN
q := p;
FContinue:=true;
if ByteCount<1 then
begin
CRCValue:=0;
Exit;
end;
FOR i := 0 TO ByteCount-1 DO
BEGIN
Application.ProcessMessages;
if i mod FProgressBlockSize=0 then
if Assigned(FProgressEvent) then FProgressEvent(self,i,Error,FContinue);
if not FContinue then exit;
CRCvalue := (CRCvalue SHR 8) XOR
Table[ q^ XOR (CRCvalue AND $000000FF) ];
INC(q)
END;
{CalcCRC32}
end;function TCRC.CheckFileCRC(FileName:string):DWord;
VAR
Stream: TMemoryStream; CRCValue:DWord;
BEGIN
CRCValue := $FFFFFFFF;
Stream := TMemoryStream.Create;
TRY
TRY
Stream.LoadFromFile(FileName);
IF Stream.Size > 0
THEN CheckCRC (Stream.Memory, Stream.Size, CRCvalue)
ELSE begin Result:=0; Exit; end;
EXCEPT
ON E: EReadError DO
Result := 0;
END;
Result := NOT CRCvalue;
FINALLY
Stream.Free
END;
END {CalcFileCRC32};function TCRC.CheckStringCRC(Str:string):DWord;
var CRCValue:DWord;
begin
if Str='' then begin Result:=0; Exit; end;
CRCValue:=$FFFFFFFF;
CheckCRC(PChar(Str),Length(Str),CRCValue);
Result:=not CRCValue;
end;constructor TCRC.Create(AOwner: TComponent);
begin
inherited;
InProgress:=false;
FContinue:=true;
FProgressBlockSize:=4096;
end;destructor TCRC.Destroy;
begin inherited;
end;end.
我的EMail:[email protected]