Kopieren, Verschieben, Löschen wie im Explorer Routinen, mit denen sich einzelne Dateien, Dateigruppen oder ganze Ordner kopieren, löschen oder umbenennen lassen.
Autor:   Dietmar G. Bayer	Bewertung:     [ Jetzt bewerten ]	Views:  84.023
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 247 Bewertung insgesamt: gut Durchschnittliche Bewertung: 3.7 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Funktionen wie Filecopy, Name und Kill sind seit jeher Bestandteil von BASIC. In der Windows-Welt sind sie aber nicht mehr besonders zeitgemäß. Kopieren Sie mal eine 1.2 MB große Datei auf die Floppy (das dauert!) und bewegen sie die Maus - nichts passiert! Oder soll beim Löschen die Datei in den Papierkorb? Kill hat sie gekillt!

Da es im im Windows-Explorer geht, geht es auch in VB! Das Windows-API stellt hierfür eine sehr hilfreiche Funktion zur Verfügung, mit welcher sich alle eben genannten Dateioperationen schnell und einfach durchführen lassen.

Alle benötigten Konstanten, die API-Deklaration und die SHFILEOPSTRUCT-Struktur.

' 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

Parameterbeschreibung

Alle Funktionen (Kopieren, Löschen, Umbenennen und Verschieben) verlangen den vollständigen Pfad für Source und Dest.

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

Kopieren wie der Explorer
Die nachfolgende Funktion kopiert eine Datei im Stile des Windows-Explorers, d.h. mit Fortschrittsanzeige und "fliegenden" Blättern.

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

Dauerhaftes Löschen oder Löschen in den Papierkorb
Die nachfolgende Routine löscht eine Datei oder einen Ordner direkt vom Datenträger oder in den Windows-Papierkorb. Zusätzlich kann angegeben werden, ob ein zusätzlicher Lösch-Hinweis angezeigt werden soll oder nicht.

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

Dateien verschieben
Die nachfolgende Routine verschiebt eine Datei, eine Dateigruppe oder auch einen ganzen Ordner in einen anderen Ordner oder auf ein anderes Laufwerk.

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

Datei umbenennen
Mit nachfolgender Routine kann eine Datei oder auch ein Verzeichnis in einen anderen Namen umbenannt werden.

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

Hilfsroutinen
Die nachfolgenden Routinen werden teilweise von den Hauptfunktionen benötigt. Zusätzlich wird gibt es hier eine Funktion, welche ein Array-Datenfeld von Dateinamen in einen String zusammenfasst, wobei die einzelnen Dateinamen automatisch mit dem notwendigen NULL-Zeichen voneinander getrennt werden.

' 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
Public Function FileExists(ByVal Filename As String) _
  As Boolean
 
  FileExists = (Dir(Filename) <> "")
End Function