Thomas Risi Softwareentwicklung
Addins - Datenbanklösungen - Komponenten - RTDServer - WebServices
GetOS
Diese Funktion ermittelt das installierte (Windows) Betriebssystem ...
Option Explicit
Private Declare Function GetVersionEx Lib "Kernel32" Alias "GetVersionExA" ( _
lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Const VER_PLATFORM_WIN32s = &H0
Const VER_PLATFORM_WIN32_WINDOWS = &H1
Const VER_PLATFORM_WIN32_NT = &H2
Function GetOS()
Dim OSString$: OSString = ""
Dim OSVersion As OSVERSIONINFO
Dim BuildNr&
On Error Goto errorhandler
OSVersion.dwOSVersionInfoSize = Len(OSVersion)
GetVersionEx OSVersion
With OSVersion
If (.dwBuildNumber And &HFFFF&) > &H7FFF Then
BuildNr = (.dwBuildNumber And &HFFFF&) - &H10000
Else
BuildNr = .dwBuildNumber And &HFFFF&
End If
If .dwPlatformId = VER_PLATFORM_WIN32_NT Then
If .dwMajorVersion = 4 Then
OSString = "Windows NT"
ElseIf .dwMajorVersion = 5 Then
If .dwMinorVersion = 0 Then
OSString = "Windows 2000"
Else
OSString = "Windows XP"
End If
End If
ElseIf .dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
If (.dwMajorVersion > 4) Or _
(.dwMajorVersion = 4 And .dwMinorVersion = 10) Then
If BuildNr = 1998 Then
OSString = "Windows 98"
Else
OSString = "Windows 98 SE"
End If
ElseIf (.dwMajorVersion = 4 And .dwMinorVersion = 0) Then
OSString = "Windows 95"
End If
If (.dwMajorVersion = 4 And .dwMinorVersion = 90) Then
OSString = "Windows ME"
End If
ElseIf .dwPlatformId = VER_PLATFORM_WIN32s Then
OSString = "Windows 32s"
End If
End With
GetOS = OSString & " Build:" & BuildNr
Exit Function
errorhandler:
End Function
© 2001 -
by Thomas Risi