对文件、字符串进行 CRC 校验

{*------------------------------------------------
CRC 校验
@author xszlo
@version P72
@todo 1
@History,2010-7-16,1
--------------------------------------------------*}

unit uCRC;

interface

uses
  Windows, SysUtils;

type
  TCRC = class(TObject)
  private
    Table: array[0..255] of DWORD;
    procedure MakeTable();
  public
    procedure GetCRC32File(FileName: string; var CRC32: DWORD);
    function GetCrc32Str(s: string; Seed: LongInt): string;
    function GetCRC32FileHexStr(FileName: string): string;
  end;

implementation

{ TCRC }

{-------------------------------------------------------------------------------
  过程名:    TCRC.GetCRC32File
  作者:      xszlo
  日期:      2008.12.09
  参数:      FileName: string; var CRC32: DWORD
  返回值:    无
  作用：     生成文件的CRC32验证码
-------------------------------------------------------------------------------}
procedure TCRC.GetCRC32File(FileName: string; var CRC32: DWORD);
var
  F: file;
  BytesRead: DWORD;
  Buffer: array[1..65521] of Byte;
  i: Word;
begin
  MakeTable;
  FileMode := 0;
  CRC32 := $FFFFFFFF;
{$I-}
  AssignFile(F, FileName);
  Reset(F, 1);
  if IoResult = 0 then
  begin
    repeat
      BlockRead(F, Buffer, Sizeof(Buffer), BytesRead);
      for i := 1 to BytesRead do
        CRC32 := (CRC32 shr 8) xor Table[Buffer[i] xor (CRC32 and $000000FF)];
    until BytesRead = 0;
  end;
  CloseFile(F);
{$I+}
  CRC32 := not CRC32;
end;

{-------------------------------------------------------------------------------
  过程名:    TCRC.GetCRC32FileHexStr
  作者:      xszlo
  日期:      2008.12.09
  参数:      FileName: string
  返回值:    string
  作用：     得到文件的RCR32验证码
-------------------------------------------------------------------------------}
function TCRC.GetCRC32FileHexStr(FileName: string): string;
var
  dcrc32: DWORD;
begin
  GetCRC32File(FileName, dcrc32);
  if dcrc32 <> 0 then
    result := PChar(IntToHex(dcrc32, 6));
end;

{*------------------------------------------------------------------------------
  生成字符CRC验证
  @param 
   s string  
   Seed Integer  
  @throws 无
  @return  string
------------------------------------------------------------------------------*}
function TCRC.GetCrc32Str(s: string; Seed: Integer): string;
var
  Count: Integer;
  CrcVal: LongInt;
begin
  MakeTable();
  CrcVal := Seed;
  for Count := 1 to Length(s) do
    CrcVal := Table[Byte(CrcVal xor DWORD(Ord(s[Count])))] xor ((CrcVal shr 8) and $00FFFFFF);
  Result := IntToHex(not (CrcVal), 8);
end;

{-------------------------------------------------------------------------------
  过程名:    TCRC.MakeTable
  作者:      xszlo
  日期:      2008.12.09
  参数:      无
  返回值:    无
  作用：     无
-------------------------------------------------------------------------------}
procedure TCRC.MakeTable;
var
  i, j, Crc: integer;
begin
  for i := 0 to 255 do
  begin
    Crc := i;
    for j := 0 to 7 do
    begin
      if (Crc and 1) <> 0 then
        Crc := (Crc shr 1) xor $EDB88320
      else
        Crc := Crc shr 1;
    end;
    Table[i] := Crc;
  end;
end;

end.

------------
使用方法：
var
CRC:TCRC;

CRC:=TCRC.Create;
showmessage(CRC.GetCRC32FileHexStr('d:\a.txt'));
FreeAndNil(CRC);

本文地址：http://www.xszlo.com/article/2012-12-13/7628.html，转发请保留这个地址，谢谢