Subversion Repositories checksum-tools

Rev

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

  1. unit SFV;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes, Common;
  7.  
  8. type
  9.   TCheckSumFileSFV = class(TCheckSumFile)
  10.   protected
  11.     sfvFile: 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 CalcFileCRC32(filename: string): string; overload;
  20. procedure SFVFileToStringList(aSFVFile: string; slOut: TStringList);
  21.  
  22. implementation
  23.  
  24. uses
  25.   Windows, SysUtils, CRC32, LongFilenameOperations;
  26.  
  27. function CalcFileCRC32(filename: string): string; overload;
  28. var
  29.   checksum: DWORD;
  30.   totalbytes: TInteger8;
  31.   error: Word;
  32. begin
  33.   CRC32.CalcFileCRC32(filename, checksum, totalbytes, error);
  34.   if error = 0 then
  35.     result := IntToHex(checksum, 8)
  36.   else
  37.     result := '';
  38. end;
  39.  
  40. procedure SFVFileToStringList(aSFVFile: string; slOut: TStringList);
  41. var
  42.   sLine: string;
  43.   originalFilename: string;
  44.   expectedChecksum: string;
  45.   fil: THandle;
  46.   csum: TChecksum;
  47.   firstLinePassed: boolean;
  48.   forceUTF8: boolean;
  49. begin
  50.   if not FileExists(aSFVFile) then
  51.     exit;
  52.  
  53.   MyAssignFile(fil, aSFVFile);
  54.   try
  55.     MyReset(fil);
  56.     firstLinePassed := false;
  57.     forceUTF8 := false;
  58.     while not MyEOF(fil) do
  59.     begin
  60.       MyReadLn(fil, sLine);
  61.  
  62.       {$REGION 'Try UTF8 decode'}
  63.       if not firstLinePassed and (length(sLine)>2) and (sLine[1]=#$EF) and (sLine[2]=#$BB) and (sLine[3]=#$BF) then
  64.       begin
  65.         delete(sLine,1,3); // Remove BOM
  66.         forceUTF8 := true;
  67.       end;
  68.       firstLinePassed := true;
  69.  
  70.       if forceUTF8 or (Pos(#$FFFD, Utf8ToString(RawByteString(sLine))) = 0) then
  71.         sLine := Utf8ToString(RawByteString(sLine));
  72.       {$ENDREGION}
  73.  
  74.       if Copy(Trim(sLine),1,1) = ';' then continue;
  75.       // Example.doc 4323C92B
  76.       sLine := TrimRight(sLine); // Trim right, because file names may have leading white spaces
  77.       if sLine = '' then
  78.         continue;
  79.       expectedChecksum := Copy(sLine, 1+Length(sLine)-8, 8);
  80.       sLine := TrimRight(Copy(sLine, 1, Length(sLine)-8));  // Trim right, because file names may have leading white spaces
  81.       originalFilename := sLine;
  82.  
  83.       //slOut.Values[originalFilename] := expectedChecksum; // <-- with this, files cannot have an equal sign
  84.       slOut.OwnsObjects := true;
  85.       csum := TChecksum.Create;
  86.       csum.checksum := expectedChecksum;
  87.       slOut.AddObject(originalFilename, csum);
  88.     end;
  89.   finally
  90.     MyCloseFile(fil);
  91.   end;
  92. end;
  93.  
  94. { TCheckSumFileSFV }
  95.  
  96. constructor TCheckSumFileSFV.Create(AFileName: string);
  97. begin
  98.   inherited;
  99.   sfvFile := AFileName;
  100.   if not SameText(ExtractFileExt(AFileName),'.sfv') then
  101.     raise Exception.Create('Invalid checksum file extension.');
  102. end;
  103.  
  104. function TCheckSumFileSFV.MergeLine(AFileName, ACheckSum: string): string;
  105. begin
  106.   result := AFileName + ' ' + ACheckSum;
  107. end;
  108.  
  109. function TCheckSumFileSFV.SingleFileChecksum(AFileName: string): string;
  110. begin
  111.   result := CalcFileCRC32(AFileName);
  112. end;
  113.  
  114. procedure TCheckSumFileSFV.ToStringList(slOut: TStringList);
  115. begin
  116.   inherited;
  117.   SFVFileToStringList(sfvFile, slOut);
  118. end;
  119.  
  120. end.
  121.