【原创内容】自制vbs——当前获取系统名称、版本、ID以及密钥

Luckys68

自制VBS脚本，打开即可快速获取当前系统名称、版本、ID、以及密钥（这个密钥是当前电脑上已经激活了的密钥）该脚本经ESET Smart Security 9.0检测无毒。
顺便把代码亮出来：

1. Option Explicit
   
2. Dim objshell,path,DigitalID, Result
   
3. Set objshell = CreateObject("WScript.Shell")
   
4. 'Set registry key path
   
5. Path = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"
   
6. 'Registry key value
   
7. DigitalID = objshell.RegRead(Path & "DigitalProductId")
   
8. Dim ProductName,ProductID,ProductKey,ProductData
   
9. 'Get ProductName, ProductID, ProductKey
   
10. ProductName = "Product Name：" & objshell.RegRead(Path & "ProductName")
    
11. ProductID = "Product ID：" & objshell.RegRead(Path & "ProductID")
    
12. ProductKey = "Product Key：" & ConvertToKey(DigitalID)
    
13. ProductData = ProductName & vbNewLine & ProductID & vbNewLine & ProductKey
    
14. 'Show messbox if save to a file
    
15. If vbYes = MsgBox(ProductData & vblf & vblf & "Save to desktop file？", vbYesNo + vbQuestion, "SoHard Activate Key Finder") then
    
16. Save ProductData
    
17. End If
    
18. 'Convert binary to chars
    
19. Function ConvertToKey(Key)
    
20. Const KeyOffset = 52
    
21. Dim isWin10, Maps, i, j, Current, KeyOutput, Last, keypart1, insert
    
22. 'Check if OS is Windows 10
    
23. isWin10 = (Key(66) \ 6) And 1
    
24. Key(66) = (Key(66) And &HF7) Or ((isWin10 And 2) * 4)
    
25. i = 24
    
26. Maps = "BCDFGHJKMPQRTVWXY2346789"
    
27. Do
    
28. Current= 0
    
29. j = 14
    
30. Do
    
31. Current = Current* 256
    
32. Current = Key(j + KeyOffset) + Current
    
33. Key(j + KeyOffset) = (Current \ 24)
    
34. Current=Current Mod 24
    
35. j = j -1
    
36. Loop While j >= 0
    
37. i = i -1
    
38. KeyOutput = Mid(Maps,Current+ 1, 1) & KeyOutput
    
39. Last = Current
    
40. Loop While i >= 0
    
41. If (isWin10 = 1) Then
    
42. keypart1 = Mid(KeyOutput, 2, Last)
    
43. insert = "N"
    
44. KeyOutput = Replace(KeyOutput, keypart1, keypart1 & insert, 2, 1, 0)
    
45. If Last = 0 Then KeyOutput = insert & KeyOutput
    
46. End If
    
47. ConvertToKey = Mid(KeyOutput, 1, 5) & "-" & Mid(KeyOutput, 6, 5) & "-" & Mid(KeyOutput, 11, 5) & "-" & Mid(KeyOutput, 16, 5) & "-" & Mid(KeyOutput, 21, 5)
    
48. End Function
    
49. 'Save data to a file
    
50. Function Save(Data)
    
51. Dim fso, fName, txt,objshell,UserName
    
52. Set objshell = CreateObject("wscript.shell")
    
53. 'Get current user name
    
54. UserName = objshell.ExpandEnvironmentStrings("%UserName%")
    
55. 'Create a text file on desktop
    
56. fName = "C:\Users\" & UserName & "\Desktop\Windows Activate Key Backup.txt"
    
57. Set fso = CreateObject("Scripting.FileSystemObject")
    
58. Set txt = fso.CreateTextFile(fName)
    
59. txt.Writeline Data
    
60. txt.Close
    
61. End Function

复制代码

懂VB编程的景友应该看得懂一些。运行后的截图如下，可以选择是否将信息保存到桌面：

z_yj

同样显示cd-key： BBBBB-BBBBB-BBBBB-BBBBB-BBBBB

z_yj

看下图结果：key和其他软件显示的一样。

longonecn

z_yj 发表于 2017-2-13 02:05
看下图结果：key和其他软件显示的一样。

应该是KMS激活吧。

suzuko

能正确显示，

Luckys68

longonecn 发表于 2017-2-13 06:45
应该是KMS激活吧。

这只是获取系统当前密钥而已，不是激活。

xyz

这个不错。

shshyp

能正确显示??

yem

用各种激活方式激活的key都可以查看吗？谢谢分享！

pzhzshun

这个好，要支持！

sooyun

我机子新加ssd重新分区格式化安装的，没有输入序列号，自动激活了

mengqing

这个好，要支持！

tomok

谢谢 分享
这个 可以试试

z_yj

longonecn 发表于 2017-2-13 06:45
应该是KMS激活吧。

都是在线的mak key激活，哪里来的kms？

默然King

企业版是获取不了KEY的。。

z_yj

按照微软说法，不能获取key表明激活不再依赖于cd-key。
能够显示key反倒不是很好的激活手段。

kfc0013

cpc

获取系统当前密钥这个好

jeffwong2017