Неплохо, если кто-нибудь проверит в WinNT4, WinXP Home, или какой-нибудь серверной версии.
Замечания и ссылки на уже существующий код с такой же функциональностью приветствуются.
- Код: Выделить всё
Option Explicit
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_NT_WORKSTATION = 1
Private Const VER_NT_DOMAIN_CONTROLLER = 2
Private Const VER_NT_SERVER = 3
Private Const VER_SERVER_NT = &H80000000
Private Const VER_WORKSTATION_NT = &H40000000
Private Const VER_SUITE_SMALLBUSINESS = &H1&
Private Const VER_SUITE_ENTERPRISE = &H2&
Private Const VER_SUITE_BACKOFFICE = &H4&
Private Const VER_SUITE_COMMUNICATIONS = &H8&
Private Const VER_SUITE_TERMINAL = &H10&
Private Const VER_SUITE_SMALLBUSINESS_RESTRICTED = &H20&
Private Const VER_SUITE_EMBEDDEDNT = &H40&
Private Const VER_SUITE_DATACENTER = &H80&
Private Const VER_SUITE_SINGLEUSERTS = &H100&
Private Const VER_SUITE_PERSONAL = &H200&
Private Const VER_SUITE_BLADE = &H400&
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Integer
wMinorVersion As Byte '9x-only
wMajorVersion As Byte '9x-only
dwPlatformId As Long
szCSDVersion(1 To 128) As Byte
End Type
Private Type OSVERSIONINFOEX
osvi As OSVERSIONINFO
wServicePackMajor As Integer
wServicePackMinor As Integer
wSuiteMask As Integer
wProductType As Byte
wReserved As Byte
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Public Function winver() As String
Dim osvix As OSVERSIONINFOEX
osvix.osvi.dwOSVersionInfoSize = Len(osvix)
If 0 = GetVersionEx(osvix.osvi) Then
osvix.osvi.dwOSVersionInfoSize = Len(osvix.osvi)
If 0 = GetVersionEx(osvix.osvi) Then
winver = "(unknown)"
Exit Function
End If
End If
Select Case osvix.osvi.dwPlatformId
Case VER_PLATFORM_WIN32_NT:
Select Case osvix.osvi.dwMajorVersion
Case 3, 4: winver = "Windows NT"
Case 5:
Select Case osvix.osvi.dwMinorVersion
Case 0: winver = "Windows 2000"
Case 1: winver = "Windows XP"
Case 2: winver = "Windows 2003"
Case Else:
winver = "(Windows NT 5.x)"
End Select
Case 6: winver = "Windows Vista"
Case Else: winver = "(Windows NT)"
End Select
If Len(osvix) = osvix.osvi.dwOSVersionInfoSize Then
Select Case osvix.wProductType
Case VER_NT_SERVER, VER_NT_DOMAIN_CONTROLLER:
If osvix.wSuiteMask And VER_SUITE_DATACENTER Then
winver = winver & " Datacenter"
ElseIf osvix.wSuiteMask And VER_SUITE_ENTERPRISE Then
winver = winver & " Advanced Server"
Else
winver = winver & " Server"
End If
Case VER_NT_WORKSTATION:
If osvix.osvi.dwMajorVersion < 5 Then
winver = winver & " Workstation"
ElseIf osvix.wSuiteMask And VER_SUITE_PERSONAL Then
winver = winver & " Home"
Else
winver = winver & " Professional"
End If
Case Else:
'no append
End Select
End If
Case VER_PLATFORM_WIN32_WINDOWS:
Select Case osvix.osvi.dwMajorVersion
Case 4:
Select Case osvix.osvi.dwMinorVersion
Case 0: winver = "Windows 95"
Case 10: winver = "Windows 98"
Case 90: winver = "Windows Me"
Case Else: winver = "(Windows 9x)"
End Select
Case Else: winver = "(Windows)"
End Select
Case Else:
winver = "(unknown)"
End Select
winver = winver & ", ver. " & osvix.osvi.dwMajorVersion & "." & osvix.osvi.dwMinorVersion & "." & osvix.osvi.dwBuildNumber
If Len(osvix) = osvix.osvi.dwOSVersionInfoSize Then
If osvix.wServicePackMajor Then
winver = winver & " SP" & osvix.wServicePackMajor
If osvix.wServicePackMinor Then
winver = winver & "." & osvix.wServicePackMinor
End If
End If
End If
End Function
Ведь будут же выходить новые винды 
А на Enterprise все еще веселее, не поверите: