Get Key

[Ozzyguy]

{10140000-0011-0000-1000-0000000FF1CE}

@GunSmokingMan

Neat little app you got goin there mate.

Im just curious.

The Office 2010 subkey of \Registration seems to be different on each PC its installed on.

The only way i could get this to return a key, was to export my Key branch....edit it with your branch number i started with above....and import the reg back in.

It did return an Office 2010 key, tho it was the wrong one.

I have a mate who is building an app in delphi and found your post while researching it for him.

We have every other Windows and office key being displayed, but were stuck on Office 2010.

Is the decryption method different from other versions ? StartOffset, EndOffset etc ?

If it is, would you mind posting the changes for me? As he can enumerate the subkey branches, but no matter what, the codes are always wrong.

Thanks in advance mate.

Edited March 14, 2010 by Ozzyguy

[gunsmokingman]

Cluberti provided the Reg Key paths from this VBS Script, I just used the Reg Key Path

in my app.

[03GrandAmGT]

Thanks GSM, neat little tool.

jd

[Ozzyguy]

Cluberti provided the Reg Key paths from this VBS Script, I just used the Reg Key Path

in my app.

Thanks for the reply Gunsmokingman.

I suppose i should post the code snip im using. (Delphi)

If i use the Windows NT location to extract the Windows key, it works fine.

Substituting Office 2010 location returns an error "Error reading registry key"

Im lost lol.

I thought either the start and finish offsets had changed for Office 2010, or, the algorithm itself has changed.

If anyone with delphi knowledge would mind checking it out, id be most happy.

Thanks in advance.

ProductKey.txt

[Glenn9999]

Substituting Office 2010 location returns an error "Error reading registry key"

If anyone with delphi knowledge would mind checking it out, id be most happy.

I don't have Office 2010, so I don't have a way to test (but I would love to, I would like a good implementation of this in Delphi I know works). But I can look at the code and see what I see.

It appears from the script posted by Cluberti that you need to iterate through all the keys on the main path and then check the key from there. It appears you're just taking a full path and going straight into checking for the value itself, and not checking the branch for existence. Duplicate what is happening here and you should have better results.

Dim strKey, subkey, arrSubkeys2, strOfficeKey, strValue

strKey = "SOFTWARE\Microsoft\Office\14.0\Registration"

ScriptHelper.Registry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubkeys2

If IsNull(arrSubkeys2) Then

'Office 2010 not installed, skip it

arrSubKeys(4,1) = ""

Else

For Each subkey In arrSubkeys2

ScriptHelper.Registry.GetBinaryValue HKEY_LOCAL_MACHINE, strKey & "\" & subkey, SEARCH_KEY, strValue

If IsNull(strValue) Then

strOfficeKey = ""

Else

strOfficeKey = strKey & "\" & subkey

arrSubKeys(4,1) = strOfficeKey

End If

Next

End If

[Ozzyguy]

Substituting Office 2010 location returns an error "Error reading registry key"

If anyone with delphi knowledge would mind checking it out, id be most happy.

I don't have Office 2010, so I don't have a way to test (but I would love to, I would like a good implementation of this in Delphi I know works). But I can look at the code and see what I see.

It appears from the script posted by Cluberti that you need to iterate through all the keys on the main path and then check the key from there. It appears you're just taking a full path and going straight into checking for the value itself, and not checking the branch for existence. Duplicate what is happening here and you should have better results.

Dim strKey, subkey, arrSubkeys2, strOfficeKey, strValue

strKey = "SOFTWARE\Microsoft\Office\14.0\Registration"

ScriptHelper.Registry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubkeys2

If IsNull(arrSubkeys2) Then

'Office 2010 not installed, skip it

arrSubKeys(4,1) = ""

Else

For Each subkey In arrSubkeys2

ScriptHelper.Registry.GetBinaryValue HKEY_LOCAL_MACHINE, strKey & "\" & subkey, SEARCH_KEY, strValue

If IsNull(strValue) Then

strOfficeKey = ""

Else

strOfficeKey = strKey & "\" & subkey

arrSubKeys(4,1) = strOfficeKey

End If

Next

End If

Thanks for your reply mate.

Yes im using my sub key branch at the moment just to test.

But, the algorithm either just doesnt work Office 2010 , or the location of the key has changed, ie the start offset (34H) and 15 byte length, which would return the Key read error.

My mate is the real programmer here, im just searching for some info on the 2010 DigitalProductID, as we have tried everything, and cant get the key to be displayed.

Every other Windows build, and office version is catered for, except this one.

2010 has us stumped at present.

[gunsmokingman]

This is how I do it in Vb.net

    '-> Reg Key Varible    Dim RegKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\"

    Dim MsKeys() As String = { _    "  Operating System Key  " & ARW & RegKey & "Windows NT\CurrentVersion", _    "  Office 14 2010 Key    " & ARW & RegKey & "Office\14.0\Registration\{10140000-0011-0000-1000-0000000FF1CE}", _    "  Office 12 2007 Key    " & ARW & RegKey & "Office\12.0\Registration", _    "  Office 11 2003 Key    " & ARW & RegKey & "Office\11.0\Registration", _    "  Office 10 XP Key      " & ARW & RegKey & "Office\10.0\Registration"}

    '-> Varible Used To Collect Various Microsoft Product Keys    Dim TxtVar1    Private Sub ListMSKeys()        For Each K In MsKeys            Dim Z1 = Split(K, ARW)            Dim A1 = Z1(1) & DigProID            Try                GetKey(Act.RegRead(A1))                TxtVar1 = TxtVar1 & Z1(0) & ARW & GetKey(Act.RegRead(A1)) & vbCrLf            Catch ex As Exception            End Try        Next        TextBox1.Text = TextBox1.Text & Lne & vB & TxtVar1    End Sub

[CoffeeFiend]

It appears from the script posted by Cluberti that you need to iterate through all the keys on the main path and then check the key from there

That's not a MS Office 2010-specific thing. Even for older versions of Office (including 2003 and 2007) you must do this, as the path (GUID) changes with the language, SKU, service pack, etc. There's just no way around enumerating the subkeys (at least, to properly do it). And it's not uncommon that there are more than one subkey containing a DigitalProductID as well (e.g. for visio or the visual studio web authoring component).

And don't forget that with x64 versions of Windows, you also have to take into account reading from Wow6432Node or not (using KEY_WOW64_64KEY in your RegOpenKeyEx call; obviously you must check for a x64 OS first), especially since there is now a x64 version of Office 2010 which writes outside of it.

Also, I believe versions of MS Office activated using MAK keys (or was it KMS?) don't store keys that way (you'll just read something invalid). I haven't tested this very much though.

MS Office 2010 apps (and a few others) indeed use a new type of DigitalProductID4 which is a little bit different. I figured I'd finally share some of the infos (although it's still subject to change until it RTMs): to decode those, you have to change your offset from 52 to 0x328 (obviously you need a bigger buffer to hold the new larger DigitalProductId) and then decode it the old way. Getting the "edition" of the suite can be tricky (I don't use the registry for this) as ProductName isn't always there.

Sorry, I'm not sharing my code It's not Delphi or VB either ways.

[Ozzyguy]

Thanks for the heads up on the offset info, thats what i was looking for mate, and, in fact all ill need. Excellent.

Yes, we have all other Os'es and platforms covered. The offset info was what had us beat ill say mate.

Will try that out in my existing code, and report back....again...Many thanks...

[Ozzyguy]

@ CoffeeFiend.

Mate, our lil app now works like a charm, due to the proper offset being used. Fantastic.

We have been able to determine the byte size of the new key, and display it correctly.

Do ya have any idea where MAK keys are stored ? I know you said you havent researched it much, but would be nice to be able to detect their presence also.

Anyways mate, thanks heaps for the assistance.

[markdmac]

I found this forum while trying to resolve an issue with my own VBScript that uses the same GetKey function listed in the source code of this tool. I have found that this function does not work on x64 systems. In fact you can't use VBScript to read the DigitalProductID on an x64 system.

I switched to using WMI to get the OS.SerialNumber and that works great, however when I pass this information on to the function it errors out. I am wondering if anyone knows why that would be the case. The function works fine on x86 systems and I don't understand why the conversion would no longer work.

In testing the above tool I have found it too does not display the original CD Key as reported. Anyone have any ideas?

Here is my vbscript:

'==========================================================================
' NAME: GetCDKeyandSerialNumber.vbs
'==========================================================================
Set WshShell = CreateObject("wscript.Shell")
Set env = WshShell.environment("Process")
strComputer = env.Item("Computername")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)
For Each objItem in colItems
    report = report &  "Original CD Key:"& GetKey(objItem.SerialNumber) & vbCrLf
    report = report &  "SerialNumber: " & objItem.SerialNumber & vbCrLf
Next
MsgBox report
Function GetKey(rpk)
	Const rpkOffset=52:i=28
	szPossibleChars="BCDFGHJKMPQRTVWXY2346789"

	Do 'Rep1
		dwAccumulator=0 : j=14
	  	Do
		  dwAccumulator=dwAccumulator*256
		  dwAccumulator=rpk(j+rpkOffset)+dwAccumulator
		  rpk(j+rpkOffset)=(dwAccumulator\24) and 255  
		  dwAccumulator=dwAccumulator Mod 24
		  j=j-1
		Loop While j>=0
		i=i-1 : szProductKey=mid(szPossibleChars,dwAccumulator+1,1)&szProductKey
	  	If (((29-i) Mod 6)=0) and (i<>-1) then
	  		i=i-1 : szProductKey="-"&szProductKey
	  	End If
	Loop While i>=0 'Goto Rep1

	GetKey=szProductKey
End Function

Edited March 20, 2010 by gunsmokingman
Added Code Tags

[gunsmokingman]

I just tried this script on Win7 x64 and it reports the correct Key.

 Dim Act :Set Act = CreateObject("WScript.Shell")
  MsgBox GetKey(Act.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))
   Function GetKey(rpk)
    Const rpkOffset=52:i=28
    szPossibleChars="BCDFGHJKMPQRTVWXY2346789"
    Do
     dwAccumulator=0 : j=14
     Do
      dwAccumulator=dwAccumulator*256
      dwAccumulator=rpk(j+rpkOffset)+dwAccumulator
      rpk(j+rpkOffset)=(dwAccumulator\24) and 255
      dwAccumulator=dwAccumulator Mod 24
      j=j-1
    Loop While j>=0
       i=i-1 : szProductKey=mid(szPossibleChars,dwAccumulator+1,1)&szProductKey
      If (((29-i) Mod 6)=0) And (i<>-1) Then 
       i=i-1 : szProductKey="-"&szProductKey
      End If
     Loop While i>=0
    GetKey=szProductKey
   End Function

If you are going to use WMI to read the registry you should read This Link

[CoffeeFiend]

Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)

You have to remove ",,48" from this for it to work (otherwise colItems can't even be evaluated, so there is nothing to pass to the GetKey function)

However, the SerialNumber property of that WMI class returns the ProductId, NOT the DigitalProductId so it won't work regardless (you can't "decode" that)

[gunsmokingman]

I have tested this on Windows 7 x64 and it works. This is for people who want a simple script that gets the OS key, install date, last boot, system uptime.

Save As Oskey.vbs

Option Explicit
 Dim Act :Set Act = CreateObject("WScript.Shell")
 Dim Tme :Set Tme = CreateObject("WbemScripting.SWbemDateTime")
 Dim Wmi :Set Wmi = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\CIMV2")
 Dim Obj
 Dim Id, It, Ky, L1, Ld, Lt, T1, Ut, Vt
 Vt = vbTab 
 Ky = " Sys Install Key    " & Vt & GetKey(Act.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))
    For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_OperatingSystem") 
     Tme.Value = Obj.InstallDate
      T1 = Split(Tme.GetVarDate, " ")
      Id = " Sys Install Date   " & Vt & MonthName(Tme.Month) & ", " & WeekdayName(Weekday(Tme.GetVarDate)) & " " & Tme.Day & " " & Tme.Year
      It = " Sys Install Time   " & Vt & T1(1) & " " & T1(2)
     Tme.Value = Obj.LastBootUpTime
      T1 = Split(Tme.GetVarDate, " ")
      Ld = " Sys LastBoot Date  " & Vt & MonthName(Tme.Month) & ", " & WeekdayName(Weekday(Tme.GetVarDate)) & " " & Tme.Day & " " & Tme.Year
      Lt = " Sys LastBoot Time  " & Vt & T1(1) & " " & T1(2)
      L1 = Tme.GetVarDate
     If DateDiff("h", L1, Now) <= 1 Then Ut = " Sys Uptime Minutes " & Vt & DateDiff("n", L1, Now)
     If DateDiff("h", L1, Now) >= 2 Then Ut = " Sys Uptime Hours   " & Vt & DateDiff("h", L1, Now)
    Next
    Dim Info :Info = Ky & vbCrLf & Id & vbCrLf & It & vbCrLf & Ld & vbCrLf & Lt & vbCrLf & Ut     
    If MsgBox(Info & vbCrLf & vbCrLf &  " Would You Like To Save This Information To A Text File?", 4132,"Save Information") = 6 Then 
     Dim Fso, Ts, Tx 
      Set Fso = CreateObject("Scripting.FileSystemObject")
      Tx = Act.SpecialFolders("Desktop") & "\" & Act.ExpandEnvironmentStrings("%ComputerName%") & "_BasicInfo.txt"
      Set Ts = Fso.CreateTextFile(Tx)
      Ts.WriteLine Info
      Ts.Close
      Act.Run(Chr(34) & Tx & Chr(34)),1,True
    End If 
   Function GetKey(rpk)
    Dim i, j, DwAcum,ProKey,SzPosChar
    Const rpkOffset=52:i=28
    SzPosChar="BCDFGHJKMPQRTVWXY2346789"
    Do
     DwAcum=0 : j=14
     Do
      DwAcum=DwAcum*256
      DwAcum=rpk(j+rpkOffset)+DwAcum
      rpk(j+rpkOffset)=(DwAcum\24) and 255
      DwAcum=DwAcum Mod 24
      j=j-1
    Loop While j>=0
       i=i-1 : ProKey=mid(SzPosChar,DwAcum+1,1)&ProKey
      If (((29-i) Mod 6)=0) And (i<>-1) Then 
       i=i-1 : ProKey="-"&ProKey
      End If
     Loop While i>=0
    GetKey=ProKey
   End Function

[Yzöwl]

I have tested this on Windows 7 x64 and it works. This is for people who want a simple script that gets the OS key, install date, last boot, system uptime.

Save As Oskey.vbs

This is the result on both Vista x86 and Xp x86