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
Anzeige
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. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. sevZIP40 Pro DLL Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. |
||||||||||||||||
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. |