I need to get inside windows Vista registry

[Victor Torres]

Hi to all, I create a small program that I can use to registry my database
apps. It use the Windows CD Key in order to registry the software. Right
now I can do it in windows XP. But I try it in Windows Vista and it doesn't
do it. I don't know why. I'm not an expert. I just use logic to manage to
change and convert some code so I don't know what the code is doing. If
someone know how codes works and have a windows vista that can verify the
code to see what is wrong and why is not working I will be glad. Here is
the code that I use to retrieve windows Key. I found this code in the
internet and I just put it to work with windows. If anyone know also how to
shrink it so it doesn't use the array well I will be glad to:


Private Sub ButtonKey_Click()
' ##############################################################
' # #
' # 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(0, 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(1, 0) = "Microsoft Exchange Product Key"
'arrSubKeys(1, 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
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

msgbox strProductKey

End Function

 

[David H]

This would be better asked in a Newsgroup that deals specifically with Vista.

 

[Victor Torres]

Nop... Because I'm doing this inside Access, plus the end product will be
Access so I think it belong to this forum. I just need someone that can look
at this code and see what is wrong with it in regards to Windows Vista.

 

[Jack Leach]

I think what David meant was that this particular problem, though it is
hitting you inside the access application, is really dealing with how vista
as an OS returns this information. Therefore, even though this is arising in
access, the root of the problem is more relevant to the vista platform. I
think you would have better luck asking this in a vista newsgroup as well,
being that the people answering questions there are most likely much more
qualified to answer.

Even though you are doing it from access, the registry key containing the
product key in vista has nothing to do with access.

--
Jack Leach
www.tristatemachine.com

"I haven''t failed, I''ve found ten thousand ways that don''t work."
-Thomas Edison (1847-1931)

 

[Douglas J. Steele]

While the others are correct about this not being the best forum in which to
ask this question, I suspect it might be a permissions issue (which is
something the Vista group should be able to confirm). It would also help to
indicate where the code is failing.

 

[Victor Torres]

Hi to all, thanks anyway with any of the direction that you give me. I will
try to ask this in the Vista forums. Why I ask this in this forum is because
I know that if I ask this in the Vista forum someone will tell me this belong
to the MS Access forum. Anyway thanks... I will try to keep searching for
my answer.

 

[Tony Toews [MVP]]

Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &
strComputer & "\root\default:StdRegProv")

1) You haven't told us what line fails or what the error message is.

2) I wonder if the various registry key fetches are doing this by
defaulting to read only mode or update mode. If update then change
the default to read only mode.

3) Actually this problem should be asked in WMI or winmgmts newsgroup
if such exists. I think WMI is the correct acronym.

I always use API calls to fetch this information myself. If
interested see vbnet.mvps.org.

Tony

 

[Victor Torres]

Hi.... Thanks Vandal, I keep looking for an answer and found another very
nice code that work great without the array of the apps. This works with one
registry for each procedure. Anyway it works great in Vista and in XP. here
is the code:

Option Compare Database
Option Explicit

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long)
As Long


Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA"
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long


Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal
lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
' Note that If you declare the lpData parameter as String, you must pass it
By Value.
Private Const REG_BINARY = 3
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const ERROR_SUCCESS = 0&




'**************************************
' Name: View Windows XP CD Key
' Description:Function: sGetXPCDKey() wi
' ll return the CD Key for Windows XP in t
' he format XXXXX-XXXXX-XXXXX-XXXXX-XXXXX.
'
' By: Snytax
'
' Inputs:Nothing.
'
' Returns:Your Windows XP CD Key.
'
'This code is copyrighted and has' limited warranties.Please see http://w
' ww.Planet-Source-Code.com/vb/scripts/Sho
' wCode.asp?txtCodeId=57164&lngWId=1'for
details.'**************************************

'sGetXPCDKey() -
'Returns the Windows XP CD Key if succes
' sful.
'Returns nothing upon failure.


Public Function sGetXPCDKey() As String

'Read the value of:
'HKLM\SOFTWARE\MICROSOFT\Windows NT\Curr
' entVersion\DigitalProductId
Dim bDigitalProductID() As Byte
Dim bProductKey() As Byte
Dim ilByte As Long
Dim lDataLen As Long
Dim hKey As Long
'Open the registry key: HKLM\SOFTWARE\MI
' CROSOFT\Windows NT\CurrentVersion


If RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\MICROSOFT\Windows
NT\CurrentVersion", hKey) = ERROR_SUCCESS Then
lDataLen = 164
ReDim Preserve bDigitalProductID(lDataLen)
'Read the value of DigitalProductID


If RegQueryValueEx(hKey, "DigitalProductId", 0&, REG_BINARY,
bDigitalProductID(0), lDataLen) = ERROR_SUCCESS Then
'Get the Product Key, 15 bytes long, off
' set by 52 bytes
ReDim Preserve bProductKey(14)


For ilByte = 52 To 66
bProductKey(ilByte - 52) = bDigitalProductID(ilByte)
Next ilByte

Else
'ERROR: Could not read "DigitalProductID
' "
sGetXPCDKey = ""
Exit Function
End If

Else
'ERROR: Could not open "HKLM\SOFTWARE\MI
' CROSOFT\Windows NT\CurrentVersion"
sGetXPCDKey = ""
Exit Function
End If

'Now we are going to 'base24' decode the
' Product Key
Dim bKeyChars(0 To 24) As Byte
'Possible characters in the CD Key:
bKeyChars(0) = Asc("B")
bKeyChars(1) = Asc("C")
bKeyChars(2) = Asc("D")
bKeyChars(3) = Asc("F")
bKeyChars(4) = Asc("G")
bKeyChars(5) = Asc("H")
bKeyChars(6) = Asc("J")
bKeyChars(7) = Asc("K")
bKeyChars(8) = Asc("M")
bKeyChars(9) = Asc("P")
bKeyChars(10) = Asc("Q")
bKeyChars(11) = Asc("R")
bKeyChars(12) = Asc("T")
bKeyChars(13) = Asc("V")
bKeyChars(14) = Asc("W")
bKeyChars(15) = Asc("X")
bKeyChars(16) = Asc("Y")
bKeyChars(17) = Asc("2")
bKeyChars(18) = Asc("3")
bKeyChars(19) = Asc("4")
bKeyChars(20) = Asc("6")
bKeyChars(21) = Asc("7")
bKeyChars(22) = Asc("8")
bKeyChars(23) = Asc("9")
Dim nCur As Integer
Dim sCDKey As String
Dim ilKeyByte As Long
Dim ilBit As Long


For ilByte = 24 To 0 Step -1
'Step through each character in the CD k
' ey
nCur = 0


For ilKeyByte = 14 To 0 Step -1
'Step through each byte in the Product K
' ey
nCur = nCur * 256 Xor bProductKey(ilKeyByte)
bProductKey(ilKeyByte) = Int(nCur / 24)
nCur = nCur Mod 24
Next ilKeyByte

sCDKey = Chr(bKeyChars(nCur)) & sCDKey
If ilByte Mod 5 = 0 And ilByte <> 0 Then sCDKey = "-" & sCDKey
Next ilByte

Me.CDkey = sCDKey
End Function

 

[Tony Toews [MVP]]

If RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\MICROSOFT\Windows
NT\CurrentVersion", hKey) = ERROR_SUCCESS Then

You may have troubles with that line of code. I don't know what the
defaults are for opening a registry key but you want to do a read only
open of the key. Doing an update open of many registry key will not
work if the user is running as a user.

If you are running as an administrator then such an open could work
but will fail when you deploy the code.

Hmm, the naming standards of the variables that the sample code
doesn't match that of the MSDN web site. Likely not a problem but
confusing for someone comparing the code with MSDN.

http://msdn.microsoft.com/en-us/library/ms724897(VS.85).aspx

Tony

 

[Tony Toews [MVP]]

If RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\MICROSOFT\Windows
NT\CurrentVersion", hKey) = ERROR_SUCCESS Then

You may have troubles with that line of code. I don't know what the
defaults are for opening a registry key but you want to do a read only
open of the key. Doing an update open of many registry key will not
work if the user is running as a user.

If you are running as an administrator then such an open could work
but will fail when you deploy the code.

Hmm, the naming standards of the variables that the sample code
doesn't match that of the MSDN web site. Likely not a problem but
confusing for someone comparing the code with MSDN.

http://msdn.microsoft.com/en-us/library/ms724897(VS.85).aspx

Tony