CodeItBetter Programming Another VB Programming Blog

How to find Windows NT registered user and organization

Posted on January 4, 2009
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
'System & API - How to find Windows NT registered user and organization
Option Explicit
 
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" 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 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
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
 
Private Const ERROR_SUCCESS = 0&
 
Private Const HKEY_LOCAL_MACHINE = &H80000002
 
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const SYNCHRONIZE = &H100000
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or _
    KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And _
    (Not SYNCHRONIZE))
 
' Return a Windows NT registered organization.
Private Function RegisteredOrganization() As String
    RegisteredOrganization = RegistryValue(HKEY_LOCAL_MACHINE, _
        "SOFTWARE\Microsoft\Windows NT\CurrentVersion", "RegisteredOrganization")
End Function
' Return a Windows NT registered name.
Private Function RegisteredOwner() As String
    RegisteredOwner = RegistryValue(HKEY_LOCAL_MACHINE, _
        "SOFTWARE\Microsoft\Windows NT\CurrentVersion", "RegisteredOwner")
End Function
 
' Return a registry value.
Private Function RegistryValue(ByVal registry_section As Long, ByVal key_name As String, _
    ByVal subkey_name As String) As String
    Dim hKey As Long
    Dim value As String
    Dim length As Long
    Dim value_type As Long
 
    ' Assume there will be trouble.
    RegistryValue = "???"
 
    ' Open the key.
    If RegOpenKeyEx(registry_section, key_name, 0&, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS Then Exit Function
 
    ' Get the subkey's value.
    length = 1024
    value = Space$(length)
    If RegQueryValueEx(hKey, subkey_name, 0&, value_type, ByVal value, length) <> ERROR_SUCCESS _
        Then Exit Function
 
    ' Remove the trailing null character.
    RegistryValue = Left$(value, length - 1)
 
    ' Close the key.
    RegCloseKey hKey
End Function
 
Private Sub Form_Load()
    lblOwner.Caption = RegisteredOwner()
    lblOrg.Caption = RegisteredOrganization()
End Sub
Comments (0) Trackbacks (0)

No comments yet.


Leave a comment


 

No trackbacks yet.