Windows provides us with the GetVersionEx API function to allow us to
retrieve extended information about the operating system. The Operating System
name and build (amongst other information) is deduced from the dwPlatformID,
dwMajorVersion, and dwMinorVersion of the OSVERSIONINFO UDT which GetVersionEx
API fills out.
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function apiGetVersionEx Lib "kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As Any) _
As Long
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
Function fOSName() As String
Dim osvi As OSVERSIONINFO
Dim strOut As String
osvi.dwOSVersionInfoSize = Len(osvi)
If CBool(apiGetVersionEx(osvi)) Then
With osvi
' Win 2000
If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
.dwMajorVersion = 5 Then
strOut = "Windows 2000 (Version " & _
.dwMajorVersion & "." & .dwMinorVersion & _
") Build " & .dwBuildNumber
If (Len(.szCSDVersion)) Then
strOut = strOut & " (" & _
fTrimNull(.szCSDVersion) & ")"
End If
End If
' XP
If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
.dwMajorVersion = 5 And _
.dwMinorVersion = 1 Then
strOut = "Windows XP (Version " & _
.dwMajorVersion & "." & .dwMinorVersion & _
") Build " & .dwBuildNumber
If (Len(.szCSDVersion)) Then
strOut = strOut & " (" & _
fTrimNull(.szCSDVersion) & ")"
End If
End If
' .Net Server
If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
.dwMajorVersion = 5 And _
.dwMinorVersion = 2 Then
strOut = "Windows .NET Server (Version " & _
.dwMajorVersion & "." & .dwMinorVersion & _
") Build " & .dwBuildNumber
If (Len(.szCSDVersion)) Then
strOut = strOut & " (" & _
fTrimNull(.szCSDVersion) & ")"
End If
End If
' Win ME
If (.dwMajorVersion = 4 And _
(.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
.dwMinorVersion = 90)) Then
strOut = "Windows Millenium"
End If
' Win 98
If (.dwMajorVersion = 4 And _
(.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
.dwMinorVersion = 10)) Then
strOut = "Windows 98"
End If
' Win 95
If (.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
.dwMinorVersion = 0) Then
strOut = "Windows 95"
End If
' Win NT
If (.dwPlatformId = VER_PLATFORM_WIN32_NT And _
.dwMajorVersion <= 4) Then
strOut = "Windows NT " & _
.dwMajorVersion & "." & .dwMinorVersion & _
" Build " & .dwBuildNumber
If (Len(.szCSDVersion)) Then
strOut = strOut & " (" & _
fTrimNull(.szCSDVersion) & ")"
End If
End If
End With
End If
fOSName = strOut
End Function
Private Function fTrimNull(strIn As String) As String
Dim intPos As Integer
intPos = InStr(1, strIn, vbNullChar)
If intPos Then
fTrimNull = Mid$(strIn, 1, intPos - 1)
Else
fTrimNull = strIn
End If
End Function
|