Solved

How to build in a progressbar in this function?

Posted on 2006-07-05
27
487 Views
Last Modified: 2010-04-05
Hey

Im using the following code in my program and was wondering if a progressbar could be made to work with it?

function DeleteExclude(Path: String; ExcludeFile: String): Boolean;
var  lpFileOp:      TSHFileOpStruct;
     srFind:        TSearchRec;
     dwFind:        Integer;
     szPath:        String;
     szList:        String;
begin
  // Set default delete list
  SetLength(szList, 0);
  // Make sure path is correct
  szPath:=ExcludeTrailingBackSlash(Path);
  // Init the find
  dwFind:=FindFirst(szPath+'\*.*', faAnyFile, srFind);
  // Check find
  if (dwFind = 0) then
  begin
     // Resource protection
     try
        // While sucess
        while (dwFind = 0) do
        begin
           // Check name
           if ((Length(srFind.Name) > 0) and not(srFind.Name[1] = '.')) then
           begin
              // Compare against exclusion
              if (CompareText(srFind.Name, ExtractFileName(ExcludeFile)) <> 0) then
              begin
                 // Add to list
                 szList:=szList+szPath+'\'+srFind.Name+#0;
              end;
           end;
           // Find next
           dwFind:=FindNext(srFind);
        end;
     finally
        // Close the find
        FindClose(srFind);
     end;
  end;
  // Check the list
  if (Length(szList) > 0) then
  begin
     // Double null terminate the list
     szList:=szList+#0;
     // Clear struct
     FillChar(lpFileOp, SizeOf(lpFileOp), 0);
     // Set params
     lpFileOp.Wnd:=Application.Handle;
     lpFileOp.wFunc:=FO_DELETE;
     lpFileOp.pFrom:=PChar(szList);
     lpFileOp.pTo:=nil;
     // Remove the FOF_ALLOWUNDO if you don't want this to go in the recycle bin
     lpFileOp.fFlags:=FOF_SILENT or FOF_NOCONFIRMATION or FOF_ALLOWUNDO;
     // Perform the delete
     if (SHFileOperation(lpFileOp) = 0) and (lpFileOp.fAnyOperationsAborted = False) then
        // Success
        result:=true
     else
        // Failure
        result:=False;
  end
  else
     // Nothing to delete
     result:=True;

end;
0
Comment
Question by:fdehell
  • 17
  • 5
  • 3
  • +1
27 Comments
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
unfortunatly no. that is because you cannot know the count of files you will find.

what you can do however is to:
- put a notify something on the form and "update" it at every pass or so (like a label that displays the characters: -\|/ and iterates through them giving a sense of rotating; or display the number of files found, or anything like that)
- put a timer and do the above in the timer
- use a TAnimate control and show it before starting the operation and hide it after finishing.
0
 
LVL 12

Expert Comment

by:AmigoJack
Comment Utility
the solution is simple and takes additional needless time: simply first find all the files and count them. then find all files again - so you have a total count of files you have to delete
0
 
LVL 1

Author Comment

by:fdehell
Comment Utility
Aha, you both say something different right? I mean ciuly says it cannot be done, and amigojack says it can? Well anyway im working with the suggestions, but have little hope, since imn really not that brilliant in delphi yet, ill have to search and find even the code for the = solution is simple <== answer of Amigojack, thx both oif you, i will not yet give away the points ofcourse, until it is final that it cannot be done or can be done and i know how, cheers
0
 
LVL 1

Author Comment

by:fdehell
Comment Utility
Amigojack, I have found the way to count the files, where do i go from there? I have the filecount in an editbox...
0
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
hm... I will tell you why amigojack's suggestion is not that good and why I said it cannot be done.

let's say that the result of the count is 10000 files. that means that you will wait upto 1 minute or even more in which time you display nothing to do the search. THEN you do the SAME search over again.
1) it is a terrible performance break
2) it is pointless (doing the same operation twice just to show a progress bar?)
3) deleting a file is faster than finding one. so that means that if the time needed is x+y (x for finding and y for deleting all files) then you will actually spend x+x+y time just to be able to display a statusbar. in numbers, let's say 10 seconds + 10 seconds + 6 seconds. so instead of doing something in 16 seconds, you do it in 26.

that is a terrible performance loss. and if you say that for a small count it is not even that much of a loss since it will be done fast, then I am asking you why do you need to display the statusbar if it's that fast? see where I am getting to? if you need a statusbar it means that the operation is slow. if the operation is slow it means that by doing a count, you will have a BIG timeout until the count is done. so the solution is not good.

so if your operation is done on a small number of files, you don't need a statusbar because the user will not get a chance to see it. if it's done on a big number of files, then doing a count will introduce a big delay and that is what you wanted to do in the first place: not have a big delay without showing something.

on the other hand, returning to the formula x+y, if y is very big in proportion to x, then it is worth doing the count, but only if again you are using some sort of mechanism (like the ones I presented) so that the user will not get the impression that the application has phrozen.
but in your case, you are using a delete, which is considerably faster then searching so it is not worth it.
0
 
LVL 26

Accepted Solution

by:
Russell Libby earned 400 total points
Comment Utility

There is absolutely no need to make two passes across the file system. The first pass can be used to build a file / path list which will satisfy the count (for the progress bar) and also give you a list to walk to delete the files (which must be done before a directory can be removed) as well as the directories to remove. That leaves the issue of the delay during the initial pass, which can be handled in a number of ways. In the example below, I push a panel to mimic the progress bar and display text to the user indicating that the deletion list is being calculated. Once the list is built, the panel is popped and the progress bar is updated as files/folders are removed.

Regards,
Russell

---

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls;

type
  TForm1            =  class(TForm)
     Button1:       TButton;
     ProgressBar1:  TProgressBar;
     procedure      Button1Click(Sender: TObject);
  private
     //Private declarations
  public
     // Public declarations
  end;

var
  Form1:            TForm1;

implementation
{$R *.DFM}

procedure RecursePath(Path: String; List: TStrings);
var  srFind:        TSearchRec;
     dwFind:        Integer;
begin

  // Add path to the list first. We delete from the bottom of the list up, so this ensures all files
  // are removed before we get to removing the path
  List.AddObject(Path, nil);

  // Init the find
  dwFind:=FindFirst(Path+'\*.*', faAnyFile, srFind);

  // Check find
  if (dwFind = 0) then
  begin
     // Allow updates
     Application.ProcessMessages;
     // Resource protection
     try
        // While sucess
        while (dwFind = 0) do
        begin
           // Check name
           if ((Length(srFind.Name) > 0) and not(srFind.Name[1] = '.')) then
           begin
              // Check path
              if ((srFind.Attr and faDirectory) = faDirectory) then
                 // Recurse all files in folder
                 RecursePath(Path+'\'+srFind.Name, List)
              // Add the file name
              else
                 // Add to list
                 List.AddObject(Path+'\'+srFind.Name, Pointer(1));
           end;
           // Find next
           dwFind:=FindNext(srFind);
        end;
     finally
        // Close the find
        FindClose(srFind);
     end;
  end;

end;

function DeleteExclude(Path: String; ExcludeFile: String; ProgressBar: TProgressBar): Boolean;
var  listFiles:     TStringList;
     srFind:        TSearchRec;
     pnlWait:       TPanel;
     dwFind:        Integer;
     szPath:        String;
begin

  // Set default result
  result:=False;

  // Set progress bar
  ProgressBar.Min:=0;
  ProgressBar.Position:=0;

  // Create panel to display status
  pnlWait:=TPanel.Create(Application);

  // Resource protection
  try
     // Set cursor
     Screen.Cursor:=crHourglass;
     // Update status panel
     pnlWait.Parent:=ProgressBar.Parent;
     pnlWait.SetBounds(ProgressBar.Left, ProgressBar.Top, ProgressBar.Width, ProgressBar.Height);
     pnlWait.BevelOuter:=bvLowered;
     pnlWait.Caption:='Calculating delete list...';
     pnlWait.Visible:=True;
     // Hide progress bar
     ProgressBar.Visible:=False;
     // Resource protection
     try
        // Make sure path is correct
        szPath:=ExcludeTrailingBackSlash(Path);
        // Init the find
        dwFind:=FindFirst(szPath+'\*.*', faAnyFile, srFind);
        // Create list to hold files and paths
        listFiles:=TStringList.Create;
        // Resource protection
        try
           // Check find
           if (dwFind = 0) then
           begin
              // Resource protection
              try
                 // While sucess
                 while (dwFind = 0) do
                 begin
                    // Check name
                    if ((Length(srFind.Name) > 0) and not(srFind.Name[1] = '.')) then
                    begin
                       // Check path
                       if ((srFind.Attr and faDirectory) = faDirectory) then
                          // Recurse all files in folder
                          RecursePath(szPath+'\'+srFind.Name, listFiles)
                       // Compare against exclusion
                       else if (CompareText(srFind.Name, ExtractFileName(ExcludeFile)) <> 0) then
                          // Add to list with file size
                          listFiles.AddObject(szPath+'\'+srFind.Name, Pointer(1));
                    end;
                    // Find next
                    dwFind:=FindNext(srFind);
                 end;
              finally
                 // Close the find
                 FindClose(srFind);
              end;
           end;
           // Hide the status panel
           pnlWait.Visible:=False;
           // Show the progress bar
           ProgressBar.Visible:=True;
           // Handle messages
           Application.ProcessMessages;
           // Check the list
           if (listFiles.Count > 0) then
           begin
              // Prepare the progress meter
              ProgressBar.Max:=listFiles.Count;
              // Now delete the file / paths
              for dwFind:=Pred(listFiles.Count) downto 0 do
              begin
                 // Check for path
                 if (listFiles.Objects[dwFind] = nil) then
                    // Remove path
                    result:=RemoveDirectory(PChar(listFiles[dwFind]))
                 else
                 begin
                    // Set attributes
                    SetFileAttributes(PChar(listFiles[dwFind]), FILE_ATTRIBUTE_ARCHIVE);
                    // Attempt to remove
                    result:=DeleteFile(PChar(listFiles[dwFind]));
                 end;
                 // Check result
                 if not(result) then break;
                 // Update the progress meter
                 ProgressBar.StepBy(1);
                 ProgressBar.Update;
                 // Check for message processing
                 if ((dwFind mod 100) = 0) then Application.ProcessMessages;
              end;
              // Reset position
              ProgressBar.Position:=0;
           end
           else
              // Nothing to delete
              result:=True;
        finally
           // Free the list
           listFiles.Free;
        end;
     finally
        // Ensure progress bar gets made visible
        ProgressBar.Visible:=True;
        // Reset cursor
        Screen.Cursor:=crDefault;
     end;
  finally
     // Free the panel
     pnlWait.Free;
  end;

end;

// The only thing that changes from the original call is that you now need to pass a TProgressBar control as the last param to the
// function. The code below is an example only
procedure TForm1.Button1Click(Sender: TObject);
var  dwMark:        LongWord;
begin

  dwMark:=GetTickCount;
  DeleteExclude('c:\somepath', 'filetoexclude.txt', ProgressBar1);
  dwMark:=GetTickCount-dwMark;
  Caption:=Format('%d ms', [dwMark]);

end;

end.


0
 
LVL 12

Expert Comment

by:AmigoJack
Comment Utility
ciuly: thx, you described it like i meant it :) everything is quite possible, but the cost of this is also for me a horror.

rllibby: excellent, also thought of that a second afterwards, because fdehell is already doing

szList:=szList+szPath+'\'+srFind.Name+#0;

of course your method is superior because it also recursively deletes all subfolders.

fdehell: tryout rllibbys suggestion and think over it if its really needful to show a progressbar for something which might be done in 2secs. if you really want to make it useful to the user, than build up a log so the user sees which files+folders have been deleted (or which have failed because of security restrictions... think about that) including a count of all files+folders which were deleted. at least for me thats a lot more useful than a simple progressbar :)
0
 
LVL 1

Author Comment

by:fdehell
Comment Utility
Thanks all of you. I am now working with the solution of rllibby, but it does not do anything visual,nor does it remove any file or folder, so im now trying to figure out where it decides not to do anything, but i cant add any visual messages to a memo and also not anything after the "TRY" statements that would tell me sumthing about why it stopped.


 while (dwFind = 0) do
        begin
           // Check name
           if ((Length(srFind.Name) > 0) and not(srFind.Name[1] = '.')) then

Looking at the above line of code, im guessing the '.' refers to the first entry in a directory, which [if displayed in dos] is exactly that, but wouldnt there then also be the second entry which is '..', i really couldnt not think of anything else that was wrong, and most likely this is not wrong either excuse me for my ignorance then, im a novice, but i have no clue why it does not perform any action at all?

So far you have given me some very good avice all three of you thanks so far
0
 
LVL 26

Expert Comment

by:Russell Libby
Comment Utility

Have you tried putting breakpoints in the code and stepping through it? What is the return value of the call? A little more info (and code showing usage) would go a LONG way in helping.

Russell
0
 
LVL 12

Assisted Solution

by:AmigoJack
AmigoJack earned 100 total points
Comment Utility
>>>>>>

while (dwFind = 0) do
        begin
           // Check name
           if ((Length(srFind.Name) > 0) and not(srFind.Name[1] = '.')) then

Looking at the above line of code, im guessing the '.' refers to the first entry in a directory, which [if displayed in dos] is exactly that, but wouldnt there then also be the second entry which is '..',

<<<<<<


yes, youre right. every folder (except the root) has the directory entries "." and "..". the code above works, as it checks for the first character being a "." - so it catches "." and also ".." - which leads to ignoring those entries. but theres a flaw, since entries can also be named with a beginning ".", like ".conf". so it should better look like this:

while (dwFind = 0) do
        begin
           // Check name
           if (srFind.Name<> '.') and (srFind.Name<> '..') then begin

personally i prefer the win32 APIs FindFirstFile(), FindNextFile() and FindClose()
0
 
LVL 26

Expert Comment

by:Russell Libby
Comment Utility

Excellent point on the '.' name check. The code is from the good old days of 8.3, and used to be a quick way to test for the '.' and '..' folders.

Should be changed to

if ((Length(srFind.Name) > 0) and (srFind.Name <> '.') and (srFind.Name <> '..')) then
  ...


Russell
0
 
LVL 1

Author Comment

by:fdehell
Comment Utility
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, RzErrHnd;

type
  TForm1            =  class(TForm)
     btn1:       TButton;
    pb1: TProgressBar;
    btn2: TButton;
    pnl1: TPanel;
     procedure btn1Click(Sender: TObject);
  private
   
  public
     // Public declarations
  end;

var
  Form1:            TForm1;

implementation
{$R *.DFM}

procedure RecursePath(Path: String; List: TStrings);
var  srFind:        TSearchRec;
     dwFind:        Integer;
begin

  // Add path to the list first. We delete from the bottom of the list up, so this ensures all files
  // are removed before we get to removing the path
  List.AddObject(Path, nil);

  // Init the find
  dwFind:=FindFirst(Path+'\*.*', faAnyFile, srFind);

  // Check find
  if (dwFind = 0) then
  begin
     // Allow updates
     Application.ProcessMessages;
     // Resource protection
     try
        // While sucess
        while (dwFind = 0) do
        begin
 >>       ShowMessage('dwfind = 0');  //added this for knowing if this succeeded
           // Check name
           //if ((Length(srFind.Name) > 0) and not(srFind.Name[1] = '.') and not(srFind.Name[2] = '..')) then
           if ((Length(srFind.Name) > 0) and (srFind.Name <> '.') and (srFind.Name <> '..')) then

           begin
              // Check path
              if ((srFind.Attr and faDirectory) = faDirectory) then
                 // Recurse all files in folder
                 RecursePath(Path+'\'+srFind.Name, List)
              // Add the file name
              else
                 // Add to list
                 List.AddObject(Path+'\'+srFind.Name, Pointer(1));

           end;
           // Find next
           dwFind:=FindNext(srFind);
        end;
     finally
        // Close the find
        FindClose(srFind);
     end;
  end;

end;

function DeleteExclude(Path: String; ExcludeFile: String; pb1: TProgressBar): Boolean;
var  listFiles:     TStringList;
     srFind:        TSearchRec;
     pnlWait:       TPanel;
     dwFind:        Integer;
     szPath:        String;

begin

  // Set default result
  result:=False;

  // Set progress bar
  pb1.Min:=0;
  pb1.Position:=0;

  // Create panel to display status
  pnlWait:=TPanel.Create(Application);

  // Resource protection
  try
     // Set cursor
     Screen.Cursor:=crHourglass;
     // Update status panel
     pnlWait.Parent:=pb1.Parent;
     pnlWait.SetBounds(pb1.Left, pb1.Top, pb1.Width, pb1.Height);
     pnlWait.BevelOuter:=bvLowered;
     pnlWait.Caption:='Calculating delete list...';
     pnlWait.Visible:=True;
     // Hide progress bar
     pb1.Visible:=False;
     // Resource protection
     try
        // Make sure path is correct
        szPath:=ExcludeTrailingBackSlash(Path);
        // Init the find
        dwFind:=FindFirst(szPath+'\*.*', faAnyFile, srFind);
        // Create list to hold files and paths
        listFiles:=TStringList.Create;

        // Resource protection
        try
           // Check find
           if (dwFind = 0) then
           begin
              // Resource protection
              try
                 // While sucess
                 while (dwFind = 0) do
                 begin
                    // Check name
                    if ((Length(srFind.Name) > 0) and not(srFind.Name[1] = '.')) then
                    begin
                       // Check path
                       if ((srFind.Attr and faDirectory) = faDirectory) then
                          // Recurse all files in folder
                          RecursePath(szPath+'\'+srFind.Name, listFiles)
                       // Compare against exclusion
                       else if (CompareText(srFind.Name, ExtractFileName(ExcludeFile)) <> 0) then
                          // Add to list with file size
                          listFiles.AddObject(szPath+'\'+srFind.Name, Pointer(1));
                    end;
                    // Find next
                    dwFind:=FindNext(srFind);
                 end;
              finally
                 // Close the find
                 FindClose(srFind);
              end;
           end;
           // Hide the status panel
           pnlWait.Visible:=False;
           // Show the progress bar
           pb1.Visible:=True;
           // Handle messages
           Application.ProcessMessages;
           // Check the list
           if (listFiles.Count > 0) then
           begin
              // Prepare the progress meter
             
              pb1.Max:=listFiles.Count;
              // Now delete the file / paths
              for dwFind:=Pred(listFiles.Count) downto 0 do
              begin
                 // Check for path
                 if (listFiles.Objects[dwFind] = nil) then
                    // Remove path
                    result:=RemoveDirectory(PChar(listFiles[dwFind]))
                 else
                 begin
                    // Set attributes
                    SetFileAttributes(PChar(listFiles[dwFind]), FILE_ATTRIBUTE_ARCHIVE);
                    // Attempt to remove
                    result:=DeleteFile(PChar(listFiles[dwFind]));

                 end;
                 // Check result
                 if not(result) then break;
                 // Update the progress meter
                 pb1.StepBy(1);
                 pb1.Update;
                 // Check for message processing
                 if ((dwFind mod 100) = 0) then Application.ProcessMessages;
              end;
              // Reset position
              pb1.Position:=0;
           end
           else
              // Nothing to delete
              result:=True;
        finally
           // Free the list
           listFiles.Free;
        end;
     finally
        // Ensure progress bar gets made visible
        pb1.Visible:=True;
        // Reset cursor
        Screen.Cursor:=crDefault;
     end;
  finally
     // Free the panel
     pnlWait.Free;
  end;

end;

// The only thing that changes from the original call is that you now need to pass a TProgressBar control as the last param to the
// function. The code below is an example only
procedure TForm1.btn1Click(Sender: TObject);
var  dwMark:        LongWord;
begin

  dwMark:=GetTickCount;
  DeleteExclude('c:\diskid', 'fdehel70.dcp', pb1);
  dwMark:=GetTickCount-dwMark;
  Caption:=Format('%d ms', [dwMark]);
 
end;

end.



I have added   ShowMessage('dwfind = 0');  //added this for knowing if this succeeded
and since  i dont see that message, i take it it does not get to there?

I also have changed the code exactly like you advised Russell thanks

Im now adding more of these statements, earlier in the code to see where it stops

Fdehell
0
 
LVL 1

Author Comment

by:fdehell
Comment Utility
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, RzErrHnd;

type
  TForm1            =  class(TForm)
     btn1:       TButton;
    pb1: TProgressBar;
    btn2: TButton;
    pnl1: TPanel;
     procedure btn1Click(Sender: TObject);
  private
   
  public
     // Public declarations
  end;

var
  Form1:            TForm1;

implementation
{$R *.DFM}

procedure RecursePath(Path: String; List: TStrings);
var  srFind:        TSearchRec;
     dwFind:        Integer;
begin

  // Add path to the list first. We delete from the bottom of the list up, so this ensures all files
  // are removed before we get to removing the path
  List.AddObject(Path, nil);
  // Init the find
  dwFind:=FindFirst(Path+'\*.*', faAnyFile, srFind);
  // Check find
  if (dwFind = 0) then
  begin


>>>     ShowMessage('dwfind = 0 line 43');  //added this one, and it does not show up either


     // Allow updates
     Application.ProcessMessages;
     // Resource protection
     try
        // While sucess
        while (dwFind = 0) do
        begin


>>>        ShowMessage('dwfind = 0');  //added this one


           // Check name
           //if ((Length(srFind.Name) > 0) and not(srFind.Name[1] = '.') and not(srFind.Name[2] = '..')) then
           if ((Length(srFind.Name) > 0) and (srFind.Name <> '.') and (srFind.Name <> '..')) then
           begin
              // Check path
              if ((srFind.Attr and faDirectory) = faDirectory) then
                 // Recurse all files in folder
                 RecursePath(Path+'\'+srFind.Name, List)
              // Add the file name
              else
                 // Add to list
                 List.AddObject(Path+'\'+srFind.Name, Pointer(1));

           end;
           // Find next
           dwFind:=FindNext(srFind);
        end;
     finally
        // Close the find
        FindClose(srFind);
     end;
  end;

end;

function DeleteExclude(Path: String; ExcludeFile: String; pb1: TProgressBar): Boolean;
var  listFiles:     TStringList;
     srFind:        TSearchRec;
     pnlWait:       TPanel;
     dwFind:        Integer;
     szPath:        String;

begin

  // Set default result
  result:=False;

  // Set progress bar
  pb1.Min:=0;
  pb1.Position:=0;

  // Create panel to display status
  pnlWait:=TPanel.Create(Application);

  // Resource protection
  try
     // Set cursor
     Screen.Cursor:=crHourglass;
     // Update status panel
     pnlWait.Parent:=pb1.Parent;
     pnlWait.SetBounds(pb1.Left, pb1.Top, pb1.Width, pb1.Height);
     pnlWait.BevelOuter:=bvLowered;
     pnlWait.Caption:='Calculating delete list...';
     pnlWait.Visible:=True;
     // Hide progress bar
     pb1.Visible:=False;
     // Resource protection
     try
        // Make sure path is correct
        szPath:=ExcludeTrailingBackSlash(Path);
        // Init the find
        dwFind:=FindFirst(szPath+'\*.*', faAnyFile, srFind);
        // Create list to hold files and paths
        listFiles:=TStringList.Create;

        // Resource protection
        try
           // Check find
           if (dwFind = 0) then
           begin
              // Resource protection
              try
                 // While sucess
                 while (dwFind = 0) do
                 begin
                    // Check name
                    if ((Length(srFind.Name) > 0) and not(srFind.Name[1] = '.')) then
                    begin
                       // Check path
                       if ((srFind.Attr and faDirectory) = faDirectory) then
                          // Recurse all files in folder
                          RecursePath(szPath+'\'+srFind.Name, listFiles)
                       // Compare against exclusion
                       else if (CompareText(srFind.Name, ExtractFileName(ExcludeFile)) <> 0) then
                          // Add to list with file size
                          listFiles.AddObject(szPath+'\'+srFind.Name, Pointer(1));
                    end;
                    // Find next
                    dwFind:=FindNext(srFind);
                 end;
              finally
                 // Close the find
                 FindClose(srFind);
              end;
           end;
           // Hide the status panel
           pnlWait.Visible:=False;
           // Show the progress bar
           pb1.Visible:=True;
           // Handle messages
           Application.ProcessMessages;
           // Check the list
           if (listFiles.Count > 0) then
           begin
              // Prepare the progress meter
             
              pb1.Max:=listFiles.Count;
              // Now delete the file / paths
              for dwFind:=Pred(listFiles.Count) downto 0 do
              begin
                 // Check for path
                 if (listFiles.Objects[dwFind] = nil) then
                    // Remove path
                    result:=RemoveDirectory(PChar(listFiles[dwFind]))
                 else
                 begin
                    // Set attributes
                    SetFileAttributes(PChar(listFiles[dwFind]), FILE_ATTRIBUTE_ARCHIVE);
                    // Attempt to remove
                    result:=DeleteFile(PChar(listFiles[dwFind]));

                 end;
                 // Check result
                 if not(result) then break;
                 // Update the progress meter
                 pb1.StepBy(1);
                 pb1.Update;
                 // Check for message processing
                 if ((dwFind mod 100) = 0) then Application.ProcessMessages;
              end;
              // Reset position
              pb1.Position:=0;
           end
           else
              // Nothing to delete
              result:=True;
        finally
           // Free the list
           listFiles.Free;
        end;
     finally
        // Ensure progress bar gets made visible
        pb1.Visible:=True;
        // Reset cursor
        Screen.Cursor:=crDefault;
     end;
  finally
     // Free the panel
     pnlWait.Free;
  end;

end;

// The only thing that changes from the original call is that you now need to pass a TProgressBar control as the last param to the
// function. The code below is an example only
procedure TForm1.btn1Click(Sender: TObject);
var  dwMark:        LongWord;
begin

  dwMark:=GetTickCount;
  DeleteExclude('c:\diskid', 'fdehel70.dcp', pb1);
  dwMark:=GetTickCount-dwMark;
  Caption:=Format('%d ms', [dwMark]);
 
end;

end.

I think the function RecursePath is not being executed, since i did not see any of the two "breakpoints" when i execute the program and push the button, so im now over to the DeleteExlcude right?
0
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 
LVL 1

Author Comment

by:fdehell
Comment Utility
procedure RecursePath(Path: String; List: TStrings);
var  srFind:        TSearchRec;
     dwFind:        Integer;
begin

  // Add path to the list first. We delete from the bottom of the list up, so this ensures all files
  // are removed before we get to removing the path
  List.AddObject('Path', nil);

Here it gives an error, im positive this is where the program does not continue, since if i temporarily comment the Try-s, the program throws an Eaccess violation at this line

Fdehell
0
 
LVL 1

Author Comment

by:fdehell
Comment Utility
I have looked up stuff i found in the procedure and function and have fixed the Eaccess error, with the following code, which now, finally gives the feedback i wanted :

procedure RecursePath(Path: String; List: TStrings);
var  srFind:        TSearchRec;
     dwFind:        Integer;
     

>>>     StringList : TStrings; //added this variable, which now replaces the List: Tstrings

begin
 

>>> StringList := TStringList.Create; //i saw this in the manual, and tried it out

  // Add path to the list first. We delete from the bottom of the list up, so this ensures all files
  // are removed before we get to removing the path
 

>>>  StringList.AddObject(Path, nil); //instead of list.addobject, i wrote Stringlist.add


  // Init the find
  dwFind:=FindFirst(Path+'\*.*', faAnyFile, srFind);

  // Check find
  if (dwFind = 0) then
  begin
     ShowMessage('dwfind = 0 line 43');  
     // Allow updates
     Application.ProcessMessages;
     // Resource protection
     //try
        // While sucess
        while (dwFind = 0) do
        begin
        ShowMessage('dwfind = 0');  
           // Check name
           //if ((Length(srFind.Name) > 0) and not(srFind.Name[1] = '.') and not(srFind.Name[2] = '..')) then
           if ((Length(srFind.Name) > 0) and (srFind.Name <> '.') and (srFind.Name <> '..')) then

           begin
              // Check path
              if ((srFind.Attr and faDirectory) = faDirectory) then
                 // Recurse all files in folder
                 RecursePath(Path+'\'+srFind.Name, List)
              // Add the file name
              else
                 // Add to list
             
>>>   StringList.AddObject(Path+'\'+srFind.Name, Pointer(1)); //instead of list.addobject, i wrote Stringlist.add

           end;
           // Find next
           dwFind:=FindNext(srFind);
        end;
    // finally
        // Close the find
        FindClose(srFind);
     //end;
  end;

end;

It now gives feedback which is more usefull, it shows the "  ShowMessage('dwfind = 0'); " 9 times, with 7 files in the directory i want to delete, plus the '.' and '..' entries [which are despite the code counted still?] would make this message appear 9 times in stead of 7 i reckoned, It does not delete anything, but i have never before got rid of such nasty Eaccess violation, plus we now are getting feedback, so that is a good thing I think

Fdehell
0
 
LVL 1

Author Comment

by:fdehell
Comment Utility
To test the RecursePath I had added the following


private
Stringlist: Tstringlist;
...
procedure TForm1.btn2Click(Sender: TObject);
begin
RecursePath('c:\diskid', StringList);
end;


Just to test the procedure itself, i forgot to say this in the previous message, and i changed the number of files in the to-delete diirectory and it showed the "  ShowMessage('dwfind = 0'); " 6 times, with 4 files in the directory, possibly counting the '.' and the '..' still which would make it appear 6 times instead of 4.  And now when thinking about it, since it still seems to count the '.' and '..' entries, i guess since they cannot be deleted, it will halt somewhere, this is however the only thing i can think of now, though the new code from Russel, should have fixed the including of these two entries?
0
 
LVL 1

Author Comment

by:fdehell
Comment Utility
Curiously enough after adding "breaks" to the deleteexclude like the following:

function DeleteExclude(Path: String; ExcludeFile: String; pb1: TProgressBar): Boolean;
var  listFiles:     TStringList;
     srFind:        TSearchRec;
     pnlWait:       TPanel;
     dwFind:        Integer;
     szPath:        String;

begin

  // Set default result
  result:=False;

  // Set progress bar
  pb1.Min:=0;
  pb1.Position:=0;

  // Create panel to display status
  pnlWait:=TPanel.Create(Application);
 >>>  ShowMessage('panel created line 99'); // to see if this panel was created


I dont see this message, so it cannot create the Tpanel? Or am I too quick with my judgement?

Fdehell
0
 
LVL 1

Author Comment

by:fdehell
Comment Utility
After setting the pb1.position to 56, and then executing the program, pushing the button, would make it set to position 0, but it does not do that either, so it halts after the line :

begin

  // Set default result
  result:=False;

  // Set progress bar
  pb1.Min:=0;
  pb1.Position:=0;

I have commented the pb1.Min:=0; to check where exactly, and it halts right after the line

  // Set default result
  result:=False;

Fdehell
0
 
LVL 1

Author Comment

by:fdehell
Comment Utility
Damn got confused here, forget the two last comments pls, i was mistaken the function for the procedure, my apologies
0
 
LVL 1

Author Comment

by:fdehell
Comment Utility
Maybe the fact that the proc RecursePath uses a different name for the stringlist, than the function uses, makes it so that the function DelexteExclude cannot use the proc RecursePath ?

Or, maybe since  the proc RecursePath has no returnvalue [at least that is what i thought was the difference between a function and a proc?] so maybe the function DeleteExclude cannot use the proc RecursePath at all?

Im stuck for the time being


Fdehell
0
 
LVL 1

Author Comment

by:fdehell
Comment Utility
The first suggestion in the above post, was not true, and is not the problem I tested it, for the rest I dont know actually
0
 
LVL 1

Author Comment

by:fdehell
Comment Utility
Hey all

I have found a new approach, since it does not have to be accurate [maybe i should have been cleaer about this, though this topic was very very usefull and really has made a big difference for me in understanding how delphi works] and since I just want to show the progressbar if the function suckeeds:


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ShellApi,StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    btn1: TButton;
    pb1: TProgressBar;
    procedure btn1Click(Sender: TObject);
  private
   
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}



function DeleteExclude(Path: String; ExcludeFile: String): Boolean;
var  lpFileOp:      TSHFileOpStruct;
     srFind:        TSearchRec;
     dwFind:        Integer;
     szPath:        String;
     szList:        String;
     pb1:TProgressBar;
     
begin
  // Set default delete list
  SetLength(szList, 0);
  // Make sure path is correct
  szPath:=ExcludeTrailingBackSlash(Path);
  // Init the find
  dwFind:=FindFirst(szPath+'\*.*', faAnyFile, srFind);
  // Check find
  if (dwFind = 0) then
  begin
     // Resource protection
     try
        // While sucess
        while (dwFind = 0) do
        begin
           // Check name
           if ((Length(srFind.Name) > 0) and not(srFind.Name[1] = '.')) then
           begin
              // Compare against exclusion
              if (CompareText(srFind.Name, ExtractFileName(ExcludeFile)) <> 0) then
              begin
                 // Add to list
                 szList:=szList+szPath+'\'+srFind.Name+#0;
                 //lst1.AddItem(szList, Application);
              end;
           end;
           // Find next
           dwFind:=FindNext(srFind);
        end;
     finally
        // Close the find
        FindClose(srFind);
     end;
  end;
  // Check the list
  if (Length(szList) > 0) then

  begin
   
     // Double null terminate the list
     szList:=szList+#0;
     // Clear struct
     FillChar(lpFileOp, SizeOf(lpFileOp), 0);
     // Set params
     lpFileOp.Wnd:=Application.Handle;
     lpFileOp.wFunc:=FO_DELETE;
     lpFileOp.pFrom:=PChar(szList);
     lpFileOp.pTo:=nil;
     // Remove the FOF_ALLOWUNDO if you don't want this to go in the recycle bin
     lpFileOp.fFlags:=FOF_SILENT or FOF_NOCONFIRMATION or FOF_ALLOWUNDO;
     // Perform the delete
     if (SHFileOperation(lpFileOp) = 0) and (lpFileOp.fAnyOperationsAborted = False) then
        // Success
       // pb1.position:=100
       result:= true
     else
        // Failure
       result:= false
  end
  else
     // Nothing to delete
     

end;
procedure TForm1.btn1Click(Sender: TObject);
begin
  if DeleteExclude('c:\diskid','ferix_checkbox.bmp') then
    try
      pb1.position:=100;
      pb1.position:=0;

   finally

{actually I noticed this kind of coding at Russels answers, so Im following it, though I had added 'Free;' after the 'Finally' code, but then my program dissappeared so I guess it is too early for that for me or sumthing}  
 
  end;

end;
end.
====
Anyway I will wait if someone comes up with anything at the previous messages, but this one suits me fine too, the points will be given ofcourse, pls state your advice, but i will wait for some time before i will post again to give you the opportunity to see and respond if you wish ofcourse

With respect
Fdehell
0
 
LVL 1

Author Comment

by:fdehell
Comment Utility
Ok i have waited two days for any suggestions ans advice so cheers to everyone, points will go to rlibby and Amigojack for both their efforts, though im thankfull to everyone!!!

Fdehell
0
 
LVL 1

Author Comment

by:fdehell
Comment Utility
PS I have given an A grade, since of the efforts that were taken, one should not only be interested in the final result, since the geisture actually is what counts much more, though that is not the goal of this site, I still decided to value more the efforts, than the fact that the answers given, were maybe not a complete solution

Fdehell
0
 
LVL 26

Expert Comment

by:Russell Libby
Comment Utility

Fdehell,

Sorry, did not get notifications on the last few posts. I will try and address the mutliple questions, though I can't make sense of some of it without code:

>> {actually I noticed this kind of coding at Russels answers, so Im following it, though I had added 'Free;' after the 'Finally' code, but then my program dissappeared so I guess it is too early for that for me or sumthing}  

 if DeleteExclude('c:\diskid','ferix_checkbox.bmp') then
    try
      pb1.position:=100;
      pb1.position:=0;

   finally

{actually I noticed this kind of coding at Russels answers, so Im following it, though I had added 'Free;' after the 'Finally' code, but then my program dissappeared so I guess it is too early for that for me or sumthing}  
 
  end;

What exactly were you Free'ing? If you just put Free, then you just free'd the form. I use the try / finally handler when I have created an object and wish to ensure that it is free'd when the routine is done.

----

>> Maybe the fact that the proc RecursePath uses a different name for the stringlist, than the function uses, makes it so that the function DelexteExclude cannot use the proc RecursePath ?

Not a chance

>> Or, maybe since  the proc RecursePath has no returnvalue [at least that is what i thought was the difference between a function and a proc?] so maybe the function DeleteExclude cannot use the proc RecursePath at all?

Its impossible to say where your problems were because you never posted a full code example of what you were doing. It helps to not only see the function being used (which I wrote), but to also see HOW it is being called and what is being passed in. You changed the code by changing my function call to take a param called pb1 which happens to be the same name as the progress meter on your form. While *technically* ok, it makes the code difficult to read, and makes me wonder what other changes were made (and not shown in the examples above)

Russell



0
 
LVL 1

Author Comment

by:fdehell
Comment Utility
Ok sowwy for the confusion, I definitely am a novice in Delphi, so that explains some of my answers i spose, anyway, i thought the Free'ing was to give back resources which were used by the program, I [also] have a very hard time in formatting delphi code, i mean i have the same problems with HTML, PHP, JAVA and even CSS, just to show the code in a clear and readable format, really is sumthing I have great difficulties with, anyway

I noticed your way of coding, and you used the Free'ing, so i thought maybe follow your example and i did the following

if DeleteExclude('c:\diskid','ferix_checkbox.bmp') then
    try
      pb1.position:=100;
      pb1.position:=0;

   finally
 free;   <===
end;

I will post the previous example fully asap, i already thought you had been away from the puter or sumthing since of the weekends or sumthing

Cheers
Fdehell
0
 
LVL 26

Expert Comment

by:Russell Libby
Comment Utility
No problem, post what you have and I can look at it. As to my coding style, you will see it normally follows:

 obj:=TSomeObject.Create;
 try
   // .. do something with the object
 finally
   // Finished with the object
   obj.Free;
 end;

This allows the program to correctly cleanup the instantiated object even if the code throws an exception. The code you have above is valid, but when Free is called with no qualifying object, then the Free gets applied to the object in the current scope, in this case, the Form

Russell


0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

6 Experts available now in Live!

Get 1:1 Help Now