如何在Windows 10，Windows 8和Windows 7中查看产品密钥

2023-11-18 作者：爱上IT 分类：教程技巧阅读：152 评论：0

Windows 11 Pro ISO文件在哪下载最新版？如何下载原装纯净版Win11 ?点击进入持续更新!

与PowerShell相比，此VBScript解决方案几乎是完美的。您只需要单击文件即可。要查看您的Windows 10产品密钥

打开记事本。

将以下文本复制并粘贴到“记事本”窗口中

Option Explicit 

Dim objshell,path,DigitalID, Result 
Set objshell = CreateObject("WScript.Shell") 
'Set registry key path 
Path = "HKLMSOFTWAREMicrosoftWindows NTCurrentVersion" 
'Registry key value 
DigitalID = objshell.RegRead(Path & "DigitalProductId") 
Dim ProductName,ProductID,ProductKey,ProductData 
'Get ProductName, ProductID, ProductKey 
ProductName = "Product Name: " & objshell.RegRead(Path & "ProductName") 
ProductID = "Product ID: " & objshell.RegRead(Path & "ProductID") 
ProductKey = "Installed Key: " & ConvertToKey(DigitalID) 
ProductData = ProductName & vbNewLine & ProductID & vbNewLine & ProductKey 
'Show messbox if save to a file 
If vbYes = MsgBox(ProductData & vblf & vblf & "Save to a file?", vbYesNo + vbQuestion, "BackUp Windows Key Information") then 
 Save ProductData 
End If 



'Convert binary to chars 
Function ConvertToKey(Key) 
 Const KeyOffset = 52 
 Dim isWin8, Maps, i, j, Current, KeyOutput, Last, keypart1, insert 
 'Check if OS is Windows 8 
 isWin8 = (Key(66)  6) And 1 
 Key(66) = (Key(66) And &HF7) Or ((isWin8 And 2) * 4) 
 i = 24 
 Maps = "BCDFGHJKMPQRTVWXY2346789" 
 Do 
  Current= 0 
 j = 14 
 Do 
 Current = Current* 256 
 Current = Key(j + KeyOffset) + Current 
 Key(j + KeyOffset) = (Current  24) 
 Current=Current Mod 24 
 j = j -1 
 Loop While j >= 0 
 i = i -1 
 KeyOutput = Mid(Maps,Current+ 1, 1) & KeyOutput 
 Last = Current 
 Loop While i >= 0 
 
 If (isWin8 = 1) Then 
 keypart1 = Mid(KeyOutput, 2, Last) 
 insert = "N" 
 KeyOutput = Replace(KeyOutput, keypart1, keypart1 & insert, 2, 1, 0) 
 If Last = 0 Then KeyOutput = insert & KeyOutput 
 End If 
 

 ConvertToKey = Mid(KeyOutput, 1, 5) & "-" & Mid(KeyOutput, 6, 5) & "-" & Mid(KeyOutput, 11, 5) & "-" & Mid(KeyOutput, 16, 5) & "-" & Mid(KeyOutput, 21, 5) 
 
 
End Function 
'Save data to a file 
Function Save(Data) 
 Dim fso, fName, txt,objshell,UserName 
 Set objshell = CreateObject("wscript.shell") 
 'Get current user name 
 UserName = objshell.ExpandEnvironmentStrings("%UserName%") 
 'Create a text file on desktop 
 fName = "C:Users" & UserName & "DesktopWindowsKeyInfo.txt" 
 Set fso = CreateObject("Scripting.FileSystemObject") 
 Set txt = fso.CreateTextFile(fName) 
 txt.Writeline Data 
 txt.Close 
End Function