Subversion Repositories checksum-tools

Rev

Rev 7 | Rev 10 | Go to most recent revision | Only display areas with differences | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 7 Rev 8
1
unit Unit3;
1
unit Unit3;
2
 
2
 
3
interface
3
interface
4
 
4
 
5
uses
5
uses
6
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
6
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
7
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
7
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
8
 
8
 
9
type
9
type
10
  TForm3 = class(TForm)
10
  TForm3 = class(TForm)
11
    Memo1: TMemo;
11
    Memo1: TMemo;
12
    Label1: TLabel;
12
    Label1: TLabel;
13
    Memo2: TMemo;
13
    Memo2: TMemo;
14
    Label2: TLabel;
14
    Label2: TLabel;
15
    Memo3: TMemo;
15
    Memo3: TMemo;
16
    Label3: TLabel;
16
    Label3: TLabel;
17
    Memo4: TMemo;
17
    Memo4: TMemo;
18
    Label4: TLabel;
18
    Label4: TLabel;
19
    Button1: TButton;
19
    Button1: TButton;
20
    OpenDialog1: TOpenDialog;
20
    OpenDialog1: TOpenDialog;
-
 
21
    Timer1: TTimer;
21
    procedure Button1Click(Sender: TObject);
22
    procedure Button1Click(Sender: TObject);
22
    procedure FormShow(Sender: TObject);
23
    procedure FormShow(Sender: TObject);
23
    procedure FormKeyPress(Sender: TObject; var Key: Char);
24
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
-
 
25
    procedure Timer1Timer(Sender: TObject);
24
  private
26
  private
25
    FChecksumFile: string;
27
    FChecksumFile: string;
26
  public
28
  public
27
    function ParamChecksumFile: string;
29
    function ParamChecksumFile: string;
28
    procedure LoadSFV;
30
    procedure LoadSFV;
29
    procedure SaveSFV;
31
    procedure SaveSFV;
30
  end;
32
  end;
31
 
33
 
32
var
34
var
33
  Form3: TForm3;
35
  Form3: TForm3;
34
 
36
 
35
implementation
37
implementation
36
 
38
 
37
{$R *.dfm}
39
{$R *.dfm}
38
 
40
 
39
uses
41
uses
40
  Common, SFV, MD5, LongFilenameOperations;
42
  Common, SFV, MD5, LongFilenameOperations;
41
 
43
 
42
procedure TForm3.Button1Click(Sender: TObject);
44
procedure TForm3.Button1Click(Sender: TObject);
43
begin
45
begin
44
  SaveSFV;
46
  SaveSFV;
45
  LoadSFV;
47
  LoadSFV;
46
end;
48
end;
47
 
49
 
48
procedure TForm3.FormKeyPress(Sender: TObject; var Key: Char);
50
procedure TForm3.FormKeyDown(Sender: TObject; var Key: Word;
-
 
51
  Shift: TShiftState);
49
begin
52
begin
-
 
53
  if (Shift = []) and (Key = VK_F6) then
-
 
54
  begin
50
  if Key = #27 then Close;
55
    Key := 0;
-
 
56
    SaveSFV;
-
 
57
    LoadSFV;
-
 
58
  end
-
 
59
  else if (Shift = []) and (Key = VK_ESCAPE) then
-
 
60
  begin
-
 
61
    Key := 0;
-
 
62
    Close;
-
 
63
  end
-
 
64
  else if (Shift = []) and (Key = VK_F5) then
-
 
65
  begin
-
 
66
    Key := 0;
-
 
67
    LoadSFV;
-
 
68
  end;
51
end;
69
end;
52
 
70
 
53
procedure TForm3.FormShow(Sender: TObject);
71
procedure TForm3.FormShow(Sender: TObject);
54
begin
72
begin
55
  Caption := ParamChecksumFile;
73
  Caption := ParamChecksumFile;
56
  LoadSFV;
74
  Timer1.Enabled := true;
57
end;
75
end;
58
 
76
 
59
procedure TForm3.LoadSFV;
77
procedure TForm3.LoadSFV;
60
var
78
var
61
  FileName: string;
79
  FileName: string;
62
  ADirectory: string;
80
  ADirectory: string;
63
  slSFV: TStringList;
81
  slSFV: TStringList;
64
  SR: TSearchRec;
82
  SR: TSearchRec;
65
  IsFound: Boolean;
83
  IsFound: Boolean;
66
  i: Integer;
84
  i: Integer;
67
  TestFilename: string;
85
  TestFilename: string;
68
  SollChecksum: string;
86
  SollChecksum: string;
69
  IstChecksum: string;
87
  IstChecksum: string;
70
  existingFiles: TStringList;
88
  existingFiles: TStringList;
71
  j: Integer;
89
  j: Integer;
72
  csman: TCheckSumFile;
90
  csman: TCheckSumFile;
73
begin
91
begin
-
 
92
  Color := clGray;
-
 
93
  Refresh;
-
 
94
 
74
  FileName := ParamChecksumFile;
95
  FileName := ParamChecksumFile;
75
  ADirectory := ExtractFilePath(FileName);
96
  ADirectory := ExtractFilePath(FileName);
76
 
97
 
77
  if not FileExists(FileName) then
98
  if not FileExists(FileName) then
78
  begin
99
  begin
79
    ShowMessageFmt('File not found: %s', [FileName]);
100
    ShowMessageFmt('File not found: %s', [FileName]);
80
    Close;
101
    Close;
81
  end;
102
  end;
82
 
103
 
83
  Memo1.Clear;
104
  Memo1.Clear;
84
  Memo2.Clear;
105
  Memo2.Clear;
85
  Memo3.Clear;
106
  Memo3.Clear;
86
  Memo4.Clear;
107
  Memo4.Clear;
87
 
108
 
88
  if SameText(ExtractFileExt(FileName), '.sfv') then
109
  if SameText(ExtractFileExt(FileName), '.sfv') then
89
    csman := TCheckSumFileSFV.Create(FileName)
110
    csman := TCheckSumFileSFV.Create(FileName)
90
  else if SameText(ExtractFileExt(FileName), '.md5') then
111
  else if SameText(ExtractFileExt(FileName), '.md5') then
91
    csman := TCheckSumFileMD5.Create(FileName)
112
    csman := TCheckSumFileMD5.Create(FileName)
92
  else
113
  else
93
    Exception.Create('Unknown file extension. Only supporting MD5 and SFV.');
114
    Exception.Create('Unknown file extension. Only supporting MD5 and SFV.');
94
 
115
 
95
  slSFV := TStringList.Create;
116
  slSFV := TStringList.Create;
96
  existingFiles := TStringList.Create;
117
  existingFiles := TStringList.Create;
97
  try
118
  try
98
    // Read SFV/MD5 file
119
    // Read SFV/MD5 file
99
    csman.ToStringList(slSFV);
120
    csman.ToStringList(slSFV);
100
 
121
 
101
    // List existing files
122
    // List existing files
102
    IsFound := FindFirst(ADirectory + '*', faAnyFile xor faDirectory, SR) = 0;
123
    IsFound := FindFirst(ADirectory + '*', faAnyFile xor faDirectory, SR) = 0;
103
    while IsFound do
124
    while IsFound do
104
    begin
125
    begin
105
      if (SR.Name <> '.') and (SR.Name <> '..') then
126
      if (SR.Name <> '.') and (SR.Name <> '..') then
106
      begin
127
      begin
107
        existingFiles.Add(LowerCase(SR.Name));
128
        existingFiles.Add(SR.Name);
108
      end;
129
      end;
109
      IsFound := FindNext(SR) = 0;
130
      IsFound := FindNext(SR) = 0;
110
    end;
131
    end;
111
    FindClose(SR);
132
    FindClose(SR);
112
 
133
 
113
    // Checksum mismatch or missing files
134
    // Checksum mismatch or missing files
114
    for i := 0 to slSFV.Count-1 do
135
    for i := 0 to slSFV.Count-1 do
115
    begin
136
    begin
116
      TestFilename := IncludeTrailingPathDelimiter(ADirectory) + slSFV.Strings[i];
137
      TestFilename := IncludeTrailingPathDelimiter(ADirectory) + slSFV.Strings[i];
117
      SollChecksum := TCheckSum(slSFV.Objects[i]).checksum;
138
      SollChecksum := TCheckSum(slSFV.Objects[i]).checksum;
118
      if not FileExists(TestFilename) then
139
      if not FileExists(TestFilename) then
119
      begin
140
      begin
120
        Memo3.Lines.Add(csman.MergeLine(slSFV.Strings[i], SollChecksum));
141
        Memo3.Lines.Add(csman.MergeLine(slSFV.Strings[i], SollChecksum));
121
      end
142
      end
122
      else
143
      else
123
      begin
144
      begin
124
        IstChecksum  := CalcFileCRC32(TestFilename);
145
        IstChecksum  := csman.SingleFileChecksum(TestFilename);
125
        if SameText(SollChecksum, IstChecksum) then
146
        if SameText(SollChecksum, IstChecksum) then
126
        begin
147
        begin
127
          Memo1.Lines.Add(csman.MergeLine(slSFV.Strings[i], SollChecksum));
148
          Memo1.Lines.Add(csman.MergeLine(slSFV.Strings[i], SollChecksum));
128
        end
149
        end
129
        else
150
        else
130
        begin
151
        begin
131
          Memo2.Lines.Add('; [CURRENT FILE CHECKSUM] ' + csman.MergeLine(slSFV.Strings[i], IstChecksum));
152
          Memo2.Lines.Add('; [CURRENT FILE CHECKSUM] ' + csman.MergeLine(slSFV.Strings[i], IstChecksum));
132
          Memo2.Lines.Add(csman.MergeLine(slSFV.Strings[i], SollChecksum));
153
          Memo2.Lines.Add(csman.MergeLine(slSFV.Strings[i], SollChecksum));
133
        end;
154
        end;
134
 
155
 
-
 
156
        {$IFDEF MSWINDOWS}
-
 
157
        existingFiles.CaseSensitive := false;
-
 
158
        {$ELSE}
-
 
159
        existingFiles.CaseSensitive := true;
-
 
160
        {$ENDIF}
135
        j := existingFiles.IndexOf(LowerCase(slSFV.Strings[i]));
161
        j := existingFiles.IndexOf(slSFV.Strings[i]);
136
        if j >= 0 then existingFiles.Delete(j);
162
        if j >= 0 then existingFiles.Delete(j);
137
      end;
163
      end;
138
    end;
164
    end;
139
 
165
 
140
    // Check non-indexed files
166
    // Check non-indexed files
141
    for i := 0 to existingFiles.Count-1 do
167
    for i := 0 to existingFiles.Count-1 do
142
    begin
168
    begin
143
      TestFileName := existingFiles[i];
169
      TestFileName := existingFiles[i];
144
      if not SameText(ExtractFileExt(TestFileName), '.sfv') and
170
      if not SameText(ExtractFileExt(TestFileName), '.sfv') and
145
         not SameText(ExtractFileExt(TestFileName), '.md5') and
171
         not SameText(ExtractFileExt(TestFileName), '.md5') and
146
         not SameText(TestFileName, 'Thumbs.db') then
172
         not SameText(TestFileName, 'Thumbs.db') then
147
      begin
173
      begin
148
        IstChecksum  := CalcFileCRC32(IncludeTrailingPathDelimiter(ADirectory) + TestFilename);
174
        IstChecksum  := CalcFileCRC32(IncludeTrailingPathDelimiter(ADirectory) + TestFilename);
149
        Memo4.Lines.Add(csman.MergeLine(TestFileName, IstChecksum));
175
        Memo4.Lines.Add(csman.MergeLine(TestFileName, IstChecksum));
150
      end;
176
      end;
151
    end;
177
    end;
152
 
178
 
153
    if (Memo2.Text = '') and (Memo3.Text = '') and (Memo4.Text = '') then
179
    if (Memo2.Text = '') and (Memo3.Text = '') and (Memo4.Text = '') then
154
      Color := clMoneyGreen
180
      Color := clMoneyGreen
155
    else if (Memo2.Text <> '') then
181
    else if (Memo2.Text <> '') then
156
      Color := clRed
182
      Color := clRed
157
    else
183
    else
158
      Color := clYellow;
184
      Color := clYellow;
-
 
185
 
-
 
186
    Memo1.SelStart := 0;
-
 
187
    Memo1.SelLength := 0;
-
 
188
    Memo2.SelStart := 0;
-
 
189
    Memo2.SelLength := 0;
-
 
190
    Memo3.SelStart := 0;
-
 
191
    Memo3.SelLength := 0;
-
 
192
    Memo4.SelStart := 0;
-
 
193
    Memo4.SelLength := 0;
-
 
194
 
-
 
195
    if Memo2.Text <> '' then Memo2.SetFocus
-
 
196
    else if Memo3.Text <> '' then Memo3.SetFocus
-
 
197
    else if Memo4.Text <> '' then Memo4.SetFocus
-
 
198
    else Memo1.SetFocus;
159
  finally
199
  finally
160
    FreeAndNil(slSFV);
200
    FreeAndNil(slSFV);
161
    FreeAndNil(existingFiles);
201
    FreeAndNil(existingFiles);
162
    FreeAndNil(csman);
202
    FreeAndNil(csman);
163
  end;
203
  end;
164
end;
204
end;
165
 
205
 
166
function TForm3.ParamChecksumFile: string;
206
function TForm3.ParamChecksumFile: string;
167
begin
207
begin
168
  if FChecksumFile <> '' then
208
  if FChecksumFile <> '' then
169
  begin
209
  begin
170
    result := FChecksumFile;
210
    result := FChecksumFile;
171
  end
211
  end
172
  else
212
  else
173
  begin
213
  begin
174
    result := ParamStr(1);
214
    result := ParamStr(1);
175
    if result = '' then
215
    if result = '' then
176
    begin
216
    begin
177
      if not OpenDialog1.Execute then
217
      if not OpenDialog1.Execute then
178
      begin
218
      begin
179
        Close;
219
        Close;
180
        Abort;
220
        Abort;
181
      end;
221
      end;
182
      result := OpenDialog1.FileName;
222
      result := OpenDialog1.FileName;
183
    end;
223
    end;
184
    FChecksumFile := result;
224
    FChecksumFile := result;
185
  end;
225
  end;
186
end;
226
end;
187
 
227
 
188
procedure TForm3.SaveSFV;
228
procedure TForm3.SaveSFV;
189
var
229
var
190
  hFile: THandle;
230
  hFile: THandle;
191
  i: Integer;
231
  i: Integer;
-
 
232
  slOut: TStringList;
192
begin
233
begin
193
  MyAssignFile(hFile, ParamChecksumFile);
234
  MyAssignFile(hFile, ParamChecksumFile);
-
 
235
  try
194
  MyRewrite(hFile); // clear File
236
    MyRewrite(hFile); // clear File
-
 
237
 
-
 
238
    slOut := TStringList.Create;
-
 
239
    try
-
 
240
      // Fill slOut with the Memo contents
195
  for i := 0 to memo1.Lines.Count-1 do
241
      for i := 0 to memo1.Lines.Count-1 do
196
  begin
242
      begin
197
    if Trim(Memo1.Lines[i]) <> '' then
243
        slOut.Add(Memo1.Lines[i]);
198
      MyWriteLn(hFile, AnsiString(utf8encode(Memo1.Lines[i])));
-
 
199
  end;
244
      end;
200
  for i := 0 to memo2.Lines.Count-1 do
245
      for i := 0 to memo2.Lines.Count-1 do
201
  begin
246
      begin
202
    if Trim(Memo2.Lines[i]) <> '' then
247
        slOut.Add(Memo2.Lines[i]);
203
      MyWriteLn(hFile, AnsiString(utf8encode(Memo2.Lines[i])));
-
 
204
  end;
248
      end;
205
  for i := 0 to memo3.Lines.Count-1 do
249
      for i := 0 to memo3.Lines.Count-1 do
206
  begin
250
      begin
207
    if Trim(Memo3.Lines[i]) <> '' then
251
        slOut.Add(Memo3.Lines[i]);
208
      MyWriteLn(hFile, AnsiString(utf8encode(Memo3.Lines[i])));
-
 
209
  end;
252
      end;
210
  for i := 0 to memo4.Lines.Count-1 do
253
      for i := 0 to memo4.Lines.Count-1 do
211
  begin
254
      begin
-
 
255
        slOut.Add(Memo4.Lines[i]);
-
 
256
      end;
-
 
257
 
-
 
258
      // Sort
-
 
259
      slOut.Sort;
-
 
260
 
-
 
261
      // Write to SFV/MD5 file
-
 
262
      for i := 0 to slOut.Count-1 do
-
 
263
      begin
212
    if Trim(Memo4.Lines[i]) <> '' then
264
        if Trim(slOut[i]) <> '' then
213
      MyWriteLn(hFile, AnsiString(utf8encode(Memo4.Lines[i])));
265
          MyWriteLn(hFile, AnsiString(utf8encode(slOut[i])));
-
 
266
      end;
-
 
267
    finally
-
 
268
      FreeAndNil(slOut);
214
  end;
269
    end;
-
 
270
  finally
215
  MyCloseFile(hFile);
271
    MyCloseFile(hFile);
216
end;
272
  end;
-
 
273
end;
-
 
274
 
-
 
275
procedure TForm3.Timer1Timer(Sender: TObject);
-
 
276
begin
-
 
277
  Timer1.Enabled := false;
-
 
278
  LoadSFV;
-
 
279
end;
217
 
280
 
218
end.
281
end.
219
 
282