Subversion Repositories checksum-tools

Rev

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

Rev Author Line No. Line
2 daniel-mar 1 
unit SFV;
2 
 
3 
interface
4 
 
5 
uses
6 daniel-mar 6 
  Classes, Common;
2 daniel-mar 7 
 
6 daniel-mar 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 
 
2 daniel-mar 19 
function CalcFileCRC32(filename: string): string; overload;
20 
procedure SFVFileToStringList(aSFVFile: string; slOut: TStringList);
21 
 
22 
implementation
23 
 
24 
uses
6 daniel-mar 25 
  Windows, SysUtils, CRC32, LongFilenameOperations;
2 daniel-mar 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 
 
6 daniel-mar 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 
 
2 daniel-mar 120 
end.