Attribute VB_Name = "ExplorerFunctions"
' KONSTANTEN DER FUNC

' Kopiert das File in pFROM nach pTo
Private Const FN_COPY = &H2&

' Löscht das File in pFrom (pTo wird ignoriert)
Private Const FN_DELETE = &H3&

' Verschiebt das File in pFROM nach pTo
Private Const FN_MOVE = &H1&

' Umbenennen des Files in pTo
Private Const FN_RENAME = &H4&
    
    
' KONSTANTEN DER FLAGS

' Undo Information -> Schiebt beim Löschen
' das (die) File(s) in den Papierkorb
Private Const FNF_ALLOWUNDO = &H40&

' Bislang keine bekannte Funktion
Private Const FNF_CONFIRMMOUSE = &H2&

' Handle zum Eltern-Fenster der
' Progress-Dialogbox (also Me.hwnd)
Private Const FnF_CREATEPROGRESSDLG = &H0&

' Nur Files - KEINE ORDNER - wenn *.* als Source
Private Const FnF_FILESONLY = &H80&

' Für diverse Stellen bei DEST (der "pTo" muss dann
' die gleiche Anzahl von Zielen aufweisen wie "pFrom"
Private Const FnF_MULTIDESTFILES = &H1&

' ANTWORTET AUTOMATISCH MIT 'JA für alle'
Private Const FnF_NOCONFIRMATION = &H10&

' Keine Abfrage für einen neuen Ordner, falls benötigt
Private Const FnF_NOCONFIRMMKDIR = &H200&

' Bei Namenskollisionen im ZIEL wird ein neuer Name
' erzeugt (z.B. Kopie(2) von xy.tmp)
Private Const FnF_RENAMEONCOLLISION = &H8&

' Zeigt keine Fortschritts-Dialogbox (fliegende Blätter)
Private Const FnF_SILENT = &H4&

' Zeigt die Fortschritts-Dialogbox an, aber ohne Filenamen
Private Const FnF_SIMPLEPROGRESS = &H100&

' Wenn FnF_RENAMECOLLISION gewählt wird,
' hNameMappings wird gefüllt (Anzahl)
Private Const FnF_WANTMAPPINGHANDLE = &H20&

' Eine Funktion für vier Dateioperationen
Private Declare Function SHFileOperation Lib "shell32.dll" _
  Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) _
  As Long

Type SHFILEOPSTRUCT
  hWnd As Long
  wFunc As Long
  pFrom As String
  pTo As String
  fFlags As Integer
  fAnyOperationsAborted As Boolean
  hNameMappings As Long
  lpszProgressTitle As String
End Type

' SOURCE: Dateiname
'         Dateiname mit Wildcards (TEST.*,*.TMP,*.*)
'         Ordner
'         oder Liste (vorher aufrufen)
'
' DEST  : siehe oben
'         wenn LISTE, dann gleiche Zahl von Einträgen

Public Function fCopy(Source As String, Dest As String, _
  Ueberschreiben As Boolean) As Long

  ' Ueberschreiben: True, wenn ohne Warnung überschrieben
  '     werden soll (Entspricht -y beim DOS copy BEFEHL)
  
  Dim FileStructur As SHFILEOPSTRUCT
  Dim FLAG As Integer
  
  FLAG = 0
  If InStr(Source, vbNullChar + vbNullChar) > 0 Then _
    FLAG = FLAG + FnF_MULTIDESTFILES
    
  If InStr(Source, "*") > 0 Then _
    FLAG = FLAG + FnF_FILESONLY
  
  If Ueberschreiben = True Then _
    FLAG = FLAG + FnF_RENAMEONCOLLISION
  
  With FileStructur
    .wFunc = FN_COPY
    .pFrom = Check_NullChars(Source)
    .pTo = Dest
    .fFlags = FLAG
  End With

  fCopy = SHFileOperation(FileStructur)
End Function

Public Function fDelete(Source As String, DelToTrash As _
  Boolean, ShowDialog As Boolean) As Long

  ' DelToTrash: True, wenn in Papierkorb gelöscht
  ' ShowDialog: True, wenn zusätzlich Löschabfrage
  '             erfolgen soll
  
  Dim FileStructur As SHFILEOPSTRUCT
  Dim Flags As Long
  
  Flags = 0
  If DelToTrash Then Flags = FNF_ALLOWUNDO
  If Not ShowDialog Then Flags = Flags Or FnF_NOCONFIRMATION
  
  With FileStructur
    .wFunc = FN_DELETE
    .pFrom = Check_NullChars(Source)
    
    .fFlags = Flags
  End With

  fDelete = SHFileOperation(FileStructur)
End Function

Public Function fMove(Source As String, _
  Dest As String) As Long

  Dim FileStructur As SHFILEOPSTRUCT
    
  With FileStructur
    .wFunc = FN_MOVE
    .pFrom = Check_NullChars(Source)
    .pTo = Dest
    .fFlags = FnF_RENAMEONCOLLISION + FnF_SILENT
  End With

  fMove = SHFileOperation(FileStructur)
End Function

Public Function fRename(Source As String, _
  Dest As String) As Long

  Dim FileStructur As SHFILEOPSTRUCT
  
  With FileStructur
    .wFunc = FN_RENAME
    .pFrom = Check_NullChars(Source)
    .pTo = Dest
    .fFlags = FnF_RENAMEONCOLLISION + FnF_SILENT
  End With

  fRename = SHFileOperation(FileStructur)
End Function

' Alle Dateinamen eines Array-Datenfeldes hintereinander
' - durch vbNullChar getrennt - zusammenfassen
Public Function FilesFromArray(Liste() As String) As String
  Dim i As Long
  Dim temp As String
  
  For i = 0 To UBound(Liste)
    If fileexists(Liste(i)) Then
      'Datei-Eintrag mit CHR(0) abschließen
      temp = temp + Liste(i) + vbNullChar
    Else
      MsgBox (Liste(i) & "existiert hier nicht")
    End If
  Next
  
  'Notwendig: Abschließendes CHR(0)
  FilesFromArray = temp + vbNullChar
End Function

' Alle Angaben müssen mit vbNullChar+vbNullChar
' abgeschlossen werden. Hier wird's noch mal geprüft
Private Function Check_NullChars(S As String) As String
  If Right(S, 2) <> vbNullChar + vbNullChar Then
    If Right(S, 1) <> vbNullChar Then
      S = S + vbNullChar + vbNullChar
    Else
      S = S + vbNullChar
    End If
  End If
  Check_NullChars = S
End Function

' Prüfen, ob Datei existiert
Function fileexists2(ByVal path As String) As Boolean
On Error GoTo fileexists_false

    Dim x As Long
    x = FreeFile

    Open path$ For Input As x
    fileexists2 = True
    Close x
    GoTo TheEnd:

fileexists_false:
    fileexists2 = False

TheEnd:
End Function