UPDATED 7/19/2007 SEE POSTS BELOW!!! Retrieve Windows Product Key I realise there are many tools out there that will achieve this same task, but a vbs version also has its advantages...
with a few modifications you could for example run this as a logon script to log a copy of all Product keys in use in a domain
Also i just wanted to see if i could do it :)
Basicaly this script retrieves the DigitalProductID from the registry, extracts the actual bytes which relate product Key
and then decodes the base24 binary data to show the key, as you know it.
I can't take credit for figuring out the base24 decoding...( i adapted that from a c++ app)
' ##############################################################
' # #
' # VBScript to find the DigitalProductID for your #
' # Microsoft windows Installation and decode it to #
' # retrieve your windows Product Key #
' # #
' # ----------------------------------------------- #
' # #
' # Created by: Parabellum #
' # #
' ##############################################################
'
' <--------------- Open Registry Key and populate binary data into an array -------------------------->
'
const HKEY_LOCAL_MACHINE = &H80000002
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
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
' <------- add the "-" between the groups of 5 Char -------->
If i Mod 5 = 0 And i <> 0 Then strProductKey = "-" & strProductKey
Next
strFinalKey = strProductKey
'
' <---------- This part of the script displays operating system Information and the license Key --------->
'
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery _
("Select * from Win32_OperatingSystem")
For Each objOperatingSystem in colOperatingSystems
strOS = objOperatingSystem.Caption
strBuild = objOperatingSystem.BuildNumber
strSerial = objOperatingSystem.SerialNumber
strRegistered = objOperatingSystem.RegisteredUser
Next
Set wshShell=CreateObject("wscript.shell")
strPopupMsg = strOS & vbNewLine & vbNewLine
strPopupMsg = strPopupMsg & "Build Number: " & strBuild & vbNewLine
strPopupMsg = strPopupMsg & "PID: " & strSerial & vbNewLine & vbNewLine
strPopupMsg = strPopupMsg & "Registered to: " & strRegistered & vbNewLine & vbNewLine & vbNewLine
strPopupMsg = strPopupMsg & "Your Windows Product Key is:" & vbNewLine & vbNewLine & strFinalKey
strPopupTitle = "Microsoft Windows License Information"
wshShell.Popup strPopupMsg,,strPopupTitle,vbCancelOnly+vbinformation
WScript.Quit
the same Code can also be applied to retrieve other microsoft DigitalProductID's (eg office)
It's just a matter of locating the corresponding registry key..
Here's a script to show an office 2003 key
' ##############################################################
' # #
' # 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
you can use this method to retrieve keys for windows 2000 onwards.. (tested on my Vista machine also..!) and for Office Products later than office XP
any comments or feedback appreciated
<message edited by Parabellum on Thursday, July 19, 2007 7:16 AM>