vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Erstellen von dynamischen Kontextmen?s - wann immer Sie sie brauchen!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: System/Windows · Prozesse/Tasks   |   VB-Versionen: VB4, VB5, VB628.07.01
Welche Module verwendet mein Programm?

Ermitteln aller von der aktuellen Anwendung benötigten Module (DLL/OCX) inkl. Versionsnummern.

Autor:   Michael HartmannBewertung:     [ Jetzt bewerten ]Views:  20.634 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Für Supportzwecke ist es oft hilfreich zu wissen, welche Module (DLL, OCX, ....) das eigene Programm denn gerade geladen hat und in welcher Version diese Module auf dem Zielrechner vorhanden sind. Da man dieses Feature leider nicht von VB geschenkt bekommt, muss man das Windows-API bemühen. Leider hat sich Microsoft für Windows 9x und Windows NT/2000 zwei verschiedene Wege ausgedacht, um an das gewünschte Ergebnis zu kommen. Das nachfolgend abgedruckte Code-Listing berücksichtigt beide Fälle (Win 9x und Win NT/2000).

Es besteht lediglich aus einem Formular, das direkt in dieser Form in bestehende Programme eingebunden werden kann. Es stellt in einem Listviewcontrol in Reportansicht alle momentan in Verwendung befindlichen Module des Programms inkl. Pfadangabe und Versionsinfo dar.

Das Formular besteht aus einem Listview-Control, einem ImageList-Control, einem Label-Control und einem CommandButton-Control (also eigentlich nichts ungewöhnliches). Das ImageList-Control enthält lediglich ein Bild, welches als Icon für die einzelnen Einträge des Listview-Controls dient. Man kan es auch weglassen, muss dann nur den entsprechenden Eintrag im Code auskommentieren.

Und hier das gesamte Code-Listing:

Option Explicit
 
' Zunächst ein paar API-Deklarationen, Typ- und
' Konstantendefinitionen, die für die diversen
' API-Calls benötigt werden:
Private Declare Function Module32First Lib "kernel32.dll" ( _
  ByVal hSnapshot As Long, _
  ByRef lppe As TMODULEENTRY32) As Long
 
Private Declare Function Module32Next Lib "kernel32.dll" ( _
  ByVal hSnapshot As Long, _
  ByRef lppe As TMODULEENTRY32) As Long
 
Private Declare Function CloseHandle Lib "kernel32.dll" ( _
  ByVal Handle As Long) As Long
 
Private Declare Function OpenProcess Lib "kernel32.dll" ( _
  ByVal dwDesiredAccessas As Long, _
  ByVal bInheritHandle As Long, _
  ByVal dwProcId As Long) As Long
 
Private Declare Function GetModuleFileName Lib "kernel32.dll" _
  Alias "GetModuleFileNameA" ( _
  ByVal hModule As Long, _
  ByVal ModuleName As String, _
  ByVal nSize As Long) As Long
 
Private Declare Function GetModuleFileNameEx Lib "psapi.dll" _
  Alias "GetModuleFileNameExA" ( _
  ByVal hProcess As Long, _
  ByVal hModule As Long, _
  ByVal ModuleName As String, _
  ByVal nSize As Long) As Long
 
Private Declare Function EnumProcessModules Lib "psapi.dll" ( _
  ByVal hProcess As Long, _
  ByRef lphModule As Long, _
  ByVal cb As Long, _
  ByRef cbNeeded As Long) As Long
 
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32.dll" ( _
  ByVal dwFlags As Long, _
  ByVal th32ProcessID As Long) As Long
 
Private Declare Function GetOSVersion Lib "kernel32.dll" _
  Alias "GetVersionExA" ( _
  ByRef lpVersionInformation As TOSVERSIONINFO) As Integer
 
Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long
 
Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long
 
Private Declare Function LoadLibrary Lib "kernel32.dll" _
  Alias "LoadLibraryA" ( _
  ByVal lpLibFileName As String) As Long
 
Private Declare Function GetFileVersionInfo Lib "Version.dll" _
  Alias "GetFileVersionInfoA" ( _
  ByVal strFileName As String, _
  ByVal lHandle As Long, _
  ByVal lLen As Long, _
  ByRef lpData As Any) As Long
 
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" _
  Alias "GetFileVersionInfoSizeA" ( _
  ByVal strFileName As String, _
  ByRef lHandle As Long) As Long
 
Private Declare Function VerQueryValue Lib "Version.dll" _
  Alias "VerQueryValueA" ( _
  ByRef Block As Any, _
  ByVal strSubBlock As String, _
  ByRef Buffer As Any, _
  ByRef lLen As Long) As Long
 
Private Declare Sub MoveMemory Lib "kernel32.dll" _
  Alias "RtlMoveMemory" ( _
  ByRef dest As Any, _
  ByVal Source As Long, _
  ByVal lLength As Long)
 
Private Declare Function GetLastError Lib "kernel32.dll" () As Long
 
Private Type TPROCESSENTRY32
  dwSize As Long
  cntUsage As Long
  th32ProcessID As Long
  th32DefaultHeapID As Long
  th32ModuleID As Long
  cntThreads As Long
  th32ParentProcessID As Long
  pcPriClassBase As Long
  dwFlags As Long
  szExeFile As String * 260
End Type
 
Private Type TMODULEENTRY32
  dwSize As Long
  th32ModuleID As Long
  th32ProcessID As Long
  glblcntUsage As Long
  proccntUsage As Long
  modBaseAddr As Long
  modBaseSize As Long
  hModule As Long
  szModule As String * 256
  szExeFile As String * 260
End Type
 
Private Type TOSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type
 
Private Type TFILEVERSIONINFO
  lSignature As Long
  iStrucVersionl As Integer
  iStrucVersionh As Integer
  iFileVersionMSl As Integer
  iFileVersionMSh As Integer
  iFileVersionLSl As Integer
  iFileVersionLSh As Integer
  iProductVersionMSl As Integer
  iProductVersionMSh As Integer
  iProductVersionLSl As Integer
  iProductVersionLSh As Integer
  lFileFlagsMask As Long
  lFileFlags As Long
  lFileOS As Long
  lFileType As Long
  lFileSubtype As Long
  lFileDateMS As Long
  lFileDateLS As Long
End Type
 
Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_READ = 16
Private Const TH32CS_SNAPPROCESS = &H2&
Private Const TH32CS_SNAPMODULE = &H8&
Private Const MAX_PATH = 260

Das CommandButton-Control dient lediglich zum Schließen der Maske und erhält nur ein Eventprozedur für das Click-Event:

Private Sub cmdClose_Click()
  Unload Me
End Sub

Der eigentlich Code zur Ermittlung der verwendetetn Module steht komplett in der Form_Load-Eventprozedur und sieht folgendermaßen aus (die Kommentare erklären, was gerade geschieht):

Private Sub Form_Load()
  Dim varSettings As Variant
  Dim liItem As ListItem
  Dim liSubItem As ListSubItem
  Dim I As Integer
  Dim strCustomer As String
  Dim lProcessID As Long
  Dim lRet As Long
  Dim hSnap As Long
  Dim hProcess As Long
  Dim hModule As Long
  Dim strModuleFileName As String
  Dim ProcEntry As TPROCESSENTRY32
  Dim ModuleEntry As TMODULEENTRY32
  Dim lBytesNeeded  As Long
  Dim lModules(199) As Long
  Dim iIndex As Integer
 
  ' Fehlerbehandlung einschalten
  On Error GoTo ErrorHandler
 
  ' Löschen aller Items im Listview-Control
  lvwFiles.ListItems.Clear
 
  ' Ermittlung der Prozess-ID des Programms
  lProcessID = GetCurrentProcessId
 
  ' Je nachdem, ob Windows 9x oder Windows NT/2000
  ' eingesetzt wird, müssen verschiedene Strategien
  ' verwendet werden
  Select Case GetVersion()
    ' Windows 9x
    Case 1
      ' Ermitteln aller im moment geladenen Module des
      ' Prozesses lProcessID
      hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, _
        lProcessID)
 
      If hSnap = 0& Then
        ' Programm hat keine externen Module geladen
        ' oder ein anderer Fehler ist aufgetreten, der
        ' das Darstellen der verwendeten Module
        ' verhindert
        Exit Sub
      End If
 
      With ModuleEntry
        .dwSize = Len(ModuleEntry)
 
        ' Durchlaufe alle Module des aktuellen Prozesses
        lRet = Module32First(hSnap, ModuleEntry)
        Do While lRet
          iIndex = InStr(1, .szExeFile, vbNullChar, _
            vbBinaryCompare)
          If iIndex > 0 Then
            strModuleFileName = Left$(.szExeFile, _
              iIndex - 1)
          Else
            strModuleFileName = .szExeFile
          End If
 
          ' Falls alle Dateien (z.B. Type-Libraries)
          ' angezeigt werden sollen, die der Prozess
          ' verwendet, so kann dieses If-Statement
          ' angepasst oder sogar ganz weg gelassen
          ' werden.
          If UCase$(Right$(strModuleFileName, 3)) = _
            "DLL" Or UCase$(Right$(strModuleFileName, _
            3)) = "OCX" Then
 
            Set liItem = lvwFiles.ListItems.Add
            liItem.Text = UCase$(strModuleFileName)
            liItem.SmallIcon = 1
            Set liSubItem = liItem.ListSubItems.Add
            With liSubItem
              .Text = GetFileVersion(strModuleFileName)
            End With
          End If
          lRet = Module32Next(hSnap, ModuleEntry)
        Loop
      End With
 
    ' Windows NT/2000
    Case 2
      ' Erzeuge Handle für aktuellen Prozess
      hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or _
        PROCESS_VM_READ, 0, lProcessID)
 
      ' Wenn hProcess den Wert 0 zurückliefert, so
      ' konnte kein Handle für den aktuellen Prozess
      ' erzeugt werden.
      If hProcess <> 0 Then
        ' Lese alle Module des aktuellen Prozesses
        lRet = EnumProcessModules(hProcess, _
          lModules(0), 200, lBytesNeeded)
        If lRet <> 0 Then
          I = 0
          Do While lModules(I) <> 0
            strModuleFileName = Space$(MAX_PATH)
            lRet = GetModuleFileNameEx(hProcess, _
              lModules(I), strModuleFileName, 500)
            If lRet <> 0 Then strModuleFileName = _
              Left$(strModuleFileName, lRet)
            ' Falls alle Dateien (z.B. Type-Libraries)
            ' angezeigt werden sollen, die der Prozess
            ' verwendet, so kann dieses If-Statement
            ' angepasst oder sogar ganz weg gelassen
            ' werden.
            If UCase$(Right$(strModuleFileName, 3)) = _
              "DLL" Or UCase$(Right$(strModuleFileName, _
              3)) = "OCX" Then
 
              Set liItem = lvwFiles.ListItems.Add
              liItem.Text = UCase$(strModuleFileName)
              liItem.SmallIcon = 1
              Set liSubItem = liItem.ListSubItems.Add
              With liSubItem
                .Text = GetFileVersion(strModuleFileName)
              End With
            End If
            I = I + 1
          Loop
          I = 0
        End If
      End If
      lRet = CloseHandle(hProcess)
  End Select
 
  Exit Sub
 
ErrorHandler:
  Call MsgBox("Runtime error " & Err.Number & vbCrLf & _
    Err.Description, vbOKOnly + vbCritical)
End Sub

Im Code werden noch zwei weitere Funktionen verwendet. Eine, um die Versionsinfo einer Datei zu ermitteln und eine weitere, die überprüft, welches Betriebssystem auf dem Rechner läuft. Dies wären folgende beiden Funktionen:

Private Function GetFileVersion(ByVal strFileName As _
 String) As String
 
  Dim lBufferLen As Long
  Dim sBuffer() As Byte
  Dim lRet As Long
  Dim lVerPointer As Long
  Dim lVerBufferLen As Long
  Dim VersionInfoBuffer As TFILEVERSIONINFO
 
  lBufferLen = GetFileVersionInfoSize(strFileName, 0&)
  If lBufferLen < 1 Then
    GetFileVersion = ""
    Exit Function
  End If
 
  ReDim sBuffer(lBufferLen)
 
  lRet = GetFileVersionInfo(strFileName, 0&, _
    lBufferLen, sBuffer(0))
 
  If lRet = 0 Then
    GetFileVersion = ""
    Exit Function
  End If
 
  lRet = VerQueryValue(sBuffer(0), "\", lVerPointer, _
    lVerBufferLen)
 
  Call MoveMemory(VersionInfoBuffer, lVerPointer, _
    Len(VersionInfoBuffer))
 
  With VersionInfoBuffer
    GetFileVersion = CStr(.iFileVersionMSh) & "."
    GetFileVersion = GetFileVersion & _
      CStr(.iFileVersionMSl) & "."
    GetFileVersion = GetFileVersion & _
      CStr(.iFileVersionLSh) & "."
    GetFileVersion = GetFileVersion & _
      CStr(.iFileVersionLSl)
  End With
End Function
 
' Ermittelt die verwendete Betriebssystemversion.
' Dies wird benötigt, da unter Windows 9x und
' Windows NT/2000 unterschiedliche Strategien verwendet
' werden müssen, um an die verwendeten Dateien des
' aktuellen Prozesses zu kommen.
Private Function GetVersion() As Long
  Dim OSInfo As TOSVERSIONINFO
  Dim iRet As Integer
 
  With OSInfo
    .dwOSVersionInfoSize = 148
    .szCSDVersion = Space$(128)
    iRet = GetOSVersion(OSInfo)
    GetVersion = .dwPlatformId
  End With
End Function

Dieser Tipp wurde bereits 20.634 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Aktuelle Diskussion anzeigen (6 Beiträge)

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle 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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel