Subversion Repositories checksum-tools

Rev

Rev 6 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit MD5;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes, Common;
  7.  
  8. type
  9.   TCheckSumFileMD5 = class(TCheckSumFile)
  10.   protected
  11.     Fmd5File: string;
  12.   public
  13.     constructor Create(AFileName: string); override;
  14.     procedure ToStringList(slOut: TStringList); override;
  15.     function SingleFileChecksum(AFileName: string): string; override;
  16.     function MergeLine(AFileName, ACheckSum: string): string; override;
  17.   end;
  18.  
  19. function md5file(const filename: string): string;
  20. procedure MD5FileToStringList(amd5file: string; slOut: TStringList);
  21.  
  22. implementation
  23.  
  24. uses
  25.   SysUtils, IdHashMessageDigest, idHash, LongFilenameOperations;
  26.  
  27. function md5file(const filename: string): string;
  28. var
  29.   IdMD5: TIdHashMessageDigest5;
  30.   FS: TFileStream;
  31. begin
  32.   IdMD5 := TIdHashMessageDigest5.Create;
  33.   FS := TFileStream.Create(filename, fmOpenRead or fmShareDenyWrite);
  34.   try
  35. {$IFDEF UNICODE} // I actually do not know at which version of Delphi/Indy, this has changed.
  36.     Result := IdMD5.HashStreamAsHex(FS);
  37. {$ELSE}
  38.     Result := IdMD5.AsHex(IdMD5.HashValue(FS));
  39. {$ENDIF}
  40.   finally
  41.     FS.Free;
  42.     IdMD5.Free;
  43.   end;
  44. end;
  45.  
  46. procedure MD5FileToStringList(amd5file: string; slOut: TStringList);
  47. var
  48.   sLine: string;
  49.   originalFilename: string;
  50.   expectedChecksum: string;
  51.   fil: THandle;
  52.   csum: TChecksum;
  53.   firstLinePassed: boolean;
  54.   forceUTF8: boolean;
  55. begin
  56.   if not FileExists(amd5file) then
  57.     exit;
  58.  
  59.   MyAssignFile(fil, amd5file);
  60.   try
  61.     MyReset(fil);
  62.     firstLinePassed := false;
  63.     forceUTF8 := false;
  64.     while not MyEOF(fil) do
  65.     begin
  66.       MyReadLn(fil, sLine);
  67.  
  68.       {$REGION 'Try UTF8 decode'}
  69.       if not firstLinePassed and (length(sLine)>2) and (sLine[1]=#$EF) and (sLine[2]=#$BB) and (sLine[3]=#$BF) then
  70.       begin
  71.         delete(sLine,1,3); // Remove BOM
  72.         forceUTF8 := true;
  73.       end;
  74.       firstLinePassed := true;
  75.  
  76.       if forceUTF8 or (Pos(#$FFFD, Utf8ToString(RawByteString(sLine))) = 0) then
  77.         sLine := Utf8ToString(RawByteString(sLine));
  78.       {$ENDREGION}
  79.  
  80.       if Copy(Trim(sLine),1,1) = ';' then continue;
  81.       // 25bfdef2651071efdd08bb3404797384 *Example.doc
  82.       sLine := Trim(sLine);
  83.       if sLine = '' then
  84.         continue;
  85.       expectedChecksum := Copy(sLine, 1, 32);
  86.       Delete(sLine, 1, 32);
  87.       sLine := Trim(sLine);
  88.       if Copy(sLine, 1, 1) = '*' then
  89.         Delete(sLine, 1, 1);
  90.       sLine := Trim(sLine);
  91.       originalFilename := sLine;
  92.  
  93.       //slOut.Values[originalFilename] := expectedChecksum; // <-- with this, files cannot have an equal sign
  94.       slOut.OwnsObjects := true;
  95.       csum := TChecksum.Create;
  96.       csum.checksum := expectedChecksum;
  97.       slOut.AddObject(originalFilename, csum);
  98.     end;
  99.   finally
  100.     MyCloseFile(fil);
  101.   end;
  102. end;
  103.  
  104. { TCheckSumFileMD5 }
  105.  
  106. constructor TCheckSumFileMD5.Create(AFileName: string);
  107. begin
  108.   inherited;
  109.   fmd5File := AFileName;
  110.   if not SameText(ExtractFileExt(AFileName),'.md5') then
  111.     raise Exception.Create('Invalid checksum file extension.');
  112. end;
  113.  
  114. function TCheckSumFileMD5.MergeLine(AFileName, ACheckSum: string): string;
  115. begin
  116.   result := ACheckSum + ' *' + AFileName;
  117. end;
  118.  
  119. function TCheckSumFileMD5.SingleFileChecksum(AFileName: string): string;
  120. begin
  121.   result := LowerCase(md5file(AFileName));
  122. end;
  123.  
  124. procedure TCheckSumFileMD5.ToStringList(slOut: TStringList);
  125. begin
  126.   inherited;
  127.   MD5FileToStringList(fmd5File, slOut);
  128. end;
  129.  
  130. end.
  131.