WebSVN – checksum-tools – Diff – /trunk/Windows/Unit3.pas


unit Unit3;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
 
type
  TForm3 = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    Memo2: TMemo;
    Label2: TLabel;
    Memo3: TMemo;
    Label3: TLabel;
    Memo4: TMemo;
    Label4: TLabel;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
  private
    FChecksumFile: string;
  public
    function ParamChecksumFile: string;
    procedure LoadSFV;
    procedure SaveSFV;
  end;
 
var
  Form3: TForm3;
 
implementation
 
{$R *.dfm}
 
uses
  Common, SFV, MD5, LongFilenameOperations;
 
procedure TForm3.Button1Click(Sender: TObject);
begin
  SaveSFV;
  LoadSFV;
end;
 
procedure TForm3.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #27 then Close;
end;
 
procedure TForm3.FormShow(Sender: TObject);
begin
  Caption := ParamChecksumFile;
  LoadSFV;
end;
 
procedure TForm3.LoadSFV;
var
  FileName: string;
  ADirectory: string;
  slSFV: TStringList;
  SR: TSearchRec;
  IsFound: Boolean;
  i: Integer;
  TestFilename: string;
  SollChecksum: string;
  IstChecksum: string;
  existingFiles: TStringList;
  j: Integer;
  csman: TCheckSumFile;
begin
  FileName := ParamChecksumFile;
  ADirectory := ExtractFilePath(FileName);
 
  if not FileExists(FileName) then
  begin
    ShowMessageFmt('File not found: %s', [FileName]);
    Close;
  end;
 
  Memo1.Clear;
  Memo2.Clear;
  Memo3.Clear;
  Memo4.Clear;
 
  if SameText(ExtractFileExt(FileName), '.sfv') then
    csman := TCheckSumFileSFV.Create(FileName)
  else if SameText(ExtractFileExt(FileName), '.md5') then
    csman := TCheckSumFileMD5.Create(FileName)
  else
    Exception.Create('Unknown file extension. Only supporting MD5 and SFV.');
 
  slSFV := TStringList.Create;
  existingFiles := TStringList.Create;
  try
    // Read SFV/MD5 file
    csman.ToStringList(slSFV);
 
    // List existing files
    IsFound := FindFirst(ADirectory + '*', faAnyFile xor faDirectory, SR) = 0;
    while IsFound do
    begin
      if (SR.Name <> '.') and (SR.Name <> '..') then
      begin
        existingFiles.Add(LowerCase(SR.Name));
      end;
      IsFound := FindNext(SR) = 0;
    end;
    FindClose(SR);
 
    // Checksum mismatch or missing files
    for i := 0 to slSFV.Count-1 do
    begin
      TestFilename := IncludeTrailingPathDelimiter(ADirectory) + slSFV.Strings[i];
      SollChecksum := TCheckSum(slSFV.Objects[i]).checksum;
      if not FileExists(TestFilename) then
      begin
        Memo3.Lines.Add(csman.MergeLine(slSFV.Strings[i], SollChecksum));
      end
      else
      begin
        IstChecksum  := CalcFileCRC32(TestFilename);
        if SameText(SollChecksum, IstChecksum) then
        begin
          Memo1.Lines.Add(csman.MergeLine(slSFV.Strings[i], SollChecksum));
        end
        else
        begin
          Memo2.Lines.Add('; [CURRENT FILE CHECKSUM] ' + csman.MergeLine(slSFV.Strings[i], IstChecksum));
          Memo2.Lines.Add(csman.MergeLine(slSFV.Strings[i], SollChecksum));
        end;
 
        j := existingFiles.IndexOf(LowerCase(slSFV.Strings[i]));
        if j >= 0 then existingFiles.Delete(j);
      end;
    end;
 
    // Check non-indexed files
    for i := 0 to existingFiles.Count-1 do
    begin
      TestFileName := existingFiles[i];
      if not SameText(ExtractFileExt(TestFileName), '.sfv') and
         not SameText(ExtractFileExt(TestFileName), '.md5') and
         not SameText(TestFileName, 'Thumbs.db') then
      begin
        IstChecksum  := CalcFileCRC32(IncludeTrailingPathDelimiter(ADirectory) + TestFilename);
        Memo4.Lines.Add(csman.MergeLine(TestFileName, IstChecksum));
      end;
    end;
 
    if (Memo2.Text = '') and (Memo3.Text = '') and (Memo4.Text = '') then
      Color := clMoneyGreen
    else if (Memo2.Text <> '') then
      Color := clRed
    else
      Color := clYellow;
  finally
    FreeAndNil(slSFV);
    FreeAndNil(existingFiles);
    FreeAndNil(csman);
  end;
end;
 
function TForm3.ParamChecksumFile: string;
begin
  if FChecksumFile <> '' then
  begin
    result := FChecksumFile;
  end
  else
  begin
    result := ParamStr(1);
    if result = '' then
    begin
      if not OpenDialog1.Execute then
      begin
        Close;
        Abort;
      end;
      result := OpenDialog1.FileName;
    end;
    FChecksumFile := result;
  end;
end;
 
procedure TForm3.SaveSFV;
var
  hFile: THandle;
  i: Integer;
begin
  MyAssignFile(hFile, ParamChecksumFile);
  MyRewrite(hFile); // clear File
  for i := 0 to memo1.Lines.Count-1 do
  begin
    if Trim(Memo1.Lines[i]) <> '' then
      MyWriteLn(hFile, AnsiString(utf8encode(Memo1.Lines[i])));
  end;
  for i := 0 to memo2.Lines.Count-1 do
  begin
    if Trim(Memo2.Lines[i]) <> '' then
      MyWriteLn(hFile, AnsiString(utf8encode(Memo2.Lines[i])));
  end;
  for i := 0 to memo3.Lines.Count-1 do
  begin
    if Trim(Memo3.Lines[i]) <> '' then
      MyWriteLn(hFile, AnsiString(utf8encode(Memo3.Lines[i])));
  end;
  for i := 0 to memo4.Lines.Count-1 do
  begin
    if Trim(Memo4.Lines[i]) <> '' then
      MyWriteLn(hFile, AnsiString(utf8encode(Memo4.Lines[i])));
  end;
  MyCloseFile(hFile);
end;
 
end.
 

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

Subversion Repositories checksum-tools

checksum-tools/trunk/Windows/Unit3.pas – Rev 6 → 7