Scripting Retrieval of Office & Windows Product Keys

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.

If you want to find the keys of newer versions of Office please note this script WILL NOT WORK

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

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

Chris Blackburn

Learn More →

3 thoughts on “Scripting Retrieval of Office & Windows Product Keys

  1. Scarbrow August 23, 2015 at 2:23 pm

    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.

    Reply
  2. Richard December 18, 2020 at 9:15 pm

    Hello! Goodnight!!

    Dear, I liked your Scripts, I am running them and they give me an error.
    I have been looking for a way to obtain the Office license by command line for a long time and I have not found someone who can help me, all attempts have been unsuccessful.

    I appreciate your great help.

    C:\Temp>cscript FindOfficeKey.vbs
    Microsoft (R) Windows Script Host versión 5.812
    Copyright (C) Microsoft Corporation. Reservados todos los derechos.

    C:\Temp\FindOfficeKey.vbs(14, 29) Error de compilación de Microsoft VBScript: Carácter no válido

    C:\Temp>cscript FindWindowsKey.vbs
    Microsoft (R) Windows Script Host versión 5.812
    Copyright (C) Microsoft Corporation. Reservados todos los derechos.

    C:\Temp\FindWindowsKey.vbs(14, 29) Error de compilación de Microsoft VBScript: Carácter no válido
    .
    .

    Thank you!!

    Reply
    1. Chris Blackburn July 6, 2021 at 11:52 am

      If you are using anything besides Office 2003 this will not work, nor will not work with newer ClickToRun versions of Office.

      Reply

Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.

css.php