XProfan

- Seite 2 -

« Dieser Beitrag wurde als Lösung gekennzeichnet. »

- Seite 3 -

Dieter
Zornow

Warum nimmst du nicht einfach die API zum löschen. Hier ist ein flexibler Code für Löschen, Kopieren Umbenennen und Bewegen. Je nach Parameter kannst du in den Papierkorb oder auch nicht löschen, ganz wie du willst. Das erspart doch den ganzen Hickhack und arbeitet zuverlässig. Im Beispiel wird ohne Nachfrage ein Verzeichnis mit Unterverzeichnissen nicht in den Papierkorb gelöscht

' Parameter 1: Auszuführende Operation=COPY, DELETE, RENAME, MOVE
' Parameter 2: Quelldatei(en)
' Parameter 3: Zielldatei(en)
' Parameter 4: 0 = Benutzer fragen, 1= ohne Nachfrage löschen
' Parameter 5: 0 = In Papierkorb verschieben, 1= "endgültig" löschen
' Parameter 6: 0 = Abbrechen bei vorhandener Datei, 1 = Kopie der Datei anlegen

Proc SHFileoperation

    Parameters operation$,File$,File2$,confirm%,recycle%,can%
    Declare opstruct#,file#,file2#,title#,operation&
    Var FOF_Flag% = 1 | 512 |  2048'FOF_MULTIDESTFILES,FOF_NOCONFIRMMKDIR,FOF_NOCOPYSECURITYATTRIBS
    Dim title#,24
    string title#,0 = "Fileoperation Progress"

    Select upper$(operation$)

        CaseOf "RENAME"

        operation&=4

        CaseOf "COPY"

        operation&=2

        CaseOf "MOVE"

        operation&=1

        CaseOf "DELETE"

        operation&=3

    endselect

    case confirm%:confirm%=16
    Casenot recycle%:recycle%=64

    If can%

        FOF_Flag% = FOF_Flag% | confirm% | recycle% | $20 | 8'$20 = FOF_WANTMAPPINGHANDLE 8 = FOF_RENAMEONCOLLISION

    Else

        FOF_Flag% = FOF_FLAG% | confirm% | recycle%'16 = FOF_NOCONFIRMATION,64 = FOF_ALLOWUNDO

    endif

    Dim opstruct#,30: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=GetActiveWindow()' Handle des aufrufenden Fensters
    Long opstruct#,4=operation&'Welche Dateioperation gemacht wird
    Long opstruct#,8=file#' pfrom : hier die Dateien für die Operation
    Long opstruct#,12=file2#'pto hier die Zieldateinamen oder 0
    Word opstruct#,16=FOF_Flag%
    Long opstruct#,18=0'Bei abbruch steht hier 1 nur bei langen Operationen
    Long opstruct#,22=0' muss immer Null sein, hier wird handle für SHNameMappings gesetzt bei Kopie
    Long opstruct#,26=Title#'Überschrift des Fortschrittsdialogs bei langen Operationen
    Var FEHLER&=External("SHELL32","SHFileOperationA",opstruct#)

    IF (long(opstruct#,18)=1)

        MessageBox("Die Dateioperation wurde abgebrochen!","Abbruch durch Benutzer!",64)

    ELSEIF (Fehler& <> 0)

        MessageBox(str$(fehler&),"Es ist ein Fehler aufgetreten",16)

    EndIf

    If val($WinVer)> 5.0

        Case LONG(opstruct#,22) <> 0:External("Shell32","SHFreeNameMappings",LONG(opstruct#,22))'min XP

    endif

    Dispose file#,file2#,opstruct#,title#

EndProc

cls
SHFileoperation("Delete","c:\\Temp\\Test\\","",1,1,0)
print "fertig"
Waitinput
end

Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2

26.07.2011 ▲

Schonmal nach ChooseDir$ ein print getDir$("@") gemacht?

Vlt. solltest du zusätzlich auch vor dem Löschen jeder einzelnen Datei den Dateipfad der Datei (z.B. mit mid$ ) mit dem gewählten Verzeichnis vergleichen.

Julian
Schmidt

@Thomas - Nein, in den Papierkorb sollen die Dateien nach dem löschen nicht landen. Erase ist schon in Ordnung auch wenn es nicht restlos ist.
@Marc - Nein, was ist das deltree? Beispiel?
@IF: -
iF (25.07.11)

Schonmal nach ChooseDir$ ein print getDir$("@") gemacht?

Wie soll das funktionieren? Kannst du's in den Code einbauen?

iF (25.07.11)

Vlt. solltest du zusätzlich auch vor dem Löschen jeder einzelnen Datei den Dateipfad der Datei (z.B. mit mid$ ) mit dem gewählten Verzeichnis vergleichen.

Gute Idee!

delete_folder_completely("C:\\Test")
'delete_folder_completely(ChooseDir$("Verzeichnis wählen:"))
Messagebox("Ordner gelöscht","INFO",64)

Proc delete_folder_completely

    Parameters Pfad$
    var addfiles.dll&=ImportDLL("addfiles.dll","")
    var h&=Create("List", 0)
    Chdir Pfad$
    case @GetDir$("@")=Pfad$ : AddFiles("*.*",h&,1)
    MoveListToHandle(h&)

    whileloop GetCount(h&)

        case Left$(GetString$(h&,&loop-1),Len(Pfad$))=Pfad$ : Erase GetString$(h&,&loop-1)

    Endwhile

    clearlist h&
    Chdir Pfad$
    case @GetDir$("@")=Pfad$ :  AddDirs("*.*",h&,1)

    whileloop GetCount(h&),1,-1

        case Left$(GetString$(h&,&loop-1),Len(Pfad$))=Pfad$ : RmDir GetString$(h&,&loop-1)

    Endwhile

    destroywindow(h&)
    case @GetDir$("@")=Pfad$ : RmDir Pfad$
    FreeDLL addfiles.dll&

EndProc

@All
Weiterhin bleiben mehrere Fragen offen.

Warum wird der Ausgangsordner nicht gelöscht? Trotz der Zeile "case @GetDir$("@")=Pfad$ : RmDir Pfad$".
Warum kommt wenn ich die erste Zeile in "delete_folder_completely(ChooseDir$("Verzeichnis wählen:"))" ändere eine Fehlermeldung?

archiv.rar	13 kB

Hochgeladen:	25.07.2011

Ladeanzahl:
		Herunterladen

˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗
Webseite [...]

Jörg
Sellmeyer

Mach doch mal das hier

Proc delete_folder_completely

    Parameters Pfad$
    print pfad$

Außerdem nützt Dir das hier:

case @GetDir$("@")=Pfad$ : AddFiles("*.*",h&,1)

nichts, um evtl. einen Fehler abzufangen, da Dein Programm so oder so weitermacht. Wenn, dann eine vernünftige iF-Abfrage in der Du auch eine Alternative programmierst. Also eine Messagebox "Falscher Pfad" oder sowas.

Du springst mit ChDir in den Ordner rein. Es kann gut sein, daß dieser dadurch blockiert wird und Du erst löschen kannst, wenn Du wieder aus dem Ordner rausgehst: ChDir ".."

Erase ist ein alter DOS-Befehl. Sehr effektiv aber auch mit Vorsicht zu genießen, wenn man sich nicht auskennt. Gib im DOS-Fenster Help /erase ein.

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

@Jörg: Ich glaube Du meinst deltree statt erase ?! Erase gibts aber auch und mit /S ists wie deltree -

mein aktuelles XP kennt deltree ("""leider""") nicht mehr.

@Julian: Einfach nach Deinem ChooseDir$ mal ein print getDir$("@") um zu schauen ob ChooseDir$ den Pfad ändert.

Warum eine Datei/ Ordner sich nicht entfernen lässt... irgend ein Prozess wird halt noch am oder im Verzeichnis rumwuseln und ein Handle halten - vlt. der Explorer der an seiner versteckten thumbs.db klebt oder ein AV-Programm oder ein Indizierungsdienst oder oder oder... nutze testweise die addFiles.DLL wie im Beispiel auch mal per external statt per importdll um auch auszuschließen ob ich da vergessen habe ein Handle zu schließen.

Tippt keiner auf UAC?

Du meinst ob der Ordner einem anderen Benutzer gehört oder der Benutzer kein Lösch-Recht besitzt?

Jörg
Sellmeyer

Ja - meinte natürlich deltree. Sorry...

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

Jörg Sellmeyer (25.07.11)

Julian
Schmidt

Außerdem nützt Dir das hier:

case @GetDir$("@")=Pfad$ : AddFiles("*.*",h&,1)

Jörg Sellmeyer (25.07.11)

cls
delete_folder_completely("C:\\Test")
'delete_folder_completely(ChooseDir$("Verzeichnis wählen:"))

Proc delete_folder_completely

    Parameters Pfad$
    declare fehler%,z%,h&
    var addfiles.dll&=ImportDLL("addfiles.dll","")

    while 1

        if DirExists(Pfad$)

            h&=Create("List", 0)
            Chdir Pfad$

            if @GetDir$("@")=Pfad$

                AddFiles("*.*",h&,1)
                MoveListToHandle(h&)

                whileloop GetCount(h&)

                    if Left$(GetString$(h&,&loop-1),Len(Pfad$))=Pfad$

                        if FileExists(GetString$(h&,&loop-1))

                            Erase GetString$(h&,&loop-1)

                            if FileExists(GetString$(h&,&loop-1))

                                Messagebox("Die Datei '"+GetString$(h&,&loop-1)+"' konnte nicht gelöscht werden!","ERROR",16)
                                fehler%=fehler%+1

                            Endif

                        Endif

                    Endif

                Endwhile

                clearlist h&
                Chdir Pfad$

                if @GetDir$("@")=Pfad$

                    AddDirs("*.*",h&,1)

                    whileloop GetCount(h&),1,-1

                        if Left$(GetString$(h&,&loop-1),Len(Pfad$))=Pfad$

                            if DirExists(GetString$(h&,&loop-1))

                                RmDir GetString$(h&,&loop-1)

                                if DirExists(GetString$(h&,&loop-1))

                                    Messagebox("Das Verzeichnis '"+GetString$(h&,&loop-1)+"' konnte nicht gelöscht werden!","ERROR",16)
                                    fehler%=fehler%+1

                                Endif

                            Endif

                        Endif

                    Endwhile

                    if @GetDir$("@")=Pfad$

                        if DirExists(Pfad$)

                            RmDir Pfad$

                            if DirExists(Pfad$)

                                Messagebox("Das Verzeichnis '"+Pfad$+"' konnte nicht gelöscht werden!","ERROR",16)
                                fehler%=fehler%+1

                            Endif

                        Endif

                    else

                        Messagebox("Der Pfad '"+Pfad$+"' konnte nicht geöffnet werden!","ERROR",16)

                    Endif

                else

                    Messagebox("Der Pfad '"+Pfad$+"' konnte nicht geöffnet werden!","ERROR",16)

                Endif

            else

                Messagebox("Der Pfad '"+Pfad$+"' konnte nicht geöffnet werden!","ERROR",16)

            Endif

        else

            Messagebox("Der Pfad '"+Pfad$+"' ist nicht vorhanden","ERROR",16)

        Endif

        if fehler%=0

            break

        else

            z%=Messagebox("Das Löschen des Ordnes '"+Pfad$+"' war nicht erfolgreich! Wollen Sie es Wiederholen?","INFO",5+64+256+4096)

            if z%=4

                fehler%=0

            else

                break

            Endif

        Endif

    Endwhile

    destroywindow(h&)
    FreeDLL addfiles.dll&

EndProc

Du springst mit ChDir in den Ordner rein. Es kann gut sein, daß dieser dadurch blockiert wird und Du erst löschen kannst, wenn Du wieder aus dem Ordner rausgehst: ChDir ".."

Wie könnte ich sowas in den Code einbeziehen?

iF (25.07.11)

Warum eine Datei/ Ordner sich nicht entfernen lässt... irgend ein Prozess wird halt noch am oder im Verzeichnis rumwuseln und ein Handle halten - vlt. der Explorer der an seiner versteckten thumbs.db klebt oder ein AV-Programm oder ein Indizierungsdienst

Das habe ich bereits vermutet! Ich habe deswegen versucht den Ordner freizugeben, den Computer neugestartet, Explorer.exe beendet. Danach ging es, wie zuvor ebenfalls nicht! Anschließend habe ich über Unlocker überprüft ob ein Prozess den Ordner verwendet. Der Sagte mir das er nicht in Verwendung ist! Nach einem weiteren Test des Löschens ging es wieder nicht. Liegt etwa am Quellcode, bzw. an RmDir? Oder weil XProfan selbst diesen Ordner blockiert.

iF (25.07.11)

oder oder oder... nutze testweise die addFiles.DLL wie im Beispiel auch mal per external statt per importdll um auch auszuschließen ob ich da vergessen habe ein Handle zu schließen.

Muss ich die DLL davor noch iwie einbinden [UseDLL oder so?]?

˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗
Webseite [...]

Nein, einfach nur External.

Julian
Schmidt

Über den Aufruf über External kommt wiederum eine Fehlermeldung.
Liegt es vlt daran das ich den kompletten Pfad zur DLL angeben muss?

delete_folder_completely("C:\\Test")
'delete_folder_completely(ChooseDir$("Verzeichnis wählen:"))

Proc delete_folder_completely

    Parameters Pfad$
    declare fehler%,z%,h&
    'var addfiles.dll&=ImportDLL("addfiles.dll","")

    while 1

        if DirExists(Pfad$)

            h&=Create("List", 0)
            Chdir Pfad$

            if @GetDir$("@")=Pfad$

                'AddFiles("*.*",h&,1)
                external("addfiles.dll","AddFiles","*.*",h&,1)
                MoveListToHandle(h&)

                whileloop GetCount(h&)

                    if Left$(GetString$(h&,&loop-1),Len(Pfad$))=Pfad$

                        if FileExists(GetString$(h&,&loop-1))

                            Erase GetString$(h&,&loop-1)

                            if FileExists(GetString$(h&,&loop-1))

                                Messagebox("Die Datei '"+GetString$(h&,&loop-1)+"' konnte nicht gelöscht werden!","ERROR",16)
                                fehler%=fehler%+1

                            Endif

                        Endif

                    Endif

                Endwhile

                clearlist h&
                Chdir Pfad$

                if @GetDir$("@")=Pfad$

                    'AddDirs("*.*",h&,1)
                    external("addfiles.dll","AddDirs","*.*",h&,1)

                    whileloop GetCount(h&),1,-1

                        if Left$(GetString$(h&,&loop-1),Len(Pfad$))=Pfad$

                            if DirExists(GetString$(h&,&loop-1))

                                RmDir GetString$(h&,&loop-1)

                                if DirExists(GetString$(h&,&loop-1))

                                    Messagebox("Das Verzeichnis '"+GetString$(h&,&loop-1)+"' konnte nicht gelöscht werden!","ERROR",16)
                                    fehler%=fehler%+1

                                Endif

                            Endif

                        Endif

                    Endwhile

                    if @GetDir$("@")=Pfad$

                        if DirExists(Pfad$)

                            RmDir Pfad$

                            if DirExists(Pfad$)

                                Messagebox("Das Verzeichnis '"+Pfad$+"' konnte nicht gelöscht werden!","ERROR",16)
                                fehler%=fehler%+1

                            Endif

                        Endif

                    else

                        Messagebox("Der Pfad '"+Pfad$+"' konnte nicht geöffnet werden!","ERROR",16)

                    Endif

                else

                    Messagebox("Der Pfad '"+Pfad$+"' konnte nicht geöffnet werden!","ERROR",16)

                Endif

            else

                Messagebox("Der Pfad '"+Pfad$+"' konnte nicht geöffnet werden!","ERROR",16)

            Endif

        else

            Messagebox("Der Pfad '"+Pfad$+"' ist nicht vorhanden","ERROR",16)

        Endif

        if fehler%=0

            break

        else

            z%=Messagebox("Das Löschen des Ordnes '"+Pfad$+"' war nicht erfolgreich! Wollen Sie es Wiederholen?","INFO",5+64+256+4096)

            if z%=4

                fehler%=0

            else

                break

            Endif

        Endif

    Endwhile

    destroywindow(h&)
    'FreeDLL addfiles.dll&

EndProc

˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗
Webseite [...]

Jörg
Sellmeyer

den kompletten Pfad zur DLL angeben muss?

Hast Du es schon ausprobiert?

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

Jörg Sellmeyer (25.07.11)

Julian
Schmidt

Julian57 (25.07.11)

den kompletten Pfad zur DLL angeben muss?

Hast Du es schon ausprobiert?

Nein geht leider nicht.