Scripting Retrieval of Office & Windows Product Keys

By Chris Blackburn

The following scripts will work on Windows 2000 & higher, and only Office 2003 to find the product keys and create a text document with the product name & product key.

Create the following 2 .vbs files to, modifying the lines in bold to point to the shared drive you want to dump the results, and then create a batch files with the following lines:

cscript x:\scripts\windowskey.vbs
cscript x:\scripts\officekey.vbs

Have your login script run this batch file upon login and have your users log off and back on to create the text documents with the product keys.

 

Save this file as office.vbs

Public Function sGetXPCDKey()

Dim bDigitalProductID
Dim bProductKey()
Dim bKeyChars(24)
Dim ilByte
Dim nCur
Dim sCDKey
Dim ilKeyByte
Dim ilBit

ReDim Preserve bProductKey(14)

Set objShell = CreateObject(“WScript.Shell”)

bDigitalProductID = objShell.RegRead(“HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\11.0\Registration\{91110409-6000-11D3-8CFE-0150048383C9}\DigitalProductID”)

Set objShell = Nothing

For ilByte = 52 To 66
bProductKey(ilByte – 52) = bDigitalProductID(ilByte)
Next

‘Possible characters in the CD Key:
bKeyChars(0) = Asc(“B”)
bKeyChars(1) = Asc(“C”)
bKeyChars(2) = Asc(“D”)
bKeyChars(3) = Asc(“F”)
bKeyChars(4) = Asc(“G”)
bKeyChars(5) = Asc(“H”)
bKeyChars(6) = Asc(“J”)
bKeyChars(7) = Asc(“K”)
bKeyChars(8) = Asc(“M”)
bKeyChars(9) = Asc(“P”)
bKeyChars(10) = Asc(“Q”)
bKeyChars(11) = Asc(“R”)
bKeyChars(12) = Asc(“T”)
bKeyChars(13) = Asc(“V”)
bKeyChars(14) = Asc(“W”)
bKeyChars(15) = Asc(“X”)
bKeyChars(16) = Asc(“Y”)
bKeyChars(17) = Asc(“2”)
bKeyChars(18) = Asc(“3”)
bKeyChars(19) = Asc(“4”)
bKeyChars(20) = Asc(“6”)
bKeyChars(21) = Asc(“7”)
bKeyChars(22) = Asc(“8”)
bKeyChars(23) = Asc(“9”)

For ilByte = 24 To 0 Step -1

nCur = 0

For ilKeyByte = 14 To 0 Step -1
‘Step through each byte in the Product Key
nCur = nCur * 256 Xor bProductKey(ilKeyByte)
bProductKey(ilKeyByte) = Int(nCur / 24)
nCur = nCur Mod 24
Next

sCDKey = Chr(bKeyChars(nCur)) & sCDKey
If ilByte Mod 5 = 0 And ilByte <> 0 Then sCDKey = “-” & sCDKey
Next

sGetXPCDKey = sCDKey

End Function

Public Function Question()
Set objFSO = CreateObject(“Scripting.FileSystemObject”)
Dim strUserName
Dim strCompName
Dim objNetwork
Dim sGetOfficePID
Dim sGetOfficePName

Set objShell = CreateObject(“WScript.Shell”)

sGetOfficePID = objShell.RegRead(“HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\11.0\Registration\{91110409-6000-11D3-8CFE-0150048383C9}\ProductID”)

sGetOfficePName = objShell.RegRead(“HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\11.0\Registration\{91110409-6000-11D3-8CFE-0150048383C9}\ProductName”)

Set objNetwork = WScript.CreateObject(“WScript.Network”)

strUserName = objNetwork.UserName
strCompName = objNetwork.ComputerName

Set oOutFile = objFSO.CreateTextFile(“x:\scripts\results\” & strUserName & “.” & strCompName & “-office.txt”)

oOutFile.WriteLine “Licensing for:” & strCompName
oOutFile.WriteLine “”
oOutFile.WriteLine “Office Version”
oOutFile.WriteLine sGetOfficePName
oOutFile.WriteLine “”
oOutFile.WriteLine “Office Product Key”
oOutFile.WriteLine sGetXPCDKey
oOutFile.WriteLine “”
oOutFile.WriteLine “Office Product ID”
oOutFile.WriteLine sGetOfficePID

End Function

call Question

‘———————————-

 

Save this file as windows.vbs

Public Function sGetXPCDKey()

Dim bDigitalProductID
Dim bProductKey()
Dim bKeyChars(24)
Dim ilByte
Dim nCur
Dim sCDKey
Dim ilKeyByte
Dim ilBit

ReDim Preserve bProductKey(14)

Set objShell = CreateObject(“WScript.Shell”)

bDigitalProductID = objShell.RegRead(“HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductID”)

Set objShell = Nothing

For ilByte = 52 To 66
bProductKey(ilByte – 52) = bDigitalProductID(ilByte)
Next

‘Possible characters in the CD Key:
bKeyChars(0) = Asc(“B”)
bKeyChars(1) = Asc(“C”)
bKeyChars(2) = Asc(“D”)
bKeyChars(3) = Asc(“F”)
bKeyChars(4) = Asc(“G”)
bKeyChars(5) = Asc(“H”)
bKeyChars(6) = Asc(“J”)
bKeyChars(7) = Asc(“K”)
bKeyChars(8) = Asc(“M”)
bKeyChars(9) = Asc(“P”)
bKeyChars(10) = Asc(“Q”)
bKeyChars(11) = Asc(“R”)
bKeyChars(12) = Asc(“T”)
bKeyChars(13) = Asc(“V”)
bKeyChars(14) = Asc(“W”)
bKeyChars(15) = Asc(“X”)
bKeyChars(16) = Asc(“Y”)
bKeyChars(17) = Asc(“2”)
bKeyChars(18) = Asc(“3”)
bKeyChars(19) = Asc(“4”)
bKeyChars(20) = Asc(“6”)
bKeyChars(21) = Asc(“7”)
bKeyChars(22) = Asc(“8”)
bKeyChars(23) = Asc(“9”)

For ilByte = 24 To 0 Step -1

nCur = 0

For ilKeyByte = 14 To 0 Step -1
‘Step through each byte in the Product Key
nCur = nCur * 256 Xor bProductKey(ilKeyByte)
bProductKey(ilKeyByte) = Int(nCur / 24)
nCur = nCur Mod 24
Next

sCDKey = Chr(bKeyChars(nCur)) & sCDKey
If ilByte Mod 5 = 0 And ilByte <> 0 Then sCDKey = “-” & sCDKey
Next

sGetXPCDKey = sCDKey

End Function

Public Function Question()
Set objFSO = CreateObject(“Scripting.FileSystemObject”)
Dim strUserName
Dim strCompName
Dim objNetwork
Dim SGetWindowsName
Dim SGetWindowsPID

Set objShell = CreateObject(“WScript.Shell”)

SGetWindowsPID = objShell.RegRead(“HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductID”)

SGetWindowsName = objShell.RegRead(“HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName”)

Set objNetwork = WScript.CreateObject(“WScript.Network”)

strUserName = objNetwork.UserName
strCompName = objNetwork.ComputerName

Set oOutFile = objFSO.CreateTextFile(“x:\scripts\results\” & strUserName & “.” & strCompName & “-windows.txt”)

oOutFile.WriteLine “Licensing for:” & strCompName
oOutFile.WriteLine “”
oOutFile.WriteLine “Windows Version”
oOutFile.WriteLine SGetWindowsName
oOutFile.WriteLine “”
oOutFile.WriteLine “Windows Product Key”
oOutFile.WriteLine sGetXPCDKey
oOutFile.WriteLine “”
oOutFile.WriteLine “Windows Product ID”
oOutFile.WriteLine SGetWindowsPID

End Function

call Question

‘———————————-

1 Comment Leave a comment

  1. Thank you very much!

    I had to tinker with it a little bit, because copy-pasting it kept the typographic kind of quotes, and a few other silly matters that were quickly solved with some find-replace. Also, there are three points in the Office Script where you need to substitute your own GUID, taken from your Registry, and your Office version (in my case, 14.0 for Office 2010).

    Armed with this, I’m going to try for that elusive “Windows 10 Clean Install”. So far, three tools have given me three different serials, all from my machine. Two have already failed. I still have much hope in yours.

Share your thoughts

css.php