Attribute VB_Name = "ModWinVer"
Option Explicit
Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
Private Const PLATFORM_WIN32s As Integer = 0
Private Const PLATFORM_WIN32_WINDOWS As Integer = 1
Private Const PLATFORM_WIN32_NT As Integer = 2
Private Type OSVERSIONINFO 'OS Version info, for querying the windows version.
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Public Function GetVersionString() As String
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo) 'Get Version
With osinfo
Select Case .dwPlatformId
Case 1 'If Platform is 9x/Me
Select Case .dwMinorVersion 'Depends on Minor Version now.
Case 0
GetVersionString = "Windows 95"
Case 10
GetVersionString = "Windows 98"
Case 90
GetVersionString = "Windows Mellinnium"
End Select
Case 2 'NT Based
Select Case .dwMajorVersion 'Depends on Major version this time.
Case 3
GetVersionString = "Windows NT 3.51"
Case 4
GetVersionString = "Windows NT 4.0"
Case 5
If .dwMinorVersion = 0 Then
GetVersionString = "Windows 2000"
Else
GetVersionString = "Windows XP"
End If
End Select
Case Else
GetVersionString = "Failed" 'Don't think this should ever happen unless you are using a new windows I haven't heard of yet =)
End Select
End With
End Function
Public Function GetVersion() As Long
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
GetVersion = osinfo.dwPlatformId 'Just return the platform ID, good for checking for NT / Win 32 (1 = Win 32 , 0 = NT)
End Function
Public Function IsWinNT() As Boolean
'Returns True if the current operating system is WinNT
Dim osvi As OSVERSIONINFO
osvi.dwOSVersionInfoSize = Len(osvi)
GetVersionExA osvi
IsWinNT = (osvi.dwPlatformId = PLATFORM_WIN32_NT)
End Function
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
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 Sub Form_Load()
Dim OSInfo As OSVERSIONINFO
Dim vMajor, vMinor As Long
OSInfo.dwOSVersionInfoSize = Len(OSInfo)
If GetVersionEx(OSInfo) = 0 Then
MsgBox "Ошибка в получении версии операционной системы!", vbExclamation
Exit Sub
Else
vMajor = OSInfo.dwMajorVersion
vMinor = OSInfo.dwMinorVersion
If vMajor = 5 And vMinor = 1 Then MsgBox "Установлена операционная система Windows XP", vbInformation
If vMajor = 6 And vMinor = 1 Then MsgBox "Установлена операционная система Windows 7", vbInformation
If vMajor = 6 And vMinor = 2 Then MsgBox "Установлена операционная система Windows 10", vbInformation
End If
End Sub
Private Sub Form_Load()
On Error GoTo ErrInfo
Dim oWMI As Object
Dim oOSs As Object
Dim oOS As Object
Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set oOSs = oWMI.ExecQuery("SELECT Caption, Version, OSArchitecture FROM Win32_OperatingSystem")
For Each oOS In oOSs
MsgBox oOS.Caption & " " & oOS.Version & " (" & oOS.OSArchitecture & ")"
Next
Set oOS = Nothing
Set oOSs = Nothing
Set oWMI = Nothing
Exit Sub
ErrInfo:
MsgBox "Ошибка: " & Err.Number & " " & Err.Description, vbExclamation, App.Title
End Sub
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
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 Sub Form_Load() 'API & WMI... Работает начиная с Win XP и выше...
On Error GoTo ErrInfo
Dim OSInfo As OSVERSIONINFO
OSInfo.dwOSVersionInfoSize = Len(OSInfo)
If GetVersionEx(OSInfo) <> 0 Then
If OSInfo.dwMajorVersion = 5 And OSInfo.dwMinorVersion = 1 Then
MsgBox "Установлена операционная система Windows XP", vbInformation
Exit Sub
End If
If OSInfo.dwMajorVersion = 6 Then
Dim oWMI As Object
Dim oOSs As Object
Dim oOS As Object
Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set oOSs = oWMI.ExecQuery("SELECT Caption, Version, OSArchitecture FROM Win32_OperatingSystem")
For Each oOS In oOSs
MsgBox oOS.Caption & " " & oOS.Version
Next
Set oOS = Nothing
Set oOSs = Nothing
Set oWMI = Nothing
End If
End If
Exit Sub
ErrInfo:
MsgBox "Ошибка: " & Err.Number & " " & Err.Description, vbExclamation, App.Title
End Sub
Документация на GetVersionEx писал(а):GetVersionExA may be altered or unavailable for releases after Windows 8.1. Instead, use the Version Helper functions. For Windows 10 apps, please see Targeting your applications for Windows.
With the release of Windows 8.1, the behavior of the GetVersionEx API has changed in the value it will return for the operating system version. The value returned by the GetVersionEx function now depends on how the application is manifested.
Applications not manifested for Windows 8.1 or Windows 10 will return the Windows 8 OS version value (6.2). Once an application is manifested for a given operating system version, GetVersionEx will always return the version that the application is manifested for in future releases. To manifest your applications for Windows 8.1 or Windows 10, refer to Targeting your application for Windows.
Это уже интересно, Спасибо!Instead, use the Version Helper functions
The trick писал(а):RtlGetVersion
Хакер писал(а):The trick писал(а):RtlGetVersion
Шутишь? Это же kernel-mode/ring-0 функция.
Сейчас этот форум просматривают: AhrefsBot и гости: 42