查看和替换Windows XP序列号的脚本

2010-11-27 王健宇 转载

序列号是在安装电脑的时候设定的,有的时候需要修改。
比如你的电脑遇上了正版验证失败的问题,微软的WGA验证或者KB892130的安装便会造成这样的问题。

Windows XP的序列号是加密存储在注册表里的,无法直接查看,如果想看的话,要借助 keyfinder 之类的软件。
根据我的实际经验,这类序列号查看、修改或注册之类软件大多数含有病毒或者恶意程序。

微软发布了一段修改XP序列号的脚本代码,来自 http://support.microsoft.com/default.aspx?scid=kb;en-us;Q328874 。从网上下载到的Windows XP注册机、华夏专用版、卜化麟版等注册工具其实其中可能都是该代码而已。

代码都是明文公开的写在这里,因此可以放心使用。
使用方法:把下面这段代码复制到记事本中,保存为扩展名vbs的文件,比如WinXPKey.vbs。
然后双击运行即可,其中可以填写入你想用的序列号。
本脚本适用于VLK版本,可能不适于OEM版本。
 

WinXPKey.vbs

内容:

' WinXPKey.vbs
' Author: elffin
' Edited from Script by Microsoft and Mark D. MacLachlan
' Version: 0.5
' Function: Display and change product key of Windows XP (Maybe Win2003)
'
' ChangLog:
' - Ver 0.5
' Add LineOut Function
' Add Name, version, etc. of Windows
' Add a little More Information
' Small change in getkey Function
' Break Line In source
' Change name of some Variables
' Add productKeyFound to deal with not installed key
' Add Ecplicit Option
' Change the methods of registry operate
' Add predefined variables at begining
' Add treatment when Pkey or PID not exist in registry
' Delete space of new key
' Add ExitScript
' - Ver 0.2
'
' Todo:
' Display the install date
'
' COMMENT: You can contact me if you find problem.
'           Please keep author and URL information if change the source.

Option Explicit

ON ERROR RESUME NEXT
Dim g_strComputer, g_objRegistry, g_EchoString

g_strComputer = "."
g_EchoString = ""

private const L_MsgErrorPKey                          = "没有安装Windows序列号, 以下为注册表残留信息。"
private const L_MsgErrorRegPKey                       = "没有在注册表中找到Windows序列号."
private const L_MsgErrorRegPID                        = "没有在注册表中找到Windows产品ID."

Private const L_MsgProductName                        = "系统:"
private const L_MsgProductDesc                        = "系统描述: "
private const L_MsgVersion                            = "版本号: "
Private Const L_MsgServicePack                        = "补丁包:"
Private Const L_MsgBuild                              = "编译代号:"

private const L_MsgProductKey                         = "序列号: "
private const L_MsgProductId                          = "产品ID: "


private const HKEY_LOCAL_MACHINE                      =  &H80000002
Private Const WindowsNTInfoPath                       = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"


Dim Obj
Dim productKeyFound
Dim strActiveStatus, strEvalRemain
Dim strProductKey, strProductId, strProductVersion, strTmp
Dim strNewProductKey, Result
Dim bRegPKeyFound, bRegPIDFound       ' value exists in registry


'If this is the local computer, set everything immediately
If g_strComputer = "." Then
        Set g_objRegistry = GetObject("winmgmts:\\" & g_strComputer & "\root\default:StdRegProv")
End If

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

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

 

For Each Obj in GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf ("win32_WindowsProductActivation")

productKeyFound = True

LineOut "主机名称:" & obj.ServerName
If Obj.ActivationRequired <> 0 Then
         strActiveStatus = "需要激活" & "(宽限期剩余" & Obj.RemainingGracePeriod & "天)"
Else
         strActiveStatus = "Windows 系统已经激活"
End If
LineOut strActiveStatus
If Obj.RemainingEvaluationPeriod <> 2147483647 Then
         strEvalRemain = Obj.RemainingEvaluationPeriod & "天"
Else
         strEvalRemain = "无限期"
End If
LineOut "剩余有效期:" & strEvalRemain
Next

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 XP(2003)序列号" & "(OEM版无效,默认版本为VLK)"

LineOut ""
LineOut ""
LineOut "请在下面输入新的序列号:"

If Wscript.arguments.count<1 Then
         strNewProductKey=InputBox(g_EchoString, "Windows XP 序列号查看替换器", _
        "MRX3F-47B9T-2487J-KWKMF-RPWBY")
        If strNewProductKey = "" Then
                 Wscript.quit
        End If
Else
         strNewProductKey = Wscript.arguments.Item(0)
End If

g_EchoString = ""
strNewProductKey = replace(strNewProductKey, Space(1), "")   'delete the space of new key
strTmp = strNewProductKey
strNewProductKey = Replace(strNewProductKey,"-","") 'remove hyphens if any
For Each Obj in GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf ("win32_WindowsProductActivation")
result = Obj.SetProductKey(strNewProductKey)
If Err = 0 Then
         LineOut "序列号成功替换为 " & strTmp & " !"
End If
If Err <> 0 Then
         LineOut "替换序列号为 " & strTmp & " 失败!" & vbNewline & "可能序列号有误或与当前系统版本不匹配。错误代码:0x" & Hex(Err.Number)
         Err.Clear
End If
Next

ExitScript 0

 

 


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 ExitScript(retval)
if (g_EchoString <> "") Then
        MsgBox g_EchoString, 0, "Windows XP 序列号查看替换器"
End If
WScript.Quit retval
End Sub


Private Sub LineOut(str)
g_EchoString = g_EchoString & str & vbNewLine
End Sub

 

' Get the resource string with the given name using the built-in default.
Private Function GetResource(name)
GetResource = Eval(name)
End Function

标签: 替换XP序列号脚本

评论:

法桐网
2010-12-01 12:49
我也用WIN7
王健宇
2010-12-01 13:50
@法桐网:win7我觉得还行,很强大很方便
李诚
2010-12-01 12:48
谢谢你的分享~
很受用
不过现在用7的比较多
王健宇
2010-12-01 13:50
@李诚:嗯。win7的脚本也有
ugg classic cardy
2010-11-28 14:09
写的很详细,或许以后用的着。支持博主
王健宇
2010-11-28 15:11
@ugg classic cardy:恩

发表评论:

Powered by emlog sitemap