Rev 2 | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
2 | daniel-mar | 1 | unit RedundancyForm; |
2 | |||
4 | daniel-mar | 3 | // TODO: man soll einstellen können, dass er redundanzen nur innerhalb eines datenträgers (= root node) findet |
4 | |||
2 | daniel-mar | 5 | interface |
6 | |||
7 | uses |
||
8 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, |
||
9 | System.Classes, Vcl.Graphics, AdoDb, |
||
10 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Samples.Gauges; |
||
11 | |||
12 | type |
||
13 | TfrmRedundancy = class(TForm) |
||
14 | Button1: TButton; |
||
15 | Memo1: TMemo; |
||
16 | Gauge1: TGauge; |
||
17 | Edit1: TEdit; |
||
18 | Label1: TLabel; |
||
19 | Label2: TLabel; |
||
20 | ComboBox1: TComboBox; |
||
21 | Label3: TLabel; |
||
22 | Label4: TLabel; |
||
23 | procedure Button1Click(Sender: TObject); |
||
24 | procedure FormClose(Sender: TObject; var Action: TCloseAction); |
||
25 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); |
||
26 | procedure FormShow(Sender: TObject); |
||
27 | private |
||
28 | procedure Mode2Rec(StartDir: string; const FileMask: string; |
||
29 | var cntRedundant: integer; var cntUnique: integer); |
||
30 | protected |
||
31 | StopRequest: Boolean; |
||
32 | procedure EnableDisableControls(v: Boolean); |
||
33 | function TableName: string; |
||
34 | function conn: TAdoConnection; |
||
35 | end; |
||
36 | |||
37 | implementation |
||
38 | |||
39 | {$R *.dfm} |
||
40 | |||
41 | uses |
||
42 | DB, AdoConnHelper, IdHashMessageDigest, idHash, MainForm, IniFiles; |
||
43 | |||
44 | function MD5File(const FileName: string): string; |
||
45 | var |
||
46 | IdMD5: TIdHashMessageDigest5; |
||
47 | FS: TFileStream; |
||
48 | begin |
||
49 | IdMD5 := TIdHashMessageDigest5.Create; |
||
50 | FS := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); |
||
51 | try |
||
52 | {$IFDEF UNICODE} // I actually do not know at which version of Delphi/Indy, this has changed. |
||
53 | Result := IdMD5.HashStreamAsHex(FS); |
||
54 | {$ELSE} |
||
55 | Result := IdMD5.AsHex(IdMD5.HashValue(FS)); |
||
56 | {$ENDIF} |
||
57 | finally |
||
58 | FS.Free; |
||
59 | IdMD5.Free; |
||
60 | end; |
||
61 | end; |
||
62 | |||
63 | procedure TfrmRedundancy.Mode2Rec(StartDir: string; const FileMask: string; |
||
64 | var cntRedundant: integer; var cntUnique: integer); |
||
65 | |||
66 | procedure CheckFile(aFilename: string); |
||
67 | var |
||
68 | md5: string; |
||
69 | begin |
||
70 | try |
||
71 | Label4.Caption := aFilename; |
||
72 | md5 := MD5File(aFilename); |
||
73 | if conn.GetScalar('select count(*) from ' + TableName + |
||
74 | ' where md5hash = ' + conn.SQLStringEscape(md5)) = 0 then |
||
75 | begin |
||
76 | Memo1.Lines.Add(aFilename); |
||
77 | Inc(cntUnique); |
||
78 | end |
||
79 | else |
||
80 | begin |
||
81 | Inc(cntRedundant); |
||
82 | end; |
||
83 | except |
||
84 | on E: Exception do |
||
85 | begin |
||
86 | Memo1.Lines.Add(Format('Error: Cannot process %s : %s', |
||
87 | [aFilename, E.Message])) |
||
88 | end; |
||
89 | end; |
||
90 | end; |
||
91 | |||
92 | var |
||
93 | SR: TSearchRec; |
||
94 | DirList: TStrings; |
||
95 | IsFound: Boolean; |
||
96 | i: integer; |
||
97 | begin |
||
98 | StartDir := IncludeTrailingPathDelimiter(StartDir); |
||
99 | |||
100 | i := 0; |
||
101 | IsFound := FindFirst(StartDir + FileMask, faAnyFile - faDirectory, SR) = 0; |
||
102 | try |
||
103 | while IsFound do |
||
104 | begin |
||
105 | Inc(i); |
||
106 | Application.ProcessMessages; |
||
107 | if Application.Terminated or StopRequest then |
||
108 | Abort; |
||
109 | |||
110 | CheckFile(StartDir + SR.Name); |
||
111 | IsFound := FindNext(SR) = 0; |
||
112 | end; |
||
113 | finally |
||
114 | FindClose(SR); |
||
115 | end; |
||
116 | |||
117 | // Build a list of subdirectories |
||
118 | DirList := TStringList.Create; |
||
119 | try |
||
120 | IsFound := FindFirst(StartDir + '*', faDirectory, SR) = 0; |
||
121 | try |
||
122 | while IsFound do |
||
123 | begin |
||
124 | if (SR.Name <> '.') and (SR.Name <> '..') then |
||
125 | begin |
||
126 | Application.ProcessMessages; |
||
127 | if Application.Terminated or StopRequest then |
||
128 | Abort; |
||
129 | |||
130 | DirList.Add(StartDir + SR.Name); |
||
131 | end; |
||
132 | IsFound := FindNext(SR) = 0; |
||
133 | end; |
||
134 | finally |
||
135 | FindClose(SR); |
||
136 | end; |
||
137 | |||
138 | // Scan the list of subdirectories |
||
139 | for i := 0 to DirList.Count - 1 do |
||
140 | begin |
||
141 | try |
||
142 | Mode2Rec(DirList[i], FileMask, cntRedundant, cntUnique); |
||
143 | except |
||
144 | on E: Exception do |
||
145 | begin |
||
146 | if E is EAbort then |
||
147 | Abort; |
||
148 | Memo1.Lines.Add('Unexpected error at directory ' + DirList[i] + ': ' + |
||
149 | E.Message); |
||
150 | end; |
||
151 | end; |
||
152 | end; |
||
153 | finally |
||
154 | DirList.Free; |
||
155 | end; |
||
156 | end; |
||
157 | |||
158 | function TfrmRedundancy.TableName: string; |
||
159 | begin |
||
160 | result := frmMain.TableName; |
||
161 | end; |
||
162 | |||
163 | procedure TfrmRedundancy.Button1Click(Sender: TObject); |
||
164 | var |
||
165 | q: TADODataSet; |
||
166 | fMD5: TField; |
||
167 | fFilename: TField; |
||
168 | dirMask: string; |
||
169 | cntRedundant: integer; |
||
170 | cntUnique: integer; |
||
171 | begin |
||
172 | EnableDisableControls(False); |
||
173 | if ComboBox1.ItemIndex = 1 then |
||
174 | Gauge1.Visible := False; |
||
175 | Memo1.Lines.Clear; |
||
176 | try |
||
177 | {$REGION 'Mode 1'} |
||
178 | if ComboBox1.ItemIndex = 0 then |
||
179 | begin |
||
180 | dirMask := IncludeTrailingPathDelimiter(Edit1.Text) + '%'; |
||
181 | q := conn.GetTable |
||
182 | ('select filename, md5hash from '+TableName+' where filename like ' + |
||
183 | conn.SQLStringEscape(dirMask) + ' order by filename'); |
||
184 | try |
||
185 | Gauge1.MinValue := 0; |
||
186 | Gauge1.MaxValue := q.RecordCount; |
||
187 | Gauge1.Progress := 0; |
||
188 | cntRedundant := 0; |
||
189 | cntUnique := 0; |
||
190 | fMD5 := q.FieldByName('md5hash'); |
||
191 | fFilename := q.FieldByName('filename'); |
||
192 | while not q.Eof do |
||
193 | begin |
||
194 | if conn.GetScalar('select count(*) from '+TableName+' where md5hash = ' + |
||
195 | conn.SQLStringEscape(fMD5.AsString) + ' and filename not like ' + |
||
196 | conn.SQLStringEscape(dirMask)) = 0 then |
||
197 | begin |
||
198 | Memo1.Lines.Add(fFilename.AsString); |
||
199 | Inc(cntUnique); |
||
200 | end |
||
201 | else |
||
202 | begin |
||
203 | Inc(cntRedundant); |
||
204 | end; |
||
205 | Gauge1.Progress := Gauge1.Progress + 1; |
||
206 | Application.ProcessMessages; |
||
207 | if Application.Terminated then |
||
208 | Abort; |
||
209 | q.Next; |
||
210 | end; |
||
211 | finally |
||
212 | q.Free; |
||
213 | end; |
||
214 | end; |
||
215 | {$ENDREGION} |
||
216 | {$REGION 'Mode 2'} |
||
217 | if ComboBox1.ItemIndex = 1 then |
||
218 | begin |
||
219 | cntRedundant := 0; |
||
220 | cntUnique := 0; |
||
221 | Mode2Rec(Edit1.Text, '*', cntRedundant, cntUnique); |
||
222 | end; |
||
223 | {$ENDREGION} |
||
224 | if (cntRedundant = 0) and (cntUnique = 0) then |
||
225 | raise Exception.Create('No files found. Is the string correct?') |
||
226 | else |
||
227 | ShowMessageFmt('Done. %d files are redundant. %d are unique.', |
||
228 | [cntRedundant, cntUnique]); |
||
229 | |||
230 | if ComboBox1.ItemIndex = 0 then |
||
231 | begin |
||
232 | ShowMessage |
||
233 | ('Attention: Only check 1 directory at a time, then delete redundant files, then re-index and only then continue with checking the redundancy of the any other directory.'); |
||
234 | end; |
||
235 | finally |
||
236 | EnableDisableControls(True); |
||
237 | Gauge1.Progress := 0; |
||
238 | Gauge1.Visible := True; |
||
239 | Label4.Caption := ''; |
||
240 | end; |
||
241 | end; |
||
242 | |||
243 | function TfrmRedundancy.conn: TAdoConnection; |
||
244 | begin |
||
245 | Result := frmMain.AdoConnection1; |
||
246 | end; |
||
247 | |||
248 | procedure TfrmRedundancy.EnableDisableControls(v: Boolean); |
||
249 | begin |
||
250 | Edit1.Enabled := v; |
||
251 | Button1.Enabled := v; |
||
252 | ComboBox1.Enabled := v; |
||
253 | end; |
||
254 | |||
255 | procedure TfrmRedundancy.FormClose(Sender: TObject; var Action: TCloseAction); |
||
256 | begin |
||
257 | Action := caFree; |
||
258 | end; |
||
259 | |||
260 | procedure TfrmRedundancy.FormCloseQuery(Sender: TObject; var CanClose: Boolean); |
||
261 | begin |
||
262 | StopRequest := True; |
||
263 | end; |
||
264 | |||
265 | procedure TfrmRedundancy.FormShow(Sender: TObject); |
||
266 | var |
||
267 | ini: TMemIniFile; |
||
268 | begin |
||
269 | ini := frmMain.ini; |
||
270 | Edit1.Text := ini.ReadString('RedundancyFinder', 'DefaultDir', ''); |
||
271 | ComboBox1.ItemIndex := ini.ReadInteger('RedundancyFinder', 'DefaultMode', 1)-1; |
||
272 | end; |
||
273 | |||
274 | end. |