Rubrik: Dateisystem · Dateien allgemein | VB-Versionen: VB4, VB5, VB6 | 13.05.01 |
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: | Views: 84.030 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
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