VB 6应用程序如何确定它是否在Windows 10上运行？

为什么旧代码被破坏？

其他答案中的代码适用于较旧版本的Windows。 具体来说，它可以顺利地处理Windows 8（版本6.2）。 但是正如你所注意到的，在Windows 8.1（版本6.3）和Windows 10（版本10.0）上，事情开始出现问题。 代码看起来应该可以工作，但是在Windows 8之后的任何版本都会得到版本6.2。

原因是微软决定改变Windows如何向应用程序报告其版本号。 为了防止旧程序错误地决定不在这些最新版本的Windows上运行，操作系统已经在6.2版本中“顶出”了它的版本号。 尽管Windows 8.1和Windows 10的内部版本号仍分别为6.3和10.0，但他们继续将其版本号报告为旧版应用程序6.2。 这个想法本质上是“你不能处理真相”，所以它会被隐瞒。 在这种情况下，当您调用这些API函数时，您的应用程序和系统之间会存在一些兼容Shim ，负责伪造版本号。

这些特定的兼容性垫片首先在Windows 8.1中引入，并影响了几个版本信息检索API。 在Windows 10中，兼容性垫片开始影响几乎所有可以检索版本号的方法，包括尝试直接从系统文件中读取版本号。

事实上，这些旧版本的信息检索API（如其他答案所使用的GetVersionEx函数）已经被微软官方“弃用”了。 在新代码中，您应该使用“ 版本帮助程序”函数来确定Windows的基础版本。 但是这些功能有两个问题：

1. 有一大堆 – 一个用于检测Windows的每个版本，包括“点”版本 – 并且它们不从任何系统DLL导出。 相反，它们是在Windows SDK中分发的C / C ++头文件中定义的内联函数。 这对于C和C ++程序员来说非常适用，但是什么是一个简陋的VB 6程序员呢？ 你不能从VB 6调用这些“帮助”功能。

2. 即使你可以从VB 6中调用它们，Windows 10也可以扩展兼容性垫片（就像我之前提到的那样），所以即使是IsWindows8Point1OrGreater和IsWindows10OrGreater函数也是如此。

兼容性清单

理想的解决方案和链接的SDK文档所提到的解决方案是，在应用程序的EXE中将清单嵌入到兼容性信息中。 清单文件首先在Windows XP中引入，作为将元数据与应用程序捆绑在一起的一种方式，随着每个新版本的Windows，清单文件中包含的信息量也随之增加。

清单文件的相关部分是一个称为compatibility的部分。 它可能看起来像这样（一个清单只是一个遵循特定格式的XML文件）：

 <!-- Declare support for various versions of Windows --> <ms_compatibility:compatibility xmlns:ms_compatibility="urn:schemas-microsoft-com:compatibility.v1" xmlns="urn:schemas-microsoft-com:compatibility.v1"> <ms_compatibility:application> <!-- Windows Vista/server 2008 --> <ms_compatibility:supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}" /> <!-- Windows 7/server 2008 R2 --> <ms_compatibility:supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}" /> <!-- Windows 8/server 2012 --> <ms_compatibility:supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}" /> <!-- Windows 8.1/server 2012 R2 --> <ms_compatibility:supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}" /> <!-- Windows 10 --> <ms_compatibility:supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}" /> </ms_compatibility:application> </ms_compatibility:compatibility> 

它的工作方式是每个版本的Windows（自Vista以来）都有一个GUID，如果你的清单包含了GUID作为一个supportedOS的OS，那么系统知道你在该版本发布之后编写了应用程序。 因此，假定您准备好处理其突破性更改和新功能，所以兼容性垫片不适用于您的应用程序。 当然包括原始代码使用的GetVersionEx函数。

如果你是一个认真的Windows开发人员，你可能已经在VB 6应用程序中嵌入了一个清单。 您需要一个清单来获取主题控件（通过明确地加入到ComCtl32.dll的版本6），防止UAC虚拟化（通过只请求asInvoker权限），甚至可能防止DPI虚拟化（通过将自己标记为高DPI知道的）。 您可以在网上找到大量有关应用程序清单中的这些和其他设置如何工作的信息。

如果您已经在应用程序中嵌入了清单文件，那么将Windows 8.1和Windows 10 GUID添加到现有清单是一件简单的事情。 这将切断操作系统版本的谎言。

如果您还没有嵌入清单文件，那么您有一些工作要做。 VB 6在发布清单前几年就已经发布了，因此IDE没有任何内置的工具来处理它们。 你必须自己处理它们。 在这里看到有关在VB 6中嵌入清单文件的提示 。 总之，他们只是文本文件，所以你可以在记事本中创建一个，并用mt.exe （ Windows SDK的一部分）将它嵌入到EXE中。 有自动执行这个过程的各种可能性，或者你可以在完成构建后手动完成。

另一种解决方案

如果你不想大惊小怪，还有另外一个解决办法。 它只涉及到您的VB 6项目中添加代码，并不需要任何类型的清单工作。

还有一个鲜为人知的API函数，您可以调用它来检索真正的操作系统版本。 它实际上是GetVersionEx和VerifyVersionInfo函数调用的内部内核模式函数。 但是当你直接调用它的时候，你会避免通常使用的兼容垫片，这意味着你得到了真正的未经过滤的版本信息。

这个函数被称为RtlGetVersion ，正如链接文档所建议的，这是一个供驱动程序使用的运行时例程。 但是，由于VB 6具有动态调用本地API函数的能力，我们可以在我们的应用程序中使用它。 以下模块显示了如何使用它：

 '================================================================================== ' RealWinVer.bas by Cody Gray, 2016 ' ' (Freely available for use and modification, provided that credit is given to the ' original author. Including a comment in the code with my name and/or a link to ' this Stack Overflow answer is sufficient.) '================================================================================== Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''' ' Windows SDK Constants, Types, & Functions '''''''''''''''''''''''''''''''''''''''''''''''''' Private Const cbCSDVersion As Long = 128 * 2 Private Const STATUS_SUCCESS As Long = 0 Private Const VER_PLATFORM_WIN32s As Long = 0 Private Const VER_PLATFORM_WIN32_WINDOWS As Long = 1 Private Const VER_PLATFORM_WIN32_NT As Long = 2 Private Const VER_NT_WORKSTATION As Byte = 1 Private Const VER_NT_DOMAIN_CONTROLLER As Byte = 2 Private Const VER_NT_SERVER As Byte = 3 Private Const VER_SUITE_PERSONAL As Integer = &H200 Private Type RTL_OSVERSIONINFOEXW dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * cbCSDVersion wServicePackMajor As Integer wServicePackMinor As Integer wSuiteMask As Integer wProductType As Byte wReserved As Byte End Type Private Declare Function RtlGetVersion Lib "ntdll" _ (lpVersionInformation As RTL_OSVERSIONINFOEXW) As Long '''''''''''''''''''''''''''''''''''''''''''''''''' ' Internal Helper Functions '''''''''''''''''''''''''''''''''''''''''''''''''' Private Function IsWinserverVersion(ByRef ver As RTL_OSVERSIONINFOEXW) As Boolean ' There are three documented values for "wProductType". ' Two of the values mean that the OS is a server versions, ' while the other value signifies a home/workstation version. Debug.Assert ver.wProductType = VER_NT_WORKSTATION Or _ ver.wProductType = VER_NT_DOMAIN_CONTROLLER Or _ ver.wProductType = VER_NT_SERVER IsWinserverVersion = (ver.wProductType <> VER_NT_WORKSTATION) End Function Private Function GetWinVerNumber(ByRef ver As RTL_OSVERSIONINFOEXW) As String Debug.Assert ver.dwPlatformId = VER_PLATFORM_WIN32_NT GetWinVerNumber = ver.dwMajorVersion & "." & _ ver.dwMinorVersion & "." & _ ver.dwBuildNumber End Function Private Function GetWinSPVerNumber(ByRef ver As RTL_OSVERSIONINFOEXW) As String Debug.Assert ver.dwPlatformId = VER_PLATFORM_WIN32_NT If (ver.wServicePackMajor > 0) Then If (ver.wServicePackMinor > 0) Then GetWinSPVerNumber = "SP" & CStr(ver.wServicePackMajor) & "." & CStr(ver.wServicePackMinor) Exit Function Else GetWinSPVerNumber = "SP" & CStr(ver.wServicePackMajor) Exit Function End If End If End Function Private Function GetWinVerName(ByRef ver As RTL_OSVERSIONINFOEXW) As String Debug.Assert ver.dwPlatformId = VER_PLATFORM_WIN32_NT Select Case ver.dwMajorVersion Case 3 If IsWinserverVersion(ver) Then GetWinVerName = "Windows NT 3.5 server" Exit Function Else GetWinVerName = "Windows NT 3.5 Workstation" Exit Function End If Case 4 If IsWinserverVersion(ver) Then GetWinVerName = "Windows NT 4.0 server" Exit Function Else GetWinVerName = "Windows NT 4.0 Workstation" Exit Function End If Case 5 Select Case ver.dwMinorVersion Case 0 If IsWinserverVersion(ver) Then GetWinVerName = "Windows 2000 server" Exit Function Else GetWinVerName = "Windows 2000 Workstation" Exit Function End If Case 1 If (ver.wSuiteMask And VER_SUITE_PERSONAL) Then GetWinVerName = "Windows XP Home Edition" Exit Function Else GetWinVerName = "Windows XP Professional" Exit Function End If Case 2 If IsWinserverVersion(ver) Then GetWinVerName = "Windows server 2003" Exit Function Else GetWinVerName = "Windows XP 64-bit Edition" Exit Function End If Case Else Debug.Assert False End Select Case 6 Select Case ver.dwMinorVersion Case 0 If IsWinserverVersion(ver) Then GetWinVerName = "Windows server 2008" Exit Function Else GetWinVerName = "Windows Vista" Exit Function End If Case 1 If IsWinserverVersion(ver) Then GetWinVerName = "Windows server 2008 R2" Exit Function Else GetWinVerName = "Windows 7" Exit Function End If Case 2 If IsWinserverVersion(ver) Then GetWinVerName = "Windows server 2012" Exit Function Else GetWinVerName = "Windows 8" Exit Function End If Case 3 If IsWinserverVersion(ver) Then GetWinVerName = "Windows server 2012 R2" Exit Function Else GetWinVerName = "Windows 8.1" Exit Function End If Case Else Debug.Assert False End Select Case 10 If IsWinserverVersion(ver) Then GetWinVerName = "Windows server 2016" Exit Function Else GetWinVerName = "Windows 10" Exit Function End If Case Else Debug.Assert False End Select GetWinVerName = "Unrecognized Version" End Function '''''''''''''''''''''''''''''''''''''''''''''''''' ' Public Functions '''''''''''''''''''''''''''''''''''''''''''''''''' ' Returns a string that contains the name of the underlying version of Windows, ' the major version of the most recently installed service pack, and the actual ' version number (in "Major.Minor.Build" format). ' ' For example: "Windows server 2003 SP2 (v5.2.3790)" or ' "Windows 10 (v10.0.14342)" ' ' This function returns the *real* Windows version, and works correctly on all ' operating systems, including Windows 10, regardless of whether or not the ' application includes a manifest. It calls the native NT version-info function ' directly in order to bypass compatibility shims that would otherwise lie to ' you about the real version number. Public Function GetActualWindowsVersion() As String Dim ver As RTL_OSVERSIONINFOEXW ver.dwOSVersionInfoSize = Len(ver) If (RtlGetVersion(ver) <> STATUS_SUCCESS) Then GetActualWindowsVersion = "Failed to retrieve Windows version" End If ' The following version-parsing logic assumes that the operating system ' is some version of Windows NT. This assumption will be true if you ' are running any version of Windows released in the past 15 years, ' including several that were released before that. Debug.Assert ver.dwPlatformId = VER_PLATFORM_WIN32_NT GetActualWindowsVersion = GetWinVerName(ver) & " " & GetWinSPVerNumber(ver) & _ " (v" & GetWinVerNumber(ver) & ")" End Function 

预期的公共接口是一个称为GetActualWindowsVersion函数，它返回一个包含Windows 实际底层版本名称的字符串。 例如，它可能会返回“Windows server 2003 SP2（v5.2.3790）”或“Windows 10（v10.0.14342）” 。
_{（完全测试并在Windows 10上工作！）}

该模块的公共函数调用了一些内部帮助函数，它们从本地RTL_OSVERSIONINFOEXW数据结构中解析信息，稍微简化了代码。 如果您想花时间修改代码来提取它，那么在这个结构中有更多的信息可用。 例如，有一个wSuiteMask成员包含标志，其存在表示某些功能或产品类型。 GetWinVerName帮助程序函数GetWinVerName显示如何使用此信息的示例，其中检查VER_SUITE_PERSONAL标志是否为Windows XP Home或Pro。

最后的想法

这个问题还有其他的一些“解决方案”在网上流传。 我建议避免这些。

一个流行的建议是尝试从注册表中读取版本号。 这是一个可怕的想法。 注册机构既不打算也不记录为程序的公共接口。 这意味着这样的代码依赖于实现细节，这些细节随时都可能发生变化，让您重新陷入破碎的境地 – 这是我们首先要解决的问题！ 通过调用一个记录的API函数来查询注册表从来没有好处。

另一个经常被建议的选项是使用WMI检索操作系统版本信息。 这比注册表更好，因为它实际上是一个记录在案的公共界面，但它仍然不是一个理想的解决方案。 首先，WMI是一个非常重要的依赖项。 并非所有系统都会运行WMI，因此您需要确保已启用WMI，否则您的代码将无法工作。 如果这是你需要使用WMI的唯一的东西，它将会很慢，因为你必须等待WMI首先启动并运行。 此外，从VB 6以编程方式查询WMI很困难。 我们没有像PowerShell那样简单！ 但是，如果您正在使用WMI，那么获取可读的操作系统版本字符串将是一个非常方便的方法。 你可以通过查询Win32_OperatingSystem.Name来做到这一点。

我甚至还看过其他的黑客，比如从进程的PEB块中读取版本 ！ 诚然，对于Delphi而言，不是VB 6，而且由于在VB 6中没有内联汇编，所以我甚至不确定是否可以想出一个VB 6等价的东西。 但即使在Delphi中，这也是一个非常糟糕的想法，因为它也依赖于实现细节。 这个问题根本。

作为GetVersionEx的上述清单解决方案的附件， osv.dwVerMajor在Cody的代码中针对osv.dwVerMajor的情况6块放置以下内容：

  Case 10 'Note: The following works only with updated manifest Select Case osv.dwVerMinor Case 0 GetWindowsVersion = "Windows 10/server 2016" Case Else End Select 

来自MSDN的这个词：“在Windows 8.1之后，GetVersionEx可能会被更改或不可用。” 是值得看的，但是。