vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Top-Preis! AP-Access-Tools-CD Volume 1  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: System/Windows · Sonstiges   |   VB-Versionen: VB4, VB5, VB613.05.03
Betriebssystem ermitteln (erweitert)

Dieser Code stellt fest, welches Betriebssystem installiert ist (erweiterte Prüfung).

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

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

Ü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.

Neue Diskussion eröffnen

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