这是用来查看和替换 Windows 7序列号的一段脚本。 目前已在 Windows 7 下测试正常。Vista 和相应服务器版上应该也能使用。欢迎测试。 不能用于 Windows XP /2003 系列及更早版本,该系列请参考本文后面的链接。 替换效果与 slmgr /ipk 过程是一样的,兼容性好,不过是采用了图形界面。 方法:将下面代码复制到文本编辑程序(如记事本)中,保存为扩展名vbs的文件(如Win7Key.vbs)。 运行过程中如果需要会自动提示UAC权限选择。 如果怕麻烦,也可以从 SkyDrive网盘 直接下载打包的vbs文件。 ' '========================================================================== ' Win7Key.vbs ' Author: elffin ( http://hi.baidu.com/elffin ) ' Edited from Script by Microsoft and Mark D. MacLachlan ' Version: 0.36 ' Function: Display and change product key of Windows 7 (Maybe Vista) ' ' ChangLog: ' - Ver 0.36 ' Add UAC process ' Add Option check and prompt ' Add System Version check ' - Ver 0.3 ' Add Reigistry information ' Fix a little display bug ' Add More Message when error ' delete the space of new key ' - Ver 0.2 ' ' TODO: Is WindowsAppId always same for all Windows ? ' Retrieve key when registry is clear. ' Display install date ' ' COMMENT: You can contact me if you find problem. ' Please keep author and URL information if change the source. ' ' '========================================================================== Option Explicit Dim g_objWMIService, g_strComputer, g_objRegistry, g_EchoString Dim g_serviceConnected g_serviceConnected = False g_strComputer = "." g_EchoString = "" ' Messages private const L_MsgInstalledPKey = "成功安装产品序列号 %PKEY% !" private const L_MsgErrorPKey = "没有安装Windows序列号, 以下为注册表残留信息。" private const L_MsgErrorRegPKey = "没有在注册表中找到Windows序列号." private const L_MsgErrorRegPID = "没有在注册表中找到Windows产品ID." Dim L_MsgErrorInstallPKey L_MsgErrorInstallPKey = "安装序列号 %PKEY% 出现错误!" & _ vbNewLine & "请查看运行权限,并检查序列号是否正确。" & _ vbNewLine & "(可使用Windows 7 PID Key Checker 或 PIDX Check 检查序列号)" & _ vbNewLine & "使用命令 'slui 0x2a 错误代码' 可查看错误详细信息。错误代码: " Private Const L_MsgErrorOption = "参数错误! 正确用法 'win7key.vbs [新序列号]' 。更多信息请看 http://hi.baidu.com/elffin " Private Const L_MsgErrorOSVersion = "本程序适用于Windows Vista系列及以后版本,不适用于 %PRODUCTNAME% !" private const L_MsgErrorText_8 = "出现错误!使用命令 'slui 0x2a 错误代码' 可查看错误详细信息。错误代码: " private const L_MsgLicenseStatusUnlicensed = "Windows 处于未许可状态" private const L_MsgLicenseStatusVL = "批量激活将于 %ENDDATE% 过期" private const L_MsgLicenseStatusTBL = "基于时间的激活将于 %ENDDATE% 过期" private const L_MsgLicenseStatusLicensed = "电脑已经永久激活." private const L_MsgLicenseStatusInitialGrace = "初始宽限期将于 %ENDDATE% 到期" private const L_MsgLicenseStatusAdditionalGrace = "附加宽限期将于 %ENDDATE% 到期(KMS授权过期或者更换硬件)" private const L_MsgLicenseStatusNonGenuineGrace = "非正版宽限期将于 %ENDDATE% 到期" private const L_MsgLicenseStatusNotification = "Windows 处于通知模式" private const L_MsgLicenseStatusExtendedGrace = "延长宽限期将于 %ENDDATE% 到期" private const L_MsgLicenseStatusUnknown = "未知的授权状态" private const L_MsgLicenseStatusEvalEndData = "评估结束日期: " private const L_MsgProductName = "系统:" private const L_MsgProductDesc = "系统描述: " private const L_MsgVersion = "版本号: " Private Const L_MsgServicePack = "补丁包:" Private Const L_MsgBuild = "编译代号:" private const L_MsgCurrentTrustedTime = "授权时间: " private const L_MsgProductKey = "序列号: " private const L_MsgProductId = "产品ID: " private const L_MsgUndeterminedPrimaryKey = "警告: 无法验证Windows当前产品序列号的正确性,请更新到最新补丁包(SP)." private const L_MsgUndeterminedPrimaryKeyOperation = "警告: 该操作可能影响超过一个目标授权,请核对结果." private const L_MsgUndeterminedOperationFormat = "正在处理以下产品授权 %PRODUCTDESCRIPTION% (%PRODUCTID%)." ' Registry constants private const HKEY_LOCAL_MACHINE = &H80000002 private const SLKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\SoftwareProtectionPlatform" private const SLKeyPath32 = "SOFTWARE\Wow6432Node\Microsoft\Windows NT\CurrentVersion\SoftwareProtectionPlatform" Private Const WindowsNTInfoPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion" ' WMI class names private const ServiceClass = "SoftwareLicensingService" private const ProductClass = "SoftwareLicensingProduct" private const WindowsAppId = "55c92734-d682-4d71-983e-d6ec3f16059f" private const ProductIsPrimarySkuSelectClause = "ID, ApplicationId, PartialProductKey, LicenseIsAddon, Description, Name" Private const PartialProductKeyNonNullWhereClause = "PartialProductKey <> null" private const EmptyWhereClause = "" private const wbemImpersonationLevelImpersonate = 3 private const wbemAuthenticationLevelPktPrivacy = 6 'If this is the local computer, set everything immediately If g_strComputer = "." Then Set g_objWMIService = GetObject("winmgmts:\\" & g_strComputer & "\root\cimv2") Set g_objRegistry = GetObject("winmgmts:\\" & g_strComputer & "\root\default:StdRegProv") If Not g_serviceConnected Then g_serviceConnected = True End If End If Dim strProductVersion, StrProductName, strNewProductKey, unknownOption g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "CurrentVersion", strProductVersion g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "ProductName", strProductName If Int(Left(strProductVersion, 1)) >= 6 Then ' if the major version later than Vista unknownOption = True If WScript.Arguments.Length = 0 Then unknownOption = False Call ExecCommand() Else strNewProductKey = Wscript.arguments.Item(0) If WScript.Arguments.Length = 1 Then unknownOption = False UACShell strNewProductKey Else If WScript.Arguments.Length = 2 Then If WScript.Arguments.Item(1) = "UAC_TAG" Then unknownOption = False InstallProductKey strNewProductKey End IF End If End If End If if unknownOption = True Then LineOut GetResource("L_MsgErrorOption") End If Else LineOut Replace(GetResource("L_MsgErrorOSVersion"), "%PRODUCTNAME%", strProductName) End If ExitScript 0 Private Sub ExecCommand Dim DisplayDate Dim productKeyFound Dim strProductKey, strProductId, strProductVersion Dim objProduct, objService Dim strDescription Dim iIsPrimaryWindowsSku Dim strNewProductKey, strTmp Dim bRegPKeyFound, bRegPIDFound ' value exists in registry bRegPKeyFound = False : bRegPIDFound = False : productKeyFound = False g_objRegistry.GetBinaryValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "DigitalProductId", strTmp If Not IsNull(strTmp) Then strProductKey=GetKey(strTmp) bRegPKeyFound = True End If g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "ProductId", strTmp If Not IsNull(strTmp) Then strProductId = strTmp bRegPIDFound = True End If For Each objProduct in GetProductCollection(ProductIsPrimarySkuSelectClause & ", " & _ "LicenseStatus, GracePeriodRemaining, EvaluationEndDate, TrustedTime", _ PartialProductKeyNonNullWhereClause) iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct) ' Warn if this can't be verified as the primary SKU If (iIsPrimaryWindowsSku = 2) Then OutputIndeterminateOperationWarning(objProduct) End If productKeyFound = True strDescription = objProduct.Description LineOut "" LineOut GetResource("L_MsgProductName") & objProduct.Name LineOut GetResource("L_MsgProductDesc") & strDescription g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "CSDVersion", strTmp If Not IsNull(strTmp) Then LineOut GetResource("L_MsgServicePack") & strTmp End If Set objService = GetServiceObject("Version") LineOut GetResource("L_MsgVersion") & objService.Version g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "BuildLabEx", strTmp If IsNull(strTmp) Then g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "BuildLab", strTmp End If LineOut GetResource("L_MsgBuild") & strTmp LineOut "" ExpirationDatime(objProduct) Set displayDate = CreateObject("WBemScripting.SWbemDateTime") displayDate.Value = objProduct.EvaluationEndDate If (displayDate.GetFileTime(false) <> 0) Then LineOut GetResource("L_MsgLicenseStatusEvalEndData") & displayDate.GetVarDate End If Next If productKeyFound <> True Then LineOut "" g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "ProductName", strTmp LineOut GetResource("L_MsgProductName") & strTmp g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "CSDVersion", strTmp If Not IsNull(strTmp) Then LineOut GetResource("L_MsgServicePack") & strTmp End If g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "CurrentVersion", strProductVersion g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "CurrentBuildNumber", strTmp strProductVersion=strProductVersion & "." & strTmp LineOut GetResource("L_MsgVersion") & strProductVersion g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "BuildLabEx", strTmp If IsNull(strTmp) Then g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "BuildLab", strTmp End If LineOut GetResource("L_MsgBuild") & strTmp End If LineOut "" If productKeyFound <> True Then LineOut GetResource("L_MsgErrorPKey") End If If bRegPKeyFound Then LineOut GetResource("L_MsgProductKey") & strProductKey Else LineOut GetResource("L_MsgErrorRegPKey") End If If bRegPIDFound Then LineOut GetResource("L_MsgProductId") & strProductId Else LineOut GetResource("L_MsgErrorRegPID") End If LineOut "" LineOut "本程序用来获取和自动替换Windows的序列号(适用于Windows 7和Vista系列)." LineOut "替换操作需要管理员权限,如果提示请允许" LineOut "相关说明请看 http://hi.baidu.com/elffin" LineOut "" LineOut "" LineOut "复制当前序列号或输入新的序列号:" strNewProductKey=InputBox(g_EchoString , "Windows 7 序列号查看替换器 (elffin@baidu制作)", strProductKey) if strNewProductKey = "" then Wscript.quit end if UACShell strNewProductKey End Sub ' Call the UAC shell execute when without UAC_TAG Sub UACShell(strProductKey) Dim oShell ' Wscript.echo strProductKey ' strProductKey="TQ32R-WFBDM-GFHD2-QGVMH-3P9GC" strProductKey = replace(strProductKey, Space(1), "") 'delete the space of new key Set oShell = CreateObject("Shell.Application") oShell.ShellExecute "wscript.exe", """" & WScript.ScriptFullName & """" & " " & strProductKey & " UAC_TAG", "", "runas", 1 Wscript.Quit(0) End Sub Private Function GetKey(rpk) 'Decode the product key Const rpkOffset=52 Dim dwAccumulator, szPossibleChars, szProductKey dim i,j i=28 : szPossibleChars="BCDFGHJKMPQRTVWXY2346789" Do 'Rep1 dwAccumulator=0 : j=14 Do dwAccumulator=dwAccumulator*256 dwAccumulator=rpk(j+rpkOffset)+dwAccumulator rpk(j+rpkOffset)=(dwAccumulator\24) and 255 dwAccumulator=dwAccumulator Mod 24 j=j-1 Loop While j>=0 i=i-1 : szProductKey=mid(szPossibleChars,dwAccumulator+1,1)&szProductKey if (((29-i) Mod 6)=0) and (i<>-1) then i=i-1 : szProductKey="-"&szProductKey end if Loop While i>=0 'Goto Rep1 GetKey=szProductKey End Function Private Sub QuitIfError() If Err.Number <> 0 Then LineOut GetResource("L_MsgErrorText_8") & "0x" & Hex(Err.Number) ExitScript Err.Number End If End Sub Private Sub InstallProductKey(strProductKey) Dim objService, objProduct Dim lRet, strDescription, strOutput, strVersion Dim iIsPrimaryWindowsSku, bIsKMS bIsKMS = False On Error Resume Next set objService = GetServiceObject("Version") strVersion = objService.Version objService.InstallProductKey(strProductKey) ' Display error information and quit if install key failed If Err.Number <> 0 Then LineOut Replace(GetResource("L_MsgErrorInstallPKey"), "%PKEY%", strProductKey) & "0x" & Hex(Err.Number) ExitScript Err.Number End If ' Installing a product key could change Windows licensing state. ' Since the service determines if it can shut down and when is the next start time ' based on the licensing state we should reconsume the licenses here. objService.RefreshLicenseStatus() For Each objProduct in GetProductCollection(ProductIsPrimarySkuSelectClause, PartialProductKeyNonNullWhereClause) strDescription = objProduct.Description iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct) If (iIsPrimaryWindowsSku = 2) Then OutputIndeterminateOperationWarning(objProduct) End If If IsKmsServer(strDescription) Then bIsKMS = True Exit For End If Next If (bIsKMS = True) Then ' Set the KMS version in the registry (64 and 32 bit versions) lRet = SetRegistryStr(HKEY_LOCAL_MACHINE, SLKeyPath, "KeyManagementServiceVersion", strVersion) If (lRet <> 0) Then QuitWithError Hex(lRet) End If If ExistsRegistryKey(HKEY_LOCAL_MACHINE, SLKeyPath32) Then lRet = SetRegistryStr(HKEY_LOCAL_MACHINE, SLKeyPath32, "KeyManagementServiceVersion", strVersion) If (lRet <> 0) Then QuitWithError Hex(lRet) End If End If Else ' Clear the KMS version in the registry (64 and 32 bit versions) lRet = DeleteRegistryValue(HKEY_LOCAL_MACHINE, SLKeyPath, "KeyManagementServiceVersion") If (lRet <> 0 And lRet <> 2 And lRet <> 5) Then QuitWithError Hex(lRet) End If lRet = DeleteRegistryValue(HKEY_LOCAL_MACHINE, SLKeyPath32, "KeyManagementServiceVersion") If (lRet <> 0 And lRet <> 2 And lRet <> 5) Then QuitWithError Hex(lRet) End If End If strOutput = Replace(GetResource("L_MsgInstalledPKey"), "%PKEY%", strProductKey) LineOut strOutput End Sub Private Sub ExpirationDatime(objProduct) Dim ls, graceRemaining, strEnds Dim strOutput Dim strDescription, bTBL ls = objProduct.LicenseStatus graceRemaining = objProduct.GracePeriodRemaining strEnds = DateAdd("n", graceRemaining, Now) strOutput = "" If ls = 0 Then strOutput = GetResource("L_MsgLicenseStatusUnlicensed") End If If ls = 1 Then If graceRemaining <> 0 Then strDescription = objProduct.Description bTBL = IsTBL(strDescription) If bTBL Then strOutput = Replace(GetResource("L_MsgLicenseStatusTBL"), "%ENDDATE%", strEnds) Else strOutput = Replace(GetResource("L_MsgLicenseStatusVL"), "%ENDDATE%", strEnds) End If Else strOutput = GetResource("L_MsgLicenseStatusLicensed") End If End If If ls = 2 Then strOutput = Replace(GetResource("L_MsgLicenseStatusInitialGrace"), "%ENDDATE%", strEnds) End If If ls = 3 Then strOutput = Replace(GetResource("L_MsgLicenseStatusAdditionalGrace"), "%ENDDATE%", strEnds) End If If ls = 4 Then strOutput = Replace(GetResource("L_MsgLicenseStatusNonGenuineGrace"), "%ENDDATE%", strEnds) End If If ls = 5 Then strOutput = GetResource("L_MsgLicenseStatusNotification") End If If ls = 6 Then strOutput = Replace(GetResource("L_MsgLicenseStatusExtendedGrace"), "%ENDDATE%", strEnds) End If If strOutput <> "" Then Lineout strOutput End If End Sub ' Get the resource string with the given name using the built-in default. Private Function GetResource(name) GetResource = Eval(name) End Function Private Sub ExitScript(retval) if (g_EchoString <> "") Then MsgBox g_EchoString, 0, "Windows 7 序列号查看替换器 (elffin@baidu制作)" End If WScript.Quit retval End Sub ' Functions Without Change Below Private Sub LineOut(str) g_EchoString = g_EchoString & str & vbNewLine End Sub Function GetProductCollection(strSelect, strWhere) Dim colProducts On Error Resume Next If strWhere = EmptyWhereClause Then Set colProducts = g_objWMIService.ExecQuery("SELECT " & strSelect & " FROM " & ProductClass) QuitIfError() Else Set colProducts = g_objWMIService.ExecQuery("SELECT " & strSelect & " FROM " & ProductClass & " WHERE " & strWhere) QuitIfError() End If set GetProductCollection = colProducts End Function Private Sub OutputIndeterminateOperationWarning(objProduct) Dim strOutput LineOut GetResource("L_MsgUndeterminedPrimaryKeyOperation") strOutput = Replace(GetResource("L_MsgUndeterminedOperationFormat"), "%PRODUCTDESCRIPTION%", objProduct.Description) strOutput = Replace(strOutput, "%PRODUCTID%", objProduct.ID) LineOut strOutput End Sub Function GetIsPrimaryWindowsSKU(objProduct) Dim iPrimarySku Dim bIsAddOn 'Assume this is not the primary SKU iPrimarySku = 0 'Verify the license is for Windows, that it has a partial key, and that If (LCase(objProduct.ApplicationId) = WindowsAppId And objProduct.PartialProductKey <> "") Then 'If we can get verify the AddOn property then we can be certain On Error Resume Next bIsAddOn = objProduct.LicenseIsAddon If Err.Number = 0 Then If bIsAddOn = true Then iPrimarySku = 0 Else iPrimarySku = 1 End If Else 'If we can not get the AddOn property then we assume this is a previous version 'and we return a value of Uncertain, unless we can prove otherwise If (IsKmsClient(objProduct.Description) Or IsKmsServer(objProduct.Description)) Then 'If the description is KMS related, we can be certain that this is a primary SKU iPrimarySku = 1 Else 'Indeterminate since the property was missing and we can't verify KMS iPrimarySku = 2 End If End If End If GetIsPrimaryWindowsSKU = iPrimarySku End Function Private Function IsKmsClient(strDescription) If InStr(strDescription, "VOLUME_KMSCLIENT") > 0 Then IsKmsClient = True Else IsKmsClient = False End If End Function Private Function IsKmsServer(strDescription) If IsKmsClient(strDescription) Then IsKmsServer = False Else If InStr(strDescription, "VOLUME_KMS") > 0 Then IsKmsServer = True Else IsKmsServer = False End If End If End Function Private Function SetRegistryStr(hKey, strKeyPath, strValueName, strValue) SetRegistryStr = g_objRegistry.SetStringValue(hKey, strKeyPath, strValueName, strValue) End Function Private Function DeleteRegistryValue(hKey, strKeyPath, strValueName) DeleteRegistryValue = g_objRegistry.DeleteValue(hKey, strKeyPath, strValueName) End Function Private Function ExistsRegistryKey(hKey, strKeyPath) Dim bGranted Dim lRet ' Check for KEY_QUERY_VALUE for this key lRet = g_objRegistry.CheckAccess(hKey, strKeyPath, 1, bGranted) ' Ignore real access rights, just look for existence of the key If lRet<>2 Then ExistsRegistryKey = True Else ExistsRegistryKey = False End If End Function Function GetServiceObject(strQuery) Dim objService Dim colServices On Error Resume Next Set colServices = g_objWMIService.ExecQuery("SELECT " & strQuery & " FROM " & ServiceClass) QuitIfError() For each objService in colServices QuitIfError() Exit For Next set GetServiceObject = objService End Function |
联系客服