Alle Dateien in einem Ordner schrotten???

[mlspider]

An alle den es interessiert. Ich habe das Problem mit einem Code-Schnipsel aus einen anderem Forum wie folgt gelöst:

Delphi-Quellcode:

function WipeFile(const szFilename: string): boolean;
var
  f      : file;
  buf    : array[0..65535]of byte;
  i,
  iRead,
  iWrite : integer;
  fpos   : longint;
begin
  {$I-}
  AssignFile(f,szFileName);
  ReSet(f,1);


  if(IoResult = 0) then begin  
    repeat
      fPos := filepos(f);                    // aktuelle Position merken  
      BlockRead(f,buf,sizeof(buf),iRead);    // max. 65k lesen  

 
      // der tatsächlich gelesene Wert steckt in "iRead" und  
      // ist irgendwann Null, wenn das Ende der Datei erreicht
      // wurde und keine Bytes mehr gelesen werden können  
      if(iRead > 0) then  
        // (alte?) Methode des DOD (US-Verteidigungsministerium):
        // einmal 00 schreiben; einmal FF schreiben (3 Wiederholungen)  
        // dann F6 schreiben  
        // (Norton WipeInfo macht´s heute noch so; außer, das 0x01
        // anstelle von 0xff angegeben ist)  
        for i := 1 to 7 do begin  
          case i of
            1,3,5 : fillchar(buf,iRead,  0); // Inhalt mit 0x00 überschreiben  
            2,4,6 : fillchar(buf,iRead,255); // Inhalt mit 0xff überschreiben  
            7     : fillchar(buf,iRead,246); // Inhalt mit 0xf6 überschreiben
          end;


          seek(f,fPos);                      // gespeicherte Position suchen  
          BlockWrite(f,buf,iRead,iWrite);    // Puffer schreiben
          if(iWrite <> iRead) then break;    // Fehler! :o(
        end;  
    until(iRead = 0) or (iWrite <> iRead);  

 
    CloseFile(f);                            // alte Datei schließen  
    Rename(f,'D');                           // alten Namen "vernichten"
    ReWrite(f,1);                            // alte Position "vernichten"
    CloseFile(f);  
    Erase(f);                                // Datei löschen
  end;  
  {$I+}

 
  Result := (IoResult = 0);  
end;

 
Procedure DeleteFiles(aPath, aFindMask: String; aWithSub: Boolean);
Var
  FindRec: tSearchRec;  
Begin
  // Wenn aPath oder aFind nicht angegeben ist  
  // dann raus
  If (aPath = '') or (aFindMask = '') Then
    Exit;  


  // Wenn am Ende der Pfadangabe noch kein \ steht, dieses hinzufügen  
  If aPath[Length (aPath)] <> '\' Then  
    aPath := aPath + '\';

 
  // Im aktuellen Verzeichnis nach der Datei suchen
  If FindFirst (aPath + aFindMask, faAnyFile, FindRec) = 0 Then  
    Repeat
      If (FindRec.Name <> '.') and (FindRec.Name <> '..') Then
        // ...Ergebnis löschen  
        WipeFile(aPath + FindRec.Name);  
    Until FindNext (FindRec) <> 0;

 
  FindClose (FindRec);

 
  // Wenn nicht in Unterverzeichnissen gesucht werden soll dann raus
  If Not aWithSub Then  
    Exit;

 
  // In Unterverzeichnissen weiter suchen  
  If FindFirst (aPath + '*.*', faAnyFile, FindRec) = 0 Then
    Repeat  
      If (FindRec.Name <> '.') and (FindRec.Name <> '..') Then  
        // Feststellen, ob es sich um ein Verzeichnis handelt
        If Boolean (FindRec.Attr and faDirectory) Then
          // Funktion erneut aufrufen, um Verzeichnis zu durchsuchen (Rekursion)  
          DeleteFiles (aPath + FindRec.Name, aFindMask, aWithSub);
    Until FindNext (FindRec) <> 0;  


   FindClose (FindRec);  
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
 DeleteFiles ('j:\test', '*.*', True);
end;

Wobei J:\Test für mein Versuchs-Ordner stand.

getestet! Es funktioniert! Das einzigste was mich daran noch stört, das die leeren Ordner erhalten bleiben. Aber vielleicht gibt es hierfür auch noch eine Lösung.