VB 6.0 获取操作系统的名称及版本源码(模块)
发现博客园插入代码的列表里面没有VB一项,只有VB.NET。。。
前几天用VB写的一个获取网卡相关信息时用到的,收藏下,说不定以后还用得到!
其实最简单的方法就是读取环境变量里面的“OS”,即:Environ("OS"),但这样获取的值不准确,所以就有了下面这种方法:
Option Explicit
Public OSName As String '操作系统名称(简称),方便程序控制时根据操作系统取值
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
wServicePackMajor As Integer
wServicePackMinor As Integer
wSuiteMask As Integer
wProductType As Byte
wReserved As Byte
End Type
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
' 获得 Windows 操作系统的名称,returnType决定返回的方式,值为0时,返回简称,否则返回全称
Public Function GetWindowsVersion(ByVal returnType As Integer) As String
Dim ver As OSVERSIONINFO, retLng As Long, os As String
ver.dwOSVersionInfoSize = Len(ver)
GetVersionEx ver
' retLng = GetVersionEx(ver)
' If retLng = 0 Then
' os = "Unknown System Version!"
' Exit Function
' End If
With ver
Select Case .dwPlatformId
Case 1
Select Case .dwMinorVersion
Case 0
If returnType = 0 Then
os = "Windows 95"
Else
Select Case .szCSDVersion
Case "C"
os = "Windows 95 OSR2"
Case "B"
os = "Windows 95 OSR2"
Case Else
os = "Windows 95"
End Select
End If
Case 10
If returnType = 0 Then
os = "Windows 98"
Else
Select Case .szCSDVersion
Case "A"
os = "Windows 98 SE"
Case Else
os = "Windows 98"
End Select
End If
Case 90
If returnType = 0 Then
os = "Windows Me"
Else
os = "Windows Millennium Edition"
End If
End Select
Case 2
Select Case .dwMajorVersion
Case 3
os = "Windows NT 3.51"
Case 4
os = "Windows NT 4.0"
Case 5
Select Case .dwMinorVersion
Case 0
If returnType = 0 Then
os = "Windows 2000"
Else
Select Case .wSuiteMask
Case &H80
os = "Windows 2000 Data center"
Case &H2
os = "Windows 2000 Advanced"
Case Else
os = "Windows 2000"
End Select
End If
Case 1
If returnType = 0 Then
os = "Windows XP"
Else
Select Case .wSuiteMask
Case &H0
os = "Windows XP Professional"
Case &H200
os = "Windows XP Home"
Case Else
os = "Windows XP"
End Select
End If
Case 2
If returnType = 0 Then
os = "Windows Server 2003"
Else
Select Case .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"
End Select
End If
End Select
If returnType <> 0 And .wServicePackMajor > 0 Then
os = os & " Service Pack " & .wServicePackMajor & IIf(.wServicePackMinor > 0, "." & .wServicePackMinor, vbNullString)
End If
Case 6
If returnType <> 0 Then
Select Case .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"
End Select
End If
Select Case .dwMinorVersion
Case 0
Select Case .wProductType
Case 3
If returnType = 0 Then
os = "Windows Server 2008"
Else
os = "Windows Server 2008 " & os
End If
Case Else
If returnType = 0 Then
os = "Windows Vista"
Else
os = "Windows Vista " & os
End If
End Select
Case 1
Select Case .wProductType
Case 3
If returnType = 0 Then
os = "Windows Server 2008 R2"
Else
os = "Windows Server 2008 R2" & os
End If
Case Else
If returnType = 0 Then
os = "Windows 7"
Else
os = "Windows 7 " & os
End If
End Select
End Select
If returnType <> 0 And .wServicePackMajor > 0 Then
os = os & " Service Pack " & .wServicePackMajor & IIf(.wServicePackMinor > 0, "." & .wServicePackMinor, vbNullString)
End If
End Select
Case Else
os = "Unknown System Version!"
End Select
If returnType <> 0 Then 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