Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const VER_PLATFORM_WIN32_WINDOWS As Long = 1
Private Const VER_PLATFORM_WIN32_NT As Long = 2
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const REG_SZ As Long = 1
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_SUCCESS As Long = 0
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const STANDARD_RIGHTS_READ As Long = &H20000
Private Const SYNCHRONIZE As Long = &H100000
Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And _
(Not SYNCHRONIZE))
'windows-defined type OSVERSIONINFO
Private Type OSVERSIONINFO
OSVSize As Long
dwVerMajor As Long
dwVerMinor As Long
dwBuildNumber As Long
PlatformID As Long
szCSDVersion As String * 128
End Type
'private type for holding results
Private Type WindowsRegistryInfo
RegOwner As String
RegCompany As String
Product As String
ProductId As String
End Type
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 Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long
Private Sub Form_Load()
Dim cnt As Long
Dim TotalRequired As Long
TotalRequired = 4
'control array is 0-based, so
'last is TotalRequired -1
For cnt = 0 To TotalRequired - 1
'index item 0 already exists
If cnt > 0 Then
Load Label1(cnt)
Load Text1(cnt)
End If
'position the newly-created control
Label1(cnt).Move 200, 330 + (cnt * 300)
Text1(cnt).Move 2000, 300 + (cnt * 300)
'and show
Label1(cnt).Visible = True
Text1(cnt).Visible = True
Next
Label1(0) = "Registered Owner :"
Label1(1) = "Registered Company :"
Label1(2) = "Product Name :"
Label1(3) = "Product Id :"
Command1.Caption = "Reg Info"
End Sub
Private Sub Command1_Click()
Dim wri As WindowsRegistryInfo
Call GetRegistryInfo(wri)
Text1(0).Text = wri.RegOwner
Text1(1).Text = wri.RegCompany
Text1(2).Text = wri.Product
Text1(3).Text = wri.ProductId
End Sub
Private Sub GetRegistryInfo(wri As WindowsRegistryInfo)
Dim osv As OSVERSIONINFO
Dim hKey As Long
Dim regPath As String
'the path to the registered owner and company
'differ in Win9x and NT, so dwPlatformID
'is used to distinguish between the two.
osv.OSVSize = Len(osv)
Call GetVersionEx(osv)
Select Case osv.PlatformID
Case VER_PLATFORM_WIN32_WINDOWS
regPath = "SOFTWARE\Microsoft\Windows\CurrentVersion"
Case VER_PLATFORM_WIN32_NT
regPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
Case Else
MsgBox "GetVersion says this isn't 9x or NT!"
Exit Sub
End Select
'Before reading a value from the reg
'the key to read must first be opened.
'hKey contains the handle used in
'subsequent calls.
hKey = OpenRegKey(HKEY_LOCAL_MACHINE, regPath)
If hKey <> 0 Then
wri.RegOwner = GetRegValue(hKey, "RegisteredOwner")
wri.RegCompany = GetRegValue(hKey, "RegisteredOrganization")
wri.Product = GetRegValue(hKey, "ProductName")
wri.ProductId = GetRegValue(hKey, "ProductId")
'the opened key must be closed
Call RegCloseKey(hKey)
End If
End Sub
Private Function GetRegValue(hSubKey As Long, sKeyName As String) As String
Dim lpValue As String 'value retrieved
Dim lpcbData As Long 'length of retrieved string
'if valid
If hSubKey <> 0 Then
'Pass an zero-length string to
'obtain the required buffer size
'required to return the result.
'If the key passed exists, the call
'will return error 234 (more data)
'and lpcbData will indicate the
'required buffer size (including
'the terminating null).
lpValue = ""
lpcbData = 0
If RegQueryValueEx(hSubKey, _
sKeyName, _
0&, _
0&, _
ByVal lpValue, _
lpcbData) = ERROR_MORE_DATA Then
lpValue = Space$(lpcbData)
'retrieve the desired value
If RegQueryValueEx(hSubKey, _
sKeyName, _
0&, _
0&, _
ByVal lpValue, _
lpcbData) = ERROR_SUCCESS Then
GetRegValue = TrimNull(lpValue)
End If 'If RegQueryValueEx (second call)
End If 'If RegQueryValueEx (first call)
End If 'If hSubKey
End Function
Private Function OpenRegKey(ByVal hKey As Long, _
ByVal lpSubKey As String) As Long
Dim hSubKey As Long
If RegOpenKeyEx(hKey, _
lpSubKey, _
0, _
KEY_READ, _
hSubKey) = ERROR_SUCCESS Then
OpenRegKey = hSubKey
End If
End Function
Private Function TrimNull(startstr As String) As String
TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
End Function
|