Ozzyguy Posted March 14, 2010 Share Posted March 14, 2010 (edited) {10140000-0011-0000-1000-0000000FF1CE}@GunSmokingManNeat 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 Link to comment Share on other sites More sharing options...
gunsmokingman Posted March 14, 2010 Author Share Posted March 14, 2010 Cluberti provided the Reg Key paths from this VBS Script, I just used the Reg Key Pathin my app. Link to comment Share on other sites More sharing options...
03GrandAmGT Posted March 14, 2010 Share Posted March 14, 2010 Thanks GSM, neat little tool.jd Link to comment Share on other sites More sharing options...
Ozzyguy Posted March 15, 2010 Share Posted March 15, 2010 Cluberti provided the Reg Key paths from this VBS Script, I just used the Reg Key Pathin 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 Link to comment Share on other sites More sharing options...
Glenn9999 Posted March 15, 2010 Share Posted March 15, 2010 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, strValuestrKey = "SOFTWARE\Microsoft\Office\14.0\Registration"ScriptHelper.Registry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubkeys2If 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 NextEnd If Link to comment Share on other sites More sharing options...
Ozzyguy Posted March 15, 2010 Share Posted March 15, 2010 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, strValuestrKey = "SOFTWARE\Microsoft\Office\14.0\Registration"ScriptHelper.Registry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubkeys2If 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 NextEnd IfThanks 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. Link to comment Share on other sites More sharing options...
gunsmokingman Posted March 17, 2010 Author Share Posted March 17, 2010 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 Link to comment Share on other sites More sharing options...
CoffeeFiend Posted March 17, 2010 Share Posted March 17, 2010 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 thereThat'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. Link to comment Share on other sites More sharing options...
Ozzyguy Posted March 17, 2010 Share Posted March 17, 2010 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... Link to comment Share on other sites More sharing options...
Ozzyguy Posted March 17, 2010 Share Posted March 17, 2010 @ 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. Link to comment Share on other sites More sharing options...
markdmac Posted March 20, 2010 Share Posted March 20, 2010 (edited) 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 & vbCrLfNextMsgBox reportFunction 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=szProductKeyEnd Function Edited March 20, 2010 by gunsmokingman Added Code Tags Link to comment Share on other sites More sharing options...
gunsmokingman Posted March 20, 2010 Author Share Posted March 20, 2010 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 FunctionIf you are going to use WMI to read the registry you should read This Link Link to comment Share on other sites More sharing options...
CoffeeFiend Posted March 20, 2010 Share Posted March 20, 2010 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) Link to comment Share on other sites More sharing options...
gunsmokingman Posted March 20, 2010 Author Share Posted March 20, 2010 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.vbsOption 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 Link to comment Share on other sites More sharing options...
Yzöwl Posted March 22, 2010 Share Posted March 22, 2010 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.vbsThis is the result on both Vista x86 and Xp x86 Link to comment Share on other sites More sharing options...
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now