Using VB6 Getting Windows RegisteredOwner

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
saljasAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
saljasConnect With a Mentor Author Commented:
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
 
Dave BaldwinFixer of ProblemsCommented:
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
 
saljasAuthor Commented:
(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
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
saljasAuthor Commented:
On 32 bit it is working fine

The problem is on 64 bit
0
 
Dave BaldwinFixer of ProblemsCommented:
Can't help you there.  Click on "Request Attention" above to get others to look at your question.
0
 
saljasAuthor Commented:
DaveBaldwin
Many thanks for your help
0
 
Rainer JeschorConnect With a Mentor Commented:
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
 
saljasAuthor Commented:
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
All Courses

From novice to tech pro — start learning today.