无法使用VBA - 自动化错误来保护Windows产品密钥

问题描述

以下代码引发自动化错误

  Sub GetWindowsProductKey（）
 
设置WshShell = CreateObject（WScript.Shell）
 MsgBox WshShell.RegRead（HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId）
 
 End Sub 
  

但此代码工作正常

  Sub GetPath（）
 
设置WshShell = CreateObject（WScript.Shell）
 MsgBox WshShell.RegRead（HKEY_CURRENT_USER\Environment\Path）
 
 End Sub 
  

显然这与产品密钥保护有关，

我在撰写一个电子表格以收集来自远程办公室的审计数据，之后任何人都认为我是（非常糟糕的）黑客。

---

更新

我正在尝试以下方法，但是我得到一个类型不匹配错误，而不是在第二个函数（第一个仍然工作）...

  Sub GetPathUsingStdRegProv（）
 
 Const HKEY_CURRENT_USER = & H80000001 
 
 strComputer =。 
 
设置oReg = GetObject（winmgmts：{impersonationLevel = impersonate}！\\& strComputer&\root\default：StdRegProv）
 
 strKeyPath =Environment
 strValueName =Path
 
 oReg.GetStringValue HKEY_CURRENT_USER，strKeyPath，strValueName，strValue 
 
 MsgBox strValue 
 
 End Sub 
  

---

  Sub GetWindowsKeyUsingStdRegProv（）
 
 Const HKEY_LOCAL_MACHINE =& H80000002 
 
 strComputer =。 
 
设置oReg = GetObject（winmgmts：{impersonationLevel = impersonate}！\\& strComputer&\root\default：StdRegProv）
 
 strKeyPath =SOFTWARE\Microsoft\Windows NT\CurrentVersion
 strValueName =DigitalProductId
 
 oReg.GetBinaryValue HKEY_LOCAL_MACHINE，strKeyPath，strValueName，strValue 
 
对于i = LBound（strValue）到UBound（strValue）
 MsgBox strValue（i）
下一个
 
 End Sub 
  pre> 
 
 
 strValue在第二个函数中为空，这解释了类型不匹配!! 
 
 
 
 
 
 
 更新2  
 
 
 
我使用了，以及
  ShellRun（wmic path softwarelicensingservice get OA3xOriginalProductKey ）
  
它在我的笔记本电脑上工作，但不在其中一个桌面上，大概是因为键是值T存储在BIOS / UEFI。所以我还在寻找一个解决方案！
 
 
 
 
 
 
 更新3  
 
 
 
我已经在中执行代码作为vbs脚本，但是我在笔记本电脑上获得的价值与上述 wmic 技术的不同之处在不同？这是64位的问题吗？这是非常令人困惑的！
解决方案
也许这有助于：
 设置WshShell = CreateObject（WScript.Shell）
 MsgBox ConvertToKey（WshShell.RegRead（HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId ））
 
函数ConvertToKey（Key）
 Const KeyOffset = 52 
i = 28 
 Chars =BCDFGHJKMPQRTVWXY2346789
 Do 
 Cur = 0 
x = 14 
 Do 
 Cur = Cur * 256 
 Cur = Key（x + KeyOffset）+ Cur 
 Key（x + KeyOffset）=（Cur \ 24）和255 
 Cur = Cur Mod 24 
x = x  -  1 
循环虽然x> = 0 
i = i  -  1 
 KeyOutput = Mid（Chars， Cur + 1,1）& KeyOutput 
如果（（（29  -  i）Mod 6）= 0）和（i -1）然后
 i = i  -  1 
 KeyOutput = - & KeyOutput 
 End If 
循环当我> = 0 
 ConvertToKey = KeyOutput 
结束函数
  
资料来源： 
 
The following code throws an 'Automation Error'
Sub GetWindowsProductKey()

Set WshShell = CreateObject("WScript.Shell")
MsgBox WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId")

End Sub
But this code works fine
Sub GetPath()

Set WshShell = CreateObject("WScript.Shell")
MsgBox WshShell.RegRead("HKEY_CURRENT_USER\Environment\Path")

End Sub
Clearly this has something to do with the product key being protected or something.
I'm writing a spreadsheet to collect auditing data from remote offices before anyone assumes I'm (really bad at) hacking.
UPDATE
I'm now trying the following approach, but I'm getting a type mismatch error instead on the second function (the first one still works) ...
Sub GetPathUsingStdRegProv()

Const HKEY_CURRENT_USER = &H80000001

strComputer = "."

Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")

strKeyPath = "Environment"
strValueName = "Path"

oReg.GetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, strValue

MsgBox strValue

End Sub
Sub GetWindowsKeyUsingStdRegProv()

Const HKEY_LOCAL_MACHINE = &H80000002

strComputer = "."

Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")

strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
strValueName = "DigitalProductId"

oReg.GetBinaryValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue

For i = LBound(strValue) To UBound(strValue)
    MsgBox strValue(i)
Next

End Sub
strValue is Null in the second function, which explains the type mismatch!!
Update 2
I've use the code from this SO question, along with
ShellRun("wmic path softwarelicensingservice get OA3xOriginalProductKey")
which works on my laptop, but not on one of the desktops, presumably because the key isn't stored in BIOS/UEFI. So I'm still looking for a solution!
update 3
I've executed the code in the answer below as a vbs script, but the value I get on my laptop is different to the one i got from wmic technique above?! Is that a 64-bit issue? This is all very confusing!!
 解决方案 
Maybe this helps:
Set WshShell = CreateObject("WScript.Shell")
MsgBox ConvertToKey(WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))

Function ConvertToKey(Key)
    Const KeyOffset = 52
    i = 28
    Chars = "BCDFGHJKMPQRTVWXY2346789"
    Do
        Cur = 0
        x = 14
        Do
            Cur = Cur * 256
            Cur = Key(x + KeyOffset) + Cur
            Key(x + KeyOffset) = (Cur \ 24) And 255
            Cur = Cur Mod 24
            x = x - 1
        Loop While x >= 0
        i = i - 1
        KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
        If (((29 - i) Mod 6) = 0) And (i <> -1) Then
            i = i - 1
            KeyOutput = "-" & KeyOutput
        End If
    Loop While i >= 0
    ConvertToKey = KeyOutput
End Function
Source: http://www.thewindowsclub.com/find-windows-10-product-key-using-vb-script
                        
这篇关于无法使用VBA  - 自动化错误来保护Windows产品密钥的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！