We help IT Professionals succeed at work.

How to modify this DeleteExclude Function?

PeterdeB
PeterdeB asked
on
265 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 ;-)
Comment
Watch Question

Commented:
Unlock this solution and get a sample of our free trial.
(No credit card required)
UNLOCK SOLUTION

Author

Commented:
Perfect works like a charm!! ;-)

KIndest regards,

Dweeeeeeeeeeep

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Unlock the solution to this question.
Thanks for using Experts Exchange.

Please provide your email to receive a sample view!

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.