Erweiterte Datei-Informationen auslesen Dieser Tipp zeigt, wie sich die erweiterten Datei- und Versionsinformationen einer 32-Bit EXE- oder DLL-Datei auslesen lassen.
Autor:  Dieter Otter	Bewertung:	Views:  1.951
http://www.tools4vb.de/	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt

Seit es das 32-Bit Betriebssystem gibt lassen sich für Dateien erweiterte Datei-Informationen festlegen. So auch unter VB. In den Projekteigenschaften können Sie hier den Firmennamen, Copyright, Produktname usw. festlegen. Diese Informationen lassen sich für die eigene VB-Applikation auch zur Laufzeit wieder auslesen - und zwar mit Hilfe des App-Objekts.

Jetzt die große Frage: Wie lassen sich diese Informationen aus beliebigen EXE- und DLL-Dateien auslesen?

Fügen Sie hierzu nachfolgenden Code in ein Modul ein:

Option Explicit
 
' zunächst die benötigten API-Deklarationen
Private Declare Function GetFileVersionInfoSize Lib "version.dll" _
  Alias "GetFileVersionInfoSizeA" ( _
  ByVal lptstrFilename As String, _
  lpdwHandle As Long) As Long
 
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
 
Public Type udtFileInfo
  CompanyName As String
  FileDescription As String
  FileVersion As String
  InternalName As String
  LegalCopyright As String
  OriginalFilename As String
  ProductName As String
  ProductVersion As String
  Comments As String
  LegalTrademarks As String
End Type

' Erweiterte Datei-Informationen auslesen
Public Function GetExtendedFileInfo(ByVal sFile As String) As udtFileInfo
  Dim nSize As Long
  Dim sBuffer As String
 
  ' zunächst Größe der FileInfo-Struktur ermitteln
  nSize = GetFileVersionInfoSize(sFile, 0&)
  If nSize = 0 Then
    ' Fehler oder keine FileInfos verfügbar
    Exit Function
  End If
 
  ' Buffer für die Info-Daten bereitstellen
  ' und Daten auslesen
  sBuffer = Space$(nSize)
  If GetFileVersionInfo(sFile, 0&, nSize, ByVal StrPtr(sBuffer)) = 0 Then
    ' Fehler!
    Exit Function
  End If
 
  ' Die Daten werden als String zurückgegeben, den wir jetzt noch
  ' extrahieren müssen
  With GetExtendedFileInfo
    .Comments = ExtractData(sBuffer, "Comments")
    .CompanyName = ExtractData(sBuffer, "CompanyName")
    .FileDescription = ExtractData(sBuffer, "FileDescription")
    .FileVersion = ExtractData(sBuffer, "FileVersion")
    .InternalName = ExtractData(sBuffer, "InternalName")
    .LegalCopyright = ExtractData(sBuffer, "LegalCopyright")
    .LegalTrademarks = ExtractData(sBuffer, "Trademarks")
    .OriginalFilename = ExtractData(sBuffer, "OriginalFilename")
    .ProductName = ExtractData(sBuffer, "ProductName")
    .ProductVersion = ExtractData(sBuffer, "ProductVersion")
  End With
End Function

' Hilfsfunktion
Private Function ExtractData(ByVal sBuffer As String, _
  ByVal sLookFor As String) As String
 
  Dim nPos As Long
  Dim sData As String
 
  nPos = InStr(sBuffer, Chr$(1) + sLookFor)
  If nPos > 0 Then
    sData = Mid$(sBuffer, nPos + Len(sLookFor) + 2)
    If Left$(sData, 1) = vbNullChar Then sData = Mid$(sData, 2)
    nPos = InStr(sData, vbNullChar)
    If nPos > 0 Then sData = Left$(sData, nPos - 1)
  End If
 
  ExtractData = sData
End Function

Beispiel:
Platzieren Sie auf die Form1 eine ListBox und einen CommandButton und fügen folgenden Code ein:

Private Sub Command1_Click()
  ' Datei-Info der Datei WINVER.EXE ermitteln
  Dim sFile As String
  Dim uInfo As udtFileInfo
 
  ' Ggf. Verzeichnis anpassen!  
  sFile = "c:\windows\system32\winver.exe"
  uInfo = GetExtendedFileInfo(sFile)
 
  With uInfo
    List1.Clear
    List1.AddItem "Coments: " + .Comments
    List1.AddItem "CompanyName: " + .CompanyName
    List1.AddItem "FileDescription: " + .FileDescription
    List1.AddItem "FileVersion: " + .FileVersion
    List1.AddItem "InternalName: " + .InternalName
    List1.AddItem "LegalCopyright: " + .LegalCopyright
    List1.AddItem "LegalTrademarks: " + .LegalTrademarks
    List1.AddItem "OriginalFilename: " + .OriginalFilename
    List1.AddItem "ProductName: " + .ProductName
    List1.AddItem "ProductVersion: " + .ProductVersion
  End With  
End Sub

Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.