Delete all files and Directories Delphi 5

illfusion82
illfusion82 used Ask the Experts™
on
I am using Delphi 5, and would like to know how to delete all files and directories under the C:\Documents and Settings\All Users\Start Menu\Programs folder except for the startup folder.
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2007
Commented:
function GetParentDir(dir: String): String;
begin
   try
     if dir[length(dir)]='\' then Delete(dir,length(dir),1);
     Result := ExcludeTrailingBackSlash (ExtractFileDir (dir));
   except
     Result := #0;
   end;
end;


function DeleteFolder(RootDir:String):Boolean;
var sr: TSearchRec;ParentDir:String;
begin
  Result:=True;
  if RootDir[length(RootDir)]<>'\' then RootDir:=RootDir+'\';
  ChDir(RootDir);
  if FindFirst('*.*', faDirectory, sr) = 0 then
  begin
    repeat
      if (sr.Name<>'.') and (sr.Name<>'..') then
      begin
         if (sr.Attr and faReadOnly)=faReadOnly then
            SetFileAttributes(pchar(RootDir+sr.Name),sr.Attr and $FE);
      end;
      if (sr.Attr and faDirectory) = faDirectory then
          if (sr.Name<>'.') and (sr.Name<>'..') then
          begin
             Result:= DeleteFolder(RootDir+sr.Name);
             ChDir(RootDir);
          end;
    until (not Result) or (FindNext(sr) <> 0);
    FindClose(sr);
  end;
  if FindFirst('*.*', faAnyFile, sr) = 0 then
  begin
    repeat
      if (sr.Attr and faDirectory) <> faDirectory then
       if (sr.Name<>'.') and (sr.Name<>'..') then Result:= DeleteFile(RootDir+sr.Name);
    until (not Result) or (FindNext(sr) <> 0);
    FindClose(sr);
  end;
  ParentDir:=GetParentDir(RootDir);
  ChDir(ParentDir);
  Result:=RemoveDir(RootDir);
end;

function ClearFolder:Boolean;
var sr: TSearchRec;RootDir:String;
begin
  Result:=True;
  RootDir:='C:\Documents and Settings\All Users\Start Menu\Programs\';
  ChDir(RootDir);
  if FindFirst('*.*', faDirectory, sr) = 0 then
  begin
    repeat
      if (sr.Name<>'.') and (sr.Name<>'..') and (not SameText(sr.Name,'startup')) then
      begin
         if (sr.Attr and faReadOnly)=faReadOnly then
            SetFileAttributes(pchar(RootDir+sr.Name),sr.Attr and $FE);
      end;
      if (sr.Attr and faDirectory) = faDirectory then
          if (sr.Name<>'.') and (sr.Name<>'..') and (not SameText(sr.Name,'startup')) then
          begin
             Result:= DeleteFolder(RootDir+sr.Name);
             ChDir(RootDir);
          end;
    until (not Result) or (FindNext(sr) <> 0);
    FindClose(sr);
  end;
  if FindFirst('*.*', faAnyFile, sr) = 0 then
  begin
    repeat
      if (sr.Attr and faDirectory) <> faDirectory then
        if (sr.Name<>'.') and (sr.Name<>'..') then Result:= DeleteFile(RootDir+sr.Name);
    until (not Result) or (FindNext(sr) <> 0);
    FindClose(sr);
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
   ClearFolder;
end;

Author

Commented:
Thanks dinilud! That worked great!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial