Office product number retrieval

[Alex]

Hi.
I want to use a Serial number protection in my own Office Addin and I want
to generate this SN depending on MS Office Product Number.

Is there a way to retrieve MS Office product number programmaticaly?
Or maybe some kind of MS Office unique instance identifier?

Thanks.

 

[DB]

Here's some vbs that should point you in the right direction .. works for
office 2003

Sub Test()
' ##############################################################
' # #
' # VBScript to find the DigitalProductID for your #
' # Microsoft Office 2003 Installation and decode #
' # it to retrieve your Product Key #
' # #
' # ----------------------------------------------- #
' # #
' # Created by: Parabellum #
' # #
' ##############################################################
'
' <--------------- Open Registry Key and populate binary data into an
array -------------------------->
'
Const HKEY_LOCAL_MACHINE = &H80000002
strKeyPath =
"SOFTWARE\Microsoft\Office\11.0\Registration\{90110409-6000-11D3-8CFE-0150048383C9}"
strValueName = "DigitalProductId"
strComputer = "."
Dim iValues()
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
oReg.GetBinaryValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, iValues
Dim arrDPID
arrDPID = Array()
For i = 52 To 66
ReDim Preserve arrDPID(UBound(arrDPID) + 1)
arrDPID(UBound(arrDPID)) = iValues(i)
Next
' <--------------- Create an array to hold the valid characters for a
microsoft Product Key -------------------------->
Dim arrChars
arrChars = Array("B", "C", "D", "F", "G", "H", "J", "K", "M", "P", "Q",
"R", "T", "V", "W", "X", "Y", "2", "3", "4", "6", "7", "8", "9")

' <--------------- The clever bit !!! (Decrypt the base24 encoded binary
data) -------------------------->
For i = 24 To 0 Step -1
k = 0
For j = 14 To 0 Step -1
k = k * 256 Xor arrDPID(j)
arrDPID(j) = Int(k / 24)
k = k Mod 24
Next
strProductKey = arrChars(k) & strProductKey
If i Mod 5 = 0 And i <> 0 Then strProductKey = "-" & strProductKey
Next
strFinalKey = strProductKey
'
' <--------------- This part of the script displays a completed/summary
message ----------------->
'
Set wshShell = CreateObject("wscript.shell")
strPopupMsg = "Your Microsoft Office 2003 Product Key is:" & vbNewLine &
vbNewLine & strFinalKey
strPopupTitle = "Product Key"
wshShell.Popup strPopupMsg, , strPopupTitle, vbCancelOnly + vbInformation
' WScript.Quit

End Sub