Dll Infos

Dll - Exe - Treiber Infos

Manchmal wäre es schön, wenn man die Versionsnummer einer Dll oder Exe abfragen könnte. Im Explorer unter Schnellansicht geht das ja, aber aus einem Programm heraus? Die API-Funktion GetFileVersionInfo erledigt das. Wegen der leichteren Handhabung habe ich das hier in eine Klasse gepackt. Sie liefert Produktversion, Dateiart, Treibertyp, LanguageID, CompanyName, FileDescription, FileVersion, InternalName, LegalCopyright, OriginalFileName, Produktname und Zielsystem einer solchen Datei, soweit diese Informationen vorhanden sind.

Beispieldatei (dllinfos.zip 29 kB

'Anfang der Klasse clsDllInfo
Option Explicit
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 Function GetSystemDirectory& _
Lib "kernel32" Alias "GetSystemDirectoryA" _
(ByVal lpBuffer As String, ByVal nSize As Long)

Private Declare Function lstrcpy Lib "kernel32" _
Alias "lstrcpyA" (ByVal lpString1 As String, _
ByVal lpString2 As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (dest As Any, _
ByVal Source As Long, ByVal Length As Long)

Private Declare Sub CopyMemoryLongInteger Lib _
  "kernel32" Alias "RtlMoveMemory" _
  (dest As Long, Source As Integer, _
  ByVal Length As Long)

Private Declare Function GetFileAttributes Lib _
"kernel32" Alias "GetFileAttributesA" _
(ByVal lpFileName As String) As Long

Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private istrDateiname As String ' interne Variable des Dateipfades
Private istrProductVersion As String ' interne Variable der Version
Private istrDateiart As String ' interne Variable der Dateiart
Private istrTreibertyp As String ' interne Variable der Treiberart
Private istrLanguageID As String ' interne Variable der Language-ID
Private istrCompanyName As String ' interne Variable CompanyName
Private istrFileDescription As String ' interne Variable istrFileDescription
Private istrFileVersion As String ' interne Variable FileVersion
Private istrInternalName As String ' interne Variable InternalName
Private istrLegalCopyright As String ' interne Variable LegalCopyright
Private istrOriginalFileName As String ' interne Variable OriginalFileName
Private istrProductName As String ' interne Variable ProductName
Private istrZielsystem As String ' interne Variable Zielsystem

Public Property Get ProductVersion() As String
ProductVersion = istrProductVersion
End Property

Public Property Get Filetype() As String
Filetype = istrDateiart
End Property

Public Property Get Drivertype() As String
Drivertype = istrTreibertyp
End Property

Public Property Get CompanyName() As String
CompanyName = istrCompanyName
End Property

Public Property Get FileDescription() As String
FileDescription = istrFileDescription
End Property

Public Property Get FileVersion() As String
FileVersion = istrFileVersion
End Property

Public Property Get InternalName() As String
InternalName = istrInternalName
End Property

Public Property Get LegalCopyright() As String
LegalCopyright = istrLegalCopyright
End Property

Public Property Get OriginalFileName() As String
OriginalFileName = istrOriginalFileName
End Property

Public Property Get ProductName() As String
ProductName = istrProductName
End Property

Public Property Get LanguageID() As String
LanguageID = istrLanguageID
End Property

Public Property Get Destinationsystem() As String
Destinationsystem = istrZielsystem
End Property

Private Sub resetten()
  'Variablen zurücksetzen
  istrZielsystem = ""
  istrLanguageID = ""
  istrProductName = ""
  istrOriginalFileName = ""
  istrLegalCopyright = ""
  istrInternalName = ""
  istrFileVersion = ""
  istrFileDescription = ""
  istrCompanyName = ""
  istrTreibertyp = ""
  istrDateiart = ""
  istrProductVersion = ""
  istrDateiname = ""
End Sub

Private Sub Versionsinfos()
  Dim arrInfo() As Byte
  Dim strBuffer As String
  Dim lngZielsystem As Long
  Dim lngInfoLänge As Long
  Dim lngVersionPointer As Long
  Dim lngSprache As Long
  Dim strInfotyp As String
  Dim intSprache(1 To 3) As Integer
  Dim lngZähler As Long
  Dim lngDateityp As Long, lngSubtyp As Long
  'Die benötigte Bufferlänge wird ermittelt
  lngInfoLänge = GetFileVersionInfoSize(istrDateiname, 0&)
  'Wenn keine Info vorhanden ist, beenden
  If lngInfoLänge = 0 Then
    istrDateiname = ""
    Exit Sub
  End If
  'Der Buffer wird entsprechend dimensioniert
  ReDim arrInfo(lngInfoLänge)
  'Der Buffer wird gefüll
  GetFileVersionInfo istrDateiname, 0&, _
    lngInfoLänge, arrInfo(0)
  '********************************************************************
  '***** Hier beginnt der allgemeine Teil, unabhängig
  '***** von der Sprachversion
  '********************************************************************
  'Pointer zur Wurzel der Infostruktur
  VerQueryValue arrInfo(0), "\", lngVersionPointer, 0
  'An der richtigen Pos. (+32) das Zielsystem lesen
  'lt. Datentyp VS_FIXEDFILEINFO
  CopyMemory lngZielsystem, (lngVersionPointer + 32), 4
  'An der richtigen Pos. (+36) den Dateityp lesen
  'lt. Datentyp VS_FIXEDFILEINFO
  CopyMemory lngDateityp, (lngVersionPointer + 36), 4
  'An der richtigen Pos. (+40) den Subtyp lesen
  'lt. Datentyp VS_FIXEDFILEINFO
  CopyMemory lngSubtyp, (lngVersionPointer + 40), 4
  'Auswertung des Zielsystems
  Select Case lngZielsystem
    Case &H10001
      istrZielsystem = "DOS/Win16"
    Case &H10004
      istrZielsystem = "DOS/Win32"
    Case &H40004
      istrZielsystem = "NT/Win32"
    Case Else
      istrZielsystem = "Keine Angabe"
  End Select
  'Auswertung des Dateityps
  Select Case lngDateityp
    Case &H1
      istrDateiart = "EXE"
    Case &H2
      istrDateiart = "DLL"
    Case &H3
      istrDateiart = "Treiber"
      'Wenn Treiber, dann den Subtyp auswerten
      Select Case lngSubtyp
        Case &H1
          istrTreibertyp = "Drucker"
        Case &H2
          istrTreibertyp = "Tastatur"
        Case &H3
          istrTreibertyp = "Sprache"
        Case &H4
          istrTreibertyp = "Monitor"
        Case &H5
          istrTreibertyp = "Maus"
        Case &H6
          istrTreibertyp = "Netzwerk"
        Case &H7
          istrTreibertyp = "System"
        Case &H9
          istrTreibertyp = "Sound"
        Case &HA
          istrTreibertyp = "Comm"
      End Select
      Case &H4
        istrDateiart = "Font"
      Case &H5
        istrDateiart = "Virtueller Gerätetreiber"
      Case &H7
        istrDateiart = "Lib"
      Case Else
        istrDateiart = "Andere"
    End Select
    'Zeiger zur Sprachversion ermitteln
    VerQueryValue arrInfo(0), _
      "\VarFileInfo\Translation", _
      lngVersionPointer, lngInfoLänge
     'Werte ab dieser Speicheradresse lesen.
     'Hier zwei Integer (4 Byte)
     CopyMemory intSprache(1), lngVersionPointer, 4
    'Reihenfolge Lo and Hi tauschen
     intSprache(3) = intSprache(1) 'intSprache(3) als Zwischenspeicher
     intSprache(1) = intSprache(2)
     intSprache(2) = intSprache(3)
    'In Datentyp Long umwandeln
    CopyMemoryLongInteger lngSprache, _
      intSprache(1), 4
    'Hexdarstellung
    istrLanguageID = Hex(lngSprache)
    'Führende Nullen hinzu
    istrLanguageID = String(8 - Len(istrLanguageID), _
      Asc("0")) & istrLanguageID
  '********************************************************************
  '***** Hier beginnt der Sprachspezifische Teil
  '***** StringFileInfo
  '********************************************************************
  For lngZähler = 1 To 8
  strBuffer = String(255, 0)
  'Der Abfragestring wird je nach Wert zähler
  'erzeugt.
  strInfotyp = "\StringFileInfo\" & _
    istrLanguageID & "\"
  Select Case lngZähler
    Case 1
      strInfotyp = strInfotyp _
        & "CompanyName"
    Case 2
      strInfotyp = strInfotyp _
        & "FileDescription"
    Case 3
      strInfotyp = strInfotyp _
        & "FileVersion"
    Case 4
      strInfotyp = strInfotyp _
        & "InternalName"
    Case 5
      strInfotyp = strInfotyp _
        & "LegalCopyright"
    Case 6
      strInfotyp = strInfotyp _
        & "OriginalFileName"
    Case 7
      strInfotyp = strInfotyp _
        & "ProductName"
    Case 8
      strInfotyp = strInfotyp _
        & "ProductVersion"
  End Select
  'Ein Pointer auf die gewünschte Info
  'wird zurückgeliefert
  VerQueryValue arrInfo(0), strInfotyp, _
    lngVersionPointer, lngInfoLänge
  'Der Buffer wird mit dem String ab der
  'Speicheradresse lngVersionPointer gefüllt
  lstrcpy strBuffer, lngVersionPointer
  'Zurückstutzen auf die richtige Länge
  strBuffer = Mid$(strBuffer, 1, _
    InStr(strBuffer, Chr(0)) - 1)
  'Variablen mit gewünschter Info füllen
  Select Case lngZähler
    Case 1
      istrCompanyName = strBuffer
    Case 2
      istrFileDescription = strBuffer
    Case 3
      istrFileVersion = strBuffer
    Case 4
      istrInternalName = strBuffer
    Case 5
      istrLegalCopyright = strBuffer
    Case 6
      istrOriginalFileName = strBuffer
    Case 7
      istrProductName = strBuffer
    Case 8
      istrProductVersion = strBuffer
  End Select
  Next
End Sub

Public Property Get Dateiname() As String
Dateiname = istrDateiname
End Property

Public Property Let Dateiname(ByVal vNewValue As String)
  Dim SysDir As String
  Call resetten 'Alle Variablen zurücksetzen
  'Dir$ wird nicht verwendet, da Dir$ keine Rekursion unterstützt
  'und eventuell ein Dir$ in der aufrufenden Prozedur stört.
  '(Hab aber nicht getestet, ob das stört)
  If GetFileAttributes(vNewValue) <> -1 Then
    'Datei existiert
    istrDateiname = vNewValue
  Else
    'Datei existiert nicht. Den Systempfad voranstellen
    SysDir = String(256, 0)
    GetSystemDirectory SysDir, 255
    SysDir = Left$(SysDir, _
    InStr(1, SysDir, Chr(0)) - 1)
    If GetFileAttributes(SysDir & "\" & vNewValue) <> -1 Then
      'Jetzt existiert Datei.
      istrDateiname = SysDir & "\" & vNewValue
    End If
  End If
  'Wenn die Variable istrDateiname leer ist wird das Aufrufen
  'der Prozedur Versionsinfos verhindert
  If istrDateiname <> "" Then
    If GetFileAttributes(istrDateiname) <> _
      FILE_ATTRIBUTE_DIRECTORY Then
      'istrDateiname darf kein Directory sein, es macht
      'keinen Sinn Versionsinfos eines Verzeichnisses
      'zu ermitteln
      Versionsinfos
    Else
      istrDateiname = ""
    End If
  End If
End Property
'Ende der Klasse
'#########################################################
'Code zum Testen der Klasse
Option Explicit

Dim Infoklasse As clsDllInfo
Public Sub DLLInfos()
  Dim Meldung As String, Datei As String
  Dim i As Long
  Set Infoklasse = New clsDllInfo
  'GetFileOpen siehe Beispielcode Nr. 6
  'oder Application.GetOpenFileName
  Datei = GetFileOpen("c:\", "dll", "Dateiinfos auflisten")
  If Datei = "" Then Exit Sub
  With Infoklasse
    .Dateiname = Datei
    If .Dateiname = "" Then Exit Sub
    Meldung = Meldung & "Datei Name= " & .Dateiname & vbCrLf
    Meldung = Meldung & "Company Name= " & .CompanyName & vbCrLf
    Meldung = Meldung & "Filetype= " & .Filetype & vbCrLf
    Meldung = Meldung & "Zielsystem= " & .Destinationsystem & vbCrLf
    Meldung = Meldung & "Treibertyp= " & .Drivertype & vbCrLf
    Meldung = Meldung & "Beschreibung= " & .FileDescription & vbCrLf
    Meldung = Meldung & "Version= " & .FileVersion & vbCrLf
    Meldung = Meldung & "Interner Name= " & .InternalName & vbCrLf
    Meldung = Meldung & "Sprache= " & .LanguageID & vbCrLf
    Meldung = Meldung & "Copyright= " & .LegalCopyright & vbCrLf
    Meldung = Meldung & "Orginalname= " & .OriginalFileName & vbCrLf
    Meldung = Meldung & "Produktname= " & .ProductName & vbCrLf
    Meldung = Meldung & "Produktversion= " & .ProductVersion
  End With
  MsgBox Meldung
End Sub