unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TSeverity = (seOK, seWarning, seCritical);
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
cbVerbose: TCheckBox;
LabeledEdit1: TLabeledEdit;
cbWarnChecksumFileMissing: TCheckBox;
cbWarningMissingChecksumFileEntry: TCheckBox;
cbWarnVanishedFile: TCheckBox;
cbWarnChecksumMismatch: TCheckBox;
Label1: TLabel;
RadioGroup1: TRadioGroup;
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
CheckSumFileCount: integer;
function CheckDirectory(ADirectory: string; recursive: boolean): TSeverity;
function VerifyChecksumFile(aChecksumFile: string): TSeverity;
function GetChecksumSafe(const filename: string): string;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
MD5, SFV, Common;
const
DUMMY_FILE = 'DUMMY.$$$';
procedure TForm1.Button1Click(Sender: TObject);
var
sev: TSeverity;
begin
Memo1.Clear;
if not DirectoryExists(LabeledEdit1.Text) then
begin
showmessage('Directory does not exist');
exit;
end;
Application.ProcessMessages;
CheckSumFileCount := 0;
sev := CheckDirectory(LabeledEdit1.Text, true);
Beep;
case sev of
seOK:
showmessage('OK');
seWarning:
showmessage('Warning');
seCritical:
showmessage('Critical');
end;
Caption := Format('Done. Checked %d checksum files.', [CheckSumFileCount]);
end;
function SevMax(a, b: TSeverity): TSeverity;
begin
if Ord(a) > Ord(b) then
Result := a
else
Result := b;
end;
function TForm1.VerifyChecksumFile(aChecksumFile: string): TSeverity;
var
slFile: TStringList;
i: integer;
originalFilename: string;
expectedChecksum: string;
IsFound: boolean;
SR: TSearchRec;
fullfilename: string;
ADirectory: string;
originalFilenameFull: string;
begin
if Copy(aChecksumFile, 2, 1) = ':' then aChecksumFile := '\\?\' + aChecksumFile; // To allow long filenames
if ExtractFileName(aChecksumFile) <> DUMMY_FILE then
begin
Inc(CheckSumFileCount);
end;
if cbVerbose.Checked then
begin
Form1.Memo1.Lines.Add('Check: ' + StringReplace(aChecksumFile,'\\?\','',[]));
end;
Result := seOK;
ADirectory := IncludeTrailingPathDelimiter(ExtractFilePath(aChecksumFile));
try
slFile := TStringList.Create;
try
slFile.CaseSensitive := false;
slFile.OwnsObjects := true;
if radiogroup1.itemindex = 0 then
SFVFileToStringList(aChecksumFile, slFile)
else
MD5FileToStringList(aChecksumFile, slFile);
// TODO: If multiple checksum files => put them together into a single array (beware conflicts!)
// 1. Check existing entries in the checksum file
for i := 0 to slFile.Count - 1 do
begin
originalFilename := slFile.Strings[i];
expectedChecksum := TChecksum(slFile.Objects[i]).checksum;
originalFilenameFull := ADirectory + originalFilename;
if not FileExists(originalFilenameFull) then
begin
if cbWarnVanishedFile.Checked then
begin
Form1.Memo1.Lines.Add('FILE VANISHED: ' + StringReplace(originalFilenameFull,'\\?\','',[]));
Result := SevMax(Result, seCritical);
end;
end
else if LowerCase(GetChecksumSafe(originalFilenameFull))
= LowerCase(expectedChecksum) then
begin
if cbVerbose.Checked then
begin
Form1.Memo1.Lines.Add('OK: ' + StringReplace(originalFilenameFull,'\\?\','',[]) + ' = ' +
expectedChecksum);
end;
Result := SevMax(Result, seOK);
end
else
begin
if cbWarnChecksumMismatch.Checked then
begin
Form1.Memo1.Lines.Add('CHECKSUM MISMATCH: ' + StringReplace(originalFilenameFull,'\\?\','',[]) +
' <> ' + expectedChecksum);
Result := SevMax(Result, seCritical);
end;
end;
end;
// 2. Checking for entries which are NOT in the checksum file
IsFound := FindFirst(ADirectory + '*', faAnyFile - faDirectory, SR) = 0;
while IsFound do
begin
fullfilename := ADirectory + SR.Name;
if (LowerCase(ExtractFileExt(fullfilename)) <> '.md5') and
(LowerCase(ExtractFileExt(fullfilename)) <> '.sfv') and
(LowerCase(ExtractFileName(fullfilename)) <> 'thumbs.db') then
begin
if slFile.IndexOf(SR.Name) = -1 then //if slFile.Values[SR.Name] = '' then
begin
if ExtractFileName(aChecksumFile) = DUMMY_FILE then
begin
if cbWarnChecksumFileMissing.Checked then
begin
Form1.Memo1.Lines.Add('NEW FILE WITHOUT CHECKSUM FILE: ' +
StringReplace(fullfilename,'\\?\','',[]));
Result := SevMax(Result, seWarning);
end;
end
else
begin
if cbWarningMissingChecksumFileEntry.Checked then
begin
Form1.Memo1.Lines.Add('NEW FILE WITHOUT CHECKSUM ENTRY: ' +
StringReplace(fullfilename,'\\?\','',[]));
Result := SevMax(Result, seWarning);
end;
end;
end;
end;
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
finally
slFile.Free;
end;
except
on E: Exception do
begin
Memo1.Lines.Add('Invalid checksum file: ' + aChecksumFile + ' : ' + E.Message);
Result := seCritical;
end;
end;
end;
function TForm1.CheckDirectory(ADirectory: string; recursive: boolean)
: TSeverity;
var
IsFound: boolean;
SR: TSearchRec;
fullfilename: string;
begin
Caption := ADirectory;
Application.ProcessMessages;
if Application.Terminated then Abort;
Result := seOK;
ADirectory := IncludeTrailingPathDelimiter(ADirectory);
// Check checksum files
if radiogroup1.itemindex = 0 then
IsFound := FindFirst(ADirectory + '*.sfv', faAnyFile - faDirectory, SR) = 0
else
IsFound := FindFirst(ADirectory + '*.md5', faAnyFile - faDirectory, SR) = 0;
if not IsFound then
begin
fullfilename := ADirectory + DUMMY_FILE; // virtual "empty" file
Result := SevMax(Result, VerifyChecksumFile(fullfilename));
end
else
begin
while IsFound do
begin
fullfilename := ADirectory + SR.Name;
Caption := fullfilename;
Application.ProcessMessages;
if Application.Terminated then Abort;
Result := SevMax(Result, VerifyChecksumFile(fullfilename));
IsFound := FindNext(SR) = 0;
end;
end;
FindClose(SR);
// Check other dirs
if recursive then
begin
IsFound := FindFirst(ADirectory + '*', faAnyFile, SR) = 0;
while IsFound do
begin
fullfilename := ADirectory + SR.Name;
if DirectoryExists(fullfilename) and (SR.Name <> '.') and (SR.Name <> '..')
then
begin
Result := SevMax(Result, CheckDirectory(fullfilename, recursive));
end;
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
end;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
if ParamCount >= 1 then
begin
LabeledEdit1.Text := ParamStr(1);
end;
end;
function TForm1.GetChecksumSafe(const filename: string): string;
begin
Caption := filename;
Application.ProcessMessages;
if Application.Terminated then Abort;
try
if radiogroup1.itemindex = 0 then
Result := CalcFileCRC32(filename)
else
Result := md5file(filename);
except
on E: Exception do
begin
Memo1.Lines.Add('Cannot read file ' + filename + ' : ' + E.Message);
Result := 'ERROR';
end;
end;
end;
end.