Retrieve Windows Product Key

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Retrieve Windows Product Key

Logged in as: Guest

arrSession:exec spGetSession 2,16,42793

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Retrieve Windows Product Key
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1] 2 next > >>

Message

<< Older Topic Newer Topic >>

Retrieve Windows Product Key - 2/1/2007 9:28:53 AM

Parabellum

Posts: 222
Score: 0
Joined: 11/12/2006
From: UK
Status: offline

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")

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 -- 7/19/2007 6:16:01 AM >

Revisions: 1 | Post #: 1

RE: Retrieve Windows Product Key - 2/1/2007 2:17:06 PM

dm_4ever

Posts: 2254
Score: 32
Joined: 6/29/2006
From: Orange County, California
Status: offline

Very neat and actually since you're using WMI to read HKLM, you could retrieve the information remotely without having to include it in a login script.

_____________________________

dm_4ever

My philosophy: K.I.S.S - Keep It Simple Stupid
Read Me: http://www.visualbasicscript.com/m_24727/tm.htm
Frequently Asked Stuff: http://www.visualbasicscript.com/m_47117/tm.htm

(in reply to Parabellum)

Post #: 2

RE: Retrieve Windows Product Key - 2/4/2007 12:00:50 PM

Parabellum

Posts: 222
Score: 0
Joined: 11/12/2006
From: UK
Status: offline

I modified the above code to make it a little more useful and user friendly,

It now detects multiple Microsoft Products.
It reads the Registry paths and Product name from an array which can be easily updated with other Microsoft Products
It also now searches that path for the installation GUID (which varies from different versions of office such as oem vlk etc.)

enjoy...

any comments or improvment suggestions appreciated

'  ##############################################################
'  #        #
'  # VBScript to retrieve Microsoft Product Keys  #
'  # from the registry by decoding DigitalProductID's #
'  #        #
'  # -------------------------------------------------- #
'  # Created by: Parabellum     #
'  #        #
'  ##############################################################
'
CONST HKEY_LOCAL_MACHINE = &H80000002
CONST SEARCH_KEY = "DigitalProductID"
Dim arrSubKeys(4,1)
Dim foundKeys
Dim iValues, arrDPID
foundKeys = Array()
iValues = Array()
arrSubKeys(0,0) = "Microsoft Windows Product Key"
arrSubKeys(0,1) = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
arrSubKeys(2,0) = "Microsoft Office XP"
arrSubKeys(2,1) = "SOFTWARE\Microsoft\Office\10.0\Registration"
arrSubKeys(1,0) = "Microsoft Office 2003"
arrSubKeys(1,1) = "SOFTWARE\Microsoft\Office\11.0\Registration"
arrSubKeys(3,0) = "Microsoft Office 2007"
arrSubKeys(3,1) = "SOFTWARE\Microsoft\Office\12.0\Registration"
arrSubKeys(4,0) = "Microsoft Exchange Product Key"
arrSubKeys(4,1) = "SOFTWARE\Microsoft\Exchange\Setup"

' <--------------- Open Registry Key and populate binary data into an array -------------------------->
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")

For x = LBound(arrSubKeys, 1) To UBound(arrSubKeys, 1)
oReg.GetBinaryValue HKEY_LOCAL_MACHINE, arrSubKeys(x,1), SEARCH_KEY, arrDPIDBytes
If Not IsNull(arrDPIDBytes) Then
 call decodeKey(arrDPIDBytes, arrSubKeys(x,0))
Else
 oReg.EnumKey HKEY_LOCAL_MACHINE, arrSubKeys(x,1), arrGUIDKeys
 If Not IsNull(arrGUIDKeys) Then
  For Each GUIDKey In arrGUIDKeys
   oReg.GetBinaryValue HKEY_LOCAL_MACHINE, arrSubKeys(x,1) & "\" & GUIDKey, SEARCH_KEY, arrDPIDBytes
   If Not IsNull(arrDPIDBytes) Then
    call decodeKey(arrDPIDBytes, arrSubKeys(x,0))
   End If
  Next
 End If
End If
Next
MsgBox("Finished")

' <----------------------------------------- Return the Product Key --------------------------------------------------->
Function decodeKey(iValues, strProduct)

Dim arrDPID
arrDPID = Array()

' <--------------- extract bytes 52-66 of the DPID -------------------------->
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")

ReDim Preserve foundKeys( UBound(foundKeys) + 1 )
foundKeys( UBound(foundKeys) ) = strProductKey
strKey = UBound(foundKeys)
MsgBox strProduct & vbNewLine & vbNewLine & foundKeys(strKey)
End Function

(in reply to dm_4ever)

Post #: 3

RE: Retrieve Windows Product Key - 2/5/2007 9:30:59 AM

Parabellum

Posts: 222
Score: 0
Joined: 11/12/2006
From: UK
Status: offline

and finally... an HTA version

<html>
<head>
<title>Microsoft Product Key Retrieval</title>
<hta:application
applicationname="MSKeyRetrieval" 
caption="MSKeyRetrieval"
contextmenu="no"
maximizebutton="no"
minimizebutton="yes"
navigable="yes"
showintaskbar="yes"
singleinstance="yes"
sysmenu="yes"
>
</head>
<script language="VBScript">
Const HKEY_LOCAL_MACHINE = &H80000002
Const SEARCH_KEY = "DigitalProductID"
Dim foundKeys
Dim iValues
Dim arrDPID
Dim strHTML
Dim arrSubKeys(4,1)
foundKeys = Array()
iValues = Array()
arrSubKeys(0,0) = "Microsoft Windows"
arrSubKeys(0,1) = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
arrSubKeys(2,0) = "Microsoft Office XP"
arrSubKeys(2,1) = "SOFTWARE\Microsoft\Office\10.0\Registration"
arrSubKeys(1,0) = "Microsoft Office 2003"
arrSubKeys(1,1) = "SOFTWARE\Microsoft\Office\11.0\Registration"
arrSubKeys(3,0) = "Microsoft Office 2007"
arrSubKeys(3,1) = "SOFTWARE\Microsoft\Office\12.0\Registration"
arrSubKeys(4,0) = "Microsoft Exchange Product Key"
arrSubKeys(4,1) = "SOFTWARE\Microsoft\Exchange\Setup"
Sub window_onload
' <--------------- Set window Size --------------->
       strComputer = "."
       Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
       Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
       For Each objItem in colItems
           intHorizontal = objItem.ScreenWidth
           intVertical = objItem.ScreenHeight
       Next
       intLeft = (intHorizontal - 500) / 2
       intTop = (intVertical - 600) / 2
       window.resizeTo 500,600
       window.moveTo intLeft, intTop
 
' <--------------- Open Registry Key and populate binary data into an array -------------------------->
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
For x = LBound(arrSubKeys, 1) To UBound(arrSubKeys, 1)
 oReg.GetBinaryValue HKEY_LOCAL_MACHINE, arrSubKeys(x,1), SEARCH_KEY, arrDPIDBytes
 If Not IsNull(arrDPIDBytes) Then
  call decodeKey(arrDPIDBytes, arrSubKeys(x,0))
 Else
  oReg.EnumKey HKEY_LOCAL_MACHINE, arrSubKeys(x,1), arrGUIDKeys
  If Not IsNull(arrGUIDKeys) Then
   For Each GUIDKey In arrGUIDKeys
    oReg.GetBinaryValue HKEY_LOCAL_MACHINE, arrSubKeys(x,1) & "\" & GUIDKey, SEARCH_KEY, arrDPIDBytes
    If Not IsNull(arrDPIDBytes) Then
     call decodeKey(arrDPIDBytes, arrSubKeys(x,0))
    End If
   Next
  End If
 End If
Next
If IsNull(foundkeys) Then
 DataArea.InnerHTML = "No Keys Found" 
Else
 DataArea.InnerHTML = strHTML
End If 
End Sub
' <----------------------- Return the Product Key ------------------------>
Function decodeKey(iValues, strProduct)
Dim arrDPID
arrDPID = Array()

' <--------------- extract bytes 52-66 of the DPID -------------------------->
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 !!! (decode 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
ReDim Preserve foundKeys( UBound(foundKeys) + 1 )
foundKeys( UBound(foundKeys) ) = strProductKey
If strProduct = "Microsoft Windows" Then
 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
 Next
 strHTML = strHTML & "<h3>" & strOS & "</h3>" & _
   "<h4>" & strProductKey & "</h4><br /><hr /><br />"
Else
 strHTML = strHTML & "<h3>" & strProduct & "</h3>" & _
   "<h4>" & strProductKey & "</h4><br /><hr /><br />"
End If
End Function

</script>
<body>
<div id="header" style="color:#ffffff; height:100px; text-align:center; font-family:Tahoma;
 filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#0011aa', EndColorStr='#ffffff')">
 <br /><h2>Retrieved Microsoft Product Keys</h2>
</div><hr />
<span id="DataArea"></span>
<br />
<div id="Print" style="text-align:center;"><input type="button" value="Print" Onclick="print()" ;></div>
</body>
</html>

(in reply to Parabellum)

Post #: 4

RE: Retrieve Windows Product Key - 2/10/2007 12:13:23 AM

est

Posts: 39
Score: 0
Joined: 10/12/2006
Status: offline

It's great! It worked on my Vista RC2, but not my Office 2007 :( Maybe the registry key path is changed.

_____________________________

Do NOT program in a programmer's way

(in reply to Parabellum)

Post #: 5

RE: Retrieve Windows Product Key - 2/10/2007 3:48:04 PM

arnabvb

Posts: 1
Score: 0
Joined: 2/10/2007
Status: offline

I've seen that there is a key called 'Product Key' in Registry which contain only numbers and 24 long. Is there any relation between this pruct id and my original key???? Help plezzz....

(in reply to Parabellum)

Post #: 6

RE: Retrieve Windows Product Key - 2/11/2007 5:18:20 AM

Parabellum

Posts: 222
Score: 0
Joined: 11/12/2006
From: UK
Status: offline

est: are you using the HTA version, in my third post?? becuase i've tested that on a machine with office 2007 (full not beta) and that worked fine??
you could check if the key exists manualy.... should be in

HKLM>SOFTWARE>MICROSOFT>OFFICE>12>{GUID}>"DigitalProductID"

arnabvb: where was this key located? There will be many references to a key called "ProductID" this is Relates to your Product Installation ID that is displayed under you sytem properties..
This value is generated from a number of details, including... the Machine hardware, type of disc used for instalation.. and the Product key used.
I couldn't find a key call Product Key on my machine.
I know windows 98 used to store the Product key directly in the regitry using a key called "Product Key", are you using win98, or was your PC upgraded from windows 98? (This script doesn't run on windows 98)

if you post the key value, i can check into it...

It is also possible to retrieve a key from aniother PC that wont boot, by copying the DAT Files for the registry from the harddrive, and loading them into a live registry.
I will post instructions and a script to do this as soon as i get chance.

(in reply to arnabvb)

Post #: 7

RE: Retrieve Windows Product Key - 2/23/2007 2:56:32 AM

gormly

Posts: 1
Score: 0
Joined: 2/23/2007
Status: offline

wow this is fantastic and just what I was looking for ..

Except, I need some help with this in .net

I am new to visual basic.net
It will not let me use the arrays, I have tried just about everything I can think of, I have most of it converted correctly except the array parts.
can anyone convert this to VB.net please?

(in reply to Parabellum)

Post #: 8

RE: Retrieve Windows Product Key - 2/23/2007 8:07:20 AM

Parabellum

Posts: 222
Score: 0
Joined: 11/12/2006
From: UK
Status: offline

sorry... my .net experience goes at about as far as ASP and databases... out of my league... any reason for converting to .net...??
I might be able to help in some other way

(in reply to gormly)

Post #: 9

RE: Retrieve Windows Product Key - 3/2/2007 12:10:23 PM

bushmaoribob

Posts: 5
Score: 0
Joined: 3/1/2007
Status: offline

Great script Parabellum

Your first Script posted on this article is Great, (just how to find the Windows Product key)

Do you know how to save the Output to a text file, or make a option to save in the output box?

Also do you know how to make the script run "behind the scences" and just save to a text file?

If you know please reply, thanks for your help

(in reply to Parabellum)

Post #: 10

RE: Retrieve Windows Product Key - 3/2/2007 1:01:46 PM

bushmaoribob

Posts: 5
Score: 0
Joined: 3/1/2007
Status: offline

Haha i forgot something,

Also you say you know how to Modify the script to find all product keys in a domain??

Can you possibly release a Script that can do that?, will it list the ip's and the Productkeys relating to it?????

And Can you Possibly release a script that can save the Output to a text file, or make a option to save in the output box? or make the script run "behind the scences" and just save to a text file???

Thanks Heapss

(in reply to bushmaoribob)

Post #: 11

RE: Retrieve Windows Product Key - 3/2/2007 1:38:15 PM

bushmaoribob

Posts: 5
Score: 0
Joined: 3/1/2007
Status: offline

Haha i allways forget something,

Also...Could you make a script in association to the script that can find windows and office product keys, with an option to close at a first message before it shows any of your keys, for example:

USE AT OWN RISK

OK CLOSE NOW

the ok and close now in dialog boxes, the ok to continue and find the keys and the close now to exit the vbs and not run it.

And with an option to save the uppcumming keys to a Text file (Example: Keys.txt on Desktop c:\Desktop\Keys.txt)

Thanks

< Message edited by bushmaoribob -- 3/2/2007 1:42:38 PM >

(in reply to bushmaoribob)

Revisions: 2 | Post #: 12

RE: Retrieve Windows Product Key - 3/6/2007 11:12:50 AM

Parabellum

Posts: 222
Score: 0
Joined: 11/12/2006
From: UK
Status: offline

bushmaoribob: Yes everything you asked for is possible at the moment though i'm very busy.. and hardly getting time to sort my own scripts..
Do you know any vbs??? if so have you tried making any of the changes yourself.. I would be happy to try and advise (when i get chance!)

(in reply to bushmaoribob)

Post #: 13

RE: Retrieve Windows Product Key - 3/6/2007 3:15:48 PM

bushmaoribob

Posts: 5
Score: 0
Joined: 3/1/2007
Status: offline

Ohkk lolz, well if you get the time to make the changes it wold be great, just post them on the fourm

Im only starting to get into vbs so im just learning so i will try tio make these changes myself when i learn more, lol

Thanks heapszz,

(in reply to Parabellum)

Post #: 14

RE: Retrieve Windows Product Key - 7/19/2007 6:13:02 AM

Parabellum

Posts: 222
Score: 0
Joined: 11/12/2006
From: UK
Status: offline

thought i'd post some amedments i made to this script...
The new version will find on license info for all computer on domain by retrieving computers from AD, check whether they are alive and switched on, and if so use WMI to retrieve license information, then write the results to an xml file..

might be useful to somebody

'  ##########################################
'  #            #
'  #  VBScript to Retrieve a List of Computers from Active  #
'  #  Directory, check connectivity and generate a report file #
'  #  containing Microsoft Windows Licensing Information.  #
'  #            #
'  ##########################################
'
Dim objDomain, strComputer, strADComputer, PC, strKeyPath, strValueName, oReg
Dim ADCompList, ActiveCompList, RetrievedKeys
Dim IE, oFSO, objShell, strPath, objFile
Set IE = CreateObject("InternetExplorer.Application")
Set objShell = CreateObject("Wscript.Shell")
strPath = Wscript.ScriptFullName
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.GetFile(strPath)
strPath = objFSO.GetParentFolderName(objFile) 
With IE
.left=200
.top=200
.height=140
.width=250
.menubar=0
.toolbar=0
.statusBar=0
.navigate "About:Blank"
.visible=1
End With
'wait a while until IE as finished to load
Do while IE.busy
loop
With IE.document
.Open
.WriteLn "<html>"
.WriteLn "<head>"
.WriteLn "<HTA:APPLICATION "
.WriteLn "     ID='objNoTitleBar'"
.WriteLn "     CAPTION=no"
.WriteLn "     SHOWINTASKBAR='NO'"
.WriteLn "     BORDER='NONE'"
.WriteLn "     APPLICATIONNAME='Please Wait'"
.WriteLn "     SCROLL='AUTO'"
.WriteLn "     SINGLEINSTANCE='yes'"
.WriteLn ">"
.WriteLn "</head>"
.WriteLn "<body text='#ffffff' bgcolor='#000000'>"
.WriteLn "<center>Please Wait....<br /><br />"
.WriteLn "<img src='" & strPath & "\ajax-loader.gif' /></center>"
.WriteLn "</body>"
.WriteLn "</html>"
.Close
End With
ADCompList = Array(0)
' Connect to root of domain
Dim rootDSE, domainContainer
Set rootDSE = GetObject("[link=http://www.visualbasicscript.com/ldap://RootDSE]LDAP://RootDSE[/link]")
domainContainer = rootDSE.Get("defaultNamingContext")
Set ObjDomain = GetObject("LDAP://" & domainContainer)
' Enumerate through the domain
WorkWithObject(ObjDomain)
Sub WorkWithObject(oContainer)
Dim oADObject
For Each oADObject in oContainer
Select Case oADObject.Class
Case "computer"
 Dim strADComputer
 strADComputer = oADObject.cn
 ADCompList(UBound(ADCompList)) = strADComputer
 ReDim Preserve ADCompList(UBound(ADCompList) + 1)
Case "organizationalUnit" , "container"
 WorkWithObject(oADObject)
End Select
Next
End Sub
ReDim Preserve ADCompList(UBound(ADCompList) - 1)
ActiveCompList = Array(0)
For Each PC In ADCompList
If Reachable(PC) Then
ActiveCompList(UBound(ActiveCompList)) = PC
ReDim Preserve ActiveCompList(UBound(ActiveCompList) + 1)
End If
Next
ReDim Preserve ActiveCompList(UBound(ActiveCompList) - 1)
Set objXMLDoc = CreateObject("Microsoft.XMLDOM") 
Set rootEl = objXMLDoc.createElement("Computers")
objXMLDoc.appendChild rootEl
Dim objCurrNode, objNewNode, objNewText 
' <--------------- Open Registry Key and populate binary data into an array -------------------------->
const HKEY_LOCAL_MACHINE = &H80000002 
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
strValueName = "DigitalProductId"
Dim iValues()
On Error Resume Next
For Each strComputer In ActiveCompList

Set objPCField = objXMLDoc.createElement("PC")
rootEl.appendChild(objPCField)

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)-------------------------->
strProductKey = ""
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

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 objNewNode = objXMLDoc.createElement("Name") 
Set objNewText = objXMLDoc.createTextNode(strComputer) 
objPCField.appendChild(objNewNode) 
objNewNode.appendChild(objNewText) 
Set objNewNode = objXMLDoc.createElement("OS") 
Set objNewText = objXMLDoc.createTextNode(strOS) 
objPCField.appendChild(objNewNode) 
objNewNode.appendChild(objNewText)

Set objNewNode = objXMLDoc.createElement("Build") 
Set objNewText = objXMLDoc.createTextNode(strBuild) 
objPCField.appendChild(objNewNode) 
objNewNode.appendChild(objNewText)

Set objNewNode = objXMLDoc.createElement("PID") 
Set objNewText = objXMLDoc.createTextNode(strSerial) 
objPCField.appendChild(objNewNode) 
objNewNode.appendChild(objNewText) 
Set objNewNode = objXMLDoc.createElement("RegisteredTo") 
Set objNewText = objXMLDoc.createTextNode(strRegistered) 
objPCField.appendChild(objNewNode) 
objNewNode.appendChild(objNewText) 
Set objNewNode = objXMLDoc.createElement("Key") 
Set objNewText = objXMLDoc.createTextNode(strFinalKey) 
objPCField.appendChild(objNewNode) 
objNewNode.appendChild(objNewText) 
Next
'Add an XML processing instruction and insert it before the root element
Set p=objXMLDoc.createProcessingInstruction("xml","version='1.0'")
xmlDoc.insertBefore p,objXMLDoc.childNodes(0)
objXMLDoc.Save("report.xml")
IE.Quit
set IE = Nothing
MsgBox("Finished")

' <----------------------- Function to check if computer is switched on and responding to Ping ---------------------->
Function Reachable(strComputer)
' On Error Resume Next
Dim wmiQuery, objWMIService, objPing, objStatus
wmiQuery = "Select * From Win32_PingStatus Where Address = '" & strComputer & "'"
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set objPing = objWMIService.ExecQuery(wmiQuery)

For Each objStatus in objPing
If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then
Reachable = False 'if computer is unreacable, return false
Else
Reachable = True 'if computer is reachable, return true
End If
Next
End Function

I've attached the animated gif i used if anyone needs it!!

Attachment (1)

< Message edited by Parabellum -- 7/19/2007 6:18:55 AM >

(in reply to bushmaoribob)

Revisions: 2 | Post #: 15

RE: Retrieve Windows Product Key - 7/19/2007 12:43:20 PM

dm_4ever

Posts: 2254
Score: 32
Joined: 6/29/2006
From: Orange County, California
Status: offline

Nice update...

(in reply to Parabellum)

Post #: 16

RE: Retrieve Windows Product Key - 11/23/2007 1:39:38 PM

abenitez77

Posts: 5
Score: 0
Joined: 10/8/2007
Status: offline

Nice Code!

How can I Do this with computers in ONLY 3 specific OU's ("MAN01", "YOR01", "STL01") ?

(in reply to Parabellum)

Post #: 17

RE: Retrieve Windows Product Key - 12/12/2007 4:42:31 AM

dedwards2

Posts: 5
Score: 0
Joined: 12/12/2007
Status: offline

Howdy,

I need to pull the product IDs from every computer on my domain, and the script you posted on 7/19 sounds like it does exactly that - execpt it's not working for me!

Here's what I've done:

I copied and pasted your code to a file and saved it as get_product_id.vbs.

I double-clicked the file.

I get an invalid syntax error on line 56, this line:

This looks like some kind of forum post code gone haywire, putting those link tags in. I poked around the internet looking at other scripts that use rootDSE, and I change that line to:

Now the script runs, but it doesn't produce any results. A window opens and says Please Wait..., and I see wscript.exe running, but after ~20 minutes, no results appear in the window.

Any idea what I'm doing wrong? Should I be waiting longer?

< Message edited by dedwards2 -- 12/12/2007 4:47:32 AM >

(in reply to Parabellum)

Revisions: 2 | Post #: 18

RE: Retrieve Windows Product Key - 12/12/2007 4:55:52 AM

ebgreen

Posts: 4613
Score: 31
Joined: 7/12/2005
Status: offline

Please post the contents of get_product_id.vbs and the contents of your script file.

_____________________________

"... when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick
Goog places to start:http://www.visualbasicscript.com/m_24727/tm.htm
http://www.visualbasicscript.com/m_47117/tm.htm

(in reply to dedwards2)

Post #: 19

RE: Retrieve Windows Product Key - 12/12/2007 11:02:01 AM