Subversion Repositories checksum-tools

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 daniel-mar 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.