Auslesen der Datei Eigenschaften Liest Versionen und Informationen von fremden Dateien aus
Autor:   VBMichi	Bewertung:     [ Jetzt bewerten ]	Views:  25.284
www.michael-kaupp.com	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

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

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Mit nachfolgendem Code lassen sich Versionsnummer und erweiterte Dateiinformationen von fremden Dateien auslesen.

Fügen Sie nachfolgenden Code in ein Modul:

Option Explicit
 
' benötigte API-Deklarationen
Private Declare Function GetFileVersionInfo Lib "Version.dll" _
  Alias "GetFileVersionInfoA" ( _
  ByVal lptstrFilename As String, _
  ByVal dwhandle As Long, _
  ByVal dwlen As Long, _
  lpData As Any) As Long
 
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" _
  Alias "GetFileVersionInfoSizeA" ( _
  ByVal lptstrFilename As String, _
    lpdwHandle As Long) As Long
 
Private Declare Function VerQueryValue Lib "Version.dll" _
  Alias "VerQueryValueA" (pBlock As Any, _
  ByVal lpSubBlock As String, _
  lplpBuffer As Any, puLen As Long) As Long
 
Private Declare Sub MoveMemory Lib "kernel32" _
  Alias "RtlMoveMemory" ( _
  dest As Any, _
  ByVal Source As Long, _
  ByVal length As Long)
 
' benötigte Konstante
Private Const VS_FFI_SIGNATURE = &HFEEF04BD
Private Const VS_FFI_STRUCVERSION = &H10000
Private Const VS_FFI_FILEFLAGSMASK = &H3F&
Private Const VS_FF_DEBUG = &H1
Private Const VS_FF_PRERELEASE = &H2
Private Const VS_FF_PATCHED = &H4
Private Const VS_FF_PRIVATEBUILD = &H8
Private Const VS_FF_INFOINFERRED = &H10
Private Const VS_FF_SPECIALBUILD = &H20
Private Const VOS_UNKNOWN = &H0
Private Const VOS_DOS = &H10000
Private Const VOS_OS216 = &H20000
Private Const VOS_OS232 = &H30000
Private Const VOS_NT = &H40000
Private Const VOS__BASE = &H0
Private Const VOS__WINDOWS16 = &H1
Private Const VOS__PM16 = &H2
Private Const VOS__PM32 = &H3
Private Const VOS__WINDOWS32 = &H4
Private Const VOS_DOS_WINDOWS16 = &H10001
Private Const VOS_DOS_WINDOWS32 = &H10004
Private Const VOS_OS216_PM16 = &H20002
Private Const VOS_OS232_PM32 = &H30003
Private Const VOS_NT_WINDOWS32 = &H40004
Private Const VFT_UNKNOWN = &H0
Private Const VFT_APP = &H1
Private Const VFT_DLL = &H2
Private Const VFT_DRV = &H3
Private Const VFT_FONT = &H4
Private Const VFT_VXD = &H5
Private Const VFT_STATIC_LIB = &H7
Private Const VFT2_UNKNOWN = &H0
Private Const VFT2_DRV_PRINTER = &H1
Private Const VFT2_DRV_KEYBOARD = &H2
Private Const VFT2_DRV_LANGUAGE = &H3
Private Const VFT2_DRV_DISPLAY = &H4
Private Const VFT2_DRV_MOUSE = &H5
Private Const VFT2_DRV_NETWORK = &H6
Private Const VFT2_DRV_SYSTEM = &H7
Private Const VFT2_DRV_INSTALLABLE = &H8
Private Const VFT2_DRV_SOUND = &H9
Private Const VFT2_DRV_COMM = &HA
 
' Struktur zum Erhalt der ausgelesenen Informationen
Private Type VS_FIXEDFILEINFO
  dwSignature As Long
  dwStrucVersionl As Integer     ' z.B. = &h0000 = 0
  dwStrucVersionh As Integer     ' z.B. = &h0042 = .42
  dwFileVersionMSl As Integer    ' z.B. = &h0003 = 3
  dwFileVersionMSh As Integer    ' z.B. = &h0075 = .75
  dwFileVersionLSl As Integer    ' z.B. = &h0000 = 0
  dwFileVersionLSh As Integer    ' z.B. = &h0031 = .31
  dwProductVersionMSl As Integer ' z.B. = &h0003 = 3
  dwProductVersionMSh As Integer ' z.B. = &h0010 = .1
  dwProductVersionLSl As Integer ' z.B. = &h0000 = 0
  dwProductVersionLSh As Integer ' z.B. = &h0031 = .31
  dwFileFlagsMask As Long        ' = &h3F für Version "0.42"
  dwFileFlags As Long            ' z.B. VFF_DEBUG oder VFF_PRERELEASE
  dwFileOS As Long               ' z.B. VOS_DOS_WINDOWS16
  dwFileType As Long             ' z.B. VFT_DRIVER
  dwFileSubtype As Long          ' z.B. VFT2_DRV_KEYBOARD
  dwFileDateMS As Long           ' z.B. 0
  dwFileDateLS As Long           ' z.B. 0
End Type
 
' Variablen für Rückgabewerte
Public Filename As String
Public Direcory As String
Public StrucVer As String
Public FileVer As String
Public ProdVer As String
Public FileFlags As String
Public FileOS As String
Public FileType As String
Public FileSubType As String

' Datei-Informationen auslesen
Public Function DisplayVerInfo(ByVal sFilename As String) As Boolean
  Dim rc As Long
  Dim lDummy As Long
  Dim sBuffer() As Byte
  Dim lBufferLen As Long
  Dim lVerPointer As Long
  Dim udtVerBuffer As VS_FIXEDFILEINFO
  Dim lVerbufferLen As Long
 
  ' Größe auslesen
  lBufferLen = GetFileVersionInfoSize(sFilename, lDummy)
  If lBufferLen < 1 Then
    MsgBox "Keine Versions-Informationen vorhanden!" & vbCrLf & _
      "Möglicherweise ist die Datei beschädigt oder nicht vorhanden." & _
      vbCrLf & "Fehlerhafte Auslesung nicht ausgeschlossen!"
 
      DisplayVerInfo = False
      Exit Function
   End If
 
  ' Datei in Pfad+Dateiname splitten
  Directory = "": Filename = sFilename
  If InStr(sFilename, "\") > 0 Then
    Direcory = Left$(sFilename, InStrRev(sFilename, "\") - 1)
    Filename = Mid$(sFilename, InStrRev(sFilename, "\") + 1)
  End If
 
  ' Informationen in das udtVerBuffer Struct ablegen
  ReDim sBuffer(lBufferLen)
  rc = GetFileVersionInfo(sFilename, 0&, lBufferLen, sBuffer(0))
  rc = VerQueryValue(sBuffer(0), "\", lVerPointer, lVerbufferLen)
  MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffer)
 
  With udtVerBuffer
    ' Auslesen der Versionsnummer
    StrucVer = Format$(.dwStrucVersionh) & "." & _
      Format$(.dwStrucVersionl)
 
    ' Auslesen der Datei Version
    FileVer = Format$(.dwFileVersionMSh) & "." & _
      Format$(.dwFileVersionMSl) & "." & _
      Format$(.dwFileVersionLSh) & "." & _
      Format$(.dwFileVersionLSl)
 
    ' Auslesen der Produkt Version
    ProdVer = Format$(.dwProductVersionMSh) & "." & _
      Format$(.dwProductVersionMSl) & "." & _
      Format$(.dwProductVersionLSh) & "." & _
      Format$(.dwProductVersionLSl)
 
    ' Auslesen der boolschen Datei-Attributen
    FileFlags = ""
    If .dwFileFlags And VS_FF_DEBUG Then FileFlags = "Debug "
    If .dwFileFlags And VS_FF_PRERELEASE Then FileFlags = FileFlags & "PreRel "
    If .dwFileFlags And VS_FF_PATCHED Then FileFlags = FileFlags & "Patched "
    If .dwFileFlags And VS_FF_PRIVATEBUILD Then FileFlags = FileFlags & "Private "
    If .dwFileFlags And VS_FF_INFOINFERRED Then FileFlags = FileFlags & "Info "
    If .dwFileFlags And VS_FF_SPECIALBUILD Then FileFlags = FileFlags & "Special "
    If .dwFileFlags And VFT2_UNKNOWN Then FileFlags = FileFlags + "Unknown "
 
    ' Auslesen für welches Betriebssystem die Datei entworfen wurde
    Select Case .dwFileOS
      Case VOS_DOS_WINDOWS16
        FileOS = "DOS-Win16"
      Case VOS_DOS_WINDOWS32
        FileOS = "DOS-Win32"
      Case VOS_OS216_PM16
        FileOS = "OS/2-16 PM-16"
      Case VOS_OS232_PM32
        FileOS = "OS/2-16 PM-32"
      Case VOS_NT_WINDOWS32
        FileOS = "NT-Win32"
      Case Else
        FileOS = "Unbekannt"
    End Select
 
    ' Auslesen um was für einen Dateityp es sich handelt
    FileSubType = ""
    Select Case .dwFileType
      Case VFT_APP
        FileType = "Ausführbare Datei" 'Programm
      Case VFT_DLL
        FileType = "DLL" 'DLL
      Case VFT_DRV
        FileType = "Drucker"
 
        Select Case .dwFileSubtype
          Case VFT2_DRV_PRINTER
            FileSubType = "Drucker drv"
          Case VFT2_DRV_KEYBOARD
            FileSubType = "Tastatur drv"
          Case VFT2_DRV_LANGUAGE
            FileSubType = "Sprache drv"
          Case VFT2_DRV_DISPLAY
            FileSubType = "Bildschirm drv"
          Case VFT2_DRV_MOUSE
            FileSubType = "Maus drv"
          Case VFT2_DRV_NETWORK
            FileSubType = "Netzwerk drv"
          Case VFT2_DRV_SYSTEM
            FileSubType = "System drv"
          Case VFT2_DRV_INSTALLABLE
            FileSubType = "Installierbar"
          Case VFT2_DRV_SOUND
            FileSubType = "Sound drv"
          Case VFT2_DRV_COMM
            FileSubType = "Comm drv"
          Case VFT2_UNKNOWN
            FileSubType = "Unbekannt"
        End Select
 
      Case VFT_FONT
        FileType = "Schriftart"
 
      Case VFT_VXD
        FileType = "VxD"
      Case VFT_STATIC_LIB
        FileType = "Lib"
      Case Else
        FileType = "Unbekannt"
    End Select
  End With
 
  DisplayVerInfo = True
End Function

Anschließend fügen wir in eine neue Form, den Aufruf der Funktion "DisplayVerInfo" ein und geben die Informationen in einer MutliLine-TextBox aus:

Private Sub Command1_Click()
  Dim sFile As String
 
  sFile = "<hier den Dateinamen eintragen>"
 
  If DisplayVerInfo(sFile) Then
    txtInfo.Text = "Ortsinformationen:" + vbCrLf  & _
      "Voller Dateipfad: " + sFile & vbCrLf & _
      "Dateiname: " & Filename & vbCrLf & _
      "Ordner: " & Directory & vbCrLf & vbCrLf & _
      "Versionsinformationen:" & vbCrLf & _
      "Versionsnummer: " & StrucVer & vbCrLf & _
      "Datei Version: " & FileVer & vbCrLf & _
      "Produkt Version: " & ProdVer & vbCrLf & vbCrLf & _
      "Sonstige Informationen:" & vbCrLf & _
      "Datei flags: " & FileFlags & vbCrLf & _
      "Betriebssystem der Datei: " & FileOS & vbCrLf & _
      "Datei-Typ: " & FileType & _
        IIf(Len(FileSubType) = 0, "", " (" & FileSubType & ")")
  End If
End Sub