Rev 2 | Rev 8 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
2 | daniel-mar | 1 | unit IndexCreatorForm; |
2 | |||
3 | // TODO: vor einem fehler bitte vorher einen löschvorgang durchführen --> geht nicht? |
||
4 | // TODO: berücksichtigen, wenn datei gesperrt. etc, fehler anschauen |
||
5 | // TODO: warum sind in der db mehr einträge als dateien auf der festplatte sind?! |
||
6 | // TODO: Möglichkeit geben, Dateien und Verzeichnisse auszuschließen |
||
7 | // TODO: should we include flags (readonly, invisible, compressed, encrypted)? |
||
8 | // TODO: search+replace tool, wenn man große verschiebungen vorgenommen hat |
||
9 | // update top (100000) files set filename = replace(filename, '\\?\Volume{560e8251-2b6a-4ab7-82fc-d03df4d93538}\', 'EHDD:\') where filename like '%\\?\%'; |
||
10 | // TODO: anzeige, wie viele stunden der prozess schon läuft |
||
11 | // TODO: multithreading |
||
12 | // TODO: diverse tools schreiben, die die datenbank nutzen, z.b. ein tool, das prüft, ob ein verzeichnis vollständig redundant ist |
||
13 | // TODO: Beim Lauf F:\nas\data wurden 1312 Fehler gefunden, aber nicht geloggt! ?! Eine exception im exception handler?! |
||
14 | // => nochmal durchlaufen lassen |
||
15 | // TODO: "Laufwerk" EHDD: soll man auch eingeben dürfen (das ist z.b. wichtig, wenn man Querverknüpfung vom Explorer verwendet) |
||
4 | daniel-mar | 16 | // TODO: validate modus auch ohne prüfsummencheck. nur gucken ob die dateien existieren |
2 | daniel-mar | 17 | |
18 | {$DEFINE VIATHINKSOFT} |
||
19 | |||
20 | interface |
||
21 | |||
22 | uses |
||
23 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
||
24 | Dialogs, StdCtrls, ComCtrls, ExtCtrls, DB, ADODB, Menus; |
||
25 | |||
26 | const |
||
27 | modusUpdate = 0; |
||
28 | modusRecreate = 1; |
||
29 | modusValidation = 2; |
||
30 | |||
31 | type |
||
32 | TfrmIndexCreator = class(TForm) |
||
33 | Button1: TButton; |
||
34 | Label1: TLabel; |
||
35 | LabeledEdit2: TLabeledEdit; |
||
36 | Button2: TButton; |
||
37 | Label2: TLabel; |
||
38 | Label3: TLabel; |
||
39 | Label4: TLabel; |
||
40 | Label5: TLabel; |
||
41 | Label6: TLabel; |
||
42 | Label7: TLabel; |
||
43 | PopupMenu1: TPopupMenu; |
||
44 | Copyuniquepathtoclipboard1: TMenuItem; |
||
45 | Label8: TLabel; |
||
46 | Label9: TLabel; |
||
47 | Label10: TLabel; |
||
48 | Label11: TLabel; |
||
49 | Label12: TLabel; |
||
50 | Label13: TLabel; |
||
51 | Memo1: TMemo; |
||
52 | Button4: TButton; |
||
53 | Label14: TLabel; |
||
54 | cbNoDelete: TCheckBox; |
||
55 | Memo2: TMemo; |
||
56 | cbVerboseLogs: TCheckBox; |
||
57 | cbSimulate: TCheckBox; |
||
58 | rgModus: TRadioGroup; |
||
59 | procedure Button1Click(Sender: TObject); |
||
60 | procedure FormClose(Sender: TObject; var Action: TCloseAction); |
||
61 | procedure Button2Click(Sender: TObject); |
||
62 | procedure FormShow(Sender: TObject); |
||
63 | procedure Copyuniquepathtoclipboard1Click(Sender: TObject); |
||
64 | procedure Button4Click(Sender: TObject); |
||
65 | procedure rgModusClick(Sender: TObject); |
||
66 | private |
||
67 | StopRequest: boolean; |
||
68 | sumsize: int64; |
||
69 | sumfiles: int64; |
||
70 | sumfiles_new: int64; |
||
71 | sumfiles_updated: int64; |
||
72 | sumfiles_error: int64; |
||
73 | sumfiles_deleted: int64; |
||
74 | sumfiles_integrityfail: int64; |
||
75 | function TableName: string; |
||
76 | function conn: TAdoConnection; |
||
77 | procedure Rec(StartDir: string; const FileMask: string); |
||
78 | procedure CheckFile(const originalFileName, uniqueFilename: string); |
||
79 | procedure EnableDisableControls(enabled: boolean); |
||
80 | procedure IndexDrive(initialdir: string); |
||
81 | procedure RedrawStats; |
||
82 | procedure DeleteVanishedFiles(mask: string = ''); |
||
83 | class function DriveGuid(const Letter: char): string; static; |
||
84 | class function uniqueFilename(const filename: string): string; static; |
||
85 | class function VtsSpecial(const filename: string): string; static; |
||
86 | procedure DeleteAllFiles(mask: string = ''); |
||
87 | end; |
||
88 | |||
89 | implementation |
||
90 | |||
91 | {$R *.dfm} |
||
92 | |||
93 | uses |
||
94 | FileCtrl, DateUtils, inifiles, IdHashMessageDigest, idHash, Math, Clipbrd, |
||
95 | StrUtils, AdoConnHelper, MainForm; |
||
96 | |||
97 | const |
||
98 | Win32ImportSuffix = {$IFDEF Unicode}'W'{$ELSE}'A'{$ENDIF}; |
||
99 | |||
100 | function GetVolumeNameForVolumeMountPointA(lpszVolumeMountPoint: PAnsiChar; |
||
101 | lpszVolumeName: PAnsiChar; cchBufferLength: DWORD): BOOL; stdcall; |
||
102 | external 'kernel32.dll'; |
||
103 | function GetVolumeNameForVolumeMountPointW(lpszVolumeMountPoint: PWideChar; |
||
104 | lpszVolumeName: PWideChar; cchBufferLength: DWORD): BOOL; stdcall; |
||
105 | external 'kernel32.dll'; |
||
106 | function GetVolumeNameForVolumeMountPoint(lpszVolumeMountPoint: PChar; |
||
107 | lpszVolumeName: PChar; cchBufferLength: DWORD): BOOL; stdcall; |
||
108 | external 'kernel32.dll' name 'GetVolumeNameForVolumeMountPoint' + |
||
109 | Win32ImportSuffix; |
||
110 | |||
111 | const |
||
112 | ERROR_FIELD_SIZE = 200; |
||
113 | {$IFDEF VIATHINKSOFT} |
||
114 | GUID_EHDD_A = '\\?\Volume{31e044b1-28dc-11e6-9bae-d067e54bf736}\'; |
||
115 | GUID_EHDD_B = '\\?\Volume{560e8251-2b6a-4ab7-82fc-d03df4d93538}\'; |
||
116 | {$ENDIF} |
||
117 | |||
118 | function MD5File(const filename: string): string; |
||
119 | var |
||
120 | IdMD5: TIdHashMessageDigest5; |
||
121 | FS: TFileStream; |
||
122 | begin |
||
123 | IdMD5 := TIdHashMessageDigest5.Create; |
||
124 | FS := TFileStream.Create(filename, fmOpenRead or fmShareDenyWrite); |
||
125 | try |
||
126 | {$IFDEF UNICODE} // I actually do not know at which version of Delphi/Indy, this has changed. |
||
127 | Result := IdMD5.HashStreamAsHex(FS); |
||
128 | {$ELSE} |
||
129 | Result := IdMD5.AsHex(IdMD5.HashValue(FS)); |
||
130 | {$ENDIF} |
||
131 | finally |
||
132 | FS.Free; |
||
133 | IdMD5.Free; |
||
134 | end; |
||
135 | end; |
||
136 | |||
137 | function FileMTime_UTC(const filename: string): TDateTime; |
||
138 | var |
||
139 | fad: TWin32FileAttributeData; |
||
140 | systime: SYSTEMTIME; |
||
141 | begin |
||
142 | if not GetFileAttributesEx(PChar(filename), GetFileExInfoStandard, @fad) then |
||
143 | RaiseLastOSError; |
||
144 | |||
145 | FileTimeToSystemTime(fad.ftLastWriteTime, systime); |
||
146 | |||
147 | Result := SystemTimeToDateTime(systime); |
||
148 | end; |
||
149 | |||
150 | function FileCTime_UTC(const filename: string): TDateTime; |
||
151 | var |
||
152 | fad: TWin32FileAttributeData; |
||
153 | systime: SYSTEMTIME; |
||
154 | begin |
||
155 | if not GetFileAttributesEx(PChar(filename), GetFileExInfoStandard, @fad) then |
||
156 | RaiseLastOSError; |
||
157 | |||
158 | FileTimeToSystemTime(fad.ftCreationTime, systime); |
||
159 | |||
160 | Result := SystemTimeToDateTime(systime); |
||
161 | end; |
||
162 | |||
163 | function UTCTimeToLocalTime(const aValue: TDateTime): TDateTime; |
||
164 | var |
||
165 | lBias: Integer; |
||
166 | lTZI: TTimeZoneInformation; |
||
167 | begin |
||
168 | lBias := 0; |
||
169 | case GetTimeZoneInformation(lTZI) of |
||
170 | TIME_ZONE_ID_UNKNOWN: |
||
171 | lBias := lTZI.Bias; |
||
172 | TIME_ZONE_ID_DAYLIGHT: |
||
173 | lBias := lTZI.Bias + lTZI.DaylightBias; |
||
174 | TIME_ZONE_ID_STANDARD: |
||
175 | lBias := lTZI.Bias + lTZI.StandardBias; |
||
176 | end; |
||
177 | // UTC = local time + bias |
||
178 | // bias is in number of minutes, TDateTime is in days |
||
179 | Result := aValue - (lBias / (24 * 60)); |
||
180 | end; |
||
181 | |||
182 | function GetFileSize(const AFileName: String): int64; |
||
183 | var |
||
184 | lFindData: TWin32FindData; |
||
185 | lHandle: Cardinal; |
||
186 | begin |
||
187 | // https://www.delphipraxis.net/24331-dateigroesse-einer-beliebigen-datei-ermitteln.html |
||
188 | lHandle := FindFirstFile(PChar(AFileName), lFindData); |
||
189 | if (lHandle <> INVALID_HANDLE_VALUE) then |
||
190 | begin |
||
191 | Result := lFindData.nFileSizeLow; |
||
192 | PCardinal(Cardinal(@Result) + SizeOf(Cardinal))^ := lFindData.nFileSizeHigh; |
||
193 | Windows.FindClose(lHandle); |
||
194 | end |
||
195 | else |
||
196 | Result := 0; |
||
197 | end; |
||
198 | |||
199 | function IntToStr2(i: int64): string; |
||
200 | begin |
||
201 | // https://www.delphipraxis.net/150464-integer-mit-tausender-trennzeichen-ausgeben.html |
||
202 | Result := Format('%.0n', [i / 1]); |
||
203 | end; |
||
204 | |||
205 | function ConvertBytes(Bytes: int64): string; |
||
206 | const |
||
207 | Description: Array [0 .. 8] of string = ('Bytes', 'KB', 'MB', 'GB', 'TB', |
||
208 | 'PB', 'EB', 'ZB', 'YB'); |
||
209 | var |
||
210 | i: Integer; |
||
211 | begin |
||
212 | // https://stackoverflow.com/questions/30548940/correct-way-to-convert-size-in-bytes-to-kb-mb-gb-delphi |
||
213 | i := 0; |
||
214 | |||
215 | while Bytes > Power(1024, i + 1) do |
||
216 | Inc(i); |
||
217 | |||
218 | Result := FormatFloat('###0.##', Bytes / IntPower(1024, i)) + ' ' + |
||
219 | Description[i]; |
||
220 | end; |
||
221 | |||
222 | var |
||
223 | DriveGuidCache: TStringList = nil; |
||
224 | |||
225 | class function TfrmIndexCreator.DriveGuid(const Letter: char): string; |
||
226 | var |
||
227 | Buffer: array [0 .. 49] of char; |
||
228 | begin |
||
229 | if not Assigned(DriveGuidCache) then |
||
230 | DriveGuidCache := TStringList.Create; |
||
231 | |||
232 | Result := DriveGuidCache.Values[Letter]; |
||
233 | if Result = '' then |
||
234 | begin |
||
235 | Win32Check(GetVolumeNameForVolumeMountPoint(PChar(Letter + ':\'), Buffer, |
||
236 | Length(Buffer))); |
||
237 | Result := Buffer; |
||
238 | DriveGuidCache.Values[Letter] := Result; |
||
239 | end; |
||
240 | end; |
||
241 | |||
242 | class function TfrmIndexCreator.uniqueFilename(const filename: string): string; |
||
243 | var |
||
244 | guid: string; |
||
245 | begin |
||
246 | if Length(filename) < 2 then |
||
247 | exit; |
||
248 | if filename[2] = ':' then |
||
249 | begin |
||
250 | guid := DriveGuid(filename[1]); |
||
251 | |||
252 | Result := guid + Copy(filename, 4, Length(filename) - 3); |
||
253 | |||
254 | // result := LowerCase(result); |
||
255 | end |
||
256 | else |
||
257 | Result := filename; // z.B. UNC-Pfad |
||
258 | end; |
||
259 | |||
260 | class function TfrmIndexCreator.VtsSpecial(const filename: string): string; |
||
261 | begin |
||
262 | Result := filename; |
||
263 | {$IFDEF VIATHINKSOFT} |
||
264 | Result := StringReplace(Result, GUID_EHDD_A, 'EHDD:\', []); |
||
265 | Result := StringReplace(Result, GUID_EHDD_B, 'EHDD:\', []); |
||
266 | {$ENDIF} |
||
267 | end; |
||
268 | |||
269 | procedure TfrmIndexCreator.CheckFile(const originalFileName, |
||
270 | uniqueFilename: string); |
||
271 | |||
272 | function DateTimeToSQL(dt: TDateTime): string; |
||
273 | begin |
||
274 | if dt = -1 then |
||
275 | Result := 'NULL' |
||
276 | else |
||
277 | Result := conn.SQLStringEscape(DateTimetoStr(dt)); |
||
278 | end; |
||
279 | |||
280 | type |
||
281 | TExistResult = (erDoesNotExist, erHadError, erChanged, erUnchanged); |
||
282 | |||
283 | var |
||
284 | lastCheckedMd5: string; |
||
285 | |||
286 | function Exists(const filename: string; size: int64; |
||
287 | const modified: TDateTime): TExistResult; |
||
288 | var |
||
289 | q: TADODataSet; |
||
290 | begin |
||
291 | q := conn.GetTable('select error, size, modified, md5hash from ' + TableName |
||
292 | + ' where filename = ' + conn.SQLStringEscape |
||
293 | (VtsSpecial(uniqueFilename))); |
||
294 | try |
||
295 | if q.RecordCount = 0 then |
||
296 | Result := erDoesNotExist |
||
297 | else if not q.Fields[0].IsNull then |
||
298 | Result := erHadError |
||
299 | else if (q.Fields[1].AsString <> IntToStr(size)) or |
||
300 | // we are combining strings because of int64 |
||
301 | (SecondsBetween(q.Fields[2].AsDateTime, UTCTimeToLocalTime(modified) |
||
302 | ) > 2) then |
||
303 | begin |
||
304 | Result := erChanged |
||
305 | end |
||
306 | else |
||
307 | Result := erUnchanged; |
||
308 | lastCheckedMd5 := q.Fields[3].AsString; |
||
309 | finally |
||
310 | FreeAndNil(q); |
||
311 | end; |
||
312 | end; |
||
313 | |||
314 | var |
||
315 | created, modified: TDateTime; |
||
316 | size: int64; |
||
317 | md5: string; |
||
318 | begin |
||
319 | Label1.Caption := MinimizeName(originalFileName, Label1.Canvas, Label1.Width); |
||
320 | Application.ProcessMessages; |
||
321 | |||
322 | try |
||
323 | if FileExists(uniqueFilename) then |
||
324 | created := FileCTime_UTC(uniqueFilename) |
||
325 | else |
||
326 | created := -1; |
||
327 | |||
328 | if FileExists(uniqueFilename) then |
||
329 | modified := FileMTime_UTC(uniqueFilename) |
||
330 | else |
||
331 | modified := -1; |
||
332 | |||
333 | size := GetFileSize(uniqueFilename); |
||
334 | Inc(sumsize, size); |
||
335 | Inc(sumfiles); |
||
336 | |||
337 | if rgModus.ItemIndex = modusRecreate then |
||
338 | begin |
||
339 | md5 := MD5File(uniqueFilename); |
||
340 | if not cbSimulate.Checked then |
||
341 | begin |
||
342 | conn.ExecSQL('INSERT INTO ' + TableName + |
||
343 | ' (filename, size, created, modified, md5hash, error) values (' + |
||
344 | conn.SQLStringEscape(VtsSpecial(uniqueFilename)) + ', ' + |
||
345 | IntToStr(size) + ', ' + DateTimeToSQL(UTCTimeToLocalTime(created)) + |
||
346 | ', ' + DateTimeToSQL(UTCTimeToLocalTime(modified)) + ', ' + |
||
347 | conn.SQLStringEscape(LowerCase(md5)) + ', NULL);'); |
||
348 | end; |
||
349 | if cbVerboseLogs.Checked then |
||
350 | Memo2.Lines.Add('New: ' + uniqueFilename); |
||
351 | Inc(sumfiles_new); |
||
352 | end |
||
353 | else |
||
354 | begin |
||
355 | case Exists(uniqueFilename, size, modified) of |
||
356 | erDoesNotExist: // File does not exist or has a different hash |
||
357 | begin |
||
358 | if rgModus.ItemIndex <> modusValidation then |
||
359 | md5 := MD5File(uniqueFilename); |
||
360 | if not cbSimulate.Checked and (rgModus.ItemIndex <> modusValidation) |
||
361 | then |
||
362 | begin |
||
363 | conn.ExecSQL('INSERT INTO ' + TableName + |
||
364 | ' (filename, size, created, modified, md5hash, error) values (' |
||
365 | + conn.SQLStringEscape(VtsSpecial(uniqueFilename)) + ', ' + |
||
366 | IntToStr(size) + ', ' + |
||
367 | DateTimeToSQL(UTCTimeToLocalTime(created)) + ', ' + |
||
368 | DateTimeToSQL(UTCTimeToLocalTime(modified)) + ', ' + |
||
369 | conn.SQLStringEscape(LowerCase(md5)) + ', NULL);'); |
||
370 | end; |
||
371 | if cbVerboseLogs.Checked then |
||
372 | Memo2.Lines.Add('New: ' + uniqueFilename); |
||
373 | Inc(sumfiles_new); |
||
374 | end; |
||
375 | erHadError, erChanged: |
||
376 | begin |
||
377 | if rgModus.ItemIndex <> modusValidation then |
||
378 | md5 := MD5File(uniqueFilename); |
||
379 | if not cbSimulate.Checked and (rgModus.ItemIndex <> modusValidation) |
||
380 | then |
||
381 | begin |
||
382 | conn.ExecSQL('UPDATE ' + TableName + ' SET size = ' + |
||
383 | IntToStr(size) + ', created = ' + |
||
384 | DateTimeToSQL(UTCTimeToLocalTime(created)) + ', modified = ' + |
||
385 | DateTimeToSQL(UTCTimeToLocalTime(modified)) + ', md5hash = ' + |
||
386 | conn.SQLStringEscape(LowerCase(md5)) + |
||
387 | ', error = NULL WHERE filename = ' + conn.SQLStringEscape |
||
388 | (VtsSpecial(uniqueFilename)) + ';'); |
||
389 | end; |
||
390 | if cbVerboseLogs.Checked then |
||
391 | Memo2.Lines.Add('Updated: ' + uniqueFilename); |
||
392 | Inc(sumfiles_updated); |
||
393 | end; |
||
394 | erUnchanged: // Date/Time+Size has not changed |
||
395 | begin |
||
396 | if rgModus.ItemIndex = modusValidation then |
||
397 | begin |
||
398 | md5 := MD5File(uniqueFilename); |
||
399 | if not SameText(md5, lastCheckedMd5) then |
||
400 | begin |
||
401 | Memo2.Lines.Add |
||
402 | ('!!! HASH HAS CHANGED WHILE DATETIME+SIZE IS THE SAME: ' + |
||
403 | uniqueFilename + ' (' + lastCheckedMd5 + ' became ' + |
||
404 | md5 + ')'); |
||
405 | Memo2.Color := clRed; |
||
406 | Inc(sumfiles_integrityfail); |
||
407 | end; |
||
408 | end; |
||
409 | end; |
||
410 | end; |
||
411 | end; |
||
412 | except |
||
413 | on E: Exception do |
||
414 | begin |
||
415 | if E is EAbort then |
||
416 | Abort; |
||
417 | // if AdoConnection1.InTransaction then AdoConnection1.RollbackTrans; |
||
418 | // AdoConnection1.BeginTrans; |
||
419 | try |
||
420 | if not cbSimulate.Checked and (rgModus.ItemIndex <> modusValidation) |
||
421 | then |
||
422 | begin |
||
423 | conn.ExecSQL('DELETE FROM ' + TableName + ' WHERE filename = ' + |
||
424 | conn.SQLStringEscape(VtsSpecial(uniqueFilename)) + ';'); |
||
425 | conn.ExecSQL('INSERT INTO ' + TableName + |
||
426 | ' (filename, size, created, modified, md5hash, error) values (' + |
||
427 | conn.SQLStringEscape(VtsSpecial(uniqueFilename)) + |
||
428 | ', NULL, NULL, NULL, NULL, ' + conn.SQLStringEscape(Copy(E.Message, |
||
429 | 1, ERROR_FIELD_SIZE)) + ');'); |
||
430 | Memo2.Lines.Add('Error (logged): ' + E.Message + ' at file ' + |
||
431 | VtsSpecial(uniqueFilename)); |
||
432 | end |
||
433 | else |
||
434 | begin |
||
435 | Memo2.Lines.Add('Error: ' + E.Message + ' at file ' + |
||
436 | VtsSpecial(uniqueFilename)); |
||
437 | end; |
||
438 | // AdoConnection1.CommitTrans; |
||
439 | except |
||
440 | // AdoConnection1.RollbackTrans; |
||
441 | Memo2.Lines.Add('Cannot write error into file database! ' + E.Message + |
||
442 | ' at file ' + VtsSpecial(uniqueFilename)); |
||
443 | end; |
||
444 | Inc(sumfiles_error); |
||
445 | end; |
||
446 | end; |
||
447 | |||
448 | RedrawStats; |
||
449 | Application.ProcessMessages; |
||
450 | end; |
||
451 | |||
452 | function TfrmIndexCreator.conn: TAdoConnection; |
||
453 | begin |
||
454 | Result := frmMain.AdoConnection1; |
||
455 | end; |
||
456 | |||
457 | procedure TfrmIndexCreator.RedrawStats; |
||
458 | begin |
||
459 | Label5.Caption := ConvertBytes(sumsize); |
||
460 | Label6.Caption := IntToStr2(sumfiles); |
||
461 | Label7.Caption := IntToStr2(sumfiles_new); |
||
462 | Label9.Caption := IntToStr2(sumfiles_updated); |
||
463 | Label11.Caption := IntToStr2(sumfiles_error); |
||
464 | Label12.Caption := IntToStr2(sumfiles_deleted); |
||
465 | // LabelXX.Caption := IntToStr2(sumfiles_integrityfail); |
||
466 | end; |
||
467 | |||
468 | procedure TfrmIndexCreator.Copyuniquepathtoclipboard1Click(Sender: TObject); |
||
469 | var |
||
470 | s: string; |
||
471 | begin |
||
472 | s := uniqueFilename(LabeledEdit2.Text); |
||
473 | Clipboard.AsText := s; |
||
474 | {$IFDEF VIATHINKSOFT} |
||
475 | if VtsSpecial(s) <> s then |
||
476 | begin |
||
477 | s := s + #13#10 + VtsSpecial(s); |
||
478 | end; |
||
479 | {$ENDIF} |
||
480 | ShowMessageFmt('Copied to clipboard:' + #13#10#13#10 + '%s', [s]); |
||
481 | end; |
||
482 | |||
483 | procedure TfrmIndexCreator.rgModusClick(Sender: TObject); |
||
484 | begin |
||
485 | cbSimulate.enabled := rgModus.ItemIndex <> modusValidation; |
||
486 | cbNoDelete.enabled := rgModus.ItemIndex <> modusValidation; |
||
487 | end; |
||
488 | |||
489 | function TfrmIndexCreator.TableName: string; |
||
490 | begin |
||
491 | Result := frmMain.TableName; |
||
492 | end; |
||
493 | |||
494 | procedure TfrmIndexCreator.Rec(StartDir: string; const FileMask: string); |
||
495 | var |
||
496 | SR: TSearchRec; |
||
497 | DirList: TStrings; |
||
498 | IsFound: boolean; |
||
499 | i: Integer; |
||
500 | UniqueStartDir: string; |
||
501 | begin |
||
502 | StartDir := IncludeTrailingPathDelimiter(StartDir); |
||
503 | |||
504 | i := 0; |
||
505 | conn.BeginTrans; |
||
506 | IsFound := FindFirst(StartDir + FileMask, faAnyFile - faDirectory, SR) = 0; |
||
507 | try |
||
508 | while IsFound do |
||
509 | begin |
||
510 | Inc(i); |
||
511 | if i mod 1000 = 0 then // Only for performance |
||
512 | begin |
||
513 | conn.CommitTrans; |
||
514 | conn.BeginTrans; |
||
515 | end; |
||
516 | Application.ProcessMessages; |
||
517 | if Application.Terminated or StopRequest then |
||
518 | Abort; |
||
519 | |||
520 | if UniqueStartDir = '' then |
||
521 | UniqueStartDir := uniqueFilename(StartDir); |
||
522 | CheckFile(StartDir + SR.Name, UniqueStartDir + SR.Name); |
||
523 | IsFound := FindNext(SR) = 0; |
||
524 | end; |
||
525 | finally |
||
526 | FindClose(SR); |
||
527 | conn.CommitTrans; |
||
528 | end; |
||
529 | |||
530 | // Build a list of subdirectories |
||
531 | DirList := TStringList.Create; |
||
532 | try |
||
533 | IsFound := FindFirst(StartDir + '*', faDirectory, SR) = 0; |
||
534 | try |
||
535 | while IsFound do |
||
536 | begin |
||
537 | if (SR.Name <> '.') and (SR.Name <> '..') then |
||
538 | begin |
||
539 | Application.ProcessMessages; |
||
540 | if Application.Terminated or StopRequest then |
||
541 | Abort; |
||
542 | |||
543 | DirList.Add(StartDir + SR.Name); |
||
544 | end; |
||
545 | IsFound := FindNext(SR) = 0; |
||
546 | end; |
||
547 | finally |
||
548 | FindClose(SR); |
||
549 | end; |
||
550 | |||
551 | // Scan the list of subdirectories |
||
552 | for i := 0 to DirList.Count - 1 do |
||
553 | begin |
||
554 | try |
||
555 | Rec(DirList[i], FileMask); |
||
556 | except |
||
557 | on E: Exception do |
||
558 | begin |
||
559 | if E is EAbort then |
||
560 | Abort; |
||
561 | Memo2.Lines.Add('Unexpected error at directory ' + DirList[i] + ': ' + |
||
562 | E.Message); |
||
563 | end; |
||
564 | end; |
||
565 | end; |
||
566 | finally |
||
567 | DirList.Free; |
||
568 | end; |
||
569 | end; |
||
570 | |||
571 | procedure TfrmIndexCreator.DeleteAllFiles(mask: string = ''); |
||
572 | begin |
||
573 | sumfiles_deleted := conn.GetScalar('select count(*) as cnt from ' + TableName |
||
574 | + ' where filename like ' + conn.SQLStringEscape(VtsSpecial(mask))); |
||
575 | RedrawStats; |
||
576 | |||
577 | if not cbSimulate.Checked and (rgModus.ItemIndex <> modusValidation) then |
||
578 | begin |
||
579 | if (mask = '') or (mask = '%') then |
||
580 | conn.ExecSQL('delete from ' + TableName) |
||
581 | else |
||
582 | conn.ExecSQL('delete from ' + TableName + ' where filename like ' + |
||
583 | conn.SQLStringEscape(VtsSpecial(mask))); |
||
584 | end; |
||
585 | end; |
||
586 | |||
587 | procedure TfrmIndexCreator.DeleteVanishedFiles(mask: string = ''); |
||
588 | |||
589 | {$IFDEF VIATHINKSOFT} |
||
590 | var |
||
591 | cacheAconnected: boolean; |
||
592 | cacheBconnected: boolean; |
||
593 | {$ENDIF} |
||
594 | function AllowFileCheck(AFileName: string): boolean; |
||
595 | var |
||
596 | guid: string; |
||
597 | begin |
||
598 | Result := false; |
||
599 | {$IFDEF VIATHINKSOFT} |
||
600 | if StartsText('EHDD:\', AFileName) then |
||
601 | begin |
||
602 | if not cacheAconnected and SysUtils.DirectoryExists(GUID_EHDD_A) then |
||
603 | begin |
||
604 | cacheAconnected := true; |
||
605 | end; |
||
606 | if not cacheBconnected and SysUtils.DirectoryExists(GUID_EHDD_B) then |
||
607 | begin |
||
608 | cacheBconnected := true; |
||
609 | end; |
||
610 | Result := cacheAconnected or cacheBconnected; |
||
611 | end |
||
612 | else |
||
613 | {$ENDIF} |
||
614 | if StartsText('\\?\Volume', AFileName) then |
||
615 | begin |
||
616 | guid := Copy(AFileName, 1, 49); |
||
617 | if EndsText('\', guid) then // should always happen |
||
618 | begin |
||
619 | // TODO: cache this result somehow, so that DirectoryExists() does not need to be called all the time |
||
620 | if SysUtils.DirectoryExists(guid) then // is drive connected/existing? |
||
621 | begin |
||
622 | Result := true; |
||
623 | end; |
||
624 | end; |
||
625 | end |
||
626 | else |
||
627 | begin |
||
628 | // TODO: Einen Code für Netzlaufwerke machen: Wir dürfen nur Dateien löschen, |
||
629 | // wenn das Netzlaufwerk wirklich da ist. |
||
630 | end; |
||
631 | end; |
||
632 | |||
633 | function FileDoesExist(AFileName: string): boolean; |
||
634 | begin |
||
635 | {$IFDEF VIATHINKSOFT} |
||
636 | if StartsText('EHDD:\', AFileName) then |
||
637 | begin |
||
638 | // Attention: AllowFileCheck must be called to initialize cacheAconnected and cacheBconnected |
||
639 | |||
640 | if cacheAconnected and FileExists(StringReplace(AFileName, 'EHDD:\', |
||
641 | GUID_EHDD_A, [])) then |
||
642 | exit(true); |
||
643 | |||
644 | if cacheBconnected and FileExists(StringReplace(AFileName, 'EHDD:\', |
||
645 | GUID_EHDD_B, [])) then |
||
646 | exit(true); |
||
647 | |||
648 | exit(false); |
||
649 | end; |
||
650 | {$ENDIF} |
||
651 | exit(FileExists(AFileName)); |
||
652 | end; |
||
653 | |||
654 | var |
||
655 | filename: string; |
||
656 | q: TADODataSet; |
||
657 | fFileName: TField; |
||
658 | i: int64; |
||
659 | begin |
||
660 | if mask <> '' then |
||
661 | q := conn.GetTable('select filename from ' + TableName + |
||
662 | ' where filename like ' + conn.SQLStringEscape(VtsSpecial(mask))) |
||
663 | else |
||
664 | q := conn.GetTable('select filename from ' + TableName); |
||
665 | try |
||
666 | i := 0; |
||
667 | fFileName := q.FieldByName('filename'); |
||
668 | while not q.Eof do |
||
669 | begin |
||
670 | filename := fFileName.AsString; |
||
671 | |||
672 | if AllowFileCheck(filename) and not FileDoesExist(filename) then |
||
673 | begin |
||
674 | if not cbSimulate.Checked and (rgModus.ItemIndex <> modusValidation) |
||
675 | then |
||
676 | begin |
||
677 | conn.ExecSQL('delete from ' + TableName + ' where filename = ' + |
||
678 | conn.SQLStringEscape(filename)); |
||
679 | end; |
||
680 | Inc(sumfiles_deleted); |
||
681 | if cbVerboseLogs.Checked then |
||
682 | Memo2.Lines.Add('Deleted: ' + filename); |
||
683 | RedrawStats; |
||
684 | end; |
||
685 | |||
686 | Inc(i); |
||
687 | if i mod 100 = 0 then |
||
688 | begin |
||
689 | Label1.Caption := MinimizeName(filename, Label1.Canvas, Label1.Width); |
||
690 | Application.ProcessMessages; |
||
691 | if Application.Terminated or StopRequest then |
||
692 | Abort; |
||
693 | end; |
||
694 | |||
695 | q.Next; |
||
696 | end; |
||
697 | finally |
||
698 | FreeAndNil(q); |
||
699 | end; |
||
700 | end; |
||
701 | |||
702 | procedure TfrmIndexCreator.IndexDrive(initialdir: string); |
||
703 | begin |
||
704 | if not cbNoDelete.Checked and not cbSimulate.Checked and |
||
705 | (rgModus.ItemIndex <> modusValidation) then |
||
706 | begin |
||
707 | if rgModus.ItemIndex = modusRecreate then |
||
708 | begin |
||
709 | DeleteAllFiles(uniqueFilename(IncludeTrailingPathDelimiter |
||
710 | (initialdir)) + '%'); |
||
711 | end |
||
712 | else |
||
713 | begin |
||
714 | DeleteVanishedFiles |
||
715 | (uniqueFilename(IncludeTrailingPathDelimiter(initialdir)) + '%'); |
||
716 | end; |
||
717 | end; |
||
718 | |||
719 | Rec(IncludeTrailingPathDelimiter(initialdir), '*'); |
||
720 | end; |
||
721 | |||
722 | procedure TfrmIndexCreator.Button1Click(Sender: TObject); |
||
723 | begin |
||
724 | sumsize := 0; |
||
725 | sumfiles := 0; |
||
726 | sumfiles_new := 0; |
||
727 | sumfiles_updated := 0; |
||
728 | sumfiles_error := 0; |
||
729 | sumfiles_deleted := 0; |
||
730 | sumfiles_integrityfail := 0; |
||
731 | |||
732 | Label1.Caption := 'Please wait...'; |
||
733 | Label5.Caption := '0'; |
||
734 | Label6.Caption := '0'; |
||
735 | Label7.Caption := '0'; |
||
736 | Label9.Caption := '0'; |
||
737 | Label11.Caption := '0'; |
||
738 | Label12.Caption := '0'; |
||
739 | Application.ProcessMessages; |
||
740 | |||
741 | EnableDisableControls(false); |
||
742 | try |
||
743 | if not SysUtils.DirectoryExists(LabeledEdit2.Text) then |
||
744 | begin |
||
745 | raise Exception.CreateFmt('Directory %s not found.', [LabeledEdit2.Text]); |
||
746 | end; |
||
747 | |||
748 | IndexDrive(LabeledEdit2.Text); |
||
749 | |||
750 | (* |
||
751 | if not Application.Terminated or StopRequest then |
||
752 | begin |
||
753 | ShowMessage('Finished'); |
||
754 | end; |
||
755 | *) |
||
756 | finally |
||
757 | EnableDisableControls(true); |
||
758 | end; |
||
759 | |||
760 | Beep; |
||
761 | Label1.Caption := 'Done.'; |
||
762 | Application.ProcessMessages; |
||
763 | end; |
||
764 | |||
765 | procedure TfrmIndexCreator.FormClose(Sender: TObject; var Action: TCloseAction); |
||
766 | begin |
||
767 | StopRequest := true; |
||
768 | Action := caFree; // TODO: müssen wir warten bis der prozess angehalten ist? |
||
769 | end; |
||
770 | |||
771 | procedure TfrmIndexCreator.FormShow(Sender: TObject); |
||
772 | var |
||
773 | ini: TMemIniFile; |
||
774 | begin |
||
775 | ini := frmMain.ini; |
||
776 | rgModus.ItemIndex := ini.ReadInteger('IndexCreator', 'DefaultMode', modusUpdate); |
||
777 | cbNoDelete.Checked := ini.ReadBool('IndexCreator', 'DefaultCheckVanished', false); |
||
778 | cbVerboseLogs.Checked := ini.ReadBool('IndexCreator', 'DefaultVerboseLogs', false); |
||
779 | cbSimulate.Checked := ini.ReadBool('IndexCreator', 'DefaultSimulate', false); |
||
780 | LabeledEdit2.Text := ini.ReadString('IndexCreator', 'DefaultDir', 'C:\'); |
||
781 | end; |
||
782 | |||
783 | procedure TfrmIndexCreator.Button2Click(Sender: TObject); |
||
784 | begin |
||
785 | StopRequest := true; |
||
786 | Close; |
||
787 | end; |
||
788 | |||
789 | procedure TfrmIndexCreator.Button4Click(Sender: TObject); |
||
790 | var |
||
791 | i: Integer; |
||
792 | s: string; |
||
793 | begin |
||
794 | sumsize := 0; |
||
795 | sumfiles := 0; |
||
796 | sumfiles_new := 0; |
||
797 | sumfiles_updated := 0; |
||
798 | sumfiles_error := 0; |
||
799 | sumfiles_deleted := 0; |
||
800 | |||
801 | Label1.Caption := 'Please wait...'; |
||
802 | Label5.Caption := '0'; |
||
803 | Label6.Caption := '0'; |
||
804 | Label7.Caption := '0'; |
||
805 | Label9.Caption := '0'; |
||
806 | Label11.Caption := '0'; |
||
807 | Label12.Caption := '0'; |
||
808 | Application.ProcessMessages; |
||
809 | |||
810 | EnableDisableControls(false); |
||
811 | try |
||
812 | // if fileexists('tmp') then memo1.lines.LoadFromFile('tmp'); |
||
813 | for i := Memo1.Lines.Count - 1 downto 0 do |
||
814 | begin |
||
815 | s := Memo1.Lines.strings[i]; |
||
816 | if Trim(s) <> '' then |
||
817 | begin |
||
818 | LabeledEdit2.Text := s; |
||
819 | |||
820 | if not SysUtils.DirectoryExists(LabeledEdit2.Text) then |
||
821 | begin |
||
822 | raise Exception.CreateFmt('Directory %s not found.', |
||
823 | [LabeledEdit2.Text]); |
||
824 | end; |
||
825 | |||
826 | IndexDrive(LabeledEdit2.Text); |
||
827 | end; |
||
828 | Memo1.Lines.Delete(i); |
||
829 | // memo1.lines.SaveToFile('tmp'); |
||
830 | end; |
||
831 | |||
832 | (* |
||
833 | if not Application.Terminated or StopRequest then |
||
834 | begin |
||
835 | ShowMessage('Finished'); |
||
836 | end; |
||
837 | *) |
||
838 | finally |
||
839 | EnableDisableControls(true); |
||
840 | end; |
||
841 | |||
842 | Beep; |
||
843 | Label1.Caption := 'Done.'; |
||
844 | Application.ProcessMessages; |
||
845 | end; |
||
846 | |||
847 | procedure TfrmIndexCreator.EnableDisableControls(enabled: boolean); |
||
848 | begin |
||
849 | rgModus.enabled := enabled; |
||
850 | cbNoDelete.enabled := enabled and (rgModus.ItemIndex <> modusValidation); |
||
851 | cbVerboseLogs.enabled := enabled; |
||
852 | cbSimulate.enabled := enabled and (rgModus.ItemIndex <> modusValidation); |
||
853 | Button1.enabled := enabled; |
||
854 | LabeledEdit2.enabled := enabled; |
||
855 | Memo1.enabled := enabled; |
||
856 | Button4.enabled := enabled; |
||
857 | end; |
||
858 | |||
859 | end. |