VB及VBA获取操作系统版本的通用模块

VB及VBA获取操作系统版本的通用模块

Option Explicit

Public OSNameAs String'操作系统名称（简称），方便程序控制时根据操作系统取值

Public Type OSVERSIONINFO
    dwOSVersionInfoSize AsLong
    dwMajorVersion AsLong
    dwMinorVersion AsLong
    dwBuildNumber AsLong
    dwPlatformId AsLong
    szCSDVersion AsString * 128
    wServicePackMajor AsInteger
    wServicePackMinor AsInteger
    wSuiteMask AsInteger
    wProductType AsByte
    wReserved AsByte
End Type

Public Declare Function GetVersionExLib "kernel32"Alias "GetVersionExA" (lpVersionInformationAs OSVERSIONINFO)As Long

' 获得 Windows 操作系统的名称，returnType决定返回的方式，值为0时，返回简称，否则返回全称
Public Function GetWindowsVersion(ByVal returnTypeAs Integer)As String
    Dim ver As OSVERSIONINFO, retLngAs Long, osAs String
    ver.dwOSVersionInfoSize =Len(ver)
    GetVersionEx ver
    
'    retLng = GetVersionEx(ver)
'    If retLng = 0 Then
'        os = "Unknown System Version!"
'        Exit Function
'    End If
    
    With ver
        SelectCase .dwPlatformId
            Case1
                SelectCase .dwMinorVersion
                    Case0
                        If returnType= 0Then
                            os ="Windows 95"
                        Else
                            SelectCase .szCSDVersion
                                Case"C"
                                    os ="Windows 95 OSR2"
                                Case"B"
                                    os ="Windows 95 OSR2"
                                CaseElse
                                    os ="Windows 95"
                            EndSelect
                        EndIf
                    Case10
                        If returnType= 0Then
                            os ="Windows 98"
                        Else
                            SelectCase .szCSDVersion
                                Case"A"
                                    os ="Windows 98 SE"
                                CaseElse
                                    os ="Windows 98"
                            EndSelect
                        EndIf
                    Case90
                        If returnType= 0Then
                            os ="Windows Me"
                        Else
                            os ="Windows Millennium Edition"
                        EndIf
                EndSelect
            Case2
                SelectCase .dwMajorVersion
                    Case3
                        os ="Windows NT 3.51"
                    Case4
                        os ="Windows NT 4.0"
                    Case5
                        SelectCase .dwMinorVersion
                            Case0
                                If returnType= 0Then
                                    os ="Windows 2000"
                                Else
                                    SelectCase .wSuiteMask
                                        Case&H80
                                            os ="Windows 2000 Data center"
                                        Case&H2
                                            os ="Windows 2000 Advanced"
                                        CaseElse
                                            os ="Windows 2000"
                                    EndSelect
                                EndIf
                            Case1
                                If returnType= 0Then
                                    os ="Windows XP"
                                Else
                                    SelectCase .wSuiteMask
                                        Case&H0
                                            os ="Windows XP Professional"
                                        Case&H200
                                            os ="Windows XP Home"
                                        CaseElse
                                            os ="Windows XP"
                                    EndSelect
                                EndIf
                            Case2
                                If returnType= 0Then
                                    os ="Windows Server 2003"
                                Else
                                    SelectCase .wSuiteMask
                                        Case&H2
                                            os ="Windows Server 2003 Enterprise"
                                        Case&H80
                                            os ="Windows Server 2003 Data center"
                                        Case&H400
                                            os ="Windows Server 2003 Web Edition"
                                        Case&H0
                                            os ="Windows Server 2003 Standard"
'                                        Case &H112
'                                            os = "Windows Server 2003 R2 Enterprise"
                                        Case Else
                                            os ="Windows Server 2003"
                                    EndSelect
                                EndIf
                        EndSelect
                        If returnType<> 0And .wServicePackMajor> 0Then
                            os = os& " Service Pack" & .wServicePackMajor& IIf(.wServicePackMinor> 0,"."& .wServicePackMinor, vbNullString)
                        EndIf
                    Case6
                        If returnType<> 0Then
                            SelectCase .wProductType
                                Case&H6
                                    os ="Business Edition"
                                Case&H10
                                    os ="Business Edition (N)"
                                Case&H12
                                    os ="Cluster Server Edition"
                                Case&H8
                                    os ="Server Datacenter Edition (full installation)"
                                Case&HC
                                    os ="Server Datacenter Edition (core installation)"
                                Case&H4
                                    os ="Enterprise Edition"
                                Case&H1B
                                    os ="Enterprise Edition (N)"
                                Case&HA
                                    os ="Server Enterprise Edition (full installation)"
                                Case&HE
                                    os ="Server Enterprise Edition (core installation)"
                                Case&HF
                                    os ="Server Enterprise Edition for Itanium-based Systems"
                                Case&H2
                                    os ="Home Basic Edition"
                                Case&H5
                                    os ="Home Basic Edition (N)"
                                Case&H3
                                    os ="Home Premium Edition"
                                Case&H1A
                                    os ="Home Premium Edition (N)"
                                Case&H13
                                    os ="Home Server Edition"
                                Case&H18
                                    os ="Server for Small Business Edition"
                                Case&H9
                                    os ="Small Business Server"
                                Case&H19
                                    os ="Small Business Server Premium Edition"
                                Case&H7
                                    os ="Server Standard Edition (full installation)"
                                Case&HD
                                    os ="Server Standard Edition (core installation)"
                                Case&H8
                                    os ="Starter Edition"
                                Case&H17
                                    os ="Storage Server Enterprise Edition"
                                Case&H14
                                    os ="Storage Server Express Edition"
                                Case&H15
                                    os ="Storage Server Standard Edition"
                                Case&H16
                                    os ="Storage Server Workgroup Edition"
                                Case&H1
                                    os ="Ultimate Edition"
                                Case&H1C
                                    os ="Ultimate Edition (N)"
                                Case&H0
                                    os ="An unknown product"
                                Case&HABCDABCD
                                    os ="Not activated product"
                                Case&H11
                                    os ="Web Server Edition"
                            EndSelect
                        EndIf
                        SelectCase .dwMinorVersion
                            Case0
                                SelectCase .wProductType
                                    Case3
                                        If returnType= 0Then
                                            os ="Windows Server 2008"
                                        Else
                                            os ="Windows Server 2008" & os
                                        EndIf
                                    CaseElse
                                        If returnType= 0Then
                                            os ="Windows Vista"
                                        Else
                                            os ="Windows Vista " & os
                                        EndIf
                                EndSelect
                            Case1
                                SelectCase .wProductType
                                    Case3
                                        If returnType= 0Then
                                            os ="Windows Server 2008 R2"
                                        Else
                                            os ="Windows Server 2008 R2"& os
                                        EndIf
                                    CaseElse
                                        If returnType= 0Then
                                            os ="Windows 7"
                                        Else
                                            os ="Windows 7 " & os
                                        EndIf
                                EndSelect
                        EndSelect
                        If returnType<> 0And .wServicePackMajor> 0Then
                            os = os& " Service Pack" & .wServicePackMajor& IIf(.wServicePackMinor> 0,"."& .wServicePackMinor, vbNullString)
                        EndIf
                EndSelect
            CaseElse
                os ="Unknown System Version!"
        End Select
    If returnType<> 0Then os = os &" [Version: " & .dwMajorVersion& "."& .dwMinorVersion& "."& .dwBuildNumber& "]"
    End With
    GetWindowsVersion = os
End Function

'返回获取本地连接属性的方式
'Vista及Win7下 GetDetailsOf(FolderItem, 2) 获取的值类似于：“Marvell Yukon 88E8056 PCI-E Gigabit Ethernet Controller”，对应XP、2000及2003下的GetDetailsOf(FolderItem, 3)
'Vista及Win7下 GetDetailsOf(FolderItem, 1) 获取的值为本地连接状态，为“网络”时说明正常，对应XP、2000及2003下的GetDetailsOf(FolderItem, 2)
Public Function getAdapterStatusType()As Integer
    Select Case OSName
        Case "Windows Vista","Windows Server 2008","Windows 7","Windows Server 2008 R2"
            getAdapterStatusType =2
        Case Else
            getAdapterStatusType =3
    End Select
End Function

 


'返回获取本地连接属性的方式
'Vista及Win7下 GetDetailsOf(FolderItem, 2) 获取的值类似于：“Marvell Yukon 88E8056 PCI-E Gigabit Ethernet Controller”，对应XP、2000及2003下的GetDetailsOf(FolderItem, 3)
'Vista及Win7下 GetDetailsOf(FolderItem, 1) 获取的值为本地连接状态，为“网络”时说明正常，对应XP、2000及2003下的GetDetailsOf(FolderItem, 2)
Public Function getAdapterStatusType()As Integer
    Select Case OSName
        Case "Windows Vista","Windows Server 2008","Windows 7","Windows Server 2008 R2"
            getAdapterStatusType =2
        Case Else
            getAdapterStatusType =3
    End Select
End Function