將CRC寫入檔頭程式碼

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ShellAPI;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Label1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  DWordA  =array [0..13059] of DWord;
  WordA   =array [0..32766] of word;
  ByteA   =array [0..65534] of byte;
  DWordP  =^DWordA;
  WordP   =^WordA;
  ByteP   =^ByteA;

var
  Form1: TForm1;

implementation

{$R *.dfm}
var CRC32T:array[0..255] of DWord;
//==========================================================================
procedure MakeCRC32;
var i,j:Word;
    R:DWord;
begin
  for i:=0 to 255 do begin
    R:=i;
    for j:=8 downto 1 do
      if (R and 1)>0 then R:=(R shr 1) xor $EDB88320 else R:=R shr 1;
    CRC32T[i]:=R;
  end;
end;

//==========================================================================
function CRC32(K,D:DWord):DWord;
begin
  Result:=CRC32T[byte(K xor DWord(D))] xor (K shr 8);
end;

//==========================================================================
function CalcCRC(P:ByteP; Len:Integer; CRC:DWord):DWord;
var i:integer;
begin
  for i:=0 to Len-1 do CRC:=CRC32(CRC,P[i]);
  Result:=CRC;
end;

//==========================================================================
function FileCRC32(N:string):DWord;
const _Start=$40;
var Hd:integer;
    P:ByteP;
    L:DWord;
begin
  Result:=0;
  if FileExists(N) then begin
    Hd:=FileOpen(N,fmOpenRead+fmShareDenyNone);
    if Hd>0 then begin
      L:=FileSeek(Hd,0,2);          FileSeek(Hd,0,0);
      GetMem(P,L);
      if (L>_Start) and (DWord(FileRead(Hd,P^,L))=L) then
        Result:=CalcCRC(@P[_Start],L-_Start,$FFFFFFFF);
      FreeMem(P);
      FileClose(Hd);
    end;
  end;
end;

//==========================================================================
function UpdateCRC32(N:string; Chk:DWord):boolean;    // Write CRC to file
const _Start=$40;
var Hd,i:integer;
    D,R:array[0..7] of byte;    // $1E
begin
  Result:=False;
  DWordP(@D[2])[0]:=Chk; //20處開始由低位元塞CRC資料 若為DWordP(@D[3])[0] 則是從21處開始塞
  if FileExists(N) then begin
    Hd:=FileOpen(N,fmOpenReadWrite); //開啟N
      FileSeek(Hd,$1E,0);      FileWrite(Hd,D[0],8); //從1E開始
      FileSeek(Hd,$1E,0);      FileRead(Hd,R[0],8);

      Result:=TRUE;
      for i:=0 to SizeOf(D)-1 do if D[i]<>R[i] then Result:=False;
      FileClose(Hd);
    //end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var S:string;
    Result:integer;
    Chk,HChk:DWord;
begin
  Result:=0;       Chk:=0;
  if ParamCount>=1 then begin
    S:=ParamStr(1);  //參數1為檔名
    if FileExists(S) then begin
      Result:=1;    //傳回結果1
      MakeCRC32;            // Initialize CRC32初始化
      Chk :=FileCRC32(S);   // Calc CRC32 存於Chk中
      if ParamCount=2 then begin    //參數2為U UpdateCRC32成功傳回結果2,否則傳回3
        if (ParamStr(2)='U') and UpdateCRC32(S,Chk) then Result:=2
                                                    else Result:=3;
      end
    end;
  end;
  case Result of
    0: begin
         showmessage('CalcCRC32, Fineart Technology Co., LTD');
         showmessage('Ex: ['+ParamStr(0)+'] SourceFile [U]');
       end;
    1: showmessage(Format('%s CRC32=[%x]',[S,Chk]));
    2: showmessage(Format('%s CRC32=[%x] Update!',[S,Chk]));
    3: showmessage(Format('%s Update failure!',[S]));
  end;
end;
end.