Subversion Repositories checksum-tools

Rev

Rev 6 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit MD5;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes;
  7.  
  8. function md5file(const filename: string): string;
  9. procedure MD5FileToStringList(amd5file: string; slOut: TStringList);
  10.  
  11. implementation
  12.  
  13. uses
  14.   SysUtils, IdHashMessageDigest, idHash, Common, LongFilenameOperations;
  15.  
  16. function md5file(const filename: string): string;
  17. var
  18.   IdMD5: TIdHashMessageDigest5;
  19.   FS: TFileStream;
  20. begin
  21.   IdMD5 := TIdHashMessageDigest5.Create;
  22.   FS := TFileStream.Create(filename, fmOpenRead or fmShareDenyWrite);
  23.   try
  24. {$IFDEF UNICODE} // I actually do not know at which version of Delphi/Indy, this has changed.
  25.     Result := IdMD5.HashStreamAsHex(FS);
  26. {$ELSE}
  27.     Result := IdMD5.AsHex(IdMD5.HashValue(FS));
  28. {$ENDIF}
  29.   finally
  30.     FS.Free;
  31.     IdMD5.Free;
  32.   end;
  33. end;
  34.  
  35. procedure MD5FileToStringList(amd5file: string; slOut: TStringList);
  36. var
  37.   sLine: string;
  38.   originalFilename: string;
  39.   expectedChecksum: string;
  40.   fil: THandle;
  41.   csum: TChecksum;
  42.   firstLinePassed: boolean;
  43.   forceUTF8: boolean;
  44. begin
  45.   if not FileExists(amd5file) then
  46.     exit;
  47.  
  48.   MyAssignFile(fil, amd5file);
  49.   try
  50.     MyReset(fil);
  51.     firstLinePassed := false;
  52.     forceUTF8 := false;
  53.     while not MyEOF(fil) do
  54.     begin
  55.       MyReadLn(fil, sLine);
  56.  
  57.       {$REGION 'Try UTF8 decode'}
  58.       if not firstLinePassed and (length(sLine)>2) and (sLine[1]=#$EF) and (sLine[2]=#$BB) and (sLine[3]=#$BF) then
  59.       begin
  60.         delete(sLine,1,3); // Remove BOM
  61.         forceUTF8 := true;
  62.       end;
  63.       firstLinePassed := true;
  64.  
  65.       if forceUTF8 or (Pos(#$FFFD, Utf8ToString(RawByteString(sLine))) = 0) then
  66.         sLine := Utf8ToString(RawByteString(sLine));
  67.       {$ENDREGION}
  68.  
  69.       if Copy(Trim(sLine),1,1) = ';' then continue;
  70.       // 25bfdef2651071efdd08bb3404797384 *Example.doc
  71.       sLine := Trim(sLine);
  72.       if sLine = '' then
  73.         continue;
  74.       expectedChecksum := Copy(sLine, 1, 32);
  75.       Delete(sLine, 1, 32);
  76.       sLine := Trim(sLine);
  77.       if Copy(sLine, 1, 1) = '*' then
  78.         Delete(sLine, 1, 1);
  79.       sLine := Trim(sLine);
  80.       originalFilename := sLine;
  81.  
  82.       //slOut.Values[originalFilename] := expectedChecksum; // <-- with this, files cannot have an equal sign
  83.       slOut.OwnsObjects := true;
  84.       csum := TChecksum.Create;
  85.       csum.checksum := expectedChecksum;
  86.       slOut.AddObject(originalFilename, csum);
  87.     end;
  88.   finally
  89.     MyCloseFile(fil);
  90.   end;
  91. end;
  92.  
  93. end.
  94.