Hallo allerseits,
ich brauch beruflich eine Software, die unter bestimmten Umständen immer und immer wieder die Verzeichnisstrukturen von längst erledigten Projekten neu erstellt. Ich hab also plötzlich einen Ordner mit 80 Unterordnern, von denen nur der eine mit dem aktuellen Projekt überhaupt Dateien enthält. Wollte ich mir also ein Program schreiben, das einfach rekursiv alle leeren Ordner löscht.
Klappt aber nicht. Sobald findnext einen Ordner irgendwie angepackt hat, kann rmdir den nicht mehr löschen, Fehlermeldung "Der Prozess kan auf die Datei … nicht zugreifen, da sie von einem anderen Prozess verwendet wird.
Wenn das Programm mit dieser Fehlermeldung anhält, kann ich den Ordner auch von Hand nicht löschen. Wenn das Programm abgebrochen wurde, geht’s wieder. Irgendwie scheint das Programm die Ordner bis zum Programmende zu locken, aber wieso???
Für jeden Tipp dankbar
Gruß
Peter
Der Code:
program ClearTW;
uses SysUtils ;
var g : tsearchrec ;
procedure clear ( s : string ) ;
var g : tsearchrec ;
begin
writeln ( s ) ;
if findfirst ( s + ‚*.*‘ , faanyfile , g ) = 0
then repeat
if g . name [1] = ‚.‘ then continue ;
if g . attr = fadirectory
then clear ( s + ‚‘ + g . name ) ;
until findnext ( g ) 0 ;
rmdir ( s ) ;
end ;
function filecount ( s : string ) : integer ;
var g : tsearchrec ;
i : integer ;
begin
i := 0 ;
if findfirst ( s + ‚*.*‘ , faanyfile , g ) = 0
then repeat
if g . name [1] = ‚.‘ then continue ;
if g . attr = fadirectory
then i := i + filecount ( s + ‚‘ + g . name )
else inc ( i ) ;
until findnext ( g ) 0 ;
filecount := i ;
end ;
begin
if findfirst ( ‚*.*‘ , fadirectory , g ) = 0
then repeat
if ( g . name [1] ‚.‘ ) and ( g . attr = fadirectory )
then begin
if filecount ( g . name ) = 0 then clear ( g . name ) ;
end ;
until findnext ( g ) 0 ;
end.