dcsimg
December 9, 2016
Hot Topics:

Service Your Applications

  • November 19, 2002
  • By Sam Huggill
  • Send Email »
  • More Articles »

I have modified the registry control to support an enumeration that contains the different HKEY constants. This makes it easy to get and set strings. Open VB, make a new Standard EXE Project and add a usercontrol, 3 standard modules, and 3 extra forms (you need 4 in total). Rename the usercontrol ctlReg and the modules modVerfiyPassword, modUtils and modDeclares. Copy and paste the following code into the ctlReg usercontrol:

Option Explicit

'Enumeration to hold the HKEY constants
Enum eHKEY
  eHKLM = HKEY_LOCAL_MACHINE
  eHKCR = HKEY_CLASSES_ROOT
  eHKCU = HKEY_CURRENT_USER
  eHKPD = HKEY_PERFORMANCE_DATA
  eHKU = HKEY_USERS
End Enum

'Function for removing a key
Public Function fDeleteValue(ByVal hKey As eHKEY, _
  ByVal strPath As String, ByVal strValue As String)

Dim keyhand As Long

Dim r As Long

'Open it
r = RegOpenKey(hKey, strPath, keyhand)

'Delete it
r = RegDeleteValue(keyhand, strValue)

'Close it
r = RegCloseKey(keyhand)

End Function


' Function for getting a string

Public Function fGetstring(hKey As eHKEY, _
strPath As String, strValue As String)

Dim keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
Dim lValueType As Long
Dim r As Long

'Open it
r = RegOpenKey(hKey, strPath, keyhand)

'Query the registry
lResult = RegQueryValueEx(keyhand, strValue, 0&,
lValueType, ByVal 0&, lDataBufSize)

If lValueType = REG_SZ Then
  strBuf = String(lDataBufSize, " ")
  lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, _
  ByVal strBuf, lDataBufSize)
  If lResult = ERROR_SUCCESS Then
     intZeroPos = InStr(strBuf, Chr$(0))
     If intZeroPos > 0 Then
	   fGetstring = Left$(strBuf, intZeroPos - 1)
	 Else
	   fGetstring = strBuf
	 End If
  End If
End If

End Function


'Function for saving a string

Public Sub fSaveString(hKey As eHKEY, strPath As String, _
strValue As String, strdata As String)

Dim keyhand As Long
Dim r As Long

'Create it
r = RegCreateKey(hKey, strPath, keyhand)

'Set it
r = RegSetValueEx(keyhand, strValue, 0, _
REG_SZ, ByVal strdata, Len(strdata))

'Close it
r = RegCloseKey(keyhand)

End Sub

Private Sub UserControl_Initialize()
'Set the width and height values
UserControl.Width = UserControl.Picture.Width
UserControl.Height = UserControl.Picture.Height
End Sub

Private Sub UserControl_Resize()
'Reset the width and height values
UserControl.Width = UserControl.Picture.Width
UserControl.Height = UserControl.Picture.Height
End Sub

Public Function EnumValues(ByVal hKey As eHKEY, _
ByVal sSectionKey As String, ByRef sKeyNames() As String, _
ByRef iKeyCount As Long) As Boolean

Dim lIndex As Long
Dim lResult As Long
Dim sName As String
Dim lNameSize As Long
Dim sData As String
Dim cJunk As Long
Dim cNameMax As Long
Dim ft As Currency

    
'Thanks to Steve McMahon as this came from his cRegistry class
' found at http://vbaccelerator.com/

iKeyCount = 0
Erase sKeyNames()

lIndex = 0
lResult = RegOpenKeyEx(hKey, sSectionKey, 0, KEY_QUERY_VALUE, hKey)

If (lResult = ERROR_SUCCESS) Then
  lResult = RegQueryInfoKey(hKey, "", cJunk, 0, cJunk, _
  cJunk, cJunk, cJunk, cNameMax, cJunk, cJunk, ft)
  Do While lResult = ERROR_SUCCESS
  lNameSize = cNameMax + 1
  sName = String$(lNameSize, 0)
  If (lNameSize = 0) Then lNameSize = 1
  lResult = RegEnumValue(hKey, lIndex, sName, lNameSize, _
  0&, 0&, 0&, 0&)
  If (lResult = ERROR_SUCCESS) Then
    sName = Left$(sName, lNameSize)
	iKeyCount = iKeyCount + 1
	ReDim Preserve sKeyNames(1 To iKeyCount) As String
	sKeyNames(iKeyCount) = sName
  End If
  lIndex = lIndex + 1
  Loop
End If

If (hKey <> 0) Then
  RegCloseKey hKey
End If

EnumValues = True

Exit Function

End Function

Now add the following code into the modDeclares module:

Option Explicit

' Path to the Serices registry key
Public Const ServicePath As String = _
"SOFTWARE\Microsoft\Windows\CurrentVersion\RunServices"

' Registry Constants
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_SUCCESS = 0&
Public Const REG_SZ = 1 ' Unicode nul terminated string

Public Const REG_DWORD = 4
Public Const KEY_QUERY_VALUE = &H1

' Registry API Declarations
Public Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long

Public Declare Function RegCreateKey Lib "advapi32.dll" _
Alias "RegCreateKeyA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
phkResult As Long) As Long

Public Declare Function RegDeleteKey Lib "advapi32.dll" _
Alias "RegDeleteKeyA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String) As Long

Public Declare Function RegDeleteValue Lib "advapi32.dll" _
Alias "RegDeleteValueA" _
(ByVal hKey As Long, _
ByVal lpValueName As String) As Long

Public Declare Function RegOpenKey Lib "advapi32.dll" _
Alias "RegOpenKeyA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
phkResult As Long) As Long

Public 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

Public Declare Function RegSetValueEx Lib "advapi32.dll" _
Alias "RegSetValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal Reserved As Long, _
ByVal dwType As Long, _
lpData As Any, _
ByVal cbData As Long) As Long

Public 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

Public Declare Function RegQueryInfoKey Lib "advapi32.dll" _
Alias "RegQueryInfoKeyA" _
(ByVal hKey As Long, _
ByVal lpClass As String, _
lpcbClass As Long, _
ByVal lpReserved As Long, _
lpcSubKeys As Long, _
lpcbMaxSubKeyLen As Long, _
lpcbMaxClassLen As Long, _
lpcValues As Long, _
lpcbMaxValueNameLen As Long, _
lpcbMaxValueLen As Long, _
lpcbSecurityDescriptor As Long, _
lpftLastWriteTime As Any) As Long

Public Declare Function RegEnumValue Lib "advapi32.dll" _
Alias "RegEnumValueA" _
(ByVal hKey As Long, _
ByVal dwIndex As Long, _
ByVal lpValueName As String, _
lpcbValueName As Long, _
ByVal lpReserved As Long, _
ByVal lpType As Long, _
ByVal lpData As Long, _
ByVal lpcbData As Long) As Long

Now add the following code to the modVerfiyPassword module:

Option Explicit

Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" _
(ByVal lpBuffer As String, _
nSize As Long) As Long

Private Declare Function WNetVerifyPassword Lib "mpr.dll" _
Alias "WNetVerifyPasswordA" _
(ByVal lpszPassword As String, _
ByRef pfMatch As Long) As Long

Public Function GetWindowsLoginUserID() As String
Dim rtn As Long
Dim sBuffer As String
Dim lSize As Long

sBuffer = String$(260, Chr$(0))
lSize = Len(sBuffer)
rtn = GetUserName(sBuffer, lSize)
If rtn Then
  sBuffer = Left$(sBuffer, lSize)
  'Reformat string
  If InStr(sBuffer, Chr$(0)) Then
    sBuffer = Left$(sBuffer, InStr(sBuffer, Chr$(0)) - 1)
  End If
  GetWindowsLoginUserID = sBuffer
Else
  'Error!
  GetWindowsLoginUserID = ""
End If

End Function

Public Function VerifyWindowsLoginUserPassword(ByVal _
Password As String) As Boolean

Dim rtn As Long, Match As Long
rtn = WNetVerifyPassword(Password, Match)

If rtn Then
  VerifyWindowsLoginUserPassword = False
Else
  VerifyWindowsLoginUserPassword = (Match <> 0)
End If

End Function




Page 2 of 2



Comment and Contribute

 


(Maximum characters: 1200). You have characters left.

 

 


Enterprise Development Update

Don't miss an article. Subscribe to our newsletter below.

Sitemap | Contact Us

Thanks for your registration, follow us on our social networks to keep up-to-date
Rocket Fuel