GetProductKeys.VBS - Get Windows and Office Product Keys

Post your handy scripts here, or any requests for help in creating a script.
Forum rules
1. Try to give more than you take, when possible.
2. Always wrap code in
Code: Select all
 tags
so it doesn't wrap the lines, and for the one-click select all feature.

GetProductKeys.VBS - Get Windows and Office Product Keys

Postby Nick » Tue Feb 12, 2013 11:43 am

This script, GetProductKeys.VBS, is designed of course to grab the Windows and Office product keys from a local system. It supports Office versions 2002 (XP) - 2013, multiple versions of Office installed on the same system, and is 32bit and 64bit compatible. After keys are retrieved of course you have the option to save them to a text file. Specifically tested on Windows XP with Office 2007 and Windows 8 with Office 2010 and verified accuracy with Nirsoft's Produkey.

Code: Select all
' GetProductKeys.VBS v1.0 by Foolish IT

Const HKEY_LOCAL_MACHINE = &H80000002

WinKey = GetWinKey

OfficeKeys = GetOfficeKey("10.0") & GetOfficeKey("11.0") & GetOfficeKey("12.0") & GetOfficeKey("14.0") & GetOfficeKey("15.0")

If Msgbox(WinKey & vbnewline & vbnewline & OfficeKeys & vbnewline & "Save All Keys to ProductKeys.txt?", vbyesno, "GetProductKeys.VBS by Foolish IT") = vbyes then
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objTextFile = objFSO.CreateTextFile("ProductKeys.txt", True)
    objTextFile.Write WinKey & vbnewline & vbnewline & OfficeKeys
    objTextFile.Close
end if

Function GetOfficeKey(sVer)
    On Error Resume Next
    Dim arrSubKeys
    Set wshShell = WScript.CreateObject( "WScript.Shell" )
    sBit = wshShell.ExpandEnvironmentStrings("%ProgramFiles(x86)%")
    if sBit <> "%ProgramFiles(x86)%" then
   sBit = "Software\wow6432node"
    else
   sBit = "Software"
    end if
    Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    objReg.EnumKey HKEY_LOCAL_MACHINE, sBit & "\Microsoft\Office\" & sVer & "\Registration", arrSubKeys
    Set objReg = Nothing
    if IsNull(arrSubKeys) = False then
        For Each Subkey in arrSubKeys
       if lenb(other) < 1 then other = wshshell.RegRead("HKLM\" & sBit & "\Microsoft\Office\" & sVer & "\Registration\" & SubKey & "\ProductName")
       if ucase(right(SubKey, 7)) = "0FF1CE}" then
                Set wshshell = CreateObject("WScript.Shell")
           key = ConvertToKey(wshshell.RegRead("HKLM\" & sBit & "\Microsoft\Office\" & sVer & "\Registration\" & SubKey & "\DigitalProductID"))
      oem = ucase(mid(wshshell.RegRead("HKLM\" & sBit & "\Microsoft\Office\" & sVer & "\Registration\" & SubKey & "\ProductID"), 7, 3))
        edition = wshshell.RegRead("HKLM\" & sBit & "\Microsoft\Office\" & sVer & "\Registration\" & SubKey & "\ProductName")
      if err.number <> 0 then
          edition = other
                   err.clear
      end if
           Set wshshell = Nothing
            if oem <> "OEM" then oem = "Retail"
           if lenb(final) > 1 then
          final = final & vbnewline & final
             else
               final = edition & " " & oem & ":  " & key
                end if
       end if
        Next
   GetOfficeKey = final & vbnewline
    End If
End Function

Function GetWinKey()
    Set wshshell = CreateObject("WScript.Shell")
    edition = wshshell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName")
    oem = ucase(mid(wshshell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductID"), 7, 3))
    key = GetKey("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId")
    set wshshell = Nothing
    if oem <> "OEM" then oem = "Retail"
    GetWinKey = edition & " " & oem & ":  " & key
End Function

Function GetKey(sReg)
    Set wshshell = CreateObject("WScript.Shell")
    GetKey = ConvertToKey(wshshell.RegRead(sReg))
    Set wshshell = Nothing
End Function

Function ConvertToKey(key)
    Const KeyOffset = 52
    i = 28
    Chars = "BCDFGHJKMPQRTVWXY2346789"
    Do
        Cur = 0
        x = 14
        Do
            Cur = Cur * 256
            Cur = key(x + KeyOffset) + Cur
            key(x + KeyOffset) = (Cur \ 24) And 255
            Cur = Cur Mod 24
            x = x - 1
        Loop While x >= 0
        i = i - 1
        KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
        If (((29 - i) Mod 6) = 0) And (i <> -1) Then
            i = i - 1
            KeyOutput = "-" & KeyOutput
        End If
    Loop While i >= 0
    ConvertToKey = KeyOutput
End Function


Use Select All and paste this code into a plain text file, naming it with a .VBS extension instead of .TXT.
This will also be available for direct download (in .TXT format) via my website here.
Author of d7x and other PC technician's tools. http://www.d7xTech.com

Image
User avatar
Nick
Site Admin
 
Posts: 2784
Joined: Mon Nov 19, 2012 7:54 pm

Re: GetProductKeys.VBS - Get Windows and Office Product Keys

Postby JohnTheComputerGuy » Sat Mar 16, 2013 2:56 pm

Nick,

FYI, something is wrong with this program as far as pulling up MS Office keys. It gives the same key no matter what. Tried it on two separate and different Office 2010 installations and one Office 2013 installation and it gave me the same key for all. And the key did not match any of the real keys.
JohnTheComputerGuy
 
Posts: 9
Joined: Sat Mar 16, 2013 2:48 pm

Re: GetProductKeys.VBS - Get Windows and Office Product Keys

Postby Nick » Sat Mar 16, 2013 9:50 pm

were they volume/preinstall keys on each of the machines you tested? because that's not consistent with my own results.
Author of d7x and other PC technician's tools. http://www.d7xTech.com

Image
User avatar
Nick
Site Admin
 
Posts: 2784
Joined: Mon Nov 19, 2012 7:54 pm

Re: GetProductKeys.VBS - Get Windows and Office Product Keys

Postby JohnTheComputerGuy » Sat Mar 16, 2013 11:09 pm

The Office 2013 was a Technet license/key.

The other two computers were MS Office Home and Business 2010 from an OEM box with CDs.
JohnTheComputerGuy
 
Posts: 9
Joined: Sat Mar 16, 2013 2:48 pm

Re: GetProductKeys.VBS - Get Windows and Office Product Keys

Postby JohnTheComputerGuy » Sun Mar 17, 2013 1:44 am

FYI, this is the key that it is giving for Office:
JohnTheComputerGuy
 
Posts: 9
Joined: Sat Mar 16, 2013 2:48 pm

Re: GetProductKeys.VBS - Get Windows and Office Product Keys

Postby Nick » Sun Mar 17, 2013 10:20 am

are you running a copy/paste of the script above, or did you try downloading it from my website instead?

EDIT: no, I see that now. That's very odd, I'll look into it.
Author of d7x and other PC technician's tools. http://www.d7xTech.com

Image
User avatar
Nick
Site Admin
 
Posts: 2784
Joined: Mon Nov 19, 2012 7:54 pm

Re: GetProductKeys.VBS - Get Windows and Office Product Keys

Postby JohnTheComputerGuy » Sun Mar 17, 2013 4:02 pm

no need to worry about that key, it doesn't work :) I tried it while trying to install a cm's 2nd license for office after running the script on their first machine (for which they conveniently threw away the box with the key on/it after I told them to be sure and keep the key, you know, the typical support customer :) )
JohnTheComputerGuy
 
Posts: 9
Joined: Sat Mar 16, 2013 2:48 pm

Re: GetProductKeys.VBS - Get Windows and Office Product Keys

Postby Nick » Sun Mar 17, 2013 4:03 pm

haha! I actually have a habit of keeping record of my customer's product keys that I know of. My regulars of course (I don't take new business now anyway) so it's not that much to keep track of.
Author of d7x and other PC technician's tools. http://www.d7xTech.com

Image
User avatar
Nick
Site Admin
 
Posts: 2784
Joined: Mon Nov 19, 2012 7:54 pm

Re: GetProductKeys.VBS - Get Windows and Office Product Keys

Postby JohnTheComputerGuy » Sun Mar 17, 2013 4:04 pm

I'm a slow learner no more :)
JohnTheComputerGuy
 
Posts: 9
Joined: Sat Mar 16, 2013 2:48 pm

Re: GetProductKeys.VBS - Get Windows and Office Product Keys

Postby Moder_20 » Wed Nov 05, 2014 8:23 am

Damne me too :D
Moder_20
 
Posts: 3
Joined: Wed Nov 05, 2014 8:22 am

Next

Return to Automation / Scripting / Batch Files