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 Unit1;
2
 
3
interface
4
 
5
uses
6
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
7
  System.Classes, Vcl.Graphics,
8
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
9
 
10
type
11
  TSeverity = (seOK, seWarning, seCritical);
12
 
13
  TForm1 = class(TForm)
14
    Button1: TButton;
15
    Memo1: TMemo;
16
    cbVerbose: TCheckBox;
17
    LabeledEdit1: TLabeledEdit;
18
    cbWarnChecksumFileMissing: TCheckBox;
19
    cbWarningMissingChecksumFileEntry: TCheckBox;
20
    cbWarnVanishedFile: TCheckBox;
21
    cbWarnChecksumMismatch: TCheckBox;
22
    Label1: TLabel;
23
    RadioGroup1: TRadioGroup;
24
    procedure Button1Click(Sender: TObject);
25
    procedure FormShow(Sender: TObject);
26
  private
27
    CheckSumFileCount: integer;
28
    function CheckDirectory(ADirectory: string; recursive: boolean): TSeverity;
29
    function VerifyChecksumFile(aChecksumFile: string): TSeverity;
30
    function GetChecksumSafe(const filename: string): string;
31
  end;
32
 
33
var
34
  Form1: TForm1;
35
 
36
implementation
37
 
38
{$R *.dfm}
39
 
40
uses
41
  MD5, SFV, Common;
42
 
43
const
44
  DUMMY_FILE = 'DUMMY.$$$';
45
 
46
procedure TForm1.Button1Click(Sender: TObject);
47
var
48
  sev: TSeverity;
49
begin
50
  Memo1.Clear;
51
  if not DirectoryExists(LabeledEdit1.Text) then
52
  begin
53
    showmessage('Directory does not exist');
54
    exit;
55
  end;
56
  Application.ProcessMessages;
57
  CheckSumFileCount := 0;
58
  sev := CheckDirectory(LabeledEdit1.Text, true);
59
  Beep;
60
  case sev of
61
    seOK:
62
      showmessage('OK');
63
    seWarning:
64
      showmessage('Warning');
65
    seCritical:
66
      showmessage('Critical');
67
  end;
68
  Caption := Format('Done. Checked %d checksum files.', [CheckSumFileCount]);
69
end;
70
 
71
function SevMax(a, b: TSeverity): TSeverity;
72
begin
73
  if Ord(a) > Ord(b) then
74
    Result := a
75
  else
76
    Result := b;
77
end;
78
 
79
function TForm1.VerifyChecksumFile(aChecksumFile: string): TSeverity;
80
var
81
  slFile: TStringList;
82
  i: integer;
83
  originalFilename: string;
84
  expectedChecksum: string;
85
  IsFound: boolean;
86
  SR: TSearchRec;
87
  fullfilename: string;
88
  ADirectory: string;
89
  originalFilenameFull: string;
90
begin
91
  if ExtractFileName(aChecksumFile) <> DUMMY_FILE then
92
  begin
93
    Inc(CheckSumFileCount);
94
  end;
95
 
96
  if cbVerbose.Checked then
97
  begin
98
    Form1.Memo1.Lines.Add('Check: ' + aChecksumFile);
99
  end;
100
 
101
  Result := seOK;
102
  ADirectory := IncludeTrailingPathDelimiter(ExtractFilePath(aChecksumFile));
103
 
104
  try
105
    slFile := TStringList.Create;
106
    try
107
      slFile.CaseSensitive := false;
108
      slFile.OwnsObjects := true;
109
 
110
      if radiogroup1.itemindex = 0 then
111
        SFVFileToStringList(aChecksumFile, slFile)
112
      else
113
        MD5FileToStringList(aChecksumFile, slFile);
114
      // TODO: If multiple checksum files => put them together into a single array (beware conflicts!)
115
 
116
      // 1. Check existing entries in the checksum file
117
 
118
      for i := 0 to slFile.Count - 1 do
119
      begin
120
        originalFilename := slFile.Strings[i];
121
        expectedChecksum := TChecksum(slFile.Objects[i]).checksum;
122
 
123
        originalFilenameFull := ADirectory + originalFilename;
124
 
125
        if not FileExists(originalFilenameFull) then
126
        begin
127
          if cbWarnVanishedFile.Checked then
128
          begin
129
            Form1.Memo1.Lines.Add('FILE VANISHED: ' + originalFilenameFull);
130
            Result := SevMax(Result, seCritical);
131
          end;
132
        end
133
        else if LowerCase(GetChecksumSafe(originalFilenameFull))
134
          = LowerCase(expectedChecksum) then
135
        begin
136
          if cbVerbose.Checked then
137
          begin
138
            Form1.Memo1.Lines.Add('OK: ' + originalFilenameFull + ' = ' +
139
              expectedChecksum);
140
          end;
141
          Result := SevMax(Result, seOK);
142
        end
143
        else
144
        begin
145
          if cbWarnChecksumMismatch.Checked then
146
          begin
147
            Form1.Memo1.Lines.Add('CHECKSUM MISMATCH: ' + originalFilenameFull +
148
              ' <> ' + expectedChecksum);
149
            Result := SevMax(Result, seCritical);
150
          end;
151
        end;
152
      end;
153
 
154
      // 2. Checking for entries which are NOT in the checksum file
155
 
156
      IsFound := FindFirst(ADirectory + '*', faAnyFile - faDirectory, SR) = 0;
157
      while IsFound do
158
      begin
159
        fullfilename := ADirectory + SR.Name;
160
        if (LowerCase(ExtractFileExt(fullfilename)) <> '.md5') and
161
           (LowerCase(ExtractFileExt(fullfilename)) <> '.sfv') and
162
           (LowerCase(ExtractFileName(fullfilename)) <> 'thumbs.db') then
163
        begin
164
          if slFile.IndexOf(SR.Name) = -1 then //if slFile.Values[SR.Name] = '' then
165
          begin
166
            if ExtractFileName(aChecksumFile) = DUMMY_FILE then
167
            begin
168
              if cbWarnChecksumFileMissing.Checked then
169
              begin
170
                Form1.Memo1.Lines.Add('NEW FILE WITHOUT CHECKSUM FILE: ' +
171
                  fullfilename);
172
                Result := SevMax(Result, seWarning);
173
              end;
174
            end
175
            else
176
            begin
177
              if cbWarningMissingChecksumFileEntry.Checked then
178
              begin
179
                Form1.Memo1.Lines.Add('NEW FILE WITHOUT CHECKSUM ENTRY: ' +
180
                  fullfilename);
181
                Result := SevMax(Result, seWarning);
182
              end;
183
            end;
184
          end;
185
        end;
186
        IsFound := FindNext(SR) = 0;
187
      end;
188
      FindClose(SR);
189
    finally
190
      slFile.Free;
191
    end;
192
  except
193
    on E: Exception do
194
    begin
195
      Memo1.Lines.Add('Invalid checksum file: ' + aChecksumFile + ' : ' + E.Message);
196
      Result := seCritical;
197
    end;
198
  end;
199
end;
200
 
201
function TForm1.CheckDirectory(ADirectory: string; recursive: boolean)
202
  : TSeverity;
203
var
204
  IsFound: boolean;
205
  SR: TSearchRec;
206
  fullfilename: string;
207
begin
208
  Caption := ADirectory;
209
  Application.ProcessMessages;
210
  if Application.Terminated then Abort;
211
 
212
  Result := seOK;
213
  ADirectory := IncludeTrailingPathDelimiter(ADirectory);
214
 
215
  // Check checksum files
216
  if radiogroup1.itemindex = 0 then
217
    IsFound := FindFirst(ADirectory + '*.sfv', faAnyFile - faDirectory, SR) = 0
218
  else
219
    IsFound := FindFirst(ADirectory + '*.md5', faAnyFile - faDirectory, SR) = 0;
220
  if not IsFound then
221
  begin
222
    fullfilename := ADirectory + DUMMY_FILE; // virtual "empty" file
223
    Result := SevMax(Result, VerifyChecksumFile(fullfilename));
224
  end
225
  else
226
  begin
227
    while IsFound do
228
    begin
229
      fullfilename := ADirectory + SR.Name;
230
 
231
      Caption := fullfilename;
232
      Application.ProcessMessages;
233
      if Application.Terminated then Abort;
234
 
235
      Result := SevMax(Result, VerifyChecksumFile(fullfilename));
236
      IsFound := FindNext(SR) = 0;
237
    end;
238
  end;
239
  FindClose(SR);
240
 
241
  // Check other dirs
242
  if recursive then
243
  begin
244
    IsFound := FindFirst(ADirectory + '*', faAnyFile, SR) = 0;
245
    while IsFound do
246
    begin
247
      fullfilename := ADirectory + SR.Name;
248
      if DirectoryExists(fullfilename) and (SR.Name <> '.') and (SR.Name <> '..')
249
      then
250
      begin
251
        Result := SevMax(Result, CheckDirectory(fullfilename, recursive));
252
      end;
253
      IsFound := FindNext(SR) = 0;
254
    end;
255
    FindClose(SR);
256
  end;
257
end;
258
 
259
procedure TForm1.FormShow(Sender: TObject);
260
begin
261
  if ParamCount >= 1 then
262
  begin
263
    LabeledEdit1.Text := ParamStr(1);
264
  end;
265
end;
266
 
267
function TForm1.GetChecksumSafe(const filename: string): string;
268
begin
269
  Caption := filename;
270
  Application.ProcessMessages;
271
  if Application.Terminated then Abort;
272
 
273
  try
274
    if radiogroup1.itemindex = 0 then
275
      Result := CalcFileCRC32(filename)
276
    else
277
      Result := md5file(filename);
278
  except
279
    on E: Exception do
280
    begin
281
      Memo1.Lines.Add('Cannot read file ' + filename + ' : ' + E.Message);
282
      Result := 'ERROR';
283
    end;
284
  end;
285
end;
286
 
287
end.