XProfan

Italia

Folgende Prozedur löscht in den Papierkorb, kopiert, verschiebt und benennt File und Ordner um - und das mit Fortschrittsdialog. Den Code hatte ich teilweise sowieso schon parat und habe ihn kurz mal auf die anderen Funktionen erweitert. Deshalb läßt sich daran auch bestimmt noch einiges verbessern...
Kompilieren Markieren Separieren

Def @SHFileOperation(1) !"SHELL32","SHFileOperationA"
Declare opstruct#,file#,file2#

Proc Fileaction

    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 Parameters Action$,file$,file2$,noconfirm%,norecycle%
    Declare FOF_Flag%,Action&,DO%
    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% = @Or(noconfirm%,norecycle%)
        Dim opstruct#,30
        Dim file#,Add(Len(file$),2)
        Dim file2#,Add(Len(file2$),2)
        String file#,0=@Add$(file$,@Chr$(0))
        String file2#,0=@Add$(file2$,@Chr$(0))
        Long opstruct#,0=%hwnd   Handle des aufrufenden Fensters
        Long opstruct#,4=Action&
        Long opstruct#,8=file#
        Long opstruct#,12=file2#
        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

        IF @Gt(@ShFileOperation(opstruct#),0)

            @MessageBox("Es ist ein Fehler aufgetreten","ShFileOperation",16)

        EndIf

    endif

    Dispose file#
    Dispose file2#
    Dispose opstruct#

EndProc

REM Beispiel
Fileaction "COPY","C:WINDOWS","C:TEMP",0,0
Fileaction "RENAME","C:WINDOWSTEMPTEST.DOC","C:WINDOWSTEMPTEST2.DOC",0,0
Fileaction "COPY","C:WINDOWSTEMPTEST2.DOC","C:WINDOWSTEMPTEST.DOC",0,0
Fileaction "MOVE","C:WINDOWSTEMPTEST2.DOC","C:WINDOWSTEMPTEST3.DOC",0,0
Fileaction "DELETE","C:WINDOWSTEMPTEST.DOC",=s3>"",0,0

(Hoffentlich jetzt ohne Rechtschreibfehler)

21.07.2004 ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione

War noch ein kleiner Fehler drin (man sollte eben nicht alles ungefragt übernehmen). So läufts (hoffentlich) besser:
Kompilieren Markieren Separieren

Def @SHFileOperation(1) !"SHELL32","SHFileOperationA"

Proc Fileaction

    Parameters Action$,File$,File2$,noconfirm%,norecycle%
    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
    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#,30
        Dim file#,Add(Len(file$),2)
        Dim file2#,Add(Len(file2$),2)
        String file#,0=@Add$(file$,@Chr$(0))
        String file2#,0=@Add$(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 @equ(FEHLER&,117)

            @MessageBox("Die Dateioperation wurde abgebrochen!","Operation abgebrochen!",64)

        ElseIF @gt(Fehler&,0)

            @MessageBox("Es ist ein Fehler aufgetreten","ShFileOperation "+@str$(Fehler&),16)

        EndIf

        Dispose file#
        Dispose file2#
        Dispose opstruct#

    endif

EndProc

REM Beispiel
Fileaction "COPY","C:WINDOWS","C:TEMP",0,0
Fileaction "DELETE",&quo