Dieser Tip beschreibt, wie man nicht nur ermittelt, auf welchem Betriebssystem gerade gearbeitet wird, sondern holt auch einige zusätzliche Informationen zum OS. Für meinen konkreten Fall war es nötig, zwischen XP Professional und XP Home Edition zu unterscheiden. Die Tipps, die man üblicherweise zu diesem Thema findet, sind hierzu leider nicht in der Lage. Meist wird das Betriebssystem mittels der OSVERSIONINFO-Struktur ermittelt. Dabei gibt es aber auch noch eine OSVERSIONINFOEX-Struktur - allerdings nicht bei allen Betriebssystemen (siehe MSDN-Library). Man müsste also wissen auf welchem OS man arbeitet, um das OS zu ermitteln. Aber es geht natürlich auch noch anders Option Explicit ' Zunächst die benötigten API-Deklarationen Private Const VER_PLATFORM_WIN32s As Long = 0 Private Const VER_PLATFORM_WIN32_WINDOWS As Long = 1 Private Const VER_PLATFORM_WIN32_NT As Long = 2 Private Const VER_NT_SERVER As Long = &H3 Private Const VER_NT_WORKSTATION As Long = &H1 Private Const VER_SUITE_PERSONAL As Long = &H200 Private Const VER_SUITE_DATACENTER As Long = &H80 Private Const VER_SUITE_ENTERPRISE As Long = &H2 ' der alte Standard Private Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End Type ' gibt's ab NT 4.0 mit SP6 (vgl. MSDN-Library) Private Type OSVERSIONINFOEX dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 wServicePackMajor As Integer wServicePackMinor As Integer wSuiteMask As Integer wProductType As Byte wReserved As Byte End Type ' nicht Standard-Deklaration, sondern ' "lpVersionInformation As OSVERSIONINFOEX"! Private Declare Function GetVersionEx Lib "kernel32" _ Alias "GetVersionExA" ( _ lpVersionInformation As OSVERSIONINFOEX) As Long Die Deklaration von GetVersionEx muß geändert werden, damit der neue Datentyp übergeben werden kann. Das Problem ist jetzt aber, dass die "alten" Betriebssysteme mit dieser Datenstruktur nicht arbeiten können und die Funktion daher nicht arbeitet. Des Rätsels Lösung besteht darin, dass man die Größe des übergebenen Datentyps entsprechend anpasst. Dann funktioniert's immer. ' Windows-Version bestimmen Public Function GetWindowsVersion() As String Dim lRet As Long Dim VerInfo1 As OSVERSIONINFOEX 'neuer Datentyp Dim VerInfo2 As OSVERSIONINFO 'alter Datentyp On Error Resume Next ' hier wird die Größe des Datentyps festgelegt VerInfo1.dwOSVersionInfoSize = Len(VerInfo1) lRet = GetVersionEx(VerInfo1) If lRet = 0 Then ' wenn der erste Aufruf von GetVersionEx fehlgeschlagen ' hat, dann einfach die Größe des übergebenen ' Datentyps auf die des alten Typs ändern VerInfo1.dwOSVersionInfoSize = Len(VerInfo2) ' Versionsabfrage erneut aufrufen; wenn das auch ' schiefgeht, dann Funktion verlassen If GetVersionEx(VerInfo1) = 0 Then Exit Function End If ' jetzt kommt ein Wust von Prüfungen; vgl. dazu auch wieder ' den entsprechenden Eintrag für OSVERSIONINFOEX in der ' MSDN-Library With VerInfo1 Select Case .dwPlatformId Case VER_PLATFORM_WIN32s GetWindowsVersion = "Win32s für Windows 3.x" Case VER_PLATFORM_WIN32_WINDOWS Select Case .dwMinorVersion Case 0 Select Case UCase(Trim(.szCSDVersion)) Case "A" GetWindowsVersion = "Windows 95 A" Case "B", "C" GetWindowsVersion = "Windows 95 OSR2" Case Else GetWindowsVersion = "Windows 95" End Select Case 10 Select Case UCase(Trim(.szCSDVersion)) Case "A" GetWindowsVersion = "Windows 98 SE" Case Else GetWindowsVersion = "Windows 98" End Select Case 90 GetWindowsVersion = "Windows ME" End Select Case VER_PLATFORM_WIN32_NT Select Case .dwMajorVersion Case 3 GetWindowsVersion = "Windows NT 3." & CStr(.dwMinorVersion) Case 4 If CInt(Right$(Trim(.szCSDVersion), 1)) >= 6 Then ' mindestens Service-Pack 6 installiert ' OSVERSIONINFOEX-Struktur kann komplett ' ausgewertet werden If .wProductType = VER_NT_WORKSTATION Then GetWindowsVersion = "Windows NT 4.0 Workstation" Else GetWindowsVersion = "Windows NT 4.0 Server" End If Else GetWindowsVersion = "Windows NT 4.0" End If Case 5 Select Case .dwMinorVersion Case 0 If .wProductType = VER_NT_WORKSTATION Then GetWindowsVersion = "Windows 2000 Professional" Else If (.wSuiteMask And VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE Then GetWindowsVersion = "Windows 2000 Advanced Server" ElseIf (.wSuiteMask And VER_SUITE_DATACENTER) = VER_SUITE_DATACENTER Then GetWindowsVersion = "Windows 2000 Datacenter Server" Else GetWindowsVersion = "Windows 2000 Server" End If End If Case 1 If .wProductType = VER_NT_WORKSTATION Then If (.wSuiteMask And VER_SUITE_PERSONAL) = VER_SUITE_PERSONAL Then GetWindowsVersion = "Windows XP Home Edition" Else GetWindowsVersion = "Windows XP Professional" End If Else GetWindowsVersion = "Neue, unbekannte Windows-Version" End If Case Else GetWindowsVersion = "Neue, unbekannte Windows-Version" End Select Case Else GetWindowsVersion = "Unbekannte Version" End Select Case Else GetWindowsVersion = "Unbekannte Version" End Select End With End Function Jetzt fehlt noch die Trim-Funktion. Ich verwende hierfür eine eigene Funktion, die neben Leerzeichen auch NULL-Characters und Tabs entfernt: Private Function Trim(ByVal InString As String) As String Trim = LTrim(RTrim(InString)) End Function Public Function LTrim(ByVal InString As String) As String While InStr(Chr$(0) + Chr$(9) + Chr$(32), Left$(InString, 1)) > 0 InString = Mid$(InString, 2) Wend LTrim = InString End Function Public Function RTrim(ByVal InString As String) As String While InStr(Chr$(0) + Chr$(9) + Chr$(32), Right$(InString, 1)) > 0 InString = Left$(InString, Len(InString) - 1) Wend RTrim = InString End Function Dieser Code wurde erfolgreich für NT4 (Server u. Workstation), Win2000 (Server u. Professional) sowie für Win XP getestet. Eine frühere Version auch für Win9x. Mich würde natürlich interessieren, ob auch die Erkennung von ganz alten Windows-Versionen, bzw. die Unterscheidung verschiedener Win2000-Server-Versionen funktioniert. Dieser Tipp wurde bereits 30.311 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. |
sevGraph (VB/VBA) Grafische Auswertungen Präsentieren Sie Ihre Daten mit wenig Aufwand in grafischer Form. sevGraph unterstützt hierbei Balken-, Linien- und Stapel-Diagramme (Stacked Bars), sowie 2D- und 3D-Tortendiagramme und arbeitet vollständig datenbankunabhängig! 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. Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
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. |