Subversion Repositories checksum-tools

Rev

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

Rev Author Line No. Line
6 daniel-mar 1
unit Unit3;
2
 
3
interface
4
 
5
uses
6
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
7
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
8
 
9
type
10
  TForm3 = class(TForm)
11
    Memo1: TMemo;
12
    Label1: TLabel;
13
    Memo2: TMemo;
14
    Label2: TLabel;
15
    Memo3: TMemo;
16
    Label3: TLabel;
17
    Memo4: TMemo;
18
    Label4: TLabel;
19
    Button1: TButton;
20
    OpenDialog1: TOpenDialog;
21
    procedure Button1Click(Sender: TObject);
22
    procedure FormShow(Sender: TObject);
23
  private
24
    FChecksumFile: string;
25
  public
26
    function ParamChecksumFile: string;
27
    procedure LoadSFV;
28
    procedure SaveSFV;
29
  end;
30
 
31
var
32
  Form3: TForm3;
33
 
34
implementation
35
 
36
{$R *.dfm}
37
 
38
uses
39
  Common, SFV, MD5, LongFilenameOperations;
40
 
41
procedure TForm3.Button1Click(Sender: TObject);
42
begin
43
  SaveSFV;
44
  LoadSFV;
45
end;
46
 
47
procedure TForm3.FormShow(Sender: TObject);
48
begin
49
  Caption := ParamChecksumFile;
50
  LoadSFV;
51
end;
52
 
53
procedure TForm3.LoadSFV;
54
var
55
  FileName: string;
56
  ADirectory: string;
57
  slSFV: TStringList;
58
  SR: TSearchRec;
59
  IsFound: Boolean;
60
  i: Integer;
61
  TestFilename: string;
62
  SollChecksum: string;
63
  IstChecksum: string;
64
  existingFiles: TStringList;
65
  j: Integer;
66
  csman: TCheckSumFile;
67
begin
68
  FileName := ParamChecksumFile;
69
  ADirectory := ExtractFilePath(FileName);
70
 
71
  if not FileExists(FileName) then
72
  begin
73
    ShowMessageFmt('File not found: %s', [FileName]);
74
    Close;
75
  end;
76
 
77
  Memo1.Clear;
78
  Memo2.Clear;
79
  Memo3.Clear;
80
  Memo4.Clear;
81
 
82
  if SameText(ExtractFileExt(FileName), '.sfv') then
83
    csman := TCheckSumFileSFV.Create(FileName)
84
  else if SameText(ExtractFileExt(FileName), '.md5') then
85
    csman := TCheckSumFileMD5.Create(FileName)
86
  else
87
    Exception.Create('Unknown file extension. Only supporting MD5 and SFV.');
88
 
89
  slSFV := TStringList.Create;
90
  existingFiles := TStringList.Create;
91
  try
92
    // Read SFV/MD5 file
93
    csman.ToStringList(slSFV);
94
 
95
    // List existing files
96
    IsFound := FindFirst(ADirectory + '*', faAnyFile, SR) = 0;
97
    while IsFound do
98
    begin
99
      if (SR.Name <> '.') and (SR.Name <> '..') then
100
      begin
101
        existingFiles.Add(LowerCase(SR.Name));
102
      end;
103
      IsFound := FindNext(SR) = 0;
104
    end;
105
    FindClose(SR);
106
 
107
    // Checksum mismatch or missing files
108
    for i := 0 to slSFV.Count-1 do
109
    begin
110
      TestFilename := IncludeTrailingPathDelimiter(ADirectory) + slSFV.Strings[i];
111
      SollChecksum := TCheckSum(slSFV.Objects[i]).checksum;
112
      if not FileExists(TestFilename) then
113
      begin
114
        Memo3.Lines.Add(csman.MergeLine(slSFV.Strings[i], SollChecksum));
115
      end
116
      else
117
      begin
118
        IstChecksum  := CalcFileCRC32(TestFilename);
119
        if SameText(SollChecksum, IstChecksum) then
120
        begin
121
          Memo1.Lines.Add(csman.MergeLine(slSFV.Strings[i], SollChecksum));
122
        end
123
        else
124
        begin
125
          Memo2.Lines.Add('; [CURRENT FILE CHECKSUM] ' + csman.MergeLine(slSFV.Strings[i], IstChecksum));
126
          Memo2.Lines.Add(csman.MergeLine(slSFV.Strings[i], SollChecksum));
127
        end;
128
 
129
        j := existingFiles.IndexOf(LowerCase(slSFV.Strings[i]));
130
        if j >= 0 then existingFiles.Delete(j);
131
      end;
132
    end;
133
 
134
    // Check non-indexed files
135
    for i := 0 to existingFiles.Count-1 do
136
    begin
137
      TestFileName := existingFiles[i];
138
      if not SameText(ExtractFileExt(TestFileName), '.sfv') and
139
         not SameText(ExtractFileExt(TestFileName), '.md5') and
140
         not SameText(TestFileName, 'Thumbs.db') then
141
      begin
142
        IstChecksum  := CalcFileCRC32(IncludeTrailingPathDelimiter(ADirectory) + TestFilename);
143
        Memo4.Lines.Add(csman.MergeLine(TestFileName, IstChecksum));
144
      end;
145
    end;
146
  finally
147
    FreeAndNil(slSFV);
148
    FreeAndNil(existingFiles);
149
    FreeAndNil(csman);
150
  end;
151
end;
152
 
153
function TForm3.ParamChecksumFile: string;
154
begin
155
  if FChecksumFile <> '' then
156
  begin
157
    result := FChecksumFile;
158
  end
159
  else
160
  begin
161
    result := ParamStr(1);
162
    if result = '' then
163
    begin
164
      if not OpenDialog1.Execute then
165
      begin
166
        Close;
167
        Abort;
168
      end;
169
      result := OpenDialog1.FileName;
170
    end;
171
    FChecksumFile := result;
172
  end;
173
end;
174
 
175
procedure TForm3.SaveSFV;
176
var
177
  hFile: THandle;
178
  i: Integer;
179
begin
180
  MyAssignFile(hFile, ParamChecksumFile);
181
  MyRewrite(hFile); // clear File
182
  for i := 0 to memo1.Lines.Count-1 do
183
  begin
184
    if Trim(Memo1.Lines[i]) <> '' then
185
      MyWriteLn(hFile, AnsiString(utf8encode(Memo1.Lines[i])));
186
  end;
187
  for i := 0 to memo2.Lines.Count-1 do
188
  begin
189
    if Trim(Memo2.Lines[i]) <> '' then
190
      MyWriteLn(hFile, AnsiString(utf8encode(Memo2.Lines[i])));
191
  end;
192
  for i := 0 to memo3.Lines.Count-1 do
193
  begin
194
    if Trim(Memo3.Lines[i]) <> '' then
195
      MyWriteLn(hFile, AnsiString(utf8encode(Memo3.Lines[i])));
196
  end;
197
  for i := 0 to memo4.Lines.Count-1 do
198
  begin
199
    if Trim(Memo4.Lines[i]) <> '' then
200
      MyWriteLn(hFile, AnsiString(utf8encode(Memo4.Lines[i])));
201
  end;
202
  MyCloseFile(hFile);
203
end;
204
 
205
end.