How to empty a directory leaving one file?

Hi my dear friends!

This is what I have and this works great:

*******************************************************************************
 function KillFiles(Path: string): Boolean;
var
  Found:         Integer;
  Attr:          Integer;
  SearchRec:     TSearchRec;
  FileName:      string;

begin
  Attr := faAnyFile;
  Found := FindFirst(Path + '\*.*', Attr, SearchRec);
  while (Found=0) do
  try
    if ((IntToHex(SearchRec.Attr, 8)='00000810')
    or  (IntToHex(SearchRec.Attr, 8)='00000010'))
    and (not (SearchRec.Name[1]='.')) then
    begin
      FileName := Path + '\' + SearchRec.Name;
      RemoveDir(FileName);
      KillFiles(FileName);
    end;
    if (not ((SearchRec.Attr=faDirectory) or (SearchRec.Attr=17))
    and not (SearchRec.Name='.') and not (SearchRec.Name='..')) then
    begin
      FileName := Path + '\' + SearchRec.Name;
      if ((FileGetAttr(FileName) and faReadOnly) > 0) then
        FileSetAttr(FileName, FileGetAttr(FileName) xor faReadOnly);

      if ((FileGetAttr(FileName) and faHidden) > 0) then
        FileSetAttr(FileName, FileGetAttr(FileName) xor faHidden);

      if ((FileGetAttr(FileName) and faSysFile) > 0) then
        FileSetAttr(FileName, FileGetAttr(FileName) xor faSysFile);

      DeleteFile(FileName);
      KillFiles(Path);
    end;
    Found := FindNext(SearchRec); //get next file in directory
  except
  end;
  FindClose(SearchRec);
end;

procedure TForm1.btnDeleteClick(Sender: TObject);
var i : cardinal;
user:string;
begin
  i:=255;
//ExtractFilePath('c:\documents and settings\');
setlength(user,i);
getusername(pchar(user),i);
setlength(user,(i-1));
//ShowMessage(user);
if not
  killfiles('c:\documents and settings\'+user+'\local settings\temporary internet files\content.ie5')
  then ShowMessage('failed!');

  end;

end.

***************************************************************************
Thanks to esoftbg and inthe btw :)

Now I want this program to leave one file unharmed untouched.....the index.dat....

How should I implement this? I'd say there would be other ways of emptying the cache of IE but so far this is my solution any other solutions are welcome as well ofcourse!

Best regards,

Paul

Ps working samples always do the trick ofcourse!
PeterdeBAsked:
Who is Participating?
 
Russell LibbyConnect With a Mentor Software Engineer, Advisory Commented:
Paul,

Here is another way using the SHFileOperation from the ShellApi unit. It keeps you from having to recurse the paths, and uses the same logic (code) that windows uses when deleting files/folders. Full example provided, let me know if you have questions.

Regards,
Russell

-----

unit Unit1;

interface

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

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

var
  Form1:            TForm1;

implementation
{$R *.DFM}

function TForm1.UserName: String;
var  dwSize:        DWORD;
begin

  // Buffer size to use
  dwSize:=256;

  // Allocate result buffer
  SetLength(result, 256);

  // Get user name
  if GetUserName(Pointer(result), dwSize) then
     // Truncate to actual result
     SetLength(result, Pred(dwSize))
  else
     // Truncate to null string
     SetLength(result, 0);

end;

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;

procedure TForm1.Button1Click(Sender: TObject);
begin

  if DeleteExclude('c:\documents and settings\'+UserName+'\local settings\temporary internet files\content.ie5', 'index.dat') then
     ShowMessage('Success')
  else
     ShowMessage('Failure');

end;

end.
0
 
PeterdeBAuthor Commented:
Tnx Russell works great!!

Regards Paul :)
0
All Courses

From novice to tech pro — start learning today.