Startseite / Tipps / VB 5/6-Tipp 0129: Laufendes Betriebssystem ermitteln

VB 5/6-Tipp 0129: Laufendes Betriebssystem ermitteln

 von ActiveVB

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label1"


' Danke an Heino für den Tipp zum Erkennen, ob es sich um ein
' Windows 2000 System handelt.

' Danke an Jürgen für den Tipp zum Erkennen, ob es sich um ein
' Windows ME System handelt.

Option Explicit
 
' Datentypen
Private Type OSVERSIONINFO
       dwOSVersionInfoSize As Long
       dwMajorVersion As Long
       dwMinorVersion As Long
       dwBuildNumber As Long
       dwPlatformId As Long
       szCSDVersion As String * 128 ' Service Pack
End Type

Private Type OSVERSIONINFOEX
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128 ' Service Pack
        wServicePackMajor As Integer
        wServicePackMinor As Integer
        wSuiteMask As Integer
        wProductType As Byte
        wReserved As Byte
End Type
 
' Enumerationen
Public Enum WindowsVersion
       WIN_OLD
       WIN_95
       WIN_98
       WIN_ME
       WIN_NT_3x
       WIN_NT_4x
       WIN_2K
       WIN_XP
       WIN_XP_HOME
       WIN_2003
End Enum

' WinAPI
Private Declare Function GetVersionEx1 Lib "kernel32.dll" Alias _
    "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO _
    ) As Long

Private Declare Function GetVersionEx2 Lib "kernel32.dll" Alias _
    "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFOEX _
    ) As Long

' Konstanten
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&

' Um zu testen, ob XP Home oder Professional verwendet wird.
' Weitere Informationen gibt es unter
'
' http://msdn.microsoft.com/library/en-us/sysinfo/base/getversionex.asp
'
' http://msdn.microsoft.com/library/default.asp?url=/library/en-us/ ->
'     sysinfo/base/osversioninfoex_str.asp

Private Const VER_SUITE_PERSONAL As Long = &H200&
 
' Private Variablen
Private m_bAlreadyGot As Boolean
Private m_OsVersion As WindowsVersion

Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Select Case GetOSVersion
        Case WIN_OLD
            Label1 = "Windows 32s"
        
        Case WIN_95
            Label1 = "Windows 95"
        
        Case WIN_98
            Label1 = "Windows 98"
        
        Case WIN_ME
            Label1 = "Windows ME"
            
        Case WIN_NT_3x
            Label1 = "Windows NT 3"
        
        Case WIN_NT_4x
            Label1 = "Windows NT 4"
        
        Case WIN_2K
            Label1 = "Windows 2000"
        
        Case WIN_XP
            Label1 = "Windows XP"
        
        Case WIN_XP_HOME
            Label1 = "Windows XP Home Edition"
            
        Case WIN_2003
            Label1 = "Windows 2003"
    End Select
End Sub

'----------------------------------------------------
' GetOSVersion As WindowsVersion
' - Gibt die Betriebssystemversion zurück
'----------------------------------------------------
Public Function GetOSVersion() As WindowsVersion
    Dim OsVersInfoEx As OSVERSIONINFOEX
    Dim OsVersInfo As OSVERSIONINFO
    
    If m_bAlreadyGot Then
        GetOSVersion = m_OsVersion
        Exit Function
    End If
    
    ' Zuerst nehmen wir nur die kleinere Struktur um sicherzugehen,
    ' dass Windows 95 und Konsorten auch damit klarkommen
    OsVersInfo.dwOSVersionInfoSize = Len(OsVersInfo)
    
    If GetVersionEx1(OsVersInfo) = 0 Then
        MsgBox "Das Betriebssystem konnte nicht korrekt erkannt werden:" & _
                vbCrLf & "Fehler im API-Aufruf"
        
        m_OsVersion = WIN_OLD
        Exit Function
    End If
        
    With OsVersInfo
        Select Case .dwPlatformId
            Case VER_PLATFORM_WIN32s
                m_OsVersion = WIN_OLD
            Case VER_PLATFORM_WIN32_WINDOWS
                Select Case .dwMinorVersion
                    Case 0
                        m_OsVersion = WIN_95
                    Case 10
                        m_OsVersion = WIN_98
                    Case 90
                        m_OsVersion = WIN_ME
                End Select
            Case VER_PLATFORM_WIN32_NT
                Select Case .dwMajorVersion
                    Case 3
                        m_OsVersion = WIN_NT_3x
                    Case 4
                        m_OsVersion = WIN_NT_4x
                    Case 5
                        Select Case .dwMinorVersion
                            Case 0
                                m_OsVersion = WIN_2K
                            Case 1
                                
' Es handelt sich um Windows XP. Um zu erfahren, ob das verwendete
' Produkt eine Home-Edition ist, erfragen wir die Version erneut und
' empfangen dieses Mal die komplette Liste
                                
                                OsVersInfoEx.dwOSVersionInfoSize = _
                                    Len(OsVersInfoEx)
                                
                                If GetVersionEx2(OsVersInfoEx) = 0 Then
                                    MsgBox "Das Betriebssystem konnte nicht " & _
                                        "korrekt erkannt werden:" & _
                                        vbCrLf & "Fehler im API-Aufruf"
                                        
                                    m_OsVersion = WIN_XP
                                    Exit Function
                                End If
                                
                                If (OsVersInfoEx.wSuiteMask And VER_SUITE_PERSONAL) _
                                    = VER_SUITE_PERSONAL Then
                                    
                                    m_OsVersion = WIN_XP_HOME
                                Else
                                    m_OsVersion = WIN_XP
                                End If
                                
                            Case 2
                                m_OsVersion = WIN_2003
                        End Select
                End Select
        End Select
    End With
    
    GetOSVersion = m_OsVersion
    m_bAlreadyGot = True
End Function
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 18 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Private Type SYSTEM_INFO
    dwOemID As Long
    dwPageSize As Long
    lpMinimumApplicationAddress As Long
    lpMaximumApplicationAddress As Long
    dwActiveProcessorMask As Long
    dwNumberOrfProcessors As Long
    dwProcessorType As Long
    dwAllocationGranularity As Long
    dwReserved As Long
End Type

Private Declare Function IsWow64Process Lib "kernel32" _
    (ByVal hProcess As Long, _
    ByRef Wow64Process As Long) As Long

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

Private Declare Sub GetNativeSystemInfo Lib "kernel32" _
    (lpSystemInfo As SYSTEM_INFO)

Case 6 'Vista
    Dim Ret As Long
    
    Call IsWow64Process(GetCurrentProcess, Ret)
    If Ret <> 0 Then
        m_OsVersion = WIN_VISTA_64
        
        Dim SysInfo64 As SYSTEM_INFO
        Call GetNativeSystemInfo(SysInfo64)
        'MsgBox "Anzahl Prozessoren im 64-Bit System: " + CStr(SysInfo64.dwNumberOrfProcessors)

    Else
        m_OsVersion = WIN_VISTA_32
    End If