寻找已安装软件丢失的产品序列号(CD-KEY)

!本文可能 超过1年没有更新，今后内容也许不会被维护或者支持，部分内容可能具有时效性，涉及技术细节或者软件使用方面，本人不保证相应的兼容和可操作性。

安装序列号又称为CD-KEY或者Product-Key，主要是用来验证用户是否是软件的合法拥有者，当第一次安装时可能会要求输入，输入正确后，软件才能正常安装并使用，并且以后不再需要输入这个序列号，由于序列号是唯一的，只在软件第一次安装或运行时需要，而且多数软件商喜欢把这个号写在产品说明书或者光盘上，不过随着时间的流逝我们有可能丢失这些印有序列号的说明书或者光盘，然后某一天当我们发现需要重新安装软件时，彻底杯具了。

不过下面我介绍的软件可能会补救一下，一般这些软件商喜欢在第一次输入序列号后将序列号存储入系统的注册表里，所以我们可以读取注册表来获取这类重要信息，比如说Windows XP/Vista/7操作系统的序列号就存储在HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion注册表路径下，键名称为DigitalProductId，不过貌似是二进制的，没关系，我在这里为大家准备了读取Windows XP系统信息的WScript/VBScript脚本，其中有一项就是解码并获取系统安装序列号：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195

Option Explicit
 
Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
 
Class RegistryItem
  Public ValueName
  Public Value
  Public ValueType
End Class
 
Class WinInfo
  Private strComputer
  Private Registry
  Private OriginalSnap
  Private PendingChanges
  Private strKeyPath
 
  Private Sub Class_Initialize()
    strComputer = "."
    strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
 
    Set Registry = GetObject(_
      "winmgmts:{impersonationLevel=impersonate}!\\" &_
      strComputer & "\root\default:StdRegProv")
 
    Set OriginalSnap = WScript.CreateObject("Scripting.Dictionary")
    Set PendingChanges = WScript.CreateObject("Scripting.Dictionary")
  End Sub
 
  Private Sub Class_Terminate()
    PendingChanges.RemoveAll
    OriginalSnap.RemoveAll
    Set PendingChanges = Nothing
    Set OriginalSnap = Nothing
    Set Registry = Nothing
  End Sub
 
  ' 解码序列号，貌似Win2008 Server R2下解码不正确
  ' parseProductId函数来自elffin ( http://hi.baidu.com/elffin )
  Private Function parseProductId(rpk)
    Const rpkOffset=52
    Dim dwAccumulator, szPossibleChars
    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
      parseProductId=mid(szPossibleChars,dwAccumulator+1,1) & parseProductId
      If (((29-i) Mod 6)=0) And (i<>-1) Then
        i=i-1
        parseProductId="-"&parseProductId
      End If
    Loop While i>=0 'Goto Rep1
  End Function
 
  Private Function parseLicenseInfo(arrBinaryDigits)
    Dim i
    For i = lBound(arrBinaryDigits) to uBound(arrBinaryDigits)
      parseLicenseInfo = parseLicenseInfo & " " & Hex(arrBinaryDigits(i))
    Next
    parseLicenseInfo = Trim(parseLicenseInfo)
  End Function
 
  Public Function getKeyCollection()
    getKeyCollection = OriginalSnap.Keys
  End Function
 
  Public Function getCount()
    getCount = OriginalSnap.Count
  End Function
 
  Public Function getItem(ByVal sName)
    If OriginalSnap.Exists(sName) Then
      Set getItem = OriginalSnap.Item(sName)
    End If
  End Function
 
  Private Function parseInstallDate(lngValue)
  parseInstallDate = DateAdd("s", lngValue, "01/01/1970 00:00:00")
  End Function
 
  Public Function getItemValue(ByVal sName)
    If OriginalSnap.Exists(sName) Then
      getItemValue = OriginalSnap.Item(sName).Value
      Select Case sName
      Case "DigitalProductId","DigitalProductId4"
        getItemValue = parseProductId(getItemValue)
      Case "LicenseInfo"
        getItemValue = parseLicenseInfo(getItemValue)
      Case "InstallDate"
        getItemValue = parseInstallDate(getItemValue)
      End Select
    End If
  End Function
 
  Public Function getItemType(ByVal sName)
    If OriginalSnap.Exists(sName) Then
      getItemType = OriginalSnap.Item(sName).ValueType
    End If
  End Function
 
  ' 加载设置
  Public Function load()
    Dim item, strValue
    Dim i, arrValueNames, arrValueTypes
    Registry.EnumValues HKEY_LOCAL_MACHINE, strKeyPath,_
      arrValueNames, arrValueTypes
 
    For i=0 To UBound(arrValueNames)
      Set item = New RegistryItem
        item.ValueName = arrValueNames(i)
        item.ValueType = arrValueTypes(i)
 
        Select Case arrValueTypes(i)
          Case REG_SZ
            Registry.GetStringValue HKEY_LOCAL_MACHINE,_
              strKeyPath,_
              arrValueNames(i),_
              strValue
          Case REG_EXPAND_SZ
            Registry.GetExpandedStringValue HKEY_LOCAL_MACHINE,_
              strKeyPath,_
              arrValueNames(i),_
              strValue
          Case REG_BINARY
            Registry.GetBinaryValue HKEY_LOCAL_MACHINE,_
              strKeyPath,_
              arrValueNames(i),_
              strValue
          Case REG_DWORD
            Registry.GetDWORDValue HKEY_LOCAL_MACHINE,_
              strKeyPath,_
              arrValueNames(i),_
              strValue
          Case REG_MULTI_SZ
            Registry.GetMultiStringValue HKEY_LOCAL_MACHINE,_
              strKeyPath,_
              arrValueNames(i),_
              strValue
        End Select
        item.Value = strValue
        OriginalSnap.Add arrValueNames(i), item
      Set item = Nothing
    Next
  End Function
 
  ' 保存设置开始，尚未实现！
  Public Function setItem(ByVal sName, ByVal sValue)
    If OriginalSnap.Exists(sName) Then
 
    End If
  End Function
 
  Public Function setItemType(ByVal sName, ByVal sValue)
 
  End Function
 
  Public Function save()
 
  End Function
  ' 保存设置结束
End Class
 
Function VBMain()
  ON ERROR RESUME NEXT
  Dim Info, Keys
  Set Info = New WinInfo
  Info.load
 
  Keys = Info.getKeyCollection
 
  Dim i, s
  For i = 0 To Info.getCount - 1
      s = s & Keys(i) & " = " & Info.getItemValue(Keys(i)) & vbCrLf
  Next
  MsgBox s
  Set Info = Nothing
 
  If Err Then Err.Clear
End Function
 
Call WScript.Quit(VBMain)

这个脚本可以正确解码并获取Windows XP和Windows 7的序列号（Vista未做尝试），Windows 2008 Server R2有DigitalProductId和DigitalProductId4（Windows 7也有），不知道DigitalProductId4是做什么用的，不过这两个字段值用上述脚本解码都是有问题的。

什么？只能获取Windows XP/7这样的操作系统的序列号？太不给力了吧！好吧，下面我再介绍两款强大而且免费的查看已安装软件序列号的工具，一款是Magical Jelly Bean的KeyFinder（主页），软件截图如下：

KeyFinder序列号查看器.png

这是一款可以获取上百种著名软件信息的小工具，虽说它有功能更为强大的收费版，但是免费版就已经足够我们使用了，更重要的是其配置文件keyfinder.cfg可以让我们自定义要获取软件信息的注册表路径及类型，我们可以使用其官方版本的keyfinder.cfg来配置我们的keyfinder程序。

另外一款是著名小工具开发商NirSoft开发的ProduKey（主页），NirSoft开发的工具以实用出名，这次也不例外，这个工具简单易用，直接运行就能列出常用软件的序列号，软件截图如下：

NirSoft Produkey 序列号查看器.png

由于准备重装系统，我尝试了这两款工具，总体上来说KeyFinder的识别软件较多，可配置性强，唯一遗憾的是没有Office的选项，我电脑上装有Office 2010，哪怕是修改配置文件，也不能读出序列号。然后据官方介绍我又下载了Recover Keys这款软件，虽说是收费的，但是其试用版依旧不能识别我电脑上安装的Office 2010；相比之下ProduKey则简单得多，虽然识别软件没有前者那么多，但是却能准确识别出电脑上的Office版本和序列号，这点相当不错，据官方介绍“ProduKey is a small utility that displays the ProductID and the CD-Key of Microsoft Office (Microsoft Office 2003, Microsoft Office 2007), Windows (Including Windows 7 and Windows Vista), Exchange Server, and SQL Server installed on your computer.”，纳尼？没有Office 2010，只有2007，但是2010确实被识别出来了，难道是Office 2007和2010的序列号是一种编码模式？

好了，就介绍这么多，更多的功能还是大家去发掘吧:-)

若无特别说明，本网站文章均为原创，原则上这些文章不允许转载，但是如果阁下是出于研究学习目的可以转载到阁下的个人博客或者主页，转载遵循创作共同性“署名-非商业性使用-相同方式共享”原则，请转载时注明作者和出处，谢绝商业性、非署名、采集站、垃圾站或者纯粹为了流量的转载。谢谢合作！

您可能喜欢

请稍后...

发表评论

电子邮件地址不会被公开。 必填项已用*标注

CAPTCHA

*

此站点使用Akismet来减少垃圾评论。了解我们如何处理您的评论数据。