Subversion Repositories checksum-tools

Rev

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

  1. unit SFV;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes;
  7.  
  8. function CalcFileCRC32(filename: string): string; overload;
  9. procedure SFVFileToStringList(aSFVFile: string; slOut: TStringList);
  10.  
  11. implementation
  12.  
  13. uses
  14.   Windows, SysUtils, CRC32, Common, LongFilenameOperations;
  15.  
  16. function CalcFileCRC32(filename: string): string; overload;
  17. var
  18.   checksum: DWORD;
  19.   totalbytes: TInteger8;
  20.   error: Word;
  21. begin
  22.   CRC32.CalcFileCRC32(filename, checksum, totalbytes, error);
  23.   if error = 0 then
  24.     result := IntToHex(checksum, 8)
  25.   else
  26.     result := '';
  27. end;
  28.  
  29. procedure SFVFileToStringList(aSFVFile: string; slOut: TStringList);
  30. var
  31.   sLine: string;
  32.   originalFilename: string;
  33.   expectedChecksum: string;
  34.   fil: THandle;
  35.   csum: TChecksum;
  36.   firstLinePassed: boolean;
  37.   forceUTF8: boolean;
  38. begin
  39.   if not FileExists(aSFVFile) then
  40.     exit;
  41.  
  42.   MyAssignFile(fil, aSFVFile);
  43.   try
  44.     MyReset(fil);
  45.     firstLinePassed := false;
  46.     forceUTF8 := false;
  47.     while not MyEOF(fil) do
  48.     begin
  49.       MyReadLn(fil, sLine);
  50.  
  51.       {$REGION 'Try UTF8 decode'}
  52.       if not firstLinePassed and (length(sLine)>2) and (sLine[1]=#$EF) and (sLine[2]=#$BB) and (sLine[3]=#$BF) then
  53.       begin
  54.         delete(sLine,1,3); // Remove BOM
  55.         forceUTF8 := true;
  56.       end;
  57.       firstLinePassed := true;
  58.  
  59.       if forceUTF8 or (Pos(#$FFFD, Utf8ToString(RawByteString(sLine))) = 0) then
  60.         sLine := Utf8ToString(RawByteString(sLine));
  61.       {$ENDREGION}
  62.  
  63.       if Copy(Trim(sLine),1,1) = ';' then continue;
  64.       // Example.doc 4323C92B
  65.       sLine := TrimRight(sLine); // Trim right, because file names may have leading white spaces
  66.       if sLine = '' then
  67.         continue;
  68.       expectedChecksum := Copy(sLine, 1+Length(sLine)-8, 8);
  69.       sLine := TrimRight(Copy(sLine, 1, Length(sLine)-8));  // Trim right, because file names may have leading white spaces
  70.       originalFilename := sLine;
  71.  
  72.       //slOut.Values[originalFilename] := expectedChecksum; // <-- with this, files cannot have an equal sign
  73.       slOut.OwnsObjects := true;
  74.       csum := TChecksum.Create;
  75.       csum.checksum := expectedChecksum;
  76.       slOut.AddObject(originalFilename, csum);
  77.     end;
  78.   finally
  79.     MyCloseFile(fil);
  80.   end;
  81. end;
  82.  
  83. end.
  84.