Jump to content
Strawberry Orange Banana Lime Leaf Slate Sky Blueberry Grape Watermelon Chocolate Marble
Strawberry Orange Banana Lime Leaf Slate Sky Blueberry Grape Watermelon Chocolate Marble

MSFN is made available via donations, subscriptions and advertising revenue. The use of ad-blocking software hurts the site. Please disable ad-blocking software or set an exception for MSFN. Alternatively, register and become a site sponsor/subscriber and ads will be disabled automatically. 


Recommended Posts

{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 by Ozzyguy

Share this post


Link to post
Share on other sites

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

Share this post


Link to post
Share on other sites

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

Share this post


Link to post
Share on other sites

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.

Share this post


Link to post
Share on other sites

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

Share this post


Link to post
Share on other sites

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 :P It's not Delphi or VB either ways.

Share this post


Link to post
Share on other sites

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...

Share this post


Link to post
Share on other sites

@ 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.

Share this post


Link to post
Share on other sites

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 by gunsmokingman
Added Code Tags

Share this post


Link to post
Share on other sites

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

Share this post


Link to post
Share on other sites

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)

Share this post


Link to post
Share on other sites

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

Share this post


Link to post
Share on other sites

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

error.jpg

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


  • Recently Browsing   0 members

    No registered users viewing this page.

×
×
  • Create New...