爱华网| 用来查看和替换Windows 7 /Vista序列号的脚本 |
这是用来查看和替换 Windows 7序列号的一段脚本。
目前已在 Windows 7 下测试正常。Vista 和相应服务器版上应该也能使用。欢迎测试。
不能用于 Windows XP /2003 系列及更早版本，该系列请参考本文后面的链接。
替换效果与 slmgr /ipk 过程是一样的，兼容性好，不过是采用了图形界面。
特点：自动提示UAC权限，自动清除序列号空格，可复制序列号，可检测系统版本
方法：将下面代码复制到文本编辑程序（如记事本）中，保存为扩展名vbs的文件（如Win7Key.vbs）。
双击运行即可。代码是明文的，因此绝对可以放心使用。
由于Windows 7要替换序列号考虑KMS及多种许可和版本类型(SKU)，因此看起来要复杂一些。
运行过程中如果需要会自动提示UAC权限选择。
当然你也可以在管理员身份的命令提示符中运行，这样不会有权限提示。
如果怕麻烦，也可以从115网盘 直接下载打包的vbs文件。
该压缩包除还包括另外两个脚本。共包括 WinKeyViewer.vbs、Win7Key.vbs、WinXPKey.vbs。
虽然几个脚本都不算长，但我还是雕琢了一段时间的。
请参考:
《用来查看和替换Windows XP序列号的脚本》
《XP/VISTA/Win7 系统序列号查看》
关于WIndows 7序列号更多知识请参考《Windows 7的几种授权激活方式及序列号相关知识介绍》
'==========================================================================
' 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 (MaybeVista)
'
' 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 constL_MsgInstalledPKey= "成功安装产品序列号 %PKEY% !"
private constL_MsgErrorPKey= "没有安装Windows序列号, 以下为注册表残留信息。"
private constL_MsgErrorRegPKey= "没有在注册表中找到Windows序列号."
private constL_MsgErrorRegPID= "没有在注册表中找到Windows产品ID."
Dim L_MsgErrorInstallPKey
L_MsgErrorInstallPKey= "安装序列号 %PKEY% 出现错误!" & _
vbNewLine & "请查看运行权限，并检查序列号是否正确。" &_
vbNewLine & "（可使用Windows 7 PID Key Checker 或 PIDXCheck 检查序列号）" & _
vbNewLine & "使用命令 'slui 0x2a 错误代码' 可查看错误详细信息。错误代码:"
Private ConstL_MsgErrorOption= "参数错误！ 正确用法 'win7key.vbs [新序列号]' 。更多信息请看http://hi.baidu.com/elffin "
Private ConstL_MsgErrorOSVersion= "本程序适用于Windows Vista系列及以后版本，不适用于 %PRODUCTNAME% ！"
private constL_MsgErrorText_8= "出现错误！使用命令 'slui 0x2a 错误代码' 可查看错误详细信息。错误代码: "
private constL_MsgLicenseStatusUnlicensed= "Windows 处于未许可状态"
private constL_MsgLicenseStatusVL= "批量激活将于 %ENDDATE% 过期"
private constL_MsgLicenseStatusTBL= "基于时间的激活将于 %ENDDATE% 过期"
private constL_MsgLicenseStatusLicensed= "电脑已经永久激活."
private constL_MsgLicenseStatusInitialGrace= "初始宽限期将于 %ENDDATE% 到期"
private constL_MsgLicenseStatusAdditionalGrace= "附加宽限期将于 %ENDDATE% 到期(KMS授权过期或者更换硬件)"
private constL_MsgLicenseStatusNonGenuineGrace= "非正版宽限期将于 %ENDDATE% 到期"
private constL_MsgLicenseStatusNotification= "Windows 处于通知模式"
private constL_MsgLicenseStatusExtendedGrace= "延长宽限期将于 %ENDDATE% 到期"
private constL_MsgLicenseStatusUnknown= "未知的授权状态"
private constL_MsgLicenseStatusEvalEndData= "评估结束日期: "
private constL_MsgProductName= "系统："
private constL_MsgProductDesc= "系统描述: "
private constL_MsgVersion= "版本号: "
Private ConstL_MsgServicePack= "补丁包："
Private ConstL_MsgBuild= "编译代号："
private constL_MsgCurrentTrustedTime= "授权时间: "
private constL_MsgProductKey= "序列号: "
private constL_MsgProductId= "产品ID: "
private constL_MsgUndeterminedPrimaryKey= "警告: 无法验证Windows当前产品序列号的正确性，请更新到最新补丁包(SP)."
private constL_MsgUndeterminedPrimaryKeyOperation= "警告: 该操作可能影响超过一个目标授权，请核对结果."
private constL_MsgUndeterminedOperationFormat= "正在处理以下产品授权 %PRODUCTDESCRIPTION% (%PRODUCTID%)."
' Registry constants
private constHKEY_LOCAL_MACHINE= &H80000002
private constSLKeyPath= "SOFTWAREMicrosoftWindowsNTCurrentVersionSoftwareProtectionPlatform"
private constSLKeyPath32= "SOFTWAREWow6432NodeMicrosoftWindowsNTCurrentVersionSoftwareProtectionPlatform"
Private ConstWindowsNTInfoPath= "SOFTWAREMicrosoftWindows NTCurrentVersion"
' WMI class names
private constServiceClass= "SoftwareLicensingService"
private constProductClass= "SoftwareLicensingProduct"
private constWindowsAppId= "55c92734-d682-4d71-983e-d6ec3f16059f"
private constProductIsPrimarySkuSelectClause= "ID, ApplicationId, PartialProductKey, LicenseIsAddon,Description, Name"
Private constPartialProductKeyNonNullWhereClause= "PartialProductKey <> null"
private constEmptyWhereClause= ""
private constwbemImpersonationLevelImpersonate= 3
private constwbemAuthenticationLevelPktPrivacy= 6
'If this is the local computer, set everything immediately
If g_strComputer = "." Then
Setg_objWMIService = GetObject("winmgmts:" &g_strComputer & "rootcimv2")
Setg_objRegistry = GetObject("winmgmts:" &g_strComputer & "rootdefault:StdRegProv")
If Notg_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 ' ifthe major version later than Vista
unknownOption = True
IfWScript.Arguments.Length = 0 Then
unknownOption = False
CallExecCommand()
Else
strNewProductKey = Wscript.arguments.Item(0)
IfWScript.Arguments.Length = 1 Then
unknownOption = False
UACShellstrNewProductKey
Else
IfWScript.Arguments.Length = 2 Then
IfWScript.Arguments.Item(1) = "UAC_TAG" Then
unknownOption = False
InstallProductKey strNewProductKey
End IF
End If
End If
End If
ifunknownOption = True Then
LineOutGetResource("L_MsgErrorOption")
End If
Else
LineOutReplace(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 inGetProductCollection(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
LineOutGetResource("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
LineOutGetResource("L_MsgLicenseStatusEvalEndData") &displayDate.GetVarDate
End If
Next
If productKeyFound <> True Then
LineOut""
g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath,"ProductName", strTmp
LineOutGetResource("L_MsgProductName") & strTmp
g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath,"CSDVersion", strTmp
If NotIsNull(strTmp) Then
LineOutGetResource("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
LineOutGetResource("L_MsgVersion") &strProductVersion
g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath,"BuildLabEx", strTmp
IfIsNull(strTmp) Then
g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath,"BuildLab", strTmp
End If
LineOutGetResource("L_MsgBuild") & strTmp
End If
LineOut ""
If productKeyFound <> True Then
LineOutGetResource("L_MsgErrorPKey")
End If
If bRegPKeyFound Then
LineOutGetResource("L_MsgProductKey") &strProductKey
Else
LineOutGetResource("L_MsgErrorRegPKey")
End If
If bRegPIDFound Then
LineOutGetResource("L_MsgProductId") & strProductId
Else
LineOutGetResource("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 newkey
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)=(dwAccumulator24) and 255
dwAccumulator=dwAccumulator Mod 24
j=j-1
Loop Whilej>=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
LineOutGetResource("L_MsgErrorText_8") & "0x"& Hex(Err.Number)
ExitScriptErr.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
LineOutReplace(GetResource("L_MsgErrorInstallPKey"), "%PKEY%",strProductKey) & "0x" &Hex(Err.Number)
ExitScriptErr.Number
End If
' Installing a product key could change Windows licensingstate.
' Since the service determines if it can shut down and when is thenext start time
' based on the licensing state we should reconsume the licenseshere.
objService.RefreshLicenseStatus()
For Each objProduct inGetProductCollection(ProductIsPrimarySkuSelectClause,PartialProductKeyNonNullWhereClause)
strDescription = objProduct.Description
iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct)
If (iIsPrimaryWindowsSku = 2) Then
OutputIndeterminateOperationWarning(objProduct)
End If
If IsKmsServer(strDescription) Then
bIsKMS =True
ExitFor
End If
Next
If (bIsKMS = True) Then
' Set theKMS 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
IfExistsRegistryKey(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 theKMS 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
IfgraceRemaining <> 0 Then
strDescription = objProduct.Description
bTBL =IsTBL(strDescription)
If bTBLThen
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
LineoutstrOutput
End If
End Sub
' Get the resource string with the given name using the built-indefault.
Private Function GetResource(name)
GetResource = eval_r(name)
End Function
Private Sub ExitScript(retval)
if (g_EchoString <> "") Then
MsgBoxg_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
SetcolProducts = g_objWMIService.ExecQuery("SELECT " &strSelect & " FROM " &ProductClass)
QuitIfError()
Else
SetcolProducts = 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, andthat
If (LCase(objProduct.ApplicationId) = WindowsAppId AndobjProduct.PartialProductKey <> "")Then
'If we canget 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 cannot get the AddOn property then we assume this is a previousversion
'and wereturn a value of Uncertain, unless we can prove otherwise
If(IsKmsClient(objProduct.Description) OrIsKmsServer(objProduct.Description)) Then
'If thedescription is KMS related, we can be certain that this is aprimary SKU
iPrimarySku= 1
Else
'Indeterminate since the property was missing and we can't verifyKMS
iPrimarySku= 2
End If
End If
End If
GetIsPrimaryWindowsSKU = iPrimarySku
End Function
Private Function IsKmsClient(strDescription)
If InStr(strDescription, "VOLUME_KMSCLIENT") > 0Then
IsKmsClient= True
Else
IsKmsClient= False
End If
End Function
Private Function IsKmsServer(strDescription)
If IsKmsClient(strDescription) Then
IsKmsServer= False
Else
IfInStr(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 thekey
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
