[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

How to modify this DeleteExclude Function?

Posted on 2007-10-08
2
Medium Priority
?
236 Views
Last Modified: 2010-04-05
Hi Folks,

I'm using this code to clean up some folders >

function TForm1.DeleteExclude(Path: String; ExcludeFile: String; dispStr: String; lbMain: TRZListbox): Boolean;
var  listFiles:     TStringList;
     srFind:        TSearchRec;
     szPath:        String;
     dwSize:        LongWord;
     dwFiles:       Integer;
     dwFind:        Integer;
begin

  // Clear output
  //Output.Clear;

  // 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
     // Add progress

        lbMain.AddObject(Format('[%s]'+dispStr,[TimeToStr(Now)]),Image1.Picture.Bitmap);
        lbMain.AddObject(Format('[%s] Folders en bestanden worden geteld...',[TimeToStr(Now)]),Image1.Picture.Bitmap);

     // 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(srFind.Size));
              end;
              // Find next
              dwFind:=FindNext(srFind);
           end;
        finally
           // Close the find
           FindClose(srFind);
        end;
     end;
     // Set default result
     result:=True;
     // Check the list
     if (listFiles.Count > 0) then
     begin
        // Set size and file count
        dwFiles:=0;
        dwSize:=0;
        // Display file and directory count
        for dwFind:=0 to Pred(listFiles.Count) do
        begin
           // Check for file
           if (Integer(listFiles.Objects[dwFind]) >= 0) then
           begin
              // Inc file count
              Inc(dwFiles);
              // Increment the total size
              Inc(dwSize, Integer(listFiles.Objects[dwFind]));
           end;
        end;
        // Add progress

  lbMain.AddObject(Format('[%s] Aantal folders: %d', [TimeToStr(Now), listFiles.Count-dwFiles]),Image1.Picture.Bitmap);
  lbMain.AddObject(Format('[%s] Aantal bestanden: %d', [TimeToStr(Now), dwFiles]),Image1.Picture.Bitmap);
  lbMain.AddObject(Format('[%s] In beslag genomen ruimte: %s', [TimeToStr(Now), FormatFileSize(dwSize)]),Image1.Picture.Bitmap);
  lbMain.AddObject(Format('[%s] Folders en bestanden worden verwijderd!', [TimeToStr(Now)]),Image1.Picture.Bitmap);

        // Allow updates
        Application.ProcessMessages;
        // Reset size again
        dwSize:=0;
        // Now delete the file / paths

        for dwFind:=Pred(listFiles.Count) downto 0 do
        begin
           // Check for path
           if (Integer(listFiles.Objects[dwFind]) = -1) then
              // Remove path
              result:=RemoveDirectory(PChar(listFiles[dwFind]))
           else
           begin
              // Set file attr
              SetFileAttributes(PChar(listFiles[dwFind]), FILE_ATTRIBUTE_ARCHIVE);
              // Attempt to remove
              result:=DeleteFile(PChar(listFiles[dwFind]));
              // Check delete
              if result then Inc(dwSize, Integer(listFiles.Objects[dwFind]));
           end;
           // Break on failure
           if not(result) then break;
        end;
        // Check result
        if not(result) then

      lbMain.AddObject(Format('[%s] Er is iets fout gegaan tijdens het verwijderen!', [TimeToStr(Now)]), image3.Picture.bitmap);
      lbMain.AddObject(Format('[%s] Vrij gemaakte schijfruimte: %s', [TimeToStr(Now), FormatFileSize(dwSize)]), image1.picture.bitmap);
      lbMain.AddObject('',Image2.Picture.Bitmap);
     end
     else
        // Add progress
       lbMain.AddObject(Format('[%s] Niks te verwijderen!', [TimeToStr(Now)]), image1.Picture.Bitmap);
       lbMain.AddObject('',Image2.Picture.Bitmap);
  finally
     // Free the list
     listFiles.Free;
  end;

end;




procedure TForm1.Button1Click(Sender: TObject);
var dirStr: string;
begin
  DeleteExclude(GetShellFolder('Cache')+ '\Content.IE5','index.dat', ' Internet Explorer tijdelijke bestanden', lbMain);
  DeleteExclude(GetShellFolder('history')+ '\History.IE5','index.dat', ' Internet Explorer Geschiedenis', lbMain);
  DeleteExclude(GetShellFolder('local settings')+ '\Temp', 'index.dat', ' Tijdelijke bestanden', lbMain);
  DeleteExclude(GetShellFolder('Recent'), 'index.dat', ' Onlangs geopende bestanden', lbMain );
  DeleteExclude(GetShellFolder('Cookies'), 'index.dat', ' Cookies', lbMain );
  DeleteExclude(GetFolder(dirStr), 'index.dat', ' FireFox tijdelijke bestanden', lbMain);
end;


function TForm1.GetShellFolder (const folder: string):string;
const cWin32 = 'SOFTWARE\Microsoft\Windows\CurrentVersion';
      cSHellPrefix = '\Explorer\Shell Folders';
var r: TRegistry;
begin
  Result:= '';
  r:= TRegistry.Create;
    try
      r.Rootkey:=HKEY_CURRENT_USER;
        if r.OpenKey (cWin32 + cShellPrefix, False) then
      Result:= r.ReadString (folder);
    finally
    r.Free;
    end;
end;


It comes from Russell  I think and the last piece from someone else whose name I forgot but me modified it a bit  and so far so good. However I have been struggling quite some time now to achieve the following >

The button click cleans up 5 folders. Now I would want 5 checkboxes to determine whether all folders should be emptied. This way I can leave a folder out. I can't get that working. And I made it a little more difficult by using a third party component a TRzCheckgroup, hence that is where the checkboxes come from.

I have no idea how to get my hands on the individual items and tried surely everything I could come up with......so now I turn to you.

I'm willing to compromise and swap the third party checkgroup for 5 seperate boxes or whatever makes this easier. But so far I can't get it working regardless of what component I use

Hopefully some of you can.....the lbMain is a listbox since I wanted a bitmap to preceeed the feedback. Orignally it was a memo but I wanted something more appealing so I swapped the memo for the listbox and I'm quite happy wiht the result. It now displays bitmaps, either green or red.

I hope this is enough info otherwise please let me know......

Kindest regards,

Dweeep ;-)
0
Comment
Question by:PeterdeB
2 Comments
 
LVL 5

Accepted Solution

by:
xr1140 earned 2000 total points
ID: 20033145

- add 5 checkboxes to you form
- name the checkboxes something like ckBox1 ... ckBox5 (or whatever you like)
- modify the code of the button to resemble some thing like below




procedure TForm1.Button1Click(Sender: TObject);
var dirStr: string;
begin
      if ckBo1.checked then
             DeleteExclude(GetShellFolder('Cache')+ '\Content.IE5','index.dat', ' Internet Explorer tijdelijke bestanden', lbMain);

      if ckBo2.checked then        
             DeleteExclude(GetShellFolder('history')+ '\History.IE5','index.dat', ' Internet Explorer Geschiedenis', lbMain);

      if ckBo3.checked then        
             DeleteExclude(GetShellFolder('local settings')+ '\Temp', 'index.dat', ' Tijdelijke bestanden', lbMain);

      if ckBo4.checked then        
             DeleteExclude(GetShellFolder('Recent'), 'index.dat', ' Onlangs geopende bestanden', lbMain );

      if ckBo5.checked then        
             DeleteExclude(GetShellFolder('Cookies'), 'index.dat', ' Cookies', lbMain );
        
       DeleteExclude(GetFolder(dirStr), 'index.dat', ' FireFox tijdelijke bestanden', lbMain);
       
end;




hope i`ve understand what you want ...
0
 

Author Comment

by:PeterdeB
ID: 20035735
Perfect works like a charm!! ;-)

KIndest regards,

Dweeeeeeeeeeep
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Integration Management Part 2
With just a little bit of  SQL and VBA, many doors open to cool things like synchronize a list box to display data relevant to other information on a form.  If you have never written code or looked at an SQL statement before, no problem! ...  give i…
Suggested Courses

830 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