Programmatically attain Office 2013 Product Key

Question

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).

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.

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.vbs has 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.

My AutoIT code:

Case "Office 2013 x86"
        $RegKey = 'HKLM\SOFTWARE\Microsoft\Office\15.0\Registration'
        If @OSArch = 'x64' Then $RegKey = 'HKLM64\SOFTWARE\Wow6432Node\Microsoft\Office\15.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\15.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

        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\15.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?

Answer 1

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 :)

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