vb.net 以编程方式获取 Office 2013 产品密钥

Programmatically attain Office 2013 Product Key

提问by DeeKayy90

I've just started working on a task assigned to me by the IT department at work, to create a program that can read the product keys used to install Microsoft Office 2013 and assign it to the computer name, so they can store it in a database in case of recovery being needed (bear in mind this is a company with over 150 systems).

我刚刚开始从事工作中 IT 部门分配给我的任务，以创建一个程序，该程序可以读取用于安装 Microsoft Office 2013 的产品密钥并将其分配给计算机名称，以便他们可以将其存储在数据库以防需要恢复（请记住，这是一家拥有 150 多个系统的公司）。

I've checked through the net to find a few suggested programs to get the product key, and then I've delved into making the program myself using both AutoIT and VB.net.

我已经通过网络检查找到了一些建议的程序来获取产品密钥，然后我深入研究了使用 AutoIT 和 VB.net 自己制作程序。

The system I'm testing this program on has Microsoft Business Retail edition installed, and running C:\Program Files(x86)\Microsoft Office\Office15\ cscript ospp.vbshas provided me with two 5-character keys - one for Microsoft Project (BWTM4) and one for Office 2013 (7PYM4). When I run my applications that I've created, I get a key with the BWMT4 key, and the applications from the net (Belarc, SterJo, etc.) return the same key. But again, this is the key for Project and Microsoft Office 2013 installation verifies this with the message : This key is for Microsoft Project 2013.

我正在测试该程序的系统安装了 Microsoft 商业零售版，并且在运行时C:\Program Files(x86)\Microsoft Office\Office15\ cscript ospp.vbs为我提供了两个 5 个字符的键 - 一个用于 Microsoft Project (BWTM4)，另一个用于 Office 2013 (7PYM4)。当我运行我创建的应用程序时，我得到一个带有 BWMT4 密钥的密钥，来自网络的应用程序（Belarc、SterJo 等）返回相同的密钥。但同样，这是 Project 的密钥，Microsoft Office 2013 安装通过消息验证这一点：This key is for Microsoft Project 2013。

My AutoIT code:

我的 AutoIT 代码：

Case "Office 2013 x86"
        $RegKey = 'HKLM\SOFTWARE\Microsoft\Office.0\Registration'
        If @OSArch = 'x64' Then $RegKey = 'HKLM64\SOFTWARE\Wow6432Node\Microsoft\Office.0\Registration'
        For $i = 1 To 1024
            $var = RegEnumKey($RegKey, $i)
            If @error <> 0 Then ExitLoop
            $bKey = RegRead($RegKey & '\' & $var, 'DigitalProductId')
            If Not @error Then ExitLoop
        Next
        $iKeyOffset = 0x328

Case "Office 2013 x64"
        If @OSArch <> 'x64' Then SetError(1, 0, "Product not found")
        $RegKey = 'HKLM64\SOFTWARE\Microsoft\Office.0\Registration'
        For $i = 1 To 1024
            $var = RegEnumKey($RegKey, $i)
            If @error <> 0 Then ExitLoop
            $bKey = RegRead($RegKey & '\' & $var, 'DigitalProductId')
            If Not @error Then ExitLoop
        Next
        $iKeyOffset = 0x328

My VB.net code:This code is based on that from the net, not taking claim to making this

我的 VB.net 代码：此代码基于网络上的代码，不声称是这样做的

        Dim digitalProductId As IList(Of Byte) = Nothing
            If True Then
                Dim registry As RegistryKey = Nothing
                registry = RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Registry64).OpenSubKey("SOFTWARE\Wow6432Node\Microsoft\Office.0\Registration\{90150000-012D-0000-0000-0000000FF1CE}", False)
            If registry IsNot Nothing Then
                digitalProductId = TryCast(registry.GetValue("DigitalProductId"), Byte())
                registry.Close()
            Else
                Return Nothing
            End If
        End If

        Dim keyStartIndex As Integer = 52
        Dim keyEndIndex As Integer = keyStartIndex + 15

Now, is there a different starting index for the Office 2013 key or is it overwritten by Lync 2013's key/Project 2013's key? Or am I going about this the completely wrong way?

现在，Office 2013 键是否有不同的起始索引，还是被 Lync 2013 的键/Project 2013 的键覆盖？还是我以完全错误的方式解决这个问题？

回答by James

The code below displays the Product Key for the Windows OS. But it uses the exact same principle to attain the Office Key. The key is obtained from the Windows Registry. Locate the registry and assign it to the code and it should work fine :)

下面的代码显示了 Windows 操作系统的产品密钥。但是它使用完全相同的原理来获取Office Key。密钥是从 Windows 注册表中获得的。找到注册表并将其分配给代码，它应该可以正常工作:)

Public Function GetProductKey(ByVal KeyPath As String, ByVal ValueName As String) As String

    Dim HexBuf As Object = My.Computer.Registry.GetValue(KeyPath, ValueName, 0)

    If HexBuf Is Nothing Then Return "N/A"

    Dim tmp As String = ""

    For l As Integer = LBound(HexBuf) To UBound(HexBuf)
        tmp = tmp & " " & Hex(HexBuf(l))
    Next

    Dim StartOffset As Integer = 52
    Dim EndOffset As Integer = 67
    Dim Digits(24) As String

    Digits(0) = "B" : Digits(1) = "C" : Digits(2) = "D" : Digits(3) = "F"
    Digits(4) = "G" : Digits(5) = "H" : Digits(6) = "J" : Digits(7) = "K"
    Digits(8) = "M" : Digits(9) = "P" : Digits(10) = "Q" : Digits(11) = "R"
    Digits(12) = "T" : Digits(13) = "V" : Digits(14) = "W" : Digits(15) = "X"
    Digits(16) = "Y" : Digits(17) = "2" : Digits(18) = "3" : Digits(19) = "4"
    Digits(20) = "6" : Digits(21) = "7" : Digits(22) = "8" : Digits(23) = "9"

    Dim dLen As Integer = 29
    Dim sLen As Integer = 15
    Dim HexDigitalPID(15) As String
    Dim Des(30) As String

    Dim tmp2 As String = ""

    For i = StartOffset To EndOffset
        HexDigitalPID(i - StartOffset) = HexBuf(i)
        tmp2 = tmp2 & " " & Hex(HexDigitalPID(i - StartOffset))
    Next

    Dim KEYSTRING As String = ""

    For i As Integer = dLen - 1 To 0 Step -1
        If ((i + 1) Mod 6) = 0 Then
            Des(i) = "-"
            KEYSTRING = KEYSTRING & "-"
        Else
            Dim HN As Integer = 0
            For N As Integer = (sLen - 1) To 0 Step -1
                Dim Value As Integer = ((HN * 2 ^ 8) Or HexDigitalPID(N))
                HexDigitalPID(N) = Value \ 24
                HN = (Value Mod 24)

            Next

            Des(i) = Digits(HN)
            KEYSTRING = KEYSTRING & Digits(HN)
        End If
    Next

    Return StrReverse(KEYSTRING)

End Function

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    Label1.Text = GetProductKey("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\", "DigitalProductId")
End Sub