Can I determine if I am on Win7 OS from VB6?
I have an old program written in VB6 which needs to run on 3 different platforms, including my laptop which is running Win7. I googled how to determine OS from VB6 and found some code which I slightly modified as follows:
Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As S开发者_JAVA百科tring * 128
End Type
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT As Long = 2
Private Function GetOS() As String
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
Dim sOS as String
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
Select Case osinfo.dwMajorVersion
Case 7
sOS = "?" 'Win7?
Case 6
sOS = "Vista"
Case 5
sOS = "XP"
Case 4
sOS = "Win2000"
End Select
MsgBox (sOS)
return sOS
End Function
When I run this from my WIN7 laptop, osinfo.dwMajorVersion = 5, which suggests it is on an XP machine.
What's ocurring here? Can I determine if I am running Win7 using this method? What's the best way of getting the info I need?
Windows 7 is actually version 6.1, not version 7. You're checking for the wrong number. Otherwise, I'm not really sure why the code you've shown doesn't work. At least one problem is that there is no return
keyword in VB 6. The last line in your GetOS
function should be GetOS = sOS
, instead. Once I fix those problems, it works just fine for me as well.
I have a full working solution available here. It detects all known versions of Windows quickly and accurately. I've personally tested this on at least 5 different versions of Windows with nary a hitch. All that you have to do is copy and paste the code into your project, and it just works.
Here's proof that it works correctly on my Windows 7 laptop:
I'm really not sure why everyone is working so hard to propose alternative, partially-working solutions. This one is guaranteed to work, or your money back. If it doesn't work for you, make sure that you are not running the application under "Windows XP Mode" or some other virtual machine.
Windows 7 has version 6.1.7600 that's majorversion 6, minorversion 1, build 7600 in your code. The reason why you are seeing MajorVersion 5 is probably because of a compatibility setting. Right-click your .exe, select properties and look in the "compatibility" tab.
I tried all the API calls and code but always ended up with Windows XP for some or other reason. Used this "hack" to solve my problem and it works for me.
Private Function GetMyWindowsVersion() As String
Dim r As Long, bFile As Integer, verString As String, fResult As String, bracketStart As Integer, verInfo As String, bracketEnd As Integer, versionLength As Integer
fResult = "Windows OS"
bFile = FreeFile
Open App.Path & "\checkos.bat" For Output As #bFile
Print #bFile, "@echo off"
Print #bFile, "ver > version.txt"
Print #bFile, "exit"
Close #bFile
r = Shell(App.Path & "\checkos.bat", vbMinimizedNoFocus)
bFile = FreeFile
Open App.Path & "\version.txt" For Input As #bFile
Do Until EOF(bFile)
Line Input #bFile, verString
If Trim(verString) <> "" Then
bracketStart = InStr(verString, "[")
bracketEnd = InStr(verString, "]")
If bracketStart And bracketEnd > 0 Then
versionLength = bracketEnd - bracketStart
verInfo = Mid(verString, bracketStart + 1, versionLength - 1)
If InStr(verString, "6.2") Then
fResult = "Windows 8 " & verInfo
End If
If InStr(verString, "6.1") Then
fResult = "Windows 7 " & verInfo
End If
If InStr(verString, "5.") Then
fResult = "Windows XP " & verInfo
End If
Exit Do
Else
fResult = verString
Exit Do
End If
End If
Loop
Close #bFile
GetMyWindowsVersion = fResult
End Function
Take a look at the following site. This works for detecting Vista and Windows 2008, with some minor enhancement it should work for Windows 7.
Your lookups are wrong; dwMajorVersion 5
is win2k or XP, 6
is Server 2k8 R2 or Win 7 - you need to take into account dwMinorVersion
to make your detection accurate. (Table of values)
This is what you are looking for....
Option Explicit
Private Const VER_PLATFORM_WIN32s = 0
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 Type OSVERSIONINFOEX
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
Private Declare Function GetVersionExA Lib "kernel32" (ByRef lpVersionInformation As OSVERSIONINFOEX) As Long
Public Function GetWindowsVersion() As String
Dim osinfo As OSVERSIONINFOEX
Dim retvalue As Integer
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
With osinfo
Select Case .dwPlatformId
Case 1
Select Case .dwMinorVersion
Case 0: GetWindowsVersion = "Windows 95"
Case 10: GetWindowsVersion = "Windows 98"
Case 90: GetWindowsVersion = "Windows Millenium"
End Select
Case 2
Select Case .dwMajorVersion
Case 3: GetWindowsVersion = "Windows NT 3.51"
Case 4: GetWindowsVersion = "Windows NT 4.0"
Case 5
Select Case .dwMinorVersion
Case 0: GetWindowsVersion = "Windows 2000"
Case 1: GetWindowsVersion = "Windows XP"
Case 2: GetWindowsVersion = "Windows 2003"
End Select
Case 6
Select Case .dwMinorVersion
Case 0: GetWindowsVersion = "Windows Vista/2008"
Case 1: GetWindowsVersion = "Windows 7/2008 R2"
Case 2: GetWindowsVersion = "Windows 8/2012"
Case 3: GetWindowsVersion = "Windows 8.1/2012 R2"
End Select
End Select
Case Else
GetWindowsVersion = "Failed"
End Select
End With
End Function
Thanks for the code. However I have tried this on Windows 7 Ultimate and it reports as "XP" with "version 5.1"?
Ok I have just tried the following and it seems to be working fine. This is using the MS SysInfo control.
Private Sub Command2_Click()
Dim MsgEnd As String
Select Case SysDetectOS.OSPlatform
Case 0
MsgEnd = "Unidentified"
Case 1
MsgEnd = "Windows 95, ver. " & _
CStr(SysDetectOS.OSVersion) & "(" & _
CStr(SysDetectOS.OSBuild) & ")"
Case 2
MsgEnd = "Windows NT, ver. " & _
CStr(SysDetectOS.OSVersion) & "(" & _
CStr(SysDetectOS.OSBuild) & ")"
If SysDetectOS.OSVersion >= 6.01 Then
MsgEnd = MsgEnd + " Win7"
End If
End Select
MsgBox "System: " & MsgEnd
End Sub
精彩评论