Sometimes, you need to retrieve the Windows Product key just for informational purposes. This is a good piece of source code that is coded by a guy named ‘Parabellum‘. I found it in some forum, where I keep forgetting that.
This script can retrieve the following product keys:
1. Microsoft Windows Product Key
2. Microsoft Office XP
3. Microsoft Office 2003
4. Microsoft Office 2007
5. Microsoft Exchange Product Key
Without further delay, here it is:
' ############################################################## ' # # ' # 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) = "SOFTWAREMicrosoftWindows NTCurrentVersion" arrSubKeys(2,0) = "Microsoft Office XP" arrSubKeys(2,1) = "SOFTWAREMicrosoftOffice10.0Registration" arrSubKeys(1,0) = "Microsoft Office 2003" arrSubKeys(1,1) = "SOFTWAREMicrosoftOffice11.0Registration" arrSubKeys(3,0) = "Microsoft Office 2007" arrSubKeys(3,1) = "SOFTWAREMicrosoftOffice12.0Registration" arrSubKeys(4,0) = "Microsoft Exchange Product Key" arrSubKeys(4,1) = "SOFTWAREMicrosoftExchangeSetup" ' <--------------- Open Registry Key and populate binary data into an array --------------------------> strComputer = "." Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\" & strComputer & "rootdefault: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") ' <--------------- 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 strKey = UBound(foundKeys) MsgBox strProduct & vbNewLine & vbNewLine & foundKeys(strKey) End FunctionSearches leading to this post:
digitalproductid decoder linux, productkey office getbinaryvalue, scriptable way to grab product keys, vbs retrieve office product key, vbscript get windows product key, vbscript office 2010 key decode
Comments on this entry are closed.