RmDir mit Unterordnern

[Jac de Lad]

Hi Profaner.

Hat jemand ne vorgefertigte Funktion mit der ich einen Ordner samt Unterordnern löschen kann? Ich habs schon mit SHFileOperation probiert, das hat aber nicht immer geklappt und auch nicht mein Favorit. RmDir in XProfan macht das nicht. Da fällt mir momentan nur eine rekursive Funktion auf, die alle Ordner abarbeitet, die in dem Stammordner liegen.

Jac

[Frabbing]

Hi Jac!

' ________________________________________________________________________________________________________________
'  Löscht ein gesamtes Verzeichnis inklusive aller Dateien und Unterverzeichnisse
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Def &FO_DELETE $3
Def &FOF_NOCONFIRMATION $10
Def SHFileOperation(1) !"Shell32.DLL","SHFileOperationA"
Cls

Declare shfileopstruct#,text$
STRUCT SHFILEOPSTRUCT = hwnd&,wFunc&,pFrom&,pTo&,fFlags&,fAnyOperationsAborted&,hNameMappings&,lpszProgressTitle&

Proc DeleteWholeDirectory   ' löscht ein gesamtes Verzeichnis inklusive aller Dateien und Unterverzeichnisse
  Parameters path$
  Declare files$,aborted&

  files$ = path$ + "\\*.*" + Chr$(0)

  Dim shfileopstruct#,SHFILEOPSTRUCT
  shfileopstruct#.hwnd& = %HWnd
  shfileopstruct#.wFunc& = &FO_DELETE
  shfileopstruct#.pFrom& = Addr(files$)
  shfileopstruct#.pTo& = 0
  shfileopstruct#.fFlags& = &FOF_NOCONFIRMATION
  shfileopstruct#.fAnyOperationsAborted& = Addr(aborted&)
  shfileopstruct#.hNameMappings& = 0
  shfileopstruct#.lpszProgressTitle& = 0
  SHFileOperation(shfileopstruct#)
  Dispose shfileopstruct#

  ' kompletter Inhalt des Ordners wurde gelöscht, nur noch Ordner selber löschen
  RmDir path$
EndProc

' ________________________________________________________________________________________________________________
'  Beispiel
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
text$="C:\Test"
Case DirExists(text$): DeleteWholeDirectory(text$)

Eigentlich ist SHFileOperation aber die bevorzugte Lösung, bist du sicher, das du nicht nur einen Fehler eingbaut hast? Ich habe keine Probleme mit der Lösung.

[horsthorn]

@Jac
Mit der Procedur kannst du sogar bestimmen, ob die Daten in den Papierkorb oder sofort gelöscht werden.

Def @SHFileOperation(1) !"SHELL32","SHFileOperationA"
DEF neq(2) @!(1) <> @!(2)
'-----------------------------------------
PROC DATEN_AKTION
Parameters Action$,File$,File2$,noconfirm%,norecycle%
'Messagebox(file$,file2$,64)
' Parameter 1: Auszuführende Aktion=COPY, DELETE, RENAME, MOVE
' Parameter 2: Quelldatei
' Parameter 3: Zielldatei
' Parameter 4: 0 = User erst fragen, 1= ohne Nachfrage löschen
' Parameter 5: 0 = In Papierkorb verschieben, 1= "endgültig" löschen
'Messagebox(file$,file2$,64)
'end
Declare FOF_Flag%,Action&,DO%,Fehler&
Declare opstruct#,file#,file2#
'LET DO%=0
IF @upper$(Action$)="RENAME"
Let Action&=4
elseIF @upper$(Action$)="COPY"
Let Action&=2
elseIF @upper$(Action$)="MOVE"
Let Action&=1
elseIF @upper$(Action$)="DELETE"
Let Action&=3
else
@messagebox("Diese Funktion ist nicht bekannt!","Aktion wird nicht ausgeführt!",64)
LEt DO%=1
endif
IF DO%=0
Case noconfirm% : Let noconfirm%=16
CaseNot norecycle% : Let norecycle%=64
Let FOF_Flag% = (noconfirm%+norecycle%)
Dim opstruct#,60
Dim file#,(Len(file$)+2)
Dim file2#,(Len(file2$)+2)
String file#,0=(file$+@Chr$(0))
String file2#,0=(file2$+@Chr$(0))
Long opstruct#,0=%hwnd ' Handle des aufrufenden Fensters
Long opstruct#,4=Action&
Long opstruct#,8=file# ' pfrom : hier der zu löschende Ordner
Long opstruct#,12=file2# ' pto (muß 0 oder eine Bereichvar. mit Zieldateinamen ' z.B. bei Umbenennung sein
Word opstruct#,16=FOF_Flag%
Long opstruct#,18=0 ' Hier steht nach dem Aufruf 1, wenn User abgebrochen hat
Long opstruct#,22=0 ' Unbedingt immer auf Null setzen!
Long opstruct#,26=0 ' Zeiger(Bereich) auf Überschrift des Fortschrittsdialogs
LET FEHLER&=@ShFileOperation(opstruct#)
IF (@long(opstruct#,18)=1)
@MessageBox("Die Dateioperation wurde abgebrochen!","Operation abgebrochen!",64)
'ELSEIF @neq(Fehler&,0)
'@MessageBox("Es ist ein Fehler aufgetreten","ShFileOperation "+@str$(Fehler&),16)
EndIf
Dispose file#
Dispose file2#
Dispose opstruct#
endif
ENDPROC

[Jac de Lad]

Ja, das klappt bei mir auch, brauchs ohne Dialog. Das geht auch, das weiß ich und ich weiß auch wie, ich dachte nur es kennt jemand eine profane Variante ohne SHFileOperation.

Jac

[horsthorn]

@Jac
Da dürfte es keine "profane" (einfache) Variante geben.
Du müsstest in das Verzeichnis (wenn da noch 5 Unterverzeichnisse mit Dateien sind.... ), die alle extra löschen (Erase + RmDir) - das ist eine endlose Schreiberei. Da würde ich dir aber schon den Code von Frank oder den von mir geschickten empfehlen.

PS: Mein Code ist nicht von mir - weiß aber auch nicht, wer ihn geschrieben hat. Nur zur Information

[Jac de Lad]

Ok, vielen Dank. Dann nehme ich doch ein verstummtes SHFileOperation.

IFs File Inc und Unit hat fDeltree und geht schon immer!

HPGL Viewer (alpha)

Hier wirds auch mal benutzt sagt google http://quelltext.xprofan.com/src/11974126759144.txt aber ist schon ein alter Quelltext.

[Frabbing]

IFs File Inc und Unit hat fDeltree und geht schon immer!

Hält ihn ja niemand ab sie zu posten, oder?

HPGL Viewer (alpha)

Da hab ich die gefunden!

[horsthorn]

Zitat von Unregistriert

IFs File Inc und Unit hat fDeltree und geht schon immer!

Oh, ein iF - Fan

stell dich doch mal vor

[iF_]

Hey Du UFO (unbekanntes Forum Object) -

stimmt zwar, dass es in der file.pcu eine Funktion deltree gibt, aber in der HPGL-Paket's file.inc sollte diese nicht enthalten sein. Auszug aus der Unit:

proc ?_deltree (string dname) export "Löscht alle Dateien und Ordner in 'dname', einschließlich 'dname' und gibt als Ergebnis den Erfolg wieder. FDeltree ist nicht 'Geschwindigkeits', sondern 'Sicherheitsorientiert' programmiert. Sollte irgend ein Problem wärend der Operation auftauchen wird abgebrochen und 0 (null) zurückgeliefert."

    bool fail=false
    int ofmode=get("FileMode")
    set("FileMode",2)
    string op=?_getdir()

    if (direxists(dname))

        if (?_chdir(dname))

            casenot (?_path.intern.rmdirandfiles(?_getdir())) : fail=true

        else

            fail=true

        endif

    endif

    chdir op
    casenot (fail) : casenot (?_rmdir(dname)) : fail=true
    set("FileMode",ofmode)
    return not(fail)

endproc

proc ?_getdir export "Vergleichbar mit getdir$('@') - aber die Ausgabe endet nicht unterschiedlich mal mit \ - oder ohne \."

    string s=getdir$("@")
    casenot (right$(s,1) == "\") : s=s+"\"
    return s

endproc

proc ?_path.intern.rmdirandfiles (string dname) noexport

    bool fail=false
    string org=dname
    string oldp=?_getdir()
    string fle="",op,newp

    if (?_chdir(dname))

        fle=?_ff()

        while ( (len(fle)>0) and (not(fail)) )

            if ( ( mid$(fle,1,1)=="[" ) and ( mid$(fle,len(fle),1)=="]" ) )

                if ( direxists(mid$(fle,2,len(fle)-2)) )

                    fle=mid$(fle,2,len(fle)-2)
                    op=?_getdir()
                    newp=?_getdir()+fle
                    casenot (?_path.intern.rmdirandfiles(newp)) : fail=true
                    casenot (fail) : casenot (?_chdir(op)) : fail=true
                    casenot (fail) : rmdir newp

                elseif ?_exist(fle)

                    casenot (?_delete(fle)) : fail=true

                else

                    fail=true

                endif

            else

                casenot (?_delete(fle)) : fail=true

            endif

            casenot fail : fle=?_ff()

        wend

    endif

    ?_chdir (oldp)
    return not(fail)

endproc

proc ?_rmdir (string dname) export "Löscht ein leeres Verzeichnis 'dname' (ohne alles/spielereien) und gibt den Erfolg als Rückgabewert zurück."

    case direxists(dname) : rmdir dname$
    return if(direxists(dname),false,true)

endproc

proc ?_chdir (string dname) export "Wechselt in das Verzeichnis 'dname' und gibt den Erfolg als Rückgabewert zurück."

    casenot direxists(dname) : return false
    string oldDir=?_getdir()
    bool fail=false

    if ioresult//ioresult zurücksetzen

    endif

    chdir dname
    fail=if(ioresult,true,false)
    case fail : chdir oldDir
    return not(fail)

endproc

proc ?_delete (string fname) export "Löscht die Datei 'fname' und liefert als Rückgabewert den Erfolg zurück."

    bool fail=false
    int ofmode=get("FileMode")
    set("FileMode",2)
    int fh=assign(fname)
    casenot fh : fail=true

    ifnot fail

        erase #fh%
        case ?_exist(fname) : fail=true
        assign #fh%,""

    endif

    set("FileMode",ofmode)
    return not(fail)

endproc

proc ?_exist (string fname) export "Gibt als Rückgabewert die Existenz der Datei 'fname' zurück."

    //ein paar Dinge welche sich bewährt hatten
    case fname=="[.]" : return false
    case fname=="[..]" : return false
    casenot fileexists(fname) : return false
    casenot len(findfirst$(fname)) : return false
    return true

endproc

Ich würde aber einfachheitshalber die (mittlerweile alte) Unit nutzen, einfach herunterladen von http://xprofan.com/thread.core?t=789 .

[Jac de Lad]

Wow, ich hatte mehr an ein verschachteltes FindFirst/FindNext gedacht.