vb-Zentrum
Dateisystem
http://www.vb-zentrum.de/tip_datei.html

© 2016 vb-Zentrum

0001 Datei auf Existenz prüfen

Fast in jeder Applikation notwendig und in vielen Varianten im Netz zu finden, hier unsere Version:

' Prüft auf Existenz der übergebenen Datei. Hierbei werden
' auch die Attribute Hidden und System mit eingebunden!
Public Function file_exist(ByVal file As String) As Boolean
  On Error GoTo FuncError
  If (file <> "") Then
    file_exist = (Dir(file, vbHidden + vbSystem) <> "")
  Else
    file_exist = False
  End If
  Exit Function
FuncError:
  file_exist = False
End Function
Autor: ralf schlegel
Stand: 10/2004

0002 Windows-Pfad ermitteln

Die Position des Windowsverzeichnisses läßt sich leicht mit der API-Funktion GetWindowsDirectory ermitteln. Beachten Sie lediglich, dass Sie bei der Pufferübergabe den String zuvor mit Leerzeichen füllen. Das kann schon in der Zeile der Variabelndeklaration geschehen: Dim temp As String * 255 legt die Variabel temp nicht nur an, sondern füllt sie auch gleichzeitig mit 255 Zeichen (s.u.).

' Deklaration:
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" _
    (ByVal lpBuffer As String, ByVal nSize As Long) As Long
 
' Funktion:
Public Function getWinFolder() As String
  Dim sLen As Long
  Dim temp As String * 255

  sLen = GetWindowsDirectory(temp, Len(temp))
  getWinFolder = Left$(temp, sLen)
End Function
Autor: ralf schlegel
Stand: 10/2004

0003 Special Folders

Um Dateien dynamisch aus den Anwenderverzeichnissen zu laden und wieder abzuspeichern ist es notwendig die Lage dieser Ordner zu ermitteln, denn "Eigene Dateien", "Eigene Bilder" , etc. können vom Benutzer an beliebigen Stellen eingerichtet worden sein. Wie man die Vielzahl der Ordner abfragt und vernünftig verwaltet erfahren Sie in diesem Demoprojekt...

   0003_Special_Folder.zip

Autor: ralf schlegel
Stand: 11/2004

0004 Windows Papierkorb verwenden

Statt mit der Basic-Anweisung "Kill" eine Datei entgültig ins Nirvana zu schicken, ist es wesentlich eleganter diese nach Explorermanier in den Papierkorb zu verschieben! Dazu benötigt man die API-Funktion SHFileOperation . Diese Funktion bietet gleich mehrere Vorteile: zum einen kann sie mehrere Datein und Verzeichnisse auf einmal löschen, zum anderen ist sie auch in der Lage eine oder mehrere Datein zu kopieren, verschieben oder umzubenennen. Den vollen Funktionsumfang, sowie eine Beschreibung aller möglichen Flags finden Sie in der Tipp-Rubrik API, hier gehen wir nur auf das Löschen ein...

' Deklaration:
Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long
Private Type
SHFILEOPSTRUCT hwnd As Long wFunc As Long pFrom As String pTo As String fFlags As Integer fAborted As Long hNameMaps As Long sProgress As String End Type


Const
FO_DELETE = &H3
Const FOF_MULTIDESTFILES = &H1 Const FOF_ALLOWUNDO = &H40 ' Funktion: ' Löscht alle an 'fname' übergebenen Dateien, bei Übergabe mehrerer ' Dateien in 'fname' müssen diese zuvor durch Chr(0) getrennt werden! ' Ist 'undo' = True, werden die Dateien in den Papierkorb verschoben! Public Sub file_delete(ByVal hwnd As Long, ByVal fname As String, _
Optional undo As Boolean = False) Dim ShellInfo As SHFILEOPSTRUCT If Trim(fname) = "" Then Exit Sub DoEvents With ShellInfo .hwnd = hwnd .wFunc = FO_DELETE .pFrom = fname & Chr(0) & Chr(0) .pTo = "" & Chr(0) .fFlags = FOF_MULTIDESTFILES If undo Then .fFlags = .fFlags Or FOF_ALLOWUNDO End With SHFileOperation ShellInfo End Sub
Autor: ralf schlegel
Stand: 12/2004

0005 BrowseForFolder (Verzeichnisauswahl-Dialog)

Die windowsinterne API-Routine zur Verzeichnisauswahl lässt sich unter Visual Basic nicht so ohne Weiteres nutzen. Es gibt im Netz einige Beispiele, wie man so etwas dennoch bewerkstelligen kann. Die hier zum Download bereitgestellte Variante von Marco Wünschmann kann jedoch noch einiges mehr! Für uns: Best Code 2004 - Gratulation Marco!

   0005_BrowseForFolder.zip

Autor: marco wünschmann
EMail: siehe Quellcode
Stand: 01/2004

0006 Dateipfad setzen / ermitteln (auch für Netzwerk)

Um den aktuelle Pfad (und das Laufwerk) im Programm zu setzten gibt es in VB die Funktionen ChDrive und ChDir. Diese beschränken sich aber auf lokale Laufwerke!
Flexibler sind die API-Funktionen SetCurrentDirectory und GetCurrentDirectory , die nicht nur Laufwerk und Pfad gleichzeitig setzen, sondern auch auf UNC-Pfade reagieren (z.B.: \\Servername\Projekte\).

' Deklaration
Private Declare Function SetCurrentDirectory Lib "kernel32" Alias _
        "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
Private Declare Function GetCurrentDirectory Lib "kernel32" Alias "GetCurrentDirectoryA" _
        (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long


' Setzt das Current Directory auch im Netzwerk
Public Function setCurrentDir(ByVal path As String) As Boolean
  setCurrentDir = CBool(SetCurrentDirectory(path))
End Function

' Ermittelt das aktuelle Laufwerk (incl. Pfad)
Public Function getCurrentDir() As String
  Dim ln As Long
  Dim sBuf As String
  
  sBuf = String$(512, 0)
  ln = GetCurrentDirectory(Len(sBuf), sBuf)
  If ln Then getCurrentDir = Left(sBuf, ln)
End Function
Autor: ralf schlegel
Stand: 01/2010

0007 Erweiterte Dateiattribute

Warum auch immer: die VBA Funktionen GetAttr und SetAttr scheinen spätestens ab Windows Vista hin und wieder Probleme zu bereiten. Erst recht, wenn sie im Batch (mehrer Dateien hintereinander) benutzt werden. Ausserdem stehen neuere Attribute, wie z.B.: compressed, nicht direkt in der Eingabe zur Verfügung, da sie in der Enumeration des alten VBA nicht angelegt wurden.

Der folgende Codeabschnitt zeigt den besser funktionierenden API-Ersatz, der zusätzlich noch UNICODE und UNC-Path unterstützt! D.h.: Der übergebene Dateiname ist nicht mehr auf MAX_PATH (256-Zeichen) beschränkt und ''\\Servername\Verzeichnis1\MeineDatei.dat'' kann auch als Dateiname übergeben werden (vorausgesetzt, Sie haben auf dem Netzlaufwerk Schreibrechte). Kopieren Sie den Code in ein beliebiges Projektmodul.
Das war's dann auch schon, da die Public Funktionsnamen und Parameter in diesem Code mit denen des VBA identisch sind, werden die alten VBA-Funktionen praktisch überschrieben, bzw. ignoriert und Sie müssen an Ihrem vorhandenen Projekt keinerlei weiter Änderungen vornehmen! - Das Leben kann so einfach sein... ;-)

Private Declare Function GetFileAttributesA Lib "kernel32" (ByVal lpFileName As String) As Long
Private Declare Function GetFileAttributesW Lib "kernel32" (ByVal lpFileName As Long) As Long
Private Declare Function SetFileAttributesA Lib "kernel32" (ByVal lpFileName As String, _
                                                            ByVal dwFileAttributes As Long) As Long
Private Declare Function SetFileAttributesW Lib "kernel32" (ByVal lpFileName As Long, _
                                                            ByVal dwFileAttributes As Long) As Long
Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInfo As OSVERSIONINFO) As Long

' Typendefinition Betriebssystem ermitteln:
Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

Public Enum vbzFileAttrib
  FILE_ATTRIBUTE_READONLY = &H1
  FILE_ATTRIBUTE_HIDDEN = &H2
  FILE_ATTRIBUTE_SYSTEM = &H4
  FILE_ATTRIBUTE_VOLUME = &H8           ' Readonly Attribut! Nicht in SetAttr verwenden!
  FILE_ATTRIBUTE_DIRECTORY = &H10
  FILE_ATTRIBUTE_ARCHIVE = &H20
  FILE_ATTRIBUTE_ALIAS = &H40
  FILE_ATTRIBUTE_NORMAL = &H80
  FILE_ATTRIBUTE_TEMPORARY = &H100
  FILE_ATTRIBUTE_REPARSE_POINT = &H400
  FILE_ATTRIBUTE_COMPRESSED = &H800
  FILE_ATTRIBUTE_OFFLINE = &H1000
  FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = &H2000
  FILE_ATTRIBUTE_ENCRYPTED = &H4000
End Enum

' Prüft auf NT (Unicode)-Betriebssysteme:
' True bei NT/2000/XP/Vista/Win7, sonst False
Private Function isUnicode() As Boolean
  Dim info As OSVERSIONINFO

  info.dwOSVersionInfoSize = Len(info)
  GetVersionExA info
  isUnicode = (info.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function

Public Function GetAttr(ByVal fName As String) As vbzFileAttrib
  If isUnicode Then
    If Left$(fName, 2) = "\\" Then fName = "UNC\" & Mid$(fName, 3)
    GetAttr = GetFileAttributesW(StrPtr("\\?\" & fName))
  Else
    GetAttr = GetFileAttributesA(fName)
  End If
End Function

Public Function SetAttr(ByVal fName As String, ByVal Attributes As vbzFileAttrib) As Boolean
  If isUnicode Then
    If Left$(fName, 2) = "\\" Then fName = "UNC\" & Mid$(fName, 3)
    SetAttr = CBool(SetFileAttributesW(StrPtr("\\?\" & fName), Attributes))
  Else
    SetAttr = CBool(SetFileAttributesA(fName, Attributes))
  End If
End Function


P.S.: die "isUnicode" Abfrage können Sie getrost entfernen, wenn Ihre Applikation ohnehin nur für Win2K und neuer gedacht ist!
Verwenden Sie dann nur die Unicode Varianten (GetFileAttributesW / SetFileAttributesW), löschen die ELSE-Bedingung und entfernen die Betriebssystem-Abfrage.

Autor: ralf schlegel
Stand: 05/2011

0008 FileLen - auch für große Dateien (über 4GB)

Die VBA Funktion FileLen ermittelt die Dateigröße in Bytes und gibt diese als Longwert zurück. Aufgrund des Datentyps Long liegt die erfassbare Grenze bei knapp 4 GByte, was im Zuge der ständig steigenden Multimedia-Dateiqualität oftmals nicht mehr ausreicht! Das hat auch Microsoft erkannt und stellt deshalb bereits seit Windows 2000 die API-Funktion GetFileSizeEx zur Verfügung, die einen LARGE_INTEGER Wert zurückgibt, den wir VB-ler mit dem Datentyp Currency verarbeiten können; zur Erinnerung (Auszug aus der MSDN):
Variablen vom Datentyp Currency werden als 64-Bit-Zahlen (8 Bytes) in einem ganzzahligen Format gespeichert und durch 10.000 dividiert, was eine Festkommazahl mit 15 Vorkomma- und 4 Nachkommastellen ergibt. Diese Darstellung ergibt einen Wertebereich von -922.337.203.685.477,5808 bis 922.337.203.685.477,5807.

Wir deklarieren also die nötigen API-Funktionen und bauen uns eine eigene FileLen Funktion, die die vorhandene VBA-Funktion überschreibt - so müssen wir nichts weiter an unserem Programmcode ändern. Achten Sie aber darauf, dass die Variable, die die Dateigröße aufnehmen soll vom Typ Long auf Currency geändert werden muss!

Private Declare Function CreateFileA Lib "kernel32" (ByVal lpFileName As String, _
        ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
        ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, _
        ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function GetFileSizeEx Lib "kernel32" (ByVal hFile As Long, _
        lpFileSize As Currency) As Boolean
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const GENERIC_READ = &H80000000
Private Const FILE_SHARE_READ = &H1&
Private Const OPEN_EXISTING = &H3

' FileLen: get the file size in bytes (VBA-Overwrite)
Public Function FileLen(ByVal fName As String) As Currency
  Dim fHandle As Long
  Dim fileSize As Currency
  
  fHandle = CreateFileA(fName, GENERIC_READ, FILE_SHARE_READ, _
                            ByVal 0&, OPEN_EXISTING, 0&, 0&)
  If fHandle > 0 Then
    If GetFileSizeEx(fHandle, fileSize) Then
      FileLen = fileSize * 10000
    End If
    Call CloseHandle(fHandle)
  End If
End Function
Autor: ralf schlegel
Stand: 01/2013