Delete Files With progressbar - delphi

I'm trying to make progressbar while deleting files here is my code:
procedure TForm1.Timer1Timer(Sender: TObject);
var
i:Integer;
begin
i:=i+1;
ProgressBar.Max:=DeleteList.Count - i ; //Files = 8192
DeleteFile(GetIniString('List', 'File' + IntToStr(i),'','FileLists.ini'));
ProgressBar.Position:=ProgressBar.Position+1;
end;

Using threads or IFileOperation both involve fairly steep learning curves. Here are a couple of possibilities:
TDirectory method
At Jerry Dodge's prompting I decided to add an example of using TDirectory to
get a list of files and process it in some way, e.g. delete files in the list.
It displays a periodic progress message - see the if i mod 100 = 0 then statement
in the ProcessFiles method. Unfortunately I couldn't find a way to show
a periodic message during the list-building stage because AFAIC TDirectory
doesn't expose the necessary hook to do so.
procedure TForm2.ProcessFileList(FileList : TStringList);
var
i : Integer;
S : String;
begin
for i := 0 to FileList.Count - 1 do begin
// do something with FileList[i], e.g. delete it
S := FileList[i];
DeleteFile(S);
// Display progress
if i mod 100 = 0 then // do something to show progress
Caption := Format('Files processed: %d ', [i]);
// OR, you could use i and FileList.Count to set a trackbar % complete
end;
Caption := Format('Processed: %d files', [FileList.Count]);
end;
procedure TForm2.GetFileList(const Path : String; FileList : TStringList);
var
Files : Types.TStringDynArray;
i : Integer;
begin
Files := TDirectory.GetFiles('C:\Temp');
FileList.BeginUpdate;
try
for i:= 0 to Length(Files) - 1 do
FileList.Add(Files[i]);
finally
FileList.EndUpdate;
end;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
FileList : TStringList;
begin
FileList := TStringList.Create;
try
GetFileList('C:\Temp', FileList);
ProcessFileList(FileList);
Memo1.Lines.Text := FileList.Text;
finally
FileList.Free;
end;
end;
It should be evident that this way of doing it is a lot simpler than using the
traditional, Windows-specific method below, at the expense of loss of some flexibility,
and has the advantage of being cross-platform.
IFileOperation method (Windows-specific)
The Windows API has functionality to retrieve and process a list of files e.g. in a directory and there used to be a trivially-simple-to-use wrapper around this, including a progress animation, in the (antique) v.3 of SysTools library from TurboPower S/Ware, but I'm not sure this wrapper ever made it into the later public domain version. On the face if it, it could also be done using the IFileOperation interface but google has yet to conjure a simple example. Note that an SO answer about this contains the comment "this is a very complex API and you do need to read the documentation carefully".
I attempted to do this myself but soon got out of my depth. Remy Lebeau's answer here to the q I posted when I got stuck shows how to do it, but the TDirectory method above seems vastly easier at my skill level.
Traditional (D7) method (Windows-specific)
In my experience, if you are only looking to process a few hundred thousand files, you should be able to do it, displaying progress as you go, by adding the files to a TStringList and then processing that, with code along the following lines:
procedure GetFileList(const Path : String; Recurse : Boolean; FileList : TStringList);
// Beware that the following code is Windows-specific
var
FileCount : Integer;
procedure GetFilesInner(sPath : String);
var
Path,
AFileName,
Ext: String;
Rec: TSearchRec;
Done: Boolean;
begin
Path := IncludeTrailingBackslash(sPath);
if FindFirst(Path + '*.*', faAnyFile, Rec) = 0 then begin
Done := False;
while not Done do begin
if (Rec.Name <> '.') and (Rec.Name <> '..') then begin
AFileName := Path + Rec.Name;
Ext := LowerCase(ExtractFileExt(AFileName));
if not ((Rec.Attr and faDirectory) = faDirectory) then begin
inc(FileCount);
if FileCount mod 100 = 0 then
//show progress in GUI
;
FileList.Add(AFileName)
end
else begin
if Recurse then
GetFilesInner(AFileName);
end;
end;
Done := FindNext(Rec) <> 0;
end;
FindClose(Rec);
end;
end;
begin
FileCount := 0;
FileList.BeginUpdate;
FileList.Sorted := True;
FileList.Duplicates := dupIgnore; // don't add duplicate filenames to the list
GetFilesInner(Path);
FileList.EndUpdate;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
FileList : TStringList;
FileName : String;
i : Integer;
begin
FileList := TStringList.Create;
try
GetFileList('d:\aaad7', True, FileList);
for i := 0 to FileList.Count - 1 do begin
FileName := FileList[i];
// do something with FileName, e.g. delete the file
if i mod 100 = 0 then
// display progess e.g. by
Caption := IntToStr(i);
end;
Memo1.Lines := FileList;
finally
FileList.Free;
end;
end;
The if [...] mod [...] = 0 then statements are where you can show the two phases' progress howver you want.
Btw, this code was olny intended to get you started. I'm obliged to Jerry Dodge for reminding me that in recent versions of Delphi, there is similar functionality built-in, by way of the TDirectory.GetFiles method so if you are interested in cross-platform and/or accommodate Unicode, you would do better to study the ins and outs of TDirectory and non-Windows-specific routines like TrailingPathDelim.

When you really want to show some progress in a UI when deleting files, you should use threads:
create a thread, which deletes the files
then poll the progress of the deletion thread from the UI
Be careful when using threads, not to access UI parts (like the progressbar) from within the deletion thread. Such things should at least be synchronized.

Related

How do I populate a Treeview via FTP

Scenario
I'm trying to duplicate the standard way to fill a Treeview with directories/folders from a folder structure, starting at the root, but using IdFTP to get the structure from a remote server instead of my local hard drive. I'd like the result to look similar to clients like Filezilla.
I used this reasonably standard code from the Swiss Delphi Centre (which works to display my hard drive's structure) and then modified it to use IdFTP.ChangeDir(Directory) and IdFTP.List instead of FindFirst() and FindNext().
Problem
I seem to have got myself in a muddle as it is not correctly 'unwinding' the recursion so that once it traverses down the /cpanel/cashes/config directories on the remote server it doesn't return and traverse all the other directories hanging off the root but exits the procedure without displaying anything else. Also it doesn't seem to show all the top level folders but this could be simply due to the order that IdFTP.List returns them in
Can anyone tell me what I have done wrong here?
If you can also tell me how I should get the root (/) shown as well that would be very helpful
(I've commented out displaying non directories as I only want folders at this stage)
What I expected to see Copied from Filezilla
What I did see Using a Ttreeview in Delphi
My Code
procedure TForm2.Button1Click(Sender: TObject);
var StartingDir : string;
begin
TreeView1.Items.BeginUpdate;
try
StartingDir := '/';
Screen.Cursor := crHourGlass;
TreeView1.Items.Clear;
FTPconnect; //procedure to connect to remote server
GetDirectories(TreeView1, StartingDir, nil, True);
FTPDisconnect; //procedure to disconnect from remote server
finally
TreeView1.Items.EndUpdate;
Screen.Cursor := crDefault;
end;
end;
procedure TForm2.GetDirectories(Tree: TTreeView; Directory: string; Item: TTreeNode; IncludeFiles: Boolean);
var
ItemTemp: TTreeNode;
DirItemType : TIdDirItemType ;
Filename , NewStartingDirectory: string;
i : Integer;
begin
Tree.Items.BeginUpdate;
IdFTP.ChangeDir(Directory);
IdFTP.List; //get directory of remote folder
i:=0;
repeat
DirItemType := IdFTP.DirectoryListing[I].ItemType;
Filename := IdFTP.DirectoryListing[I].FileName;
If (DirItemType = ditDirectory) and (Filename <> '.') and (Filename <> '..')then
begin
if DirItemType = ditDirectory then
Item := Tree.Items.AddChild(Item, Filename);
ItemTemp := Item.Parent;
if Directory = '/' then
NewStartingDirectory := Directory + Filename
else
NewStartingDirectory := Directory + '/' +Filename;
GetDirectories(Tree, NewStartingDirectory, Item, IncludeFiles);
Item := ItemTemp;
end
else
if IncludeFiles then
begin //this bit commented out as we only want to see directories
// if (Filename <> '.') and (Filename <> '..') then
// Tree.Items.AddChild(Item, Filename);
end;
inc(i);
until i = IdFTP.DirectoryListing.Count;
Tree.Items.EndUpdate;
end;
Swiss Delhpi Centre's code (for comparison)
procedure TForm1.Button1Click(Sender: TObject);
var
Node: TTreeNode;
Path: string;
Dir: string;
begin
Dir := 'c:\temp';
Screen.Cursor := crHourGlass;
TreeView1.Items.BeginUpdate;
try
TreeView1.Items.Clear;
GetDirectories(TreeView1, Dir, nil, True);
finally
Screen.Cursor := crDefault;
TreeView1.Items.EndUpdate;
end;
end;
procedure TForm1.GetDirectories(Tree: TTreeView; Directory: string; Item: TTreeNode; IncludeFiles: Boolean);
var
SearchRec: TSearchRec;
ItemTemp: TTreeNode;
begin
Tree.Items.BeginUpdate;
if Directory[Length(Directory)] <> '\' then Directory := Directory + '\';
if FindFirst(Directory + '*.*', faDirectory, SearchRec) = 0 then
begin
repeat
if (SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name[1] <> '.') then
begin
if (SearchRec.Attr and faDirectory > 0) then
Item := Tree.Items.AddChild(Item, SearchRec.Name);
ItemTemp := Item.Parent;
GetDirectories(Tree, Directory + SearchRec.Name, Item, IncludeFiles);
Item := ItemTemp;
end
else if IncludeFiles then
if SearchRec.Name[1] <> '.' then
Tree.Items.AddChild(Item, SearchRec.Name);
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
Tree.Items.EndUpdate;
end;
I've looked on SO here - too complicated and wrong language and here - similar to the Swiss Delphi Centre and here - wrong language and not sure what its doing.
if it's better to use a TlistView, can you please show me the equivalent code to use that instead?
Untested:
I made the TIdFTP variable a parameter, since TTreeView was also one and it should be done consistently, not archaic.
Using for loops instead of repeat until.
Eliminating IncludeFiles when it wasn't used anyway.
Eliminating weird logic to always get the new TreeNode's parent.
Not locking the TreeView anymore - do this once before calling this method and unlock it after calling - otherwise you do that dozens of times in vain.
Basic logic is as I wrote in the comments:
Store all folder strings into your own list and avoid recursion at this point.
Fix the path to be concatenated once, not with every iteration of a loop.
Go through that list to do the recursion - at this point the state of FTP is irrelevant and you won't mess up listings at different levels.
Of course, release the created instance of the StringList.
procedure TForm2.GetFolders
( Ftp: TIdFTP // The source, from which we read the content
; Tree: TTreeView // The destination, which we want to fill
; ParentNode: TTreeNode // Node under which all new child nodes should be created
; Path: String // Starting directory
);
var
NewNode: TTreeNode; // New child in the tree
Filename: String; // Check against unwanted folder entries
i: Integer; // Looping over both lists
sl: TStringList; // Collect folders only
begin
FTP.ChangeDir( Path );
FTP.List; // Entire remote listing
sl:= TStringList.Create; // Collect all entries we're interested in
try
for i:= 0 to FTP.DirectoryListing.Count- 1 do begin // For each entry
Filename:= FTP.DirectoryListing[i].FileName;
if (FTP.DirectoryListing[i].ItemType= ditDirectory) // Only folders
and (Filename<> '.')
and (Filename<> '..') then begin
sl.Add( Filename ); // Only the name, not the full path
end;
end;
// Do this only once
if Path<> '/' then Path:= '/'+ Path+ '/';
for i:= 0 to sl.Count- 1 do begin // All collected folders
NewNode:= Tree.Items.AddChild( ParentNode, sl[i] ); // Populate tree
GetFolders( Ftp, Tree, NewNode, Path+ sl[i] ); // Recursion of folder name + current path
end;
finally
sl.Free;
end;
end;
Untested, but should compile.

TClientDataSet And Deleting Files In A Collection

I have an experimental app that I am developing that adds image filenames to a collection. I am attempting to find the most efficient way to delete all the files in a collection except
for files that exist in another collection. Files can exist in any collection.
I have a TClientDataSet with the following fields:
ClientDataSet1.FieldDefs.Add('Index', ftInteger);
ClientDataSet1.FieldDefs.Add('Collection', ftString, 50);
ClientDataSet1.FieldDefs.Add('Filename', ftString, 254);
I came up with this which seems to work but seems inefficient:
var
i: Integer;
j: Integer;
iCollectionToDelete: string;
iCollection: string;
iFilename: string;
iFilenameInOtherCollection: string;
iFilesInOtherCollectionsStringList: TStringList;
begin
iCollectionToDelete := ListBox1.Items[ListBox1.ItemIndex];
{ Set filtered to false to see all the records in the database }
ClientDataSet1.Filtered := False;
{ Create a list of files not in the collection to be deleted }
iFilesInOtherCollectionsStringList := TStringList.Create;
try
for i := 0 to ClientDataSet1.RecordCount - 1 do
begin
iCollection := ClientDataSet1.FieldByName('Collection').AsString;
iFilename := ClientDataSet1.FieldByName('Filename').AsString;
if iCollection <> iCollectionToDelete then
begin
iFilenameInOtherCollection := ClientDataSet1.FieldByName('Filename').AsString;
iFilesInOtherCollectionsStringList.Add(iFilename);
end;
ClientDataSet1.Next;
end;
{ Compare the iFilenameInOtherCollection with all the filenames in the
dataset and if the iFilename is not in the other collection then
erase the file }
ClientDataSet1.First;
for i := 0 to ClientDataSet1.RecordCount - 1 do
begin
iFilename := ClientDataSet1.FieldByName('Filename').AsString;
ClientDataSet1.Next;
for j := 0 to iFilesInOtherCollectionsStringList.Count - 1 do
begin
iFilenameInOtherCollection := iFilesInOtherCollectionsStringList[j];
if iFilesInOtherCollectionsStringList.IndexOf(iFilename) = -1 then
if FileExists(iFilename) then
WindowsErase(handle, iFilename, False, False, False, False);
end;
end;
finally
iFilesInOtherCollectionsStringList.Free;
end;
end;
My question is can this be made more efficient or is there a way to do the same thing
using just TClientDataset methods?
Just for amusement, I thought I'd try doing this without using Stringlists at all, and instead use a couple of features of ClientDataSets, namely Filtering and the ability to copy data from one CDS to another in a single statement. It's quite a bit shorter than using stringlists and probably easier to maintain/modify/refactor as a result.
I've not benchmarked it against the Stringlist version but would be surprised if it were any faster,
because it depends on TClientDataSet.Locate, which is not a particularly efficient operation even when working against an indexed field.
The code is below. Hopefully the comments will explain how it works.
procedure TForm1.SetUp;
begin
ClientDataSet1.FieldDefs.Add('Index', ftInteger);
ClientDataSet1.FieldDefs.Add('Collection', ftString, 50);
ClientDataSet1.FieldDefs.Add('Filename', ftString, 254);
ClientDataSet1.CreateDataSet;
// Create some test data
ClientDataSet1.InsertRecord([1, 'C1', 'F1']);
ClientDataSet1.InsertRecord([2, 'C2', 'F1']);
ClientDataSet1.InsertRecord([3, 'C3', 'F1']);
ClientDataSet1.InsertRecord([4, 'C1', 'F2']);
ClientDataSet1.InsertRecord([5, 'C3', 'F3']);
end;
procedure Tform1.ApplyCDSFilter(CDS : TClientDataSet; FilterExpr : String);
// utility routine to filter/unfilter a dataset
begin
CDS.Filtered := False;
CDS.Filter := FilterExpr;
if FilterExpr <> '' then
CDS.Filtered := True;
end;
procedure TForm1.RemoveFilesOnlyInCollection(CollectionName : String);
var
CDS : TClientDataSet;
FilterExpr : String;
AFileName : String;
begin
// In the following, I'm just going to add the names of the files which belong to the
// specified collection as well as to another one
// to a listbox so as to be able to check the results by inspection
Listbox1.Items.Clear;
// next create a temporary CDS
CDS := TClientDataSet.Create(Nil);
// Index it by Filename
CDS.IndexFieldNames := 'Filename';
// Copy the data from ClientDataSet1 into it
CDS.Data := ClientDataSet1.Data;
// Construct a filter expression to select the collection whose members are to be
// retained. NOTE : the QuotedStr is to handle quotes embedded in the collection name.
FilterExpr := '(Collection =' + QuotedStr(CollectionName) + ')';
// Apply the filter to ClientDataSet1, so that only records that contain the CollectionName
// are "visible", temporarily
ApplyCDSFilter(ClientDataSet1, FilterExpr);
// Next, negate the filter expression and apply it to the temporary CDS
FilterExpr := 'not ' + FilterExpr;
ApplyCDSFilter(CDS, FilterExpr);
// Now, we can loop through ClientDataSet1 and test whether the Filename is present
// in the temporary CDS. If it is, that means that the Filename belongs to another
// collection too.
try
ClientDataSet1.DisableControls;
ClientDataSet1.First;
while not ClientDataSet1.Eof do begin
AFileName := ClientDataSet1.FieldByName('Filename').AsString;
if not CDS.Locate('Filename', AFileName, [loCaseInsensitive]) then
Listbox1.Items.Add(AFileName);
ClientDataSet1.Next;
end;
finally
CDS.Free;
ClientDataSet1.EnableControls;
ApplyCDSFilter(ClientDataSet1, '');
end;
end;
Just add iFilesInOtherCollectionsStringList.Sorted := True after you fill it. IndexOf will then use fast binary search instead of extremely slow one-by-one looping. Probably that will be enough for your purposes.
Another option is to prepare list-to-delete first and then launch a worker thread which will execute removal in the background. This will likely help because usually file operations much more slow than memory comparisons. You may check if it is the deletion that slows down your process by commenting out the WindowsErase line.

Save Dbgrid Column Width Values to Ini and Reread them

I have Inherited form and a Ehlib dbgrid on it for selecting-listing records... The form is ready made for a lot of buttons and im using this form with different queries.
Like this...
If Dm.QrTmp.Active then Dm.QrTmp.Active:=False;
Dm.QrTmp.SQL.Clear;
Dm.QrTmp.SQL.Add(' SELECT ');
Dm.QrTmp.SQL.Add(' ch.cari_RECno AS KayitNo ');
Dm.QrTmp.SQL.Add(' FROM CARI_HESAPLAR ch ');
if FrmTmp=nil then FrmTmp:=TFrmTmp.Create(Self);
FrmTmp.StatusBar.Hide;
Dm.QrTmp.Open;
FrmTmp.DbGrid.DataSource:=Dm.DsQrTmp;
This query is cutted down but i have of course use a lot of fields. And Queries changes alot of time in the application.
The problem is column width. Manager wants to set column widths and restore them again. Actually my grid component supports save - restore column properties but as you can see my usage i m not using static columns. also i dont want to use xgrid.columns[0].width percent by percent.
Im using a ini in may app.
I want to add new section on it and named "Gridwidth"...
[Gridname]
Colwidths=x,y,z (where they are width values)
I'm now coding this line by line.
My write procedure is like this.
With dbgridx do
begin
For i:=0 to columns.count-1
begin
widthstr:=widthstr+Column[i].width+',';
end;
end;
Widthstr will be "15,23,45,67" etc...
But i want to know if this is good solution and if somebody know a better way and has some good code.
This should do it:
uses
IniFiles;
const
SETTINGS_FILE = 'Edijus\Settings.ini';
procedure TForm1.LoadDBGridColumnsWidth(const ADBGrid: TDBGrid);
var
_MemIniU: TMemIniFile;
_SettingsPath: string;
i, j: integer;
_ParentClass: TWinControl;
begin
_SettingsPath := GetHomePath + PathDelim + SETTINGS_FILE;
if (not Assigned(ADBGrid)) or (not Assigned(ADBGrid.DataSource)) or
(not Assigned(ADBGrid.DataSource.DataSet)) then
Exit;
_MemIniU := TMemIniFile.Create(_SettingsPath, TEncoding.UTF8);
try
_ParentClass := ADBGrid.Parent;
while not(_ParentClass is TForm) do
_ParentClass := _ParentClass.Parent;
for i := 0 to Pred(ADBGrid.DataSource.DataSet.Fields.Count) do
for j := 0 to Pred(ADBGrid.Columns.Count) do
begin
if (ADBGrid.DataSource.DataSet.Fields[i].FieldName = ADBGrid.Columns[j]
.FieldName) then
ADBGrid.Columns[j].Width :=
_MemIniU.ReadInteger(_ParentClass.Name + '_' + ADBGrid.Name,
ADBGrid.Columns[j].FieldName, 64);
end;
finally
FreeAndNil(_MemIniU);
end;
end;
procedure TForm1.SaveDBGridColumnsWidth(const ADBGrid: TDBGrid);
var
_MemIniU: TMemIniFile;
_SettingsPath: string;
i: integer;
_ParentClass: TWinControl;
begin
_SettingsPath := GetHomePath + PathDelim + SETTINGS_FILE;
if (not Assigned(ADBGrid)) or
(not ForceDirectories(ExtractFilePath(_SettingsPath))) then
Exit;
_MemIniU := TMemIniFile.Create(_SettingsPath, TEncoding.UTF8);
try
_ParentClass := ADBGrid.Parent;
while not(_ParentClass is TForm) do
_ParentClass := _ParentClass.Parent;
for i := 0 to Pred(ADBGrid.Columns.Count) do
if (ADBGrid.Columns[i].FieldName <> '') then
_MemIniU.WriteInteger(_ParentClass.Name + '_' + ADBGrid.Name,
ADBGrid.Columns[i].FieldName, ADBGrid.Columns[i].Width);
_MemIniU.UpdateFile;
finally
FreeAndNil(_MemIniU);
end;
end;

Delete Directory with non empty subdirectory and files

How to delete one directory having some files and some non empty sub directory.
I have tried SHFileOperation Function. It has some compatibility issue in Windows 7.
Then I have tried IFileOperation Interface. But it is not compatible in Windows XP.
Then I have tried the following codes as suggested by David Heffernan :
procedure TMainForm.BitBtn01Click(Sender: TObject);
var
FileAndDirectoryExist: TSearchRec;
ResourceSavingPath : string;
begin
ResourceSavingPath := (GetWinDir) + 'Web\Wallpaper\';
if FindFirst(ResourceSavingPath + '\*', faAnyFile, FileAndDirectoryExist) = 0 then
try
repeat
if (FileAndDirectoryExist.Name <> '.') and (FileAndDirectoryExist.Name <> '..') then
if (FileAndDirectoryExist.Attr and faDirectory) <> 0 then
//it's a directory, empty it
ClearFolder(ResourceSavingPath +'\' + FileAndDirectoryExist.Name, mask, recursive)
else
//it's a file, delete it
DeleteFile(ResourceSavingPath + '\' + FileAndDirectoryExist.Name);
until FindNext(FileAndDirectoryExist) <> 0;
//now that this directory is empty, we can delete it
RemoveDir(ResourceSavingPath);
finally
FindClose(FileAndDirectoryExist);
end;
end;
But it does not get compiled mentioning error as Undeclared Identifier at ClearFolder, mask and recursive. My requirement is to that "If any sub folder exist under WALLPAPER folder it will be deleted". The same sub folder may contain any number of non empty sub folder or files.
Well, for starters, SHFileOperation has no compatibility issues on Windows 7 or Windows 8. Yes, you are now recommended to use IFileOperation instead. But if you want to support older operating systems like XP, then you can and should just call SHFileOperation. It works and will continue to work. It's pefectly fine to use it on Windows 7 and Windows 8 and I'll eat my hat if it's ever removed from Windows. Microsoft go to extraordinary lengths to maintain backwards compatibility. So, SHFileOperation is your best option in my view.
Your FindFirst based approach fails because you need to put it in a separate function in order to allow recursion. And the code I posted in that other answer is incomplete. Here is a complete version:
procedure DeleteDirectory(const Name: string);
var
F: TSearchRec;
begin
if FindFirst(Name + '\*', faAnyFile, F) = 0 then begin
try
repeat
if (F.Attr and faDirectory <> 0) then begin
if (F.Name <> '.') and (F.Name <> '..') then begin
DeleteDirectory(Name + '\' + F.Name);
end;
end else begin
DeleteFile(Name + '\' + F.Name);
end;
until FindNext(F) <> 0;
finally
FindClose(F);
end;
RemoveDir(Name);
end;
end;
This deletes a directory and its contents. You'd want to walk the top level directory and then call this function for each subdirectory that you found.
Finally I have implemented the following Code:
uses
ShellAPI;
...
...
function GetWinDir: string;
var
WindowsDirectory: array[0..MAX_PATH] of Char;
begin
GetWindowsDirectory(WindowsDirectory, MAX_PATH - 1);
SetLength(Result, StrLen(WindowsDirectory));
Result := IncludeTrailingPathDelimiter(WindowsDirectory);
end;
...
...
procedure DeleteDirectory(const DirName: string);
var
FileFolderOperation: TSHFileOpStruct;
begin
FillChar(FileFolderOperation, SizeOf(FileFolderOperation), 0);
FileFolderOperation.wFunc := FO_DELETE;
FileFolderOperation.pFrom := PChar(ExcludeTrailingPathDelimiter(DirName) + #0);
FileFolderOperation.fFlags := FOF_SILENT or FOF_NOERRORUI or FOF_NOCONFIRMATION;
SHFileOperation(FileFolderOperation);
end;
...
...
procedure TMainForm.BitBtn01Click(Sender: TObject);
begin
DeleteDirectory((GetWinDir) + '\Web\Wallpapers\');
end
...
...
Please don't mention anything regarding 'TrailingPathDelimiter', I have intentionally implemented. I works successfully having one problem that the files or folder successfully deleted without going to 'Recycle Bin' in case of Windows XP, but in case of Vista and higher those files goes to 'Recycle Bin' and I don't have any option for directly deletion without sending to 'Recycle Bin' in case of Vista or Higher.
This is a pretty complete function that works both with files and folders.
It allows you to specify the following parameters:
DeleteToRecycle
ShowConfirm
TotalSilence
{---------------------------------------------------------------
DELETE FILE
Deletes a file/folder to RecycleBin.
----------------------------------------------------------------}
function RecycleItem(CONST ItemName: string; CONST DeleteToRecycle: Boolean= TRUE; CONST ShowConfirm: Boolean= TRUE; CONST TotalSilence: Boolean= FALSE): Boolean;
VAR
SHFileOpStruct: TSHFileOpStruct;
begin
FillChar(SHFileOpStruct, SizeOf(SHFileOpStruct), #0);
SHFileOpStruct.wnd := Application.MainForm.Handle; { Others are using 0. But Application.MainForm.Handle is better because otherwise, the 'Are you sure you want to delete' will be hidden under program's window }
SHFileOpStruct.wFunc := FO_DELETE;
SHFileOpStruct.pFrom := PChar(ItemName+ #0);
SHFileOpStruct.pTo := NIL;
SHFileOpStruct.hNameMappings := NIL;
if DeleteToRecycle
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_ALLOWUNDO;
if TotalSilence
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_NO_UI
else
if NOT ShowConfirm
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_NOCONFIRMATION;
Result:= SHFileOperation(SHFileOpStruct)= 0;
end;

How to Search a File through all the SubDirectories in Delphi

I have implemented this code in Delphi, it will search for the File or the name given but it omits searching all the subdirectories. How can this be done?
Code:
if FindFirst(filePath,faAnyFile,searchResult)=0 then
try
repeat
lbSearchResult.Items.Append(searchResult.Name);
until FindNext(searchResult)<>0
except
on e:Exception do
ShowMessage(e.Message);
end; //try ends
FindClose(searchResult);
With Delphi XE and up, you can have a look at IOUtils.pas:
TDirectory.GetFiles('C:\', '*.dll', TSearchOption.soAllDirectories);
If you don't need threading, the simplest way is this:
procedure TForm1.AddAllFilesInDir(const Dir: string);
var
SR: TSearchRec;
begin
if FindFirst(IncludeTrailingBackslash(Dir) + '*.*', faAnyFile or faDirectory, SR) = 0 then
try
repeat
if (SR.Attr and faDirectory) = 0 then
ListBox1.Items.Add(SR.Name)
else if (SR.Name <> '.') and (SR.Name <> '..') then
AddAllFilesInDir(IncludeTrailingBackslash(Dir) + SR.Name); // recursive call!
until FindNext(Sr) <> 0;
finally
FindClose(SR);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.BeginUpdate;
AddAllFilesInDir('C:\Users\Andreas Rejbrand\Documents\Aweb');
ListBox1.Items.EndUpdate;
end;
The simplest way is:
uses
DSiWin32;
DSiEnumFilesToStringList('c:\somefolder\file.name', 0, ListBox1.Items, true, true);
DSiWin32 is a free Delphi library.
When i need to do trickslike override protected methods i tend to use a generic solution to the problem... i do a hack to the class.
Here is how to do it with TDirectoryListbox.
On every Form you need to use this hacked TDirectoryListbox just add unitTDirectoryListbox_WithHiddenAndSystemFolders to interface uses, that way the form will use the hacked TDirectoryListbox.
Create a file called unitTDirectoryListbox_WithHiddenAndSystemFolders.pas on your proyect folder.
Put this text inside that file (i will explain later what i have done):
unit unitTDirectoryListbox_WithHiddenAndSystemFolders;
interface
uses
Windows
,SysUtils
,Classes
,FileCtrl
;
type TDirectoryListbox=class(FileCtrl.TDirectoryListbox)
private
FPreserveCase:Boolean;
FCaseSensitive:Boolean;
protected
function ReadDirectoryNames(const ParentDirectory:String;DirectoryList:TStringList):Integer;
procedure BuildList;override;
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
property PreserveCase:Boolean read FPreserveCase;
property CaseSensitive:Boolean read FCaseSensitive;
end;
implementation
constructor TDirectoryListbox.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
end;
destructor TDirectoryListbox.Destroy;
begin
inherited Destroy;
end;
function TDirectoryListbox.ReadDirectoryNames(const ParentDirectory:String;DirectoryList:TStringList):Integer;
var
TheCount,Status:Integer;
SearchRec:TSearchRec;
begin
TheCount:=0;
Status:=FindFirst(IncludeTrailingPathDelimiter(ParentDirectory)+'*.*',faDirectory or faHidden or faSysFile,SearchRec);
try
while 0=Status
do begin
if faDirectory=(faDirectory and SearchRec.Attr)
then begin
if ('.'<>SearchRec.Name)
and
('..'<>SearchRec.Name)
then begin
DirectoryList.Add(SearchRec.Name);
Inc(TheCount);
end;
end;
Status:=FindNext(SearchRec);
end;
finally
FindClose(SearchRec);
end;
ReadDirectoryNames:=TheCount;
end;
procedure TDirectoryListBox.BuildList;
var
TempPath: string;
DirName: string;
IndentLevel, BackSlashPos: Integer;
VolFlags: DWORD;
I: Integer;
Siblings: TStringList;
NewSelect: Integer;
Root: string;
begin
try
Items.BeginUpdate;
Items.Clear;
IndentLevel := 0;
Root := ExtractFileDrive(Directory)+'\';
GetVolumeInformation(PChar(Root), nil, 0, nil, DWORD(i), VolFlags, nil, 0);
FPreserveCase := VolFlags and (FS_CASE_IS_PRESERVED or FS_CASE_SENSITIVE) <> 0;
FCaseSensitive := (VolFlags and FS_CASE_SENSITIVE) <> 0;
if (Length(Root) >= 2) and (Root[2] = '\') then
begin
Items.AddObject(Root, OpenedBMP);
Inc(IndentLevel);
TempPath := Copy(Directory, Length(Root)+1, Length(Directory));
end
else
TempPath := Directory;
if (Length(TempPath) > 0) then
begin
if AnsiLastChar(TempPath)^ <> '\' then
begin
BackSlashPos := AnsiPos('\', TempPath);
while BackSlashPos <> 0 do
begin
DirName := Copy(TempPath, 1, BackSlashPos - 1);
if IndentLevel = 0 then DirName := DirName + '\';
Delete(TempPath, 1, BackSlashPos);
Items.AddObject(DirName, OpenedBMP);
Inc(IndentLevel);
BackSlashPos := AnsiPos('\', TempPath);
end;
end;
Items.AddObject(TempPath, CurrentBMP);
end;
NewSelect := Items.Count - 1;
Siblings := TStringList.Create;
try
Siblings.Sorted := True;
{ read all the dir names into Siblings }
ReadDirectoryNames(Directory, Siblings);
for i := 0 to Siblings.Count - 1 do
Items.AddObject(Siblings[i], ClosedBMP);
finally
Siblings.Free;
end;
finally
Items.EndUpdate;
end;
if HandleAllocated then
ItemIndex := NewSelect;
end;
end.
Now i explain what i have done:
By adding unitTDirectoryListbox_WithHiddenAndSystemFolders to interface uses i make the form to use the modified (aka, hacked) component.
I started by copying protected method called ReadDirectoryNames (the one that needs a modification), i copy it from unit FileCtrl and then i edit that copy on my own unit to fix the problem (not showing Hidden folders, neither System folders); the trick is to edit the call to FindFirst by adding after faDirectory the part or faHidden or faSysFile, i also change SlashSep to IncludeTrailingPathDelimiter (avoid some extra references, etc) and also do a reformat (indexing, etc) so i can see that method is the one i had modified.
Then i follow things missing... like BuildList, that one i just simply copy it from unit FileCtrl without any modification (if not copied the hack does not work, since the call to ReadDirectoryNames is inside BuildList).
Then i copy the declaration of FPreserveCase and FCaseSensitive and their property declarations (they are used inside BuildList method).
That is it, now the modified TDirectoryListBox will see hidden and system folders
Hope this helps others, this way you can have both TDirectoryListBox (original one and modified one) at same time (but not on same form, sorry) on your project, without modifing VCL at all.
P.D.: Someone with extra knowledge maybe is able to add properties to configure if it must show or not hidden and/or system folders as an improvement, it must not be very difficoult, two private boolean variables and their corresponding property declaration with read and write methods... i did not do it since i would like to add not only such two, also SymLinks, etc (search for faSymLink on unit SysUtils and see how many there are, a lot of work to add them all), sorry for any inconvenience for that.
I posted this solution for a different question a short while ago:
Delphi: Copy Files from folder with Overall progress. CopyFileEx?

Resources