• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 891
  • Last Modified:

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
0
saljas
Asked:
saljas
  • 5
  • 2
2 Solutions
 
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
 
saljasAuthor Commented:
On 32 bit it is working fine

The problem is on 64 bit
0
Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

 
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 JeschorCommented:
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:
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
 
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 5
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now