vbregmod.bas

一个用VB开发的细胞元动机

Attribute VB_Name = "VbRegMod"
Option Explicit

'---------------------------------------------------
'-- VbRegMod.Bas
'-- A Visual Basic 32-Bit Module For Accessing
'-- The Windows Registry.
'--
'-- Date: Sunday, May 17, 1998
'-- By Custom Software Designers.
'-- Programmer Raymond L. King
'---------------------------------------------------

'-- Windows Registry Root Key Constants.
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_DYN_DATA = &H80000006
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003

'-- Windows Registry Key Type Constants.
Public Const REG_OPTION_NON_VOLATILE = 0        ' Key is preserved when system is rebooted
Public Const REG_EXPAND_SZ = 2                  ' Unicode nul terminated string
Public Const REG_DWORD = 4                      ' 32-bit number
Public Const REG_SZ = 1                         ' Unicode nul terminated string
Public Const REG_BINARY = 3                     ' Free form binary
Public Const REG_DWORD_BIG_ENDIAN = 5           ' 32-bit number
Public Const REG_DWORD_LITTLE_ENDIAN = 4        ' 32-bit number (same as REG_DWORD)

'-- Function Error Constants.
Public Const ERROR_SUCCESS = 0
Public Const ERROR_REG = 1

'-- Registry Access Rights.
Public Const SYNCHRONIZE = &H100000
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public 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))
Public Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))


'--Constants for Disposition value returned in lpdwDisposition variable in RegCreateKeyEx
Public Const REG_CREATED_NEW_KEY = &H1      'New Registry Key created
Public Const REG_OPENED_EXISTING_KEY = &H2  'Existing Key opened




'-- Windows Registry API Declarations.
'-- Registry API To Open A Key.
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

'-- Registry API To Create A New Key.
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" _
  (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, _
  ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
  ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long

'-- Registry API To Query A String Value.
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
  lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
  ' Note that if you declare the lpData parameter as String, you must pass it By Value.

'-- Registry API To Query A Long (DWORD) Value.
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
  lpType As Long, lpData As Long, lpcbData As Long) As Long

'-- Registry API To Query A NULL Value.
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
  lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long

'-- Registry API To Set A String Value.
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
  ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
  ' Note that if you declare the lpData parameter as String, you must pass it By Value.

'-- Registry API To Set A Long (DWORD) Value.
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" _
  (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
  ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long

'-- Registry API To Delete A Key.
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
  (ByVal hKey As Long, ByVal lpSubKey As String) As Long

'-- Registry API To Delete A Key Value.
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
  (ByVal hKey As Long, ByVal lpValueName As String) As Long

'-- Registry API To Close A Key.
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

'-- Constants For Error Messages.
Public Const OpenErr = "Error: Opening Registry Key!"
Public Const DeleteErr = "Error: Deleteing Key!"
Public Const CreateErr = "Error: Creating Key!"
Public Const QueryErr = "Error: Querying Value!"

'-------------------------------------------------------------
'-- Procedure   : Public Method VbRegDeleteKey
'-- Programmer  : Raymond L. King
'-- Created On  : Sunday, May 17, 1998 11:03:04 AM
'-- Module      : VbRegMod
'-- Module File : VbRegMod.bas
'-- Project     : Project1
'-- Project File: Project1.vbp
'-- Parameters  :
'-- RootKey     : The Root Key To Open, EG: HKEY_CURRENT_USER
'-- KeyName     : The Key Name To Open
'--             : Example: MySettings\Settings
'-- SubKey      : The Sub Key Under KeyName To Delete
'-------------------------------------------------------------
'
Public Sub VbRegDeleteKey _
       (RootKey As Long, KeyName As String, SubKey As String)

  Dim lRtn    As Long      '-- API Return Value
  Dim hKey    As Long      '-- Handle Of Key
  
  '-- Open The Specified Registry Key.
  lRtn = RegOpenKeyEx(RootKey, KeyName, 0&, KEY_ALL_ACCESS, hKey)
  
  '-- Check For An Error.
  If lRtn <> ERROR_SUCCESS Then
    MsgBox OpenErr
    RegCloseKey (hKey)
    Exit Sub
  End If
  
  '-- Delete The Registry SubKey.
  lRtn = RegDeleteKey(hKey, SubKey)
  
  '-- Check For An Error.
  If lRtn <> ERROR_SUCCESS Then
    MsgBox DeleteErr
  End If
  
  '-- Close The Registry Key.
  RegCloseKey (hKey)
  
End Sub

'-------------------------------------------------------------
'-- Procedure   : Public Method VbRegCreateKey
'-- Programmer  : Raymond L. King
'-- Created On  : Sunday, May 17, 1998 11:03:18 AM
'-- Module      : VbRegMod
'-- Module File : VbRegMod.bas
'-- Project     : Project1
'-- Project File: Project1.vbp
'-- Parameters  :
'-- RootKey     : The Root Key To Open, EG: HKEY_CURRENT_USER
'-- KeyName     : The New Key Name To Create
'--             : Example: MySettings\Settings
'-------------------------------------------------------------
'
Public Sub VbRegCreateKey(RootKey As Long, KeyName As String, lDisposition As Long)

  Dim lRtn    As Long     '-- Registry API Return Value
  Dim hKey    As Long     '-- Handle Of Open Key
  Dim lDisp   As Long     '-- Disposition - returns REG_CREATED_NEW_KEY if new key was created.
                          '               - returns REG_OPENED_EXISTING_KEY if the key existed
                          '                 and it was successfully opened.
                          
  
  '-- Create The New Registry Key.
  lRtn = RegCreateKeyEx(RootKey, KeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, _
                          KEY_ALL_ACCESS, 0&, hKey, lDisp)
    
  '-- Check For An Error.
  If lRtn <> ERROR_SUCCESS Then
    MsgBox CreateErr
  Else
    Select Case lDisp
        Case REG_CREATED_NEW_KEY
            lDisposition = REG_CREATED_NEW_KEY
        Case REG_OPENED_EXISTING_KEY
            lDisposition = REG_OPENED_EXISTING_KEY
    End Select
  End If
  
  '-- Close The Registry Key.
  RegCloseKey (hKey)
  
End Sub

'-------------------------------------------------------------
'-- Procedure   : Public Method VbRegQueryValue
'-- Programmer  : Raymond L. King
'-- Created On  : Sunday, May 17, 1998 11:03:29 AM
'-- Module      : VbRegMod
'-- Module File : VbRegMod.bas
'-- Project     : Project1
'-- Project File: Project1.vbp
'-- Parameters  :
'-- RootKey     : The Root Key To Open, EG: HKEY_CURRENT_USER
'-- KeyName     : The Key Name To Open
'--             : Example: MySettings\Settings
'-- ValueName   : The Value Name To Query
'-------------------------------------------------------------
'
Public Function VbRegQueryValue _
       (RootKey As Long, KeyName As String, ValueName As String) As Variant
  
  Dim lRtn    As Long     '-- API Return Code
  Dim hKey    As Long     '-- Handle Of Open Key
  Dim lCdata  As Long     '-- The Data
  Dim lValue  As Long     '-- Long (DWORD) Value
  Dim sValue  As String   '-- String Value
  Dim lRtype  As Long     '-- Type Returned String Or DWORD
  
  '-- Open The Registry Key.
  lRtn = RegOpenKeyEx(RootKey, KeyName, 0&, KEY_ALL_ACCESS, hKey)
  
  '-- Check For An Error.
  If lRtn <> ERROR_SUCCESS Then
    MsgBox OpenErr
    RegCloseKey (hKey)
    Exit Function
  End If
  
  '-- Query Registry Key For Value Type.
  lRtn = RegQueryValueExNULL(hKey, ValueName, 0&, lRtype, 0&, lCdata)
  
  '-- Check For An Error.
  If lRtn <> ERROR_SUCCESS Then
    MsgBox QueryErr
    RegCloseKey (hKey)
    Exit Function
  End If
  
  '-- Get The Key Value By Type.
  Select Case lRtype
    Case 1    '-- REG_SZ (String)
      sValue = String(lCdata, 0)
      '-- Get Registry String Value.
      lRtn = RegQueryValueExString(hKey, ValueName, 0&, lRtype, sValue, lCdata)
      '-- Check For Error.
      If lRtn = ERROR_SUCCESS Then
        VbRegQueryValue = sValue
      Else
        VbRegQueryValue = Empty
      End If
    Case 4    '-- REG_DWORD
      '-- Get Registry Long (DWORD) Value.
      lRtn = RegQueryValueExLong(hKey, ValueName, 0&, lRtype, lValue, lCdata)
      '-- Check For Error.
      If lRtn = ERROR_SUCCESS Then
        VbRegQueryValue = lValue
      Else
        VbRegQueryValue = Empty
      End If
  End Select
  
  '-- Close The Registry Key.
  RegCloseKey (hKey)
  
End Function

'-------------------------------------------------------------
'-- Procedure   : Public Method VbRegSetValue
'-- Programmer  : Raymond L. King
'-- Created On  : Sunday, May 17, 1998 11:03:42 AM
'-- Module      : VbRegMod
'-- Module File : VbRegMod.bas
'-- Project     : Project1
'-- Project File: Project1.vbp
'-- Parameters  :
'-- RootKey     : The Root Key To Open, EG: HKEY_CURRENT_USER
'-- KeyName     : The Key Name To Open
'--             : Example: MySettings\Settings
'-- ValueName   : The Value Name To Open
'-- KeyType     : The Key Type, EG: REG_SZ Or REG_DWORD
'-- KeyValue    : The Value To Set Under ValueName
'-------------------------------------------------------------
'
Public Sub VbRegSetValue _
       (RootKey As Long, KeyName As String, _
        ValueName As String, KeyType As Integer, _
        KeyValue As Variant)

  Dim lRtn    As Long     '-- Returned Value From API Registry Call
  Dim hKey    As Long     '-- Handle Of The Opened Key
  Dim lValue  As Long     '-- Setting A Long Data Value
  Dim sValue  As String   '-- Setting A String Data Value
  Dim lSize   As Long     '-- Size Of String Data To Set
  
  '-- Open The Registry Key.
  lRtn = RegOpenKeyEx(RootKey, KeyName, 0, KEY_ALL_ACCESS, hKey)
  
  '-- Check For An Error.
  If lRtn <> ERROR_SUCCESS Then
    MsgBox OpenErr
    RegCloseKey (hKey)
    Exit Sub
  End If
  
  '-- Select The Key Type.
  Select Case KeyType
    Case 1    '-- REG_SZ (String)
      sValue = KeyValue        '-- Assign Key Value
      lSize = Len(sValue)      '-- Get Size Of String
      '-- Set String Value.
      lRtn = RegSetValueExString(hKey, ValueName, 0&, REG_SZ, sValue, lSize)
      '-- Check For An Error.
      If lRtn <> ERROR_SUCCESS Then
        MsgBox "Error Setting String Value!"
        RegCloseKey (hKey)
        Exit Sub
      End If
    Case 4    '-- REG_DWORD
      lValue = KeyValue    '-- Assign The Long Value.
      '-- Set The Long Value (DWORD).
      lRtn = RegSetValueExLong(hKey, ValueName, 0&, REG_DWORD, lValue, 4)
      '-- Check For An Error.
      If lRtn <> ERROR_SUCCESS Then
        MsgBox "Error Setting Long (DWORD) Value!"
      End If
  End Select

  '-- Close The Registry Key.
  RegCloseKey (hKey)
  
End Sub

'-------------------------------------------------------------
'-- Procedure   : Public Method VbRegDeleteValue
'-- Programmer  : Raymond L. King
'-- Created On  : Sunday, May 17, 1998 11:03:49 AM
'-- Module      : VbRegMod
'-- Module File : VbRegMod.bas
'-- Project     : Project1
'-- Project File: Project1.vbp
'-- Parameters  :
'-- RootKey     : The Root Key To Open, EG: HKEY_CURRENT_USER
'-- KeyName     : The Key Name To Open
'--             : Example: MySettings\Settings
'-- ValueName   : The Value Name To Delete
'-------------------------------------------------------------
'
Public Sub VbRegDeleteValue _
           (RootKey As Long, KeyName As String, ValueName As String)

  Dim lRtn    As Long        '-- API Call Returned Value
  Dim hKey    As Long        '-- Handle Of Opened Key
  
  '-- Open Registry Key...
  lRtn = RegOpenKeyEx(RootKey, KeyName, 0&, KEY_ALL_ACCESS, hKey)
  
  '-- Check For An Error.
  If lRtn <> ERROR_SUCCESS Then
    MsgBox OpenErr
    RegCloseKey (hKey)
    Exit Sub
  End If
  
  '-- Delete Opened Key Value Name...
  lRtn = RegDeleteValue(hKey, ValueName)
  '-- Check For An Error.
  If lRtn <> ERROR_SUCCESS Then
    MsgBox DeleteErr
  End If
  
  '-- Close The Registry Key.
  RegCloseKey (hKey)
  
End Sub