Solved

Using VB6 Getting Windows RegisteredOwner

Posted on 2013-11-03
9
748 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
9 Comments
 
LVL 83

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
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

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.

 
LVL 83

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 250 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

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

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.

Question has a verified solution.

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

Suggested Solutions

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

792 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