Home  |   French  |   About  |   Search  | mvps.org  

What's New
Table Of Contents
Credits
Netiquette
10 Commandments 
Bugs
Tables
Queries
Forms
Reports
Modules
APIs
Strings
Date/Time
General
Downloads
Resources
Search
Feedback
mvps.org

In Memoriam

Terms of Use


VB Petition

API: Retrieving Operating System Name

Author(s)
Dev Ashish

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.

' ******** Code Start ********
 'This code was originally written by Dev Ashish.
 'It is not to be altered or distributed,
 'except as part of an application.
 'You are free to use it in any application,
 'provided the copyright notice is left unchanged.
 '
 'Code Courtesy of
 'Dev Ashish
 '  

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
'   ********** Code End **********

© 1998-2010, Dev Ashish & Arvin Meyer, All rights reserved. Optimized for Microsoft Internet Explorer