XProfan

' 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