Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Using VB6 Getting Windows RegisteredOwner

Posted on 2013-11-03
9
Medium Priority
?
842 Views
Last Modified: 2013-11-11
I am using vb6 and I tried some of the codes available on the internet to programatically get the RegisteredOwner of windows. They  all give RegisteredOwner="Microsoft" while my windows RegisteredOwner="user".
Any idea how to do it?
Here is one of the codes I used,

Private Declare Function RegQueryValueExStr Lib "advapi32" Alias "RegQueryValueExA" _
   (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
    ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
 Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
   (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
   ByVal samDesired As Long, phkResult As Long) As Long
 Private Declare Function RegQueryValueExLong Lib "advapi32" Alias "RegQueryValueExA" _
   (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
    ByRef lpType As Long, szData As Long, ByRef lpcbData As Long) As Long


 Private Const ERROR_MORE_DATA = 234
 Private Const HKEY_CLASSES_ROOT = &H80000000
 Private Const HKEY_CURRENT_USER = &H80000001
 Private Const HKEY_LOCAL_MACHINE = &H80000002
 Private Const HKEY_USERS = &H80000003
 Private Const KEY_QUERY_VALUE = &H1

 Private Sub Form_Load()
     Dim sKey As String
     sKey = "Software\Microsoft\Windows\CurrentVersion"
     If GetStringValue("Software\Microsof\tWindows\CurrentVersion", "SystemRoot") = "" Then
         sKey = "Software\Microsoft\Windows NT\CurrentVersion"
     End If
         
     txtRegOwner = GetStringValue(sKey, "RegisteredOwner")
     txtRegOrg = GetStringValue(sKey, "RegisteredOrganization")
     txtProductName = GetStringValue(sKey, "ProductName")
     txtProductID = GetStringValue(sKey, "ProductId")
 End Sub
 Private Function GetStringValue(sSectionKey As String, sValueKey As String) As String
 Dim hKey As Long
 Dim lResult As Long
 Dim ordType As Long
 Dim cData As Long
 Dim sData As String
 Dim e As Long
 
     lResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sSectionKey, 0, KEY_QUERY_VALUE, hKey)

     lResult = RegQueryValueExLong(hKey, sValueKey, 0&, ordType, 0&, cData)
     If lResult And lResult <> ERROR_MORE_DATA Then
         DoEvents
         Exit Function
     End If
     If ordType = 1 Then 'REG_SZ
         sData = String$(cData - 1, 0)
         lResult = RegQueryValueExStr(hKey, sValueKey, 0&, ordType, sData, cData)
         GetStringValue = sData
     Else
         'MsgBox "Invalid String Value"
     End If
 End Function
0
Comment
Question by:saljas
  • 5
  • 2
8 Comments
 
LVL 84

Expert Comment

by:Dave Baldwin
ID: 39619587
This line
If GetStringValue("Software\Microsof\tWindows\CurrentVersion", "SystemRoot") = "" Then

Open in new window

has a typo "Microsof\t".

This computer has my name under "Software\Microsoft\Windows NT\CurrentVersion\RegisteredOwner" but I think I put it there.  My other computer has the previous owner's name in the same spot.
0
 

Author Comment

by:saljas
ID: 39619631
(Microsof\tWindows)

Your right I fixed the line, it is already done on my computer.

The problem is that ProductName is giving the right info

But

RegisteredOwner and RegisteredOrganization are giving  "Microsoft" Which is wrong
ProductID is giving "null" which is also wrong
0
 

Author Comment

by:saljas
ID: 39620829
On 32 bit it is working fine

The problem is on 64 bit
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 84

Expert Comment

by:Dave Baldwin
ID: 39620835
Can't help you there.  Click on "Request Attention" above to get others to look at your question.
0
 

Author Comment

by:saljas
ID: 39620917
DaveBaldwin
Many thanks for your help
0
 
LVL 44

Assisted Solution

by:Rainer Jeschor
Rainer Jeschor earned 1000 total points
ID: 39622794
Hi,
I know where this issue is coming from but have currently no tested workaround.

The problem is that your VB6 program will be executed as 32bit application hence every registry access will be redirected to the related 32 bit hive. Windows itself is running 64bit hence using the 64 bit hive.

There is a flag parameter for some Reg functions to explicitely set the desired hive:
http://msdn.microsoft.com/en-us/library/windows/desktop/aa384129%28v=vs.85%29.aspx

You might try to change your constant
Private Const KEY_QUERY_VALUE = &H1

Open in new window

to
Private Const KEY_QUERY_VALUE = &H100

Open in new window


HTH
Rainer
0
 

Accepted Solution

by:
saljas earned 0 total points
ID: 39627835
To RainerJ
You are right, the problem get from there.
The link you have sent explained it.
The following is the right code to do it right for all windows platforms

Option Explicit

Private Const ERROR_SUCCESS As Long = &H0

Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long
Private Declare Function GetVersion Lib "kernel32.dll" () As Long
Private Declare Function IsWow64Process Lib "kernel32.dll" (ByVal hProcess As Long, ByRef Wow64Process As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKeyExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegOpenKeyExW Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpSubKey As Long, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As Any, ByRef lpcbData As Long) As Long
Private Declare Function RegQueryValueExW Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As Long, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As Any, ByRef lpcbData As Long) As Long

Private Sub Command1_Click()
    Const OS_PLATFORM = &H80000000, HKEY_LOCAL_MACHINE = &H80000002
    Const KEY_WOW64_64KEY = &H100&, KEY_QUERY_VALUE = &H1&
    Dim bSucceeded As Boolean, Win9x As Boolean, hKey As Long

    On Error Resume Next                        'If GetVersion API is unavailable, OS is probably > Win 8.1
    Win9x = (GetVersion And OS_PLATFORM) <> 0&  'If high order bit <> 0 Then OS is Win9x Else it's NT-based
    On Error GoTo 0

    If Not Win9x Then
        bSucceeded = RegOpenKeyExW(HKEY_LOCAL_MACHINE, _
                                   StrPtr("SOFTWARE\Microsoft\Windows NT\CurrentVersion"), _
                                   0&, _
                                   KEY_QUERY_VALUE Or KEY_WOW64_64KEY * -IsOS64Bit, _
                                   hKey) _
                   = ERROR_SUCCESS
    Else
        bSucceeded = RegOpenKeyExA(HKEY_LOCAL_MACHINE, _
                                   "SOFTWARE\Microsoft\Windows\CurrentVersion", _
                                   0&, _
                                   KEY_QUERY_VALUE, _
                                   hKey) _
                   = ERROR_SUCCESS
    End If

    If bSucceeded Then
        txtRegOwner = GetStringValue(hKey, "RegisteredOwner", Not Win9x)
        txtRegOrg = GetStringValue(hKey, "RegisteredOrganization", Not Win9x)
        txtProductName = GetStringValue(hKey, "ProductName", Not Win9x)
        txtProductID = GetStringValue(hKey, "ProductId", Not Win9x)

        hKey = RegCloseKey(hKey):   Debug.Assert hKey = ERROR_SUCCESS
    End If

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then Unload Me
End Sub

Private Function GetStringValue(ByVal hKey As Long, ByRef ValueName As String, ByVal Unicode As Boolean) As String
    Const REG_SZ = 1&
    Dim lRegType As Long, lSize As Long

    If Unicode Then
        If RegQueryValueExW(hKey, StrPtr(ValueName), 0&, lRegType, 0&, lSize) = ERROR_SUCCESS Then
            If lRegType = REG_SZ Then
                GetStringValue = Space$(lSize \ 2& - 1&)
                If RegQueryValueExW(hKey, StrPtr(ValueName), 0&, lRegType, StrPtr(GetStringValue), lSize) <> ERROR_SUCCESS Then GetStringValue = vbNullString
            End If
        End If
    Else
        If RegQueryValueExA(hKey, ValueName, 0&, lRegType, vbNullString, lSize) = ERROR_SUCCESS Then
            If lRegType = REG_SZ Then
                GetStringValue = Space$(lSize - 1&)
                If RegQueryValueExA(hKey, ValueName, 0&, lRegType, GetStringValue, lSize) <> ERROR_SUCCESS Then GetStringValue = vbNullString
            End If
        End If
    End If
End Function

Private Function IsOS64Bit() As Boolean
    Dim Wow64Process As Long

    On Error Resume Next
    IsOS64Bit = IsWow64Process(GetCurrentProcess, Wow64Process) And Wow64Process
End Function
0
 

Author Closing Comment

by:saljas
ID: 39638289
RainerJ directed me to what causes the problem but did not provide with code, Then on another forum I got an answer saying the same as RainerJ said and provided with the code that is why my answer is a solution and RainerJ deserve a reward.
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses

824 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question