0,0 → 1,858 |
unit IndexCreatorForm; |
|
// TODO: vor einem fehler bitte vorher einen löschvorgang durchführen --> geht nicht? |
// TODO: berücksichtigen, wenn datei gesperrt. etc, fehler anschauen |
// TODO: warum sind in der db mehr einträge als dateien auf der festplatte sind?! |
// TODO: Möglichkeit geben, Dateien und Verzeichnisse auszuschließen |
// TODO: should we include flags (readonly, invisible, compressed, encrypted)? |
// TODO: search+replace tool, wenn man große verschiebungen vorgenommen hat |
// update top (100000) files set filename = replace(filename, '\\?\Volume{560e8251-2b6a-4ab7-82fc-d03df4d93538}\', 'EHDD:\') where filename like '%\\?\%'; |
// TODO: anzeige, wie viele stunden der prozess schon läuft |
// TODO: multithreading |
// TODO: diverse tools schreiben, die die datenbank nutzen, z.b. ein tool, das prüft, ob ein verzeichnis vollständig redundant ist |
// TODO: Beim Lauf F:\nas\data wurden 1312 Fehler gefunden, aber nicht geloggt! ?! Eine exception im exception handler?! |
// => nochmal durchlaufen lassen |
// TODO: "Laufwerk" EHDD: soll man auch eingeben dürfen (das ist z.b. wichtig, wenn man Querverknüpfung vom Explorer verwendet) |
|
{$DEFINE VIATHINKSOFT} |
|
interface |
|
uses |
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
Dialogs, StdCtrls, ComCtrls, ExtCtrls, DB, ADODB, Menus; |
|
const |
modusUpdate = 0; |
modusRecreate = 1; |
modusValidation = 2; |
|
type |
TfrmIndexCreator = class(TForm) |
Button1: TButton; |
Label1: TLabel; |
LabeledEdit2: TLabeledEdit; |
Button2: TButton; |
Label2: TLabel; |
Label3: TLabel; |
Label4: TLabel; |
Label5: TLabel; |
Label6: TLabel; |
Label7: TLabel; |
PopupMenu1: TPopupMenu; |
Copyuniquepathtoclipboard1: TMenuItem; |
Label8: TLabel; |
Label9: TLabel; |
Label10: TLabel; |
Label11: TLabel; |
Label12: TLabel; |
Label13: TLabel; |
Memo1: TMemo; |
Button4: TButton; |
Label14: TLabel; |
cbNoDelete: TCheckBox; |
Memo2: TMemo; |
cbVerboseLogs: TCheckBox; |
cbSimulate: TCheckBox; |
rgModus: TRadioGroup; |
procedure Button1Click(Sender: TObject); |
procedure FormClose(Sender: TObject; var Action: TCloseAction); |
procedure Button2Click(Sender: TObject); |
procedure FormShow(Sender: TObject); |
procedure Copyuniquepathtoclipboard1Click(Sender: TObject); |
procedure Button4Click(Sender: TObject); |
procedure rgModusClick(Sender: TObject); |
private |
StopRequest: boolean; |
sumsize: int64; |
sumfiles: int64; |
sumfiles_new: int64; |
sumfiles_updated: int64; |
sumfiles_error: int64; |
sumfiles_deleted: int64; |
sumfiles_integrityfail: int64; |
function TableName: string; |
function conn: TAdoConnection; |
procedure Rec(StartDir: string; const FileMask: string); |
procedure CheckFile(const originalFileName, uniqueFilename: string); |
procedure EnableDisableControls(enabled: boolean); |
procedure IndexDrive(initialdir: string); |
procedure RedrawStats; |
procedure DeleteVanishedFiles(mask: string = ''); |
class function DriveGuid(const Letter: char): string; static; |
class function uniqueFilename(const filename: string): string; static; |
class function VtsSpecial(const filename: string): string; static; |
procedure DeleteAllFiles(mask: string = ''); |
end; |
|
implementation |
|
{$R *.dfm} |
|
uses |
FileCtrl, DateUtils, inifiles, IdHashMessageDigest, idHash, Math, Clipbrd, |
StrUtils, AdoConnHelper, MainForm; |
|
const |
Win32ImportSuffix = {$IFDEF Unicode}'W'{$ELSE}'A'{$ENDIF}; |
|
function GetVolumeNameForVolumeMountPointA(lpszVolumeMountPoint: PAnsiChar; |
lpszVolumeName: PAnsiChar; cchBufferLength: DWORD): BOOL; stdcall; |
external 'kernel32.dll'; |
function GetVolumeNameForVolumeMountPointW(lpszVolumeMountPoint: PWideChar; |
lpszVolumeName: PWideChar; cchBufferLength: DWORD): BOOL; stdcall; |
external 'kernel32.dll'; |
function GetVolumeNameForVolumeMountPoint(lpszVolumeMountPoint: PChar; |
lpszVolumeName: PChar; cchBufferLength: DWORD): BOOL; stdcall; |
external 'kernel32.dll' name 'GetVolumeNameForVolumeMountPoint' + |
Win32ImportSuffix; |
|
const |
ERROR_FIELD_SIZE = 200; |
{$IFDEF VIATHINKSOFT} |
GUID_EHDD_A = '\\?\Volume{31e044b1-28dc-11e6-9bae-d067e54bf736}\'; |
GUID_EHDD_B = '\\?\Volume{560e8251-2b6a-4ab7-82fc-d03df4d93538}\'; |
{$ENDIF} |
|
function MD5File(const filename: string): string; |
var |
IdMD5: TIdHashMessageDigest5; |
FS: TFileStream; |
begin |
IdMD5 := TIdHashMessageDigest5.Create; |
FS := TFileStream.Create(filename, fmOpenRead or fmShareDenyWrite); |
try |
{$IFDEF UNICODE} // I actually do not know at which version of Delphi/Indy, this has changed. |
Result := IdMD5.HashStreamAsHex(FS); |
{$ELSE} |
Result := IdMD5.AsHex(IdMD5.HashValue(FS)); |
{$ENDIF} |
finally |
FS.Free; |
IdMD5.Free; |
end; |
end; |
|
function FileMTime_UTC(const filename: string): TDateTime; |
var |
fad: TWin32FileAttributeData; |
systime: SYSTEMTIME; |
begin |
if not GetFileAttributesEx(PChar(filename), GetFileExInfoStandard, @fad) then |
RaiseLastOSError; |
|
FileTimeToSystemTime(fad.ftLastWriteTime, systime); |
|
Result := SystemTimeToDateTime(systime); |
end; |
|
function FileCTime_UTC(const filename: string): TDateTime; |
var |
fad: TWin32FileAttributeData; |
systime: SYSTEMTIME; |
begin |
if not GetFileAttributesEx(PChar(filename), GetFileExInfoStandard, @fad) then |
RaiseLastOSError; |
|
FileTimeToSystemTime(fad.ftCreationTime, systime); |
|
Result := SystemTimeToDateTime(systime); |
end; |
|
function UTCTimeToLocalTime(const aValue: TDateTime): TDateTime; |
var |
lBias: Integer; |
lTZI: TTimeZoneInformation; |
begin |
lBias := 0; |
case GetTimeZoneInformation(lTZI) of |
TIME_ZONE_ID_UNKNOWN: |
lBias := lTZI.Bias; |
TIME_ZONE_ID_DAYLIGHT: |
lBias := lTZI.Bias + lTZI.DaylightBias; |
TIME_ZONE_ID_STANDARD: |
lBias := lTZI.Bias + lTZI.StandardBias; |
end; |
// UTC = local time + bias |
// bias is in number of minutes, TDateTime is in days |
Result := aValue - (lBias / (24 * 60)); |
end; |
|
function GetFileSize(const AFileName: String): int64; |
var |
lFindData: TWin32FindData; |
lHandle: Cardinal; |
begin |
// https://www.delphipraxis.net/24331-dateigroesse-einer-beliebigen-datei-ermitteln.html |
lHandle := FindFirstFile(PChar(AFileName), lFindData); |
if (lHandle <> INVALID_HANDLE_VALUE) then |
begin |
Result := lFindData.nFileSizeLow; |
PCardinal(Cardinal(@Result) + SizeOf(Cardinal))^ := lFindData.nFileSizeHigh; |
Windows.FindClose(lHandle); |
end |
else |
Result := 0; |
end; |
|
function IntToStr2(i: int64): string; |
begin |
// https://www.delphipraxis.net/150464-integer-mit-tausender-trennzeichen-ausgeben.html |
Result := Format('%.0n', [i / 1]); |
end; |
|
function ConvertBytes(Bytes: int64): string; |
const |
Description: Array [0 .. 8] of string = ('Bytes', 'KB', 'MB', 'GB', 'TB', |
'PB', 'EB', 'ZB', 'YB'); |
var |
i: Integer; |
begin |
// https://stackoverflow.com/questions/30548940/correct-way-to-convert-size-in-bytes-to-kb-mb-gb-delphi |
i := 0; |
|
while Bytes > Power(1024, i + 1) do |
Inc(i); |
|
Result := FormatFloat('###0.##', Bytes / IntPower(1024, i)) + ' ' + |
Description[i]; |
end; |
|
var |
DriveGuidCache: TStringList = nil; |
|
class function TfrmIndexCreator.DriveGuid(const Letter: char): string; |
var |
Buffer: array [0 .. 49] of char; |
begin |
if not Assigned(DriveGuidCache) then |
DriveGuidCache := TStringList.Create; |
|
Result := DriveGuidCache.Values[Letter]; |
if Result = '' then |
begin |
Win32Check(GetVolumeNameForVolumeMountPoint(PChar(Letter + ':\'), Buffer, |
Length(Buffer))); |
Result := Buffer; |
DriveGuidCache.Values[Letter] := Result; |
end; |
end; |
|
class function TfrmIndexCreator.uniqueFilename(const filename: string): string; |
var |
guid: string; |
begin |
if Length(filename) < 2 then |
exit; |
if filename[2] = ':' then |
begin |
guid := DriveGuid(filename[1]); |
|
Result := guid + Copy(filename, 4, Length(filename) - 3); |
|
// result := LowerCase(result); |
end |
else |
Result := filename; // z.B. UNC-Pfad |
end; |
|
class function TfrmIndexCreator.VtsSpecial(const filename: string): string; |
begin |
Result := filename; |
{$IFDEF VIATHINKSOFT} |
Result := StringReplace(Result, GUID_EHDD_A, 'EHDD:\', []); |
Result := StringReplace(Result, GUID_EHDD_B, 'EHDD:\', []); |
{$ENDIF} |
end; |
|
procedure TfrmIndexCreator.CheckFile(const originalFileName, |
uniqueFilename: string); |
|
function DateTimeToSQL(dt: TDateTime): string; |
begin |
if dt = -1 then |
Result := 'NULL' |
else |
Result := conn.SQLStringEscape(DateTimetoStr(dt)); |
end; |
|
type |
TExistResult = (erDoesNotExist, erHadError, erChanged, erUnchanged); |
|
var |
lastCheckedMd5: string; |
|
function Exists(const filename: string; size: int64; |
const modified: TDateTime): TExistResult; |
var |
q: TADODataSet; |
begin |
q := conn.GetTable('select error, size, modified, md5hash from ' + TableName |
+ ' where filename = ' + conn.SQLStringEscape |
(VtsSpecial(uniqueFilename))); |
try |
if q.RecordCount = 0 then |
Result := erDoesNotExist |
else if not q.Fields[0].IsNull then |
Result := erHadError |
else if (q.Fields[1].AsString <> IntToStr(size)) or |
// we are combining strings because of int64 |
(SecondsBetween(q.Fields[2].AsDateTime, UTCTimeToLocalTime(modified) |
) > 2) then |
begin |
Result := erChanged |
end |
else |
Result := erUnchanged; |
lastCheckedMd5 := q.Fields[3].AsString; |
finally |
FreeAndNil(q); |
end; |
end; |
|
var |
created, modified: TDateTime; |
size: int64; |
md5: string; |
begin |
Label1.Caption := MinimizeName(originalFileName, Label1.Canvas, Label1.Width); |
Application.ProcessMessages; |
|
try |
if FileExists(uniqueFilename) then |
created := FileCTime_UTC(uniqueFilename) |
else |
created := -1; |
|
if FileExists(uniqueFilename) then |
modified := FileMTime_UTC(uniqueFilename) |
else |
modified := -1; |
|
size := GetFileSize(uniqueFilename); |
Inc(sumsize, size); |
Inc(sumfiles); |
|
if rgModus.ItemIndex = modusRecreate then |
begin |
md5 := MD5File(uniqueFilename); |
if not cbSimulate.Checked then |
begin |
conn.ExecSQL('INSERT INTO ' + TableName + |
' (filename, size, created, modified, md5hash, error) values (' + |
conn.SQLStringEscape(VtsSpecial(uniqueFilename)) + ', ' + |
IntToStr(size) + ', ' + DateTimeToSQL(UTCTimeToLocalTime(created)) + |
', ' + DateTimeToSQL(UTCTimeToLocalTime(modified)) + ', ' + |
conn.SQLStringEscape(LowerCase(md5)) + ', NULL);'); |
end; |
if cbVerboseLogs.Checked then |
Memo2.Lines.Add('New: ' + uniqueFilename); |
Inc(sumfiles_new); |
end |
else |
begin |
case Exists(uniqueFilename, size, modified) of |
erDoesNotExist: // File does not exist or has a different hash |
begin |
if rgModus.ItemIndex <> modusValidation then |
md5 := MD5File(uniqueFilename); |
if not cbSimulate.Checked and (rgModus.ItemIndex <> modusValidation) |
then |
begin |
conn.ExecSQL('INSERT INTO ' + TableName + |
' (filename, size, created, modified, md5hash, error) values (' |
+ conn.SQLStringEscape(VtsSpecial(uniqueFilename)) + ', ' + |
IntToStr(size) + ', ' + |
DateTimeToSQL(UTCTimeToLocalTime(created)) + ', ' + |
DateTimeToSQL(UTCTimeToLocalTime(modified)) + ', ' + |
conn.SQLStringEscape(LowerCase(md5)) + ', NULL);'); |
end; |
if cbVerboseLogs.Checked then |
Memo2.Lines.Add('New: ' + uniqueFilename); |
Inc(sumfiles_new); |
end; |
erHadError, erChanged: |
begin |
if rgModus.ItemIndex <> modusValidation then |
md5 := MD5File(uniqueFilename); |
if not cbSimulate.Checked and (rgModus.ItemIndex <> modusValidation) |
then |
begin |
conn.ExecSQL('UPDATE ' + TableName + ' SET size = ' + |
IntToStr(size) + ', created = ' + |
DateTimeToSQL(UTCTimeToLocalTime(created)) + ', modified = ' + |
DateTimeToSQL(UTCTimeToLocalTime(modified)) + ', md5hash = ' + |
conn.SQLStringEscape(LowerCase(md5)) + |
', error = NULL WHERE filename = ' + conn.SQLStringEscape |
(VtsSpecial(uniqueFilename)) + ';'); |
end; |
if cbVerboseLogs.Checked then |
Memo2.Lines.Add('Updated: ' + uniqueFilename); |
Inc(sumfiles_updated); |
end; |
erUnchanged: // Date/Time+Size has not changed |
begin |
if rgModus.ItemIndex = modusValidation then |
begin |
md5 := MD5File(uniqueFilename); |
if not SameText(md5, lastCheckedMd5) then |
begin |
Memo2.Lines.Add |
('!!! HASH HAS CHANGED WHILE DATETIME+SIZE IS THE SAME: ' + |
uniqueFilename + ' (' + lastCheckedMd5 + ' became ' + |
md5 + ')'); |
Memo2.Color := clRed; |
Inc(sumfiles_integrityfail); |
end; |
end; |
end; |
end; |
end; |
except |
on E: Exception do |
begin |
if E is EAbort then |
Abort; |
// if AdoConnection1.InTransaction then AdoConnection1.RollbackTrans; |
// AdoConnection1.BeginTrans; |
try |
if not cbSimulate.Checked and (rgModus.ItemIndex <> modusValidation) |
then |
begin |
conn.ExecSQL('DELETE FROM ' + TableName + ' WHERE filename = ' + |
conn.SQLStringEscape(VtsSpecial(uniqueFilename)) + ';'); |
conn.ExecSQL('INSERT INTO ' + TableName + |
' (filename, size, created, modified, md5hash, error) values (' + |
conn.SQLStringEscape(VtsSpecial(uniqueFilename)) + |
', NULL, NULL, NULL, NULL, ' + conn.SQLStringEscape(Copy(E.Message, |
1, ERROR_FIELD_SIZE)) + ');'); |
Memo2.Lines.Add('Error (logged): ' + E.Message + ' at file ' + |
VtsSpecial(uniqueFilename)); |
end |
else |
begin |
Memo2.Lines.Add('Error: ' + E.Message + ' at file ' + |
VtsSpecial(uniqueFilename)); |
end; |
// AdoConnection1.CommitTrans; |
except |
// AdoConnection1.RollbackTrans; |
Memo2.Lines.Add('Cannot write error into file database! ' + E.Message + |
' at file ' + VtsSpecial(uniqueFilename)); |
end; |
Inc(sumfiles_error); |
end; |
end; |
|
RedrawStats; |
Application.ProcessMessages; |
end; |
|
function TfrmIndexCreator.conn: TAdoConnection; |
begin |
Result := frmMain.AdoConnection1; |
end; |
|
procedure TfrmIndexCreator.RedrawStats; |
begin |
Label5.Caption := ConvertBytes(sumsize); |
Label6.Caption := IntToStr2(sumfiles); |
Label7.Caption := IntToStr2(sumfiles_new); |
Label9.Caption := IntToStr2(sumfiles_updated); |
Label11.Caption := IntToStr2(sumfiles_error); |
Label12.Caption := IntToStr2(sumfiles_deleted); |
// LabelXX.Caption := IntToStr2(sumfiles_integrityfail); |
end; |
|
procedure TfrmIndexCreator.Copyuniquepathtoclipboard1Click(Sender: TObject); |
var |
s: string; |
begin |
s := uniqueFilename(LabeledEdit2.Text); |
Clipboard.AsText := s; |
{$IFDEF VIATHINKSOFT} |
if VtsSpecial(s) <> s then |
begin |
s := s + #13#10 + VtsSpecial(s); |
end; |
{$ENDIF} |
ShowMessageFmt('Copied to clipboard:' + #13#10#13#10 + '%s', [s]); |
end; |
|
procedure TfrmIndexCreator.rgModusClick(Sender: TObject); |
begin |
cbSimulate.enabled := rgModus.ItemIndex <> modusValidation; |
cbNoDelete.enabled := rgModus.ItemIndex <> modusValidation; |
end; |
|
function TfrmIndexCreator.TableName: string; |
begin |
Result := frmMain.TableName; |
end; |
|
procedure TfrmIndexCreator.Rec(StartDir: string; const FileMask: string); |
var |
SR: TSearchRec; |
DirList: TStrings; |
IsFound: boolean; |
i: Integer; |
UniqueStartDir: string; |
begin |
StartDir := IncludeTrailingPathDelimiter(StartDir); |
|
i := 0; |
conn.BeginTrans; |
IsFound := FindFirst(StartDir + FileMask, faAnyFile - faDirectory, SR) = 0; |
try |
while IsFound do |
begin |
Inc(i); |
if i mod 1000 = 0 then // Only for performance |
begin |
conn.CommitTrans; |
conn.BeginTrans; |
end; |
Application.ProcessMessages; |
if Application.Terminated or StopRequest then |
Abort; |
|
if UniqueStartDir = '' then |
UniqueStartDir := uniqueFilename(StartDir); |
CheckFile(StartDir + SR.Name, UniqueStartDir + SR.Name); |
IsFound := FindNext(SR) = 0; |
end; |
finally |
FindClose(SR); |
conn.CommitTrans; |
end; |
|
// Build a list of subdirectories |
DirList := TStringList.Create; |
try |
IsFound := FindFirst(StartDir + '*', faDirectory, SR) = 0; |
try |
while IsFound do |
begin |
if (SR.Name <> '.') and (SR.Name <> '..') then |
begin |
Application.ProcessMessages; |
if Application.Terminated or StopRequest then |
Abort; |
|
DirList.Add(StartDir + SR.Name); |
end; |
IsFound := FindNext(SR) = 0; |
end; |
finally |
FindClose(SR); |
end; |
|
// Scan the list of subdirectories |
for i := 0 to DirList.Count - 1 do |
begin |
try |
Rec(DirList[i], FileMask); |
except |
on E: Exception do |
begin |
if E is EAbort then |
Abort; |
Memo2.Lines.Add('Unexpected error at directory ' + DirList[i] + ': ' + |
E.Message); |
end; |
end; |
end; |
finally |
DirList.Free; |
end; |
end; |
|
procedure TfrmIndexCreator.DeleteAllFiles(mask: string = ''); |
begin |
sumfiles_deleted := conn.GetScalar('select count(*) as cnt from ' + TableName |
+ ' where filename like ' + conn.SQLStringEscape(VtsSpecial(mask))); |
RedrawStats; |
|
if not cbSimulate.Checked and (rgModus.ItemIndex <> modusValidation) then |
begin |
if (mask = '') or (mask = '%') then |
conn.ExecSQL('delete from ' + TableName) |
else |
conn.ExecSQL('delete from ' + TableName + ' where filename like ' + |
conn.SQLStringEscape(VtsSpecial(mask))); |
end; |
end; |
|
procedure TfrmIndexCreator.DeleteVanishedFiles(mask: string = ''); |
|
{$IFDEF VIATHINKSOFT} |
var |
cacheAconnected: boolean; |
cacheBconnected: boolean; |
{$ENDIF} |
function AllowFileCheck(AFileName: string): boolean; |
var |
guid: string; |
begin |
Result := false; |
{$IFDEF VIATHINKSOFT} |
if StartsText('EHDD:\', AFileName) then |
begin |
if not cacheAconnected and SysUtils.DirectoryExists(GUID_EHDD_A) then |
begin |
cacheAconnected := true; |
end; |
if not cacheBconnected and SysUtils.DirectoryExists(GUID_EHDD_B) then |
begin |
cacheBconnected := true; |
end; |
Result := cacheAconnected or cacheBconnected; |
end |
else |
{$ENDIF} |
if StartsText('\\?\Volume', AFileName) then |
begin |
guid := Copy(AFileName, 1, 49); |
if EndsText('\', guid) then // should always happen |
begin |
// TODO: cache this result somehow, so that DirectoryExists() does not need to be called all the time |
if SysUtils.DirectoryExists(guid) then // is drive connected/existing? |
begin |
Result := true; |
end; |
end; |
end |
else |
begin |
// TODO: Einen Code für Netzlaufwerke machen: Wir dürfen nur Dateien löschen, |
// wenn das Netzlaufwerk wirklich da ist. |
end; |
end; |
|
function FileDoesExist(AFileName: string): boolean; |
begin |
{$IFDEF VIATHINKSOFT} |
if StartsText('EHDD:\', AFileName) then |
begin |
// Attention: AllowFileCheck must be called to initialize cacheAconnected and cacheBconnected |
|
if cacheAconnected and FileExists(StringReplace(AFileName, 'EHDD:\', |
GUID_EHDD_A, [])) then |
exit(true); |
|
if cacheBconnected and FileExists(StringReplace(AFileName, 'EHDD:\', |
GUID_EHDD_B, [])) then |
exit(true); |
|
exit(false); |
end; |
{$ENDIF} |
exit(FileExists(AFileName)); |
end; |
|
var |
filename: string; |
q: TADODataSet; |
fFileName: TField; |
i: int64; |
begin |
if mask <> '' then |
q := conn.GetTable('select filename from ' + TableName + |
' where filename like ' + conn.SQLStringEscape(VtsSpecial(mask))) |
else |
q := conn.GetTable('select filename from ' + TableName); |
try |
i := 0; |
fFileName := q.FieldByName('filename'); |
while not q.Eof do |
begin |
filename := fFileName.AsString; |
|
if AllowFileCheck(filename) and not FileDoesExist(filename) then |
begin |
if not cbSimulate.Checked and (rgModus.ItemIndex <> modusValidation) |
then |
begin |
conn.ExecSQL('delete from ' + TableName + ' where filename = ' + |
conn.SQLStringEscape(filename)); |
end; |
Inc(sumfiles_deleted); |
if cbVerboseLogs.Checked then |
Memo2.Lines.Add('Deleted: ' + filename); |
RedrawStats; |
end; |
|
Inc(i); |
if i mod 100 = 0 then |
begin |
Label1.Caption := MinimizeName(filename, Label1.Canvas, Label1.Width); |
Application.ProcessMessages; |
if Application.Terminated or StopRequest then |
Abort; |
end; |
|
q.Next; |
end; |
finally |
FreeAndNil(q); |
end; |
end; |
|
procedure TfrmIndexCreator.IndexDrive(initialdir: string); |
begin |
if not cbNoDelete.Checked and not cbSimulate.Checked and |
(rgModus.ItemIndex <> modusValidation) then |
begin |
if rgModus.ItemIndex = modusRecreate then |
begin |
DeleteAllFiles(uniqueFilename(IncludeTrailingPathDelimiter |
(initialdir)) + '%'); |
end |
else |
begin |
DeleteVanishedFiles |
(uniqueFilename(IncludeTrailingPathDelimiter(initialdir)) + '%'); |
end; |
end; |
|
Rec(IncludeTrailingPathDelimiter(initialdir), '*'); |
end; |
|
procedure TfrmIndexCreator.Button1Click(Sender: TObject); |
begin |
sumsize := 0; |
sumfiles := 0; |
sumfiles_new := 0; |
sumfiles_updated := 0; |
sumfiles_error := 0; |
sumfiles_deleted := 0; |
sumfiles_integrityfail := 0; |
|
Label1.Caption := 'Please wait...'; |
Label5.Caption := '0'; |
Label6.Caption := '0'; |
Label7.Caption := '0'; |
Label9.Caption := '0'; |
Label11.Caption := '0'; |
Label12.Caption := '0'; |
Application.ProcessMessages; |
|
EnableDisableControls(false); |
try |
if not SysUtils.DirectoryExists(LabeledEdit2.Text) then |
begin |
raise Exception.CreateFmt('Directory %s not found.', [LabeledEdit2.Text]); |
end; |
|
IndexDrive(LabeledEdit2.Text); |
|
(* |
if not Application.Terminated or StopRequest then |
begin |
ShowMessage('Finished'); |
end; |
*) |
finally |
EnableDisableControls(true); |
end; |
|
Beep; |
Label1.Caption := 'Done.'; |
Application.ProcessMessages; |
end; |
|
procedure TfrmIndexCreator.FormClose(Sender: TObject; var Action: TCloseAction); |
begin |
StopRequest := true; |
Action := caFree; // TODO: müssen wir warten bis der prozess angehalten ist? |
end; |
|
procedure TfrmIndexCreator.FormShow(Sender: TObject); |
var |
ini: TMemIniFile; |
begin |
ini := frmMain.ini; |
rgModus.ItemIndex := ini.ReadInteger('IndexCreator', 'DefaultMode', modusUpdate); |
cbNoDelete.Checked := ini.ReadBool('IndexCreator', 'DefaultCheckVanished', false); |
cbVerboseLogs.Checked := ini.ReadBool('IndexCreator', 'DefaultVerboseLogs', false); |
cbSimulate.Checked := ini.ReadBool('IndexCreator', 'DefaultSimulate', false); |
LabeledEdit2.Text := ini.ReadString('IndexCreator', 'DefaultDir', 'C:\'); |
end; |
|
procedure TfrmIndexCreator.Button2Click(Sender: TObject); |
begin |
StopRequest := true; |
Close; |
end; |
|
procedure TfrmIndexCreator.Button4Click(Sender: TObject); |
var |
i: Integer; |
s: string; |
begin |
sumsize := 0; |
sumfiles := 0; |
sumfiles_new := 0; |
sumfiles_updated := 0; |
sumfiles_error := 0; |
sumfiles_deleted := 0; |
|
Label1.Caption := 'Please wait...'; |
Label5.Caption := '0'; |
Label6.Caption := '0'; |
Label7.Caption := '0'; |
Label9.Caption := '0'; |
Label11.Caption := '0'; |
Label12.Caption := '0'; |
Application.ProcessMessages; |
|
EnableDisableControls(false); |
try |
// if fileexists('tmp') then memo1.lines.LoadFromFile('tmp'); |
for i := Memo1.Lines.Count - 1 downto 0 do |
begin |
s := Memo1.Lines.strings[i]; |
if Trim(s) <> '' then |
begin |
LabeledEdit2.Text := s; |
|
if not SysUtils.DirectoryExists(LabeledEdit2.Text) then |
begin |
raise Exception.CreateFmt('Directory %s not found.', |
[LabeledEdit2.Text]); |
end; |
|
IndexDrive(LabeledEdit2.Text); |
end; |
Memo1.Lines.Delete(i); |
// memo1.lines.SaveToFile('tmp'); |
end; |
|
(* |
if not Application.Terminated or StopRequest then |
begin |
ShowMessage('Finished'); |
end; |
*) |
finally |
EnableDisableControls(true); |
end; |
|
Beep; |
Label1.Caption := 'Done.'; |
Application.ProcessMessages; |
end; |
|
procedure TfrmIndexCreator.EnableDisableControls(enabled: boolean); |
begin |
rgModus.enabled := enabled; |
cbNoDelete.enabled := enabled and (rgModus.ItemIndex <> modusValidation); |
cbVerboseLogs.enabled := enabled; |
cbSimulate.enabled := enabled and (rgModus.ItemIndex <> modusValidation); |
Button1.enabled := enabled; |
LabeledEdit2.enabled := enabled; |
Memo1.enabled := enabled; |
Button4.enabled := enabled; |
end; |
|
end. |