查看Windows XP /Vista /Win7 等版本序列号脚本

2010-11-27 王健宇转载

方法：将下面代码复制到文本编辑程序（如记事本）中，保存为扩展名vbs的文件（如WinKeyViewer.vbs）。
双击运行即可。代码是明文的，因此绝对可以放心使用。

WinKeyViewer.vbs

内容：

' WinKeyViewer.vbs
' Author: elffin
' Referred to Script by Mark D. MacLachlan
' Version: 0.3
' Function: Display key for Windows XP, 2003, Vista, Win7 etc.
'
' ChangLog:
' - ver 0.3
' Add the function of save to file
' Add ShowInfo
' Change ExitScript
' - ver 0.2
'
' TODO: Support Windows 98
' Add 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"

'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

Call ExecCommand()
Call ShowInfo()

ExitScript 0

Private Sub ExecCommand

Dim productKeyFound
Dim strProductKey, strProductId, strProductVersion, strTmp
Dim bRegPKeyFound, bRegPIDFound ' value exists in registry

'Retrieve information from 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

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

productKeyFound = True

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的序列号。"
LineOut "适用于绝大多数Windows系统，包括 XP/Vista/Win7 系列等。"

End Sub

Private Sub ShowInfo

Dim Ans, objFSO, outFile, strSave

Set objFSO = CreateObject("Scripting.FileSystemObject")
strSave = vbNewLine & "-----------------------------------------------------------" & vbNewLine & g_EchoString
strSave = strSave & vbNewLine & vbNewLine& "------ " & Now() & " " & "Windows 序列号查看器保存" & " ------" & vbNewLine

LineOut ""
LineOut ""
LineOut "是否保存以上信息到文本文件 WindowsKey.txt ？"

Ans = MsgBox(g_EchoString, 4, "Windows 序列号查看器")

g_EchoString = ""
If Ans = vbYes Then
Set outFile = objFSO.OpenTextFile(".\WindowsKey.txt", 8 , True) ' append to file
outFile.WriteLine strSave
outFile.Close
LineOut "已经保存到文件 WindowsKey.txt ！"
End If

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

' 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 序列号查看器"
End If
WScript.Quit retval
End Sub

' Functions Without Change Below

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

标签: VBS查看windows序列号