Найдите текущий язык пользователя
Function fun_OS_Lang() As Integer
fun_OS_Lang = Application.International(XlApplicationInternational.xlCountryCode)
End Function
Select Case Application.International(xlApplicationInternational.xlCountryCode)
Case 1: Call MsgBox("English")
Case 33: Call MsgBox("French")
Case 49: Call MsgBox("German")
Case 81: Call MsgBox("Japanese")
End Select
'===============================================================
Option Explicit
Dim OSVer As New clsOSInfo
Private Sub Form_Load()
Debug.Print "Название ОС: "; OSVer.OSName
Debug.Print "Версия SP: "; OSVer.SPVer
Debug.Print "Язык, отображаемый в диалогах: "; OSVer.LangNonUnicodeCode; " Название: "; OSVer.LangNonUnicodeName
OSVer.IsVistaOrLater
OSVer.MajorMinor
End
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set OSVer = Nothing
End Sub
Option Explicit
' Класс OSInfo by Alex Dragokas
' ver 1.4.6
'
Private Type OSVERSIONINFOEX
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion(255) As Byte
wServicePackMajor As Integer
wServicePackMinor As Integer
wSuiteMask As Integer
wProductType As Byte
wReserved As Byte
End Type
Private Type SID_IDENTIFIER_AUTHORITY
value(0 To 5) As Byte
End Type
Private Type SID_AND_ATTRIBUTES
Sid As Long
Attributes As Long
End Type
Private Type TOKEN_GROUPS
GroupCount As Long
Groups(20) As SID_AND_ATTRIBUTES
End Type
Private Declare Function GetUserDefaultUILanguage Lib "kernel32.dll" () As Long
Private Declare Function GetSystemDefaultUILanguage Lib "kernel32.dll" () As Long
Private Declare Function GetSystemDefaultLCID Lib "kernel32.dll" () As Long
Private Declare Function GetUserDefaultLCID Lib "kernel32.dll" () As Long
Private Declare Function IsWow64Process Lib "kernel32.dll" (ByVal hProc As Long, bWow64Process As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExW" (lpVersionInformation As OSVERSIONINFOEX) As Long
Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Private Declare Function GetProductInfo Lib "kernel32.dll" (ByVal dwOSMajorVersion As Long, ByVal dwOSMinorVersion As Long, ByVal dwSpMajorVersion As Long, ByVal dwSpMinorVersion As Long, pdwReturnedProductType As Long) As Long
Private Declare Function CheckTokenMembership Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal SidToCheck As Long, IsMember As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal TokenInformationClass As Long, TokenInformation As Any, ByVal TokenInformationLength As Long, ReturnLength As Long) As Long
Private Declare Function OpenThreadToken Lib "advapi32" (ByVal ThreadHandle As Long, ByVal DesiredAccess As Long, ByVal OpenAsSelf As Long, TokenHandle As Long) As Long
Private Declare Function GetCurrentThread Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Source As Any, ByVal lSize As Long)
Private Declare Function GetMem4 Lib "msvbvm60.dll" (Src As Any, Dst As Any) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function LocalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Sub FreeSid Lib "advapi32.dll" (ByVal pSid As Long)
Private Declare Function AllocateAndInitializeSid Lib "advapi32.dll" (pIdentifierAuthority As Any, ByVal nSubAuthorityCount As Byte, ByVal nSubAuthority0 As Long, ByVal nSubAuthority1 As Long, ByVal nSubAuthority2 As Long, ByVal nSubAuthority3 As Long, ByVal nSubAuthority4 As Long, ByVal nSubAuthority5 As Long, ByVal nSubAuthority6 As Long, ByVal nSubAuthority7 As Long, lpPSid As Long) As Long
Private Declare Function IsValidSid Lib "advapi32" (ByVal pSid As Long) As Long
Private Declare Function GetSidSubAuthority Lib "advapi32.dll" (ByVal pSid As Long, ByVal nSubAuthority As Long) As Long
Private Declare Function GetSidSubAuthorityCount Lib "advapi32.dll" (ByVal pSid As Long) As Long
Private Declare Function EqualSid Lib "advapi32.dll" (pSid1 As Any, pSid2 As Any) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExW" (ByVal hKey As Long, ByVal lpSubKey As Long, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueExStr Lib "advapi32.dll" Alias "RegQueryValueExW" (ByVal hKey As Long, ByVal lpValueName As Long, ByVal lpReserved As Long, lpType As Long, ByVal szData As Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExW" (ByVal hKey As Long, ByVal lpValueName As Long, ByVal lpReserved As Long, lpType As Long, szData As Long, lpcbData As Long) As Long
Private Const SM_SERVERR2 As Long = 89&
Private Const VER_NT_WORKSTATION As Long = 1&
Private Const VER_SUITE_STORAGE_SERVER As Long = &H2000&
Private Const VER_SUITE_DATACENTER As Long = &H80&
Private Const VER_SUITE_PERSONAL As Long = &H200&
Private Const VER_SUITE_ENTERPRISE As Long = 2&
Private Const SM_CLEANBOOT As Long = 67&
Private Const LOCALE_SYSTEM_DEFAULT As Long = &H800&
Private Const LOCALE_USER_DEFAULT As Long = &H400&
Private Const LOCALE_SENGLANGUAGE As Long = &H1001&
Dim osi As OSVERSIONINFOEX
Dim OSName_ As String
Dim Family_ As String
Dim Bitness_ As String
Dim Edition_ As String
Dim MajorMinor_ As Single
Dim SPver_ As Single
Dim IsSafeBoot_ As Boolean
Dim IsElevated_ As Boolean
Dim IntegrityLevel_ As String
Dim UserType_ As String
Dim IsVistaOrLater_ As Boolean
Dim LangSystemName_ As String
Dim LangSystemCode_ As Long
Dim LangDisplayName_ As String
Dim LangDisplayCode_ As Long
Dim LangNonUnicodeName_ As String
Dim LangNonUnicodeCode_ As Long
Dim t ' not used
Private Sub Class_Initialize()
On Error Resume Next
Dim dec As Single
Dim ProductType As Long
LangDisplayCode_ = GetUserDefaultUILanguage Mod &H10000
LangDisplayName_ = GetLangNameByCultureCode(LangDisplayCode_)
LangSystemCode_ = GetSystemDefaultUILanguage Mod &H10000
LangSystemName_ = GetLangNameByCultureCode(LangSystemCode_)
LangNonUnicodeCode_ = GetSystemDefaultLCID Mod &H10000
LangNonUnicodeName_ = GetLangNameByCultureCode(LangNonUnicodeCode_)
osi.dwOSVersionInfoSize = Len(osi)
GetVersionEx osi
Family_ = IIf(osi.dwMajorVersion >= 6, "Vista", "NT")
IsVistaOrLater_ = (osi.dwMajorVersion >= 6)
Bitness_ = IIf(IsWin64, "x64", "x32")
IsSafeBoot_ = (GetSystemMetrics(SM_CLEANBOOT) > 0) ' 0 - Normal boot, 1 - Fail-safe boot, 2 - Fail-safe with network boot
' OS Major + Minor
dec = osi.dwMinorVersion
If dec <> 0 Then Do: dec = dec / 10: Loop Until dec < 1
MajorMinor_ = osi.dwMajorVersion + dec
' Service Pack Major + Minor
dec = osi.wServicePackMinor
If dec <> 0 Then Do: dec = dec / 10: Loop Until dec < 1
SPver_ = osi.wServicePackMajor + dec
Select Case MajorMinor_
Case 10
If osi.wProductType = VER_NT_WORKSTATION Then
OSName_ = "Windows 10"
Else
OSName_ = "Windows 10 Server"
End If
Case 6.4
OSName_ = "Windows 10 Technical Preview"
Case 6.3
If osi.wProductType = VER_NT_WORKSTATION Then
OSName_ = "Windows 8.1"
Else
OSName_ = "Windows Server 2012 R2"
End If
Case 6.2
If osi.wProductType = VER_NT_WORKSTATION Then
OSName_ = "Windows 8"
Else
OSName_ = "Windows Server 2012"
End If
Case 6.1
If osi.wProductType = VER_NT_WORKSTATION Then
OSName_ = "Windows 7"
Else
OSName_ = "Windows Server 2008 R2"
End If
Case 6
If osi.wProductType = VER_NT_WORKSTATION Then
OSName_ = "Windows Vista"
Else
OSName_ = "Windows Server 2008"
End If
Case 5.2
If GetSystemMetrics(SM_SERVERR2) Then
OSName_ = "Windows Server 2003 R2"
ElseIf osi.wSuiteMask And VER_SUITE_STORAGE_SERVER Then
OSName_ = "Windows Storage Server 2003"
ElseIf osi.wProductType = VER_NT_WORKSTATION And Bitness_ = "x64" Then
OSName_ = "Windows XP"
Edition_ = "Professional"
Else
OSName_ = "Windows Server 2003"
End If
Case 5.1
OSName_ = "Windows XP"
If osi.wSuiteMask = VER_SUITE_PERSONAL Then
Edition_ = "Home Edition"
Else
Edition_ = "Professional"
End If
Case 5
OSName_ = "Windows 2000"
If osi.wProductType = VER_NT_WORKSTATION Then
Edition_ = "Professional"
Else
If osi.wSuiteMask And VER_SUITE_DATACENTER Then
Edition_ = "Datacenter Server"
ElseIf osi.wSuiteMask And VER_SUITE_ENTERPRISE Then
Edition_ = "Advanced Server"
Else
Edition_ = "Server"
End If
End If
Case Else
OSName_ = "Windows Unknown" & "(ver. " & MajorMinor_ & ") (" & "Build: " & osi.dwBuildNumber & ")" & " Registry's data: " & GetWindowsNameFromRegistry()
End Select
'Редакция
If Edition_ = "" Then
If MajorMinor_ >= 6 Then
If GetProductInfo(osi.dwMajorVersion, osi.dwMinorVersion, osi.wServicePackMajor, osi.wServicePackMinor, ProductType) Then
Edition_ = GetProductName(ProductType)
End If
End If
End If
IsElevated_ = IsProcessElevated()
IntegrityLevel_ = GetIntegrityLevel()
UserType_ = GetUserType()
End Sub
Function GetWindowsNameFromRegistry() As String
On Error GoTo ErrorHandler
Const HKEY_LOCAL_MACHINE As Long = &H80000002
Const KEY_QUERY_VALUE As Long = &H1&
Dim OSName As String
Dim hKey As Long
Dim ordType As Long
Dim cData As Long
RegOpenKeyEx HKEY_LOCAL_MACHINE, StrPtr("SOFTWARE\Microsoft\Windows NT\CurrentVersion"), 0&, KEY_QUERY_VALUE, hKey
RegQueryValueExLong hKey, StrPtr("ProductName"), 0&, ordType, 0&, cData
If cData > 1 Then
OSName = String$(cData - 1&, 0&)
RegQueryValueExStr hKey, StrPtr("ProductName"), 0&, ordType, StrPtr(OSName), cData
End If
If hKey <> 0 Then RegCloseKey hKey
GetWindowsNameFromRegistry = OSName
ErrorHandler:
End Function
Function IsProcessElevated(Optional hProcess As Long) As Boolean
On Error GoTo ErrorHandler
Const TOKEN_QUERY As Long = &H8&
Const TokenElevation As Long = 20&
Dim hToken As Long
Dim dwLengthNeeded As Long
Dim dwIsElevated As Long
' < Win Vista. Устанавливаем true, если пользователь состоит в группе "Администраторы"
If osi.dwMajorVersion < 6 Then IsProcessElevated = (GetUserType() = "Administrator"): Exit Function
If hProcess = 0 Then hProcess = GetCurrentProcess()
If OpenProcessToken(hProcess, TOKEN_QUERY, hToken) Then
If 0 <> GetTokenInformation(hToken, TokenElevation, dwIsElevated, 4&, dwLengthNeeded) Then
IsProcessElevated = (dwIsElevated <> 0)
End If
CloseHandle hToken
End If
ErrorHandler:
End Function
Public Function GetUserType(Optional hProcess As Long) As String
On Error GoTo ErrorHandler
Const TOKEN_QUERY As Long = &H8&
Const SECURITY_NT_AUTHORITY As Long = 5&
Const TokenGroups As Long = 2&
Const SECURITY_BUILTIN_DOMAIN_RID As Long = &H20&
Const DOMAIN_ALIAS_RID_ADMINS As Long = &H220&
Const DOMAIN_ALIAS_RID_USERS As Long = &H221&
Const DOMAIN_ALIAS_RID_GUESTS As Long = &H222&
Const DOMAIN_ALIAS_RID_POWER_USERS As Long = &H223&
Dim hProcessToken As Long
Dim BufferSize As Long
Dim psidAdmin As Long
Dim psidPower As Long
Dim psidUser As Long
Dim psidGuest As Long
Dim lResult As Long
Dim i As Long
Dim tpTokens As TOKEN_GROUPS
Dim tpSidAuth As SID_IDENTIFIER_AUTHORITY
GetUserType = "Unknown"
tpSidAuth.value(5) = SECURITY_NT_AUTHORITY
' в идеале, сначала нужно проверять токен, полученный от потока
' If Not OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, True, hProcessToken) Then
' ограничимся токеном процесса, т.к. пока не планируем более 1 потока
If hProcess = 0 Then hProcess = GetCurrentProcess()
If 0 = OpenProcessToken(hProcess, TOKEN_QUERY, hProcessToken) Then Exit Function
If hProcessToken Then
' Определяем требуемый размер буфера
GetTokenInformation hProcessToken, ByVal TokenGroups, 0&, 0&, BufferSize
If BufferSize Then
ReDim InfoBuffer((BufferSize \ 4) - 1) As Long ' Переводим размер byte -> Long
' Получаем информацию о SID-ах групп, ассоциированных с этим токеном
If 0 <> GetTokenInformation(hProcessToken, ByVal TokenGroups, InfoBuffer(0), BufferSize, BufferSize) Then
' Заполняем структуру из буфера
Call CopyMemory(tpTokens, InfoBuffer(0), Len(tpTokens))
' Получаем SID-ы каждого типа пользователей
lResult = AllocateAndInitializeSid(tpSidAuth, 2&, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0&, 0&, 0&, 0&, 0&, 0&, psidAdmin)
lResult = AllocateAndInitializeSid(tpSidAuth, 2&, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_POWER_USERS, 0&, 0&, 0&, 0&, 0&, 0&, psidPower)
lResult = AllocateAndInitializeSid(tpSidAuth, 2&, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_USERS, 0&, 0&, 0&, 0&, 0&, 0&, psidUser)
lResult = AllocateAndInitializeSid(tpSidAuth, 2&, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_GUESTS, 0&, 0&, 0&, 0&, 0&, 0&, psidGuest)
If IsValidSid(psidAdmin) And IsValidSid(psidPower) And IsValidSid(psidUser) And IsValidSid(psidGuest) Then
For i = 0 To tpTokens.GroupCount
' Берем SID каждой из ассоциированных групп
If IsValidSid(tpTokens.Groups(i).Sid) Then
' Проверяем на соответствие
If EqualSid(ByVal tpTokens.Groups(i).Sid, ByVal psidAdmin) Then
GetUserType = "Administrator": Exit For
ElseIf EqualSid(ByVal tpTokens.Groups(i).Sid, ByVal psidPower) Then
GetUserType = "Power User": Exit For
ElseIf EqualSid(ByVal tpTokens.Groups(i).Sid, ByVal psidUser) Then
GetUserType = "Limited User": Exit For
ElseIf EqualSid(ByVal tpTokens.Groups(i).Sid, ByVal psidGuest) Then
GetUserType = "Guest": Exit For
End If
End If
Next
End If
If psidAdmin Then FreeSid psidAdmin
If psidPower Then FreeSid psidPower
If psidUser Then FreeSid psidUser
If psidGuest Then FreeSid psidGuest
End If
End If
CloseHandle hProcessToken
End If
Exit Function
ErrorHandler:
If hProcessToken Then CloseHandle hProcessToken
End Function
Function GetIntegrityLevel(Optional hProcess As Long) As String 'https://msdn.microsoft.com/en-us/library/bb625966.aspx?f=255
On Error GoTo ErrorHandler
Const SECURITY_MANDATORY_UNTRUSTED_RID As Long = 0&
Const SECURITY_MANDATORY_LOW_RID As Long = &H1000&
Const SECURITY_MANDATORY_MEDIUM_RID As Long = &H2000&
Const SECURITY_MANDATORY_HIGH_RID As Long = &H3000&
Const SECURITY_MANDATORY_SYSTEM_RID As Long = &H4000&
Const SECURITY_MANDATORY_PROTECTED_PROCESS_RID As Long = &H5000&
Const TokenIntegrityLevel As Long = 25&
Const TOKEN_QUERY As Long = &H8&
Const ERROR_INSUFFICIENT_BUFFER As Long = &H7A&
Dim hToken As Long
Dim dwLengthNeeded As Long
Dim bTIL() As Byte
Dim pSidSub As Long
Dim dwIntegrityLevel As Long
Dim pSidAuthCnt As Long
Dim SidAuthCnt As Long
Dim pILSid As Long
Dim ILevel As String
If osi.dwMajorVersion < 6 Then GetIntegrityLevel = "Not supported": Exit Function ' < Win Vista
ILevel = "Unknown"
If hProcess = 0 Then hProcess = GetCurrentProcess()
If OpenProcessToken(hProcess, TOKEN_QUERY, hToken) Then
GetTokenInformation hToken, TokenIntegrityLevel, 0&, 0&, dwLengthNeeded
If ERROR_INSUFFICIENT_BUFFER = Err.LastDllError Then
ReDim bTIL(dwLengthNeeded - 1)
If 0 <> GetTokenInformation(hToken, TokenIntegrityLevel, bTIL(0), dwLengthNeeded, dwLengthNeeded) Then
GetMem4 bTIL(0), pILSid
If IsValidSid(pILSid) Then
pSidAuthCnt = GetSidSubAuthorityCount(pILSid)
If pSidAuthCnt Then
GetMem4 ByVal pSidAuthCnt, SidAuthCnt
If SidAuthCnt Then
pSidSub = GetSidSubAuthority(pILSid, SidAuthCnt - 1)
If pSidSub Then GetMem4 ByVal pSidSub, dwIntegrityLevel
Select Case dwIntegrityLevel
Case Is < SECURITY_MANDATORY_UNTRUSTED_RID
ILevel = "Unknown"
Case Is < SECURITY_MANDATORY_LOW_RID
ILevel = "Untrusted"
Case Is < SECURITY_MANDATORY_MEDIUM_RID
ILevel = "Low"
Case Is < SECURITY_MANDATORY_HIGH_RID
ILevel = "Medium"
Case Is < SECURITY_MANDATORY_SYSTEM_RID
ILevel = "High"
Case Is < SECURITY_MANDATORY_PROTECTED_PROCESS_RID
ILevel = "System"
Case Else
ILevel = "ProtectedProcess"
End Select
End If
End If
FreeSid pILSid
End If
End If
End If
CloseHandle hToken
End If
GetIntegrityLevel = ILevel
Exit Function
ErrorHandler:
If hToken Then CloseHandle hToken
End Function
Function GetProductName(ProductType As Long) As String
On Error Resume Next
Dim ProductName As String
Select Case ProductType
Case &H6&
ProductName = "Business"
Case &H10&
ProductName = "Business N"
Case &H12&
ProductName = "HPC Edition"
Case &H40&
ProductName = "Server Hyper Core V"
Case &H65&
ProductName = "" '"Windows 8"
Case &H62&
ProductName = "N" ' "Windows 8 N"
Case &H63&
ProductName = "China" ' "Windows 8 China"
Case &H64&
ProductName = "Single Language" ' "Windows 8 Single Language"
Case &H50&
ProductName = "Server Datacenter (EI)"
Case &H8&
ProductName = "Server Datacenter (FI)"
Case &HC&
ProductName = "Server Datacenter (CI)"
Case &H27&
ProductName = "Server Datacenter without Hyper-V (CI)"
Case &H25&
ProductName = "Server Datacenter without Hyper-V (FI)"
Case &H4&
ProductName = "Enterprise"
Case &H46&
ProductName = "Not supported"
Case &H54&
ProductName = "Enterprise N (EI)"
Case &H1B&
ProductName = "Enterprise N"
Case &H48&
ProductName = "Server Enterprise (EI)"
Case &HA&
ProductName = "Server Enterprise (FI)"
Case &HE&
ProductName = "Server Enterprise (CI)"
Case &H29&
ProductName = "Server Enterprise without Hyper-V (CI)"
Case &HF&
ProductName = "Server Enterprise for Itanium-based Systems"
Case &H26&
ProductName = "Server Enterprise without Hyper-V (FI)"
Case &H3B&
ProductName = "Windows Essential Server Solution Management"
Case &H3C&
ProductName = "Windows Essential Server Solution Additional"
Case &H3D&
ProductName = "Windows Essential Server Solution Management SVC"
Case &H3E&
ProductName = "Windows Essential Server Solution Additional SVC"
Case &H2&
ProductName = "Home Basic"
Case &H43&
ProductName = "Not supported"
Case &H5&
ProductName = "Home Basic N"
Case &H3&
ProductName = "Home Premium"
Case &H44&
ProductName = "Not supported"
Case &H1A&
ProductName = "Home Premium N"
Case &H22&
ProductName = "Windows Home Server 2011"
Case &H13&
ProductName = "Windows Storage Server 2008 R2 Essentials"
Case &H2A&
ProductName = "Microsoft Hyper-V Server"
Case &H1E&
ProductName = "Windows Essential Business Server Management Server"
Case &H20&
ProductName = "Windows Essential Business Server Messaging Server"
Case &H1F&
ProductName = "Windows Essential Business Server Security Server"
Case &H4C&
ProductName = "Windows MultiPoint Server Standard (FI)"
Case &H4D&
ProductName = "Windows MultiPoint Server Premium (FI)"
Case &H30&
ProductName = "Professional"
Case &H45&
ProductName = "Not supported"
Case &H31&
ProductName = "Professional N"
Case &H67&
ProductName = "Professional with Media Center"
Case &H36&
ProductName = "Server For SB Solutions EM"
Case &H33&
ProductName = "Server For SB Solutions"
Case &H37&
ProductName = "Server For SB Solutions EM"
Case &H18&
ProductName = "Windows Server 2008 for Windows Essential Server Solutions"
Case &H23&
ProductName = "Windows Server 2008 without Hyper-V for Windows Essential Server Solutions"
Case &H21&
ProductName = "Server Foundation"
Case &H32&
ProductName = "Windows Small Business Server 2011 Essentials"
Case &H9&
ProductName = "Windows Small Business Server"
Case &H19&
ProductName = "Small Business Server Premium"
Case &H3F&
ProductName = "Small Business Server Premium (CI)"
Case &H38&
ProductName = "Windows MultiPoint Server"
Case &H4F&
ProductName = "Server Standard (EI)"
Case &H7&
ProductName = "Server Standard"
Case &HD&
ProductName = "Server Standard (CI)"
Case &H24&
ProductName = "Server Standard without Hyper-V"
Case &H28&
ProductName = "Server Standard without Hyper-V (CI)"
Case &H34&
ProductName = "Server Solutions Premium"
Case &H35&
ProductName = "Server Solutions Premium (CI)"
Case &HB&
ProductName = "Starter"
Case &H42&
ProductName = "Not supported"
Case &H2F&
ProductName = "Starter N"
Case &H17&
ProductName = "Storage Server Enterprise"
Case &H2E&
ProductName = "Storage Server Enterprise (CI)"
Case &H14&
ProductName = "Storage Server Express"
Case &H2B&
ProductName = "Storage Server Express (CI)"
Case &H60&
ProductName = "Storage Server Standard (EI)"
Case &H15&
ProductName = "Storage Server Standard"
Case &H2C&
ProductName = "Storage Server Standard (CI)"
Case &H5F&
ProductName = "Storage Server Workgroup (EI)"
Case &H16&
ProductName = "Storage Server Workgroup"
Case &H2D&
ProductName = "Storage Server Workgroup (CI)"
Case &H0&
ProductName = "An unknown product"
Case &H1&
ProductName = "Ultimate"
Case &H47&
ProductName = "Not supported"
Case &H1C&
ProductName = "Ultimate N"
Case &H11&
ProductName = "Web Server (FI)"
Case &H1D&
ProductName = "Web Server (CI)"
Case Else
ProductName = "Unknown Edition"
End Select
GetProductName = ProductName
End Function
Function GetLangNameByCultureCode(CultureCode As Long) As String
Dim Lang$
Select Case CultureCode
Case &H419&
'Lang = "ru-RU"
Lang = "RU"
Case &H409&
'Lang = "en-US"
Lang = "EN"
Case &H422&
'Lang = "uk-UA"
Lang = "UA"
Case &H423&
Lang = "be-BY"
Case &H402&
'Lang = "bg-BG"
Lang = "BG"
Case &H436&
Lang = "af-ZA"
Case &H41C&
Lang = "sq-AL"
Case &H1401&
Lang = "ar-DZ"
Case &H3C01&
Lang = "ar-BH"
Case &HC01&
Lang = "ar-EG"
Case &H801&
Lang = "ar-IQ"
Case &H2C01&
Lang = "ar-JO"
Case &H3401&
Lang = "ar-KW"
Case &H3001&
Lang = "ar-LB"
Case &H1001&
Lang = "ar-LY"
Case &H1801&
Lang = "ar-MA"
Case &H2001&
Lang = "ar-OM"
Case &H4001&
Lang = "ar-QA"
Case &H401&
Lang = "ar-SA"
Case &H2801&
Lang = "ar-SY"
Case &H1C01&
Lang = "ar-TN"
Case &H3801&
Lang = "ar-AE"
Case &H2401&
Lang = "ar-YE"
Case &H42B&
Lang = "hy-AM"
Case &H82C&
Lang = "Cy-az-AZ"
Case &H42C&
Lang = "Lt-az-AZ"
Case &H42D&
Lang = "eu-ES"
Case &H403&
Lang = "ca-ES"
Case &H804&
Lang = "zh-CN"
Case &HC04&
Lang = "zh-HK"
Case &H1404&
Lang = "zh-MO"
Case &H1004&
Lang = "zh-SG"
Case &H404&
Lang = "zh-TW"
Case &H4&
Lang = "zh-CHS"
Case &H7C04&
Lang = "zh-CHT"
Case &H41A&
Lang = "hr-HR"
Case &H405&
Lang = "cs-CZ"
Case &H406&
Lang = "da-DK"
Case &H465&
Lang = "div-MV"
Case &H813&
Lang = "nl-BE"
Case &H413&
Lang = "nl-NL"
Case &HC09&
Lang = "en-AU"
Case &H2809&
Lang = "en-BZ"
Case &H1009&
Lang = "en-CA"
Case &H2409&
Lang = "en-CB"
Case &H1809&
Lang = "en-IE"
Case &H2009&
Lang = "en-JM"
Case &H1409&
Lang = "en-NZ"
Case &H3409&
Lang = "en-PH"
Case &H1C09&
Lang = "en-ZA"
Case &H2C09&
Lang = "en-TT"
Case &H809&
Lang = "en-GB"
Case &H3009&
Lang = "en-ZW"
Case &H425&
Lang = "et-EE"
Case &H438&
Lang = "fo-FO"
Case &H429&
Lang = "fa-IR"
Case &H40B&
Lang = "fi-FI"
Case &H80C&
Lang = "fr-BE"
Case &HC0C&
Lang = "fr-CA"
Case &H40C&
Lang = "fr-FR"
Case &H140C&
Lang = "fr-LU"
Case &H180C&
Lang = "fr-MC"
Case &H100C&
Lang = "fr-CH"
Case &H456&
Lang = "gl-ES"
Case &H437&
Lang = "ka-GE"
Case &HC07&
Lang = "de-AT"
Case &H407&
Lang = "de-DE"
Case &H1407&
Lang = "de-LI"
Case &H1007&
Lang = "de-LU"
Case &H807&
Lang = "de-CH"
Case &H408&
Lang = "el-GR"
Case &H447&
Lang = "gu-IN"
Case &H40D&
Lang = "he-IL"
Case &H439&
Lang = "hi-IN"
Case &H40E&
Lang = "hu-HU"
Case &H40F&
Lang = "is-IS"
Case &H421&
Lang = "id-ID"
Case &H410&
Lang = "it-IT"
Case &H810&
Lang = "it-CH"
Case &H411&
Lang = "ja-JP"
Case &H44B&
Lang = "kn-IN"
Case &H43F&
Lang = "kk-KZ"
Case &H457&
Lang = "kok-IN"
Case &H412&
Lang = "ko-KR"
Case &H440&
Lang = "ky-KZ"
Case &H426&
Lang = "lv-LV"
Case &H427&
Lang = "lt-LT"
Case &H42F&
Lang = "mk-MK"
Case &H83E&
Lang = "ms-BN"
Case &H43E&
Lang = "ms-MY"
Case &H44E&
Lang = "mr-IN"
Case &H450&
Lang = "mn-MN"
Case &H414&
Lang = "nb-NO"
Case &H814&
Lang = "nn-NO"
Case &H415&
Lang = "pl-PL"
Case &H416&
Lang = "pt-BR"
Case &H816&
Lang = "pt-PT"
Case &H446&
Lang = "pa-IN"
Case &H418&
Lang = "ro-RO"
Case &H44F&
Lang = "sa-IN"
Case &HC1A&
Lang = "Cy-sr-SP"
Case &H81A&
Lang = "Lt-sr-SP"
Case &H41B&
Lang = "sk-SK"
Case &H424&
Lang = "sl-SI"
Case &H2C0A&
Lang = "es-AR"
Case &H400A&
Lang = "es-BO"
Case &H340A&
Lang = "es-CL"
Case &H240A&
Lang = "es-CO"
Case &H140A&
Lang = "es-CR"
Case &H1C0A&
Lang = "es-DO"
Case &H300A&
Lang = "es-EC"
Case &H440A&
Lang = "es-SV"
Case &H100A&
Lang = "es-GT"
Case &H480A&
Lang = "es-HN"
Case &H80A&
Lang = "es-MX"
Case &H4C0A&
Lang = "es-NI"
Case &H180A&
Lang = "es-PA"
Case &H3C0A&
Lang = "es-PY"
Case &H280A&
Lang = "es-PE"
Case &H500A&
Lang = "es-PR"
Case &HC0A&
Lang = "es-ES"
Case &H380A&
Lang = "es-UY"
Case &H200A&
Lang = "es-VE"
Case &H441&
Lang = "sw-KE"
Case &H81D&
Lang = "sv-FI"
Case &H41D&
Lang = "sv-SE"
Case &H45A&
Lang = "syr-SY"
Case &H449&
Lang = "ta-IN"
Case &H444&
Lang = "tt-RU"
Case &H44A&
Lang = "te-IN"
Case &H41E&
Lang = "th-TH"
Case &H41F&
Lang = "tr-TR"
Case &H420&
Lang = "ur-PK"
Case &H843&
Lang = "Cy-uz-UZ"
Case &H443&
Lang = "Lt-uz-UZ"
Case &H42A&
Lang = "vi-VN"
Case Else
Lang = "unknown"
End Select
GetLangNameByCultureCode = Lang
End Function
Public Function IsWin64() As Boolean ' Разрядность ОС
On Error Resume Next
Dim lIsWin64 As Long
IsWow64Process GetCurrentProcess, lIsWin64
IsWin64 = CBool(lIsWin64)
End Function
Public Property Get Family() As String
Family = Family_
End Property
Public Property Get Bitness() As String
Bitness = Bitness_
End Property
Public Property Get Major() As Long
Major = osi.dwMajorVersion
End Property
Public Property Get Minor() As Long
Minor = osi.dwMinorVersion
End Property
Public Property Get MajorMinor() As Single
MajorMinor = MajorMinor_
End Property
Public Property Get Build() As Long
Build = osi.dwBuildNumber
End Property
Public Property Get SPVer() As Single
SPVer = SPver_
End Property
Public Property Get OSName() As String
OSName = OSName_
End Property
Public Property Get Edition() As String
Edition = Edition_
End Property
Public Property Get IsElevated() As Boolean
IsElevated = IsElevated_
End Property
Public Property Get IntegrityLevel() As String
IntegrityLevel = IntegrityLevel_
End Property
Public Property Get UserType() As String
UserType = UserType_
End Property
Public Property Get IsSafeBoot() As Boolean
IsSafeBoot = IsSafeBoot_
End Property
Public Property Get LangSystemCode() As Long
LangSystemCode = LangSystemCode_
End Property
Public Property Get LangSystemName() As String
LangSystemName = LangSystemName_
End Property
Public Property Get LangNonUnicodeCode() As Long
LangNonUnicodeCode = LangNonUnicodeCode_
End Property
Public Property Get LangNonUnicodeName() As String
LangNonUnicodeName = LangNonUnicodeName_
End Property
Public Property Get LangDisplayCode() As Long
LangDisplayCode = LangDisplayCode_
End Property
Public Property Get LangDisplayName() As String
LangDisplayName = LangDisplayName_
End Property
Public Property Get IsVistaOrLater() As Boolean
IsVistaOrLater = IsVistaOrLater_
End Property
