WebSVN – checksum-tools – Blame – /trunk/Windows/Unit1.pas

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
17	daniel-mar	91	if Copy(aChecksumFile, 2, 1) = ':' then aChecksumFile := '\\?\' + aChecksumFile; // To allow long filenames
		92
2	daniel-mar	93	if ExtractFileName(aChecksumFile) <> DUMMY_FILE then
		94	begin
		95	Inc(CheckSumFileCount);
		96	end;
		97
		98	if cbVerbose.Checked then
		99	begin
17	daniel-mar	100	Form1.Memo1.Lines.Add('Check: ' + StringReplace(aChecksumFile,'\\?\','',[]));
2	daniel-mar	101	end;
		102
		103	Result := seOK;
		104	ADirectory := IncludeTrailingPathDelimiter(ExtractFilePath(aChecksumFile));
		105
		106	try
		107	slFile := TStringList.Create;
		108	try
		109	slFile.CaseSensitive := false;
		110	slFile.OwnsObjects := true;
		111
		112	if radiogroup1.itemindex = 0 then
		113	SFVFileToStringList(aChecksumFile, slFile)
		114	else
		115	MD5FileToStringList(aChecksumFile, slFile);
		116	// TODO: If multiple checksum files => put them together into a single array (beware conflicts!)
		117
		118	// 1. Check existing entries in the checksum file
		119
		120	for i := 0 to slFile.Count - 1 do
		121	begin
		122	originalFilename := slFile.Strings[i];
		123	expectedChecksum := TChecksum(slFile.Objects[i]).checksum;
		124
		125	originalFilenameFull := ADirectory + originalFilename;
		126	if not FileExists(originalFilenameFull) then
		127	begin
		128	if cbWarnVanishedFile.Checked then
		129	begin
17	daniel-mar	130	Form1.Memo1.Lines.Add('FILE VANISHED: ' + StringReplace(originalFilenameFull,'\\?\','',[]));
2	daniel-mar	131	Result := SevMax(Result, seCritical);
		132	end;
		133	end
		134	else if LowerCase(GetChecksumSafe(originalFilenameFull))
		135	= LowerCase(expectedChecksum) then
		136	begin
		137	if cbVerbose.Checked then
		138	begin
17	daniel-mar	139	Form1.Memo1.Lines.Add('OK: ' + StringReplace(originalFilenameFull,'\\?\','',[]) + ' = ' +
2	daniel-mar	140	expectedChecksum);
		141	end;
		142	Result := SevMax(Result, seOK);
		143	end
		144	else
		145	begin
		146	if cbWarnChecksumMismatch.Checked then
		147	begin
17	daniel-mar	148	Form1.Memo1.Lines.Add('CHECKSUM MISMATCH: ' + StringReplace(originalFilenameFull,'\\?\','',[]) +
2	daniel-mar	149	' <> ' + expectedChecksum);
		150	Result := SevMax(Result, seCritical);
		151	end;
		152	end;
		153	end;
		154
		155	// 2. Checking for entries which are NOT in the checksum file
		156
		157	IsFound := FindFirst(ADirectory + '*', faAnyFile - faDirectory, SR) = 0;
		158	while IsFound do
		159	begin
		160	fullfilename := ADirectory + SR.Name;
		161	if (LowerCase(ExtractFileExt(fullfilename)) <> '.md5') and
		162	(LowerCase(ExtractFileExt(fullfilename)) <> '.sfv') and
		163	(LowerCase(ExtractFileName(fullfilename)) <> 'thumbs.db') then
		164	begin
		165	if slFile.IndexOf(SR.Name) = -1 then //if slFile.Values[SR.Name] = '' then
		166	begin
		167	if ExtractFileName(aChecksumFile) = DUMMY_FILE then
		168	begin
		169	if cbWarnChecksumFileMissing.Checked then
		170	begin
		171	Form1.Memo1.Lines.Add('NEW FILE WITHOUT CHECKSUM FILE: ' +
17	daniel-mar	172	StringReplace(fullfilename,'\\?\','',[]));
2	daniel-mar	173	Result := SevMax(Result, seWarning);
		174	end;
		175	end
		176	else
		177	begin
		178	if cbWarningMissingChecksumFileEntry.Checked then
		179	begin
		180	Form1.Memo1.Lines.Add('NEW FILE WITHOUT CHECKSUM ENTRY: ' +
17	daniel-mar	181	StringReplace(fullfilename,'\\?\','',[]));
2	daniel-mar	182	Result := SevMax(Result, seWarning);
		183	end;
		184	end;
		185	end;
		186	end;
		187	IsFound := FindNext(SR) = 0;
		188	end;
		189	FindClose(SR);
		190	finally
		191	slFile.Free;
		192	end;
		193	except
		194	on E: Exception do
		195	begin
		196	Memo1.Lines.Add('Invalid checksum file: ' + aChecksumFile + ' : ' + E.Message);
		197	Result := seCritical;
		198	end;
		199	end;
		200	end;
		201
		202	function TForm1.CheckDirectory(ADirectory: string; recursive: boolean)
		203	: TSeverity;
		204	var
		205	IsFound: boolean;
		206	SR: TSearchRec;
		207	fullfilename: string;
		208	begin
		209	Caption := ADirectory;
		210	Application.ProcessMessages;
		211	if Application.Terminated then Abort;
		212
		213	Result := seOK;
		214	ADirectory := IncludeTrailingPathDelimiter(ADirectory);
		215
		216	// Check checksum files
		217	if radiogroup1.itemindex = 0 then
		218	IsFound := FindFirst(ADirectory + '*.sfv', faAnyFile - faDirectory, SR) = 0
		219	else
		220	IsFound := FindFirst(ADirectory + '*.md5', faAnyFile - faDirectory, SR) = 0;
		221	if not IsFound then
		222	begin
		223	fullfilename := ADirectory + DUMMY_FILE; // virtual "empty" file
		224	Result := SevMax(Result, VerifyChecksumFile(fullfilename));
		225	end
		226	else
		227	begin
		228	while IsFound do
		229	begin
		230	fullfilename := ADirectory + SR.Name;
		231
		232	Caption := fullfilename;
		233	Application.ProcessMessages;
		234	if Application.Terminated then Abort;
		235
		236	Result := SevMax(Result, VerifyChecksumFile(fullfilename));
		237	IsFound := FindNext(SR) = 0;
		238	end;
		239	end;
		240	FindClose(SR);
		241
		242	// Check other dirs
		243	if recursive then
		244	begin
		245	IsFound := FindFirst(ADirectory + '*', faAnyFile, SR) = 0;
		246	while IsFound do
		247	begin
		248	fullfilename := ADirectory + SR.Name;
		249	if DirectoryExists(fullfilename) and (SR.Name <> '.') and (SR.Name <> '..')
		250	then
		251	begin
		252	Result := SevMax(Result, CheckDirectory(fullfilename, recursive));
		253	end;
		254	IsFound := FindNext(SR) = 0;
		255	end;
		256	FindClose(SR);
		257	end;
		258	end;
		259
		260	procedure TForm1.FormShow(Sender: TObject);
		261	begin
		262	if ParamCount >= 1 then
		263	begin
		264	LabeledEdit1.Text := ParamStr(1);
		265	end;
		266	end;
		267
		268	function TForm1.GetChecksumSafe(const filename: string): string;
		269	begin
		270	Caption := filename;
		271	Application.ProcessMessages;
		272	if Application.Terminated then Abort;
		273
		274	try
		275	if radiogroup1.itemindex = 0 then
		276	Result := CalcFileCRC32(filename)
		277	else
		278	Result := md5file(filename);
		279	except
		280	on E: Exception do
		281	begin
		282	Memo1.Lines.Add('Cannot read file ' + filename + ' : ' + E.Message);
		283	Result := 'ERROR';
		284	end;
		285	end;
		286	end;
		287
		288	end.

Subversion Repositories checksum-tools

checksum-tools/trunk/Windows/Unit1.pas @ 9 – Rev 17