// Hiermit kann man die Checksumme einer Datei bestimmen.


// Getestet mit D4 unter WinME

// Variante 1: Schnell, taugt aber nur um eine Datei mit sich selbst zu
//             vergleichen, ob beispielsweise einige Bytes angehängt wurden.

function Checksumme(Datei: string): cardinal; 
var 
  buf: array[0..1999] of byte; 
  anzahl: cardinal;                 
  foc: file of cardinal; 
  hlp: pointer; 
begin 
  FileMode := 0; 
  hlp := @buf; 
  AssignFile(foc, Datei); 
  Reset(foc); 
  Seek(foc, FileSize(foc) div 2); 
  anzahl := FileSize(foc) - FilePos(foc) - 1; 
  if anzahl > 500 then anzahl := 500; 
  BlockRead(foc, buf, anzahl); 
  Close(foc); 
  asm 
    xor eax, eax 
    xor ecx, ecx 
    mov edx, hlp 
  @again: 
    add eax, [edx + 4 * ecx] 
    inc ecx 
    cmp ecx, anzahl 
    jl @again 
    mov @result, eax 
  end; 
end; 
 
 
// Beispielaufruf 
 
procedure TForm1.Button10Click(Sender: TObject); 
var cs: cardinal; 
  s: string; 
begin 
  s := 'c:\windows\explorer.exe'; 
  cs := checksumme(s); 
  showmessage(inttostr(cs)); 
end; 
// -----------------------------------------------------------------

// Variante 2: Erstellt von jeder Datei eine individuelle Prüfsumme

var 
  PRFSArray: array[0..255] of integer; 
 
procedure BuildTable(Polynom: integer); 
var 
  x, y: integer; 
begin 
  if Polynom < $11111111 then Polynom := $11111111; 
  for x := 0 to 255 do begin 
    PRFSArray[x] := x shl 1; 
    for y := 0 to 7 do 
      if odd(PRFSArray[x]) then 
        PRFSArray[x] := (PRFSArray[x] shr 1) xor Polynom 
      else PRFSArray[x] := PRFSArray[x] shr 1; 
  end; 
end; 
 
function GetPRFS(FileName: string; Polynom: integer): integer; 
var 
  buff: array[0..255] of Byte; 
  gelesen, x: integer; 
  fs: TFilestream; 
begin 
  if fileexists(FileName) then begin 
    fs := TFilestream.create(FileName, fmopenread); 
    try 
      BuildTable(Polynom); 
      Result := -1; 
      repeat 
        gelesen := fs.read(buff, 256); 
        for x := 0 to pred(gelesen) do 
          Result := PRFSArray[(Result xor buff[x]) and $FF] 
            xor ((Result shr 8) and $FFFFFF); 
      until (gelesen < 256) or (fs.position = fs.size); 
    except 
      Result := 0; 
    end; 
    fs.free; 
  end else Result := 0; 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button7Click(Sender: TObject); 
var 
  Polynom, CRC: integer; 
begin 
  Polynom := $4C11DB73; 
  CRC := GetPRFS('c:\test.txt', Polynom); 
  if CRC = 0 then showmessage('FEHLER') else 
    showmessage(inttohex(CRC, 8)); 
end;



Zugriffe seit 6.9.2001 auf Delphi-Ecke