XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Ordner mit Unterordnern und Dateien kopieren, verschieben, umbenennen, löschen
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% = @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#  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(@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

Rem Beispiel
Fileaction COPY,C:WINDOWS,E:TEMP,0,0
Fileaction DELETE,E:TEMP,,1,1