regmodule.bas

一个功能强大、程序条理分明的学生学籍管理系统

Attribute VB_Name = "RegModule"
Option Explicit

'读写注册表任何地方的函数
'用于操作注册表的API函数定义    -begin-
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
    (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
        
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
        
Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" _
    (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, _
    ByVal lpData As String, ByVal cbData As Long) As Long
        
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
        
Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" _
    (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, _
    lpcbValue As Long) As Long
        
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
        
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
    (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
        
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
    (ByVal hKey As Long, ByVal lpSubKey As String) As Long
        
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
    (ByVal hKey As Long, ByVal lpValueName As String) As Long
        
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" _
    (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
    ByVal cbName As Long) As Long

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, lpType As Long, _
    ByVal lpData As String, lpcbData As Long) As Long

Private 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

'用于操作注册表的API函数定义    -end-

#If WinNT Then
'打开注册文件的方式
Public Const KEY_EVENT = &H1
Public Const KEY_NOTIFY = &H10
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_CREATE_LINK = &H20
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_EXECUTE = (KEY_READ)
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) 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))
#End If
'''''

'用于操作注册表的常数定义   -begin-
'预定义的根结点
'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_PERFORMANCE_DATA = &H80000004
'Public Const HKEY_USERS = &H80000003
'预定义的键值类型
'Public Const REG_NONE = 0
'Public Const REG_SZ = 1
'Public Const REG_EXPAND_SZ = 2
'Public Const REG_BINARY = 3
'Public Const REG_DWORD = 4
'Public Const REG_DWORD_LITTLE_ENDIAN = 4
'Public Const REG_DWORD_BIG_ENDIAN = 5
'Public Const REG_LINK = 6
'Public Const REG_MULTI_SZ = 7
'Public Const REG_RESOURCE_LIST = 8
'Public Const REG_FULL_RESOURCE_DESCRIPTOR = 9
'Public Const REG_RESOURCE_REQUIREMENTS_LIST = 10

'masks for the predefined standard access types
Const STANDARD_RIGHTS_ALL = &H1F0000
Const SPECIFIC_RIGHTS_ALL = &HFFFF
Const SYNCHRONIZE = &H100000
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)

Const KEY_QUERY_VALUE = &H1
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_READ = ((READ_CONTROL Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))



'注册文件错误描述
Const ERROR_SUCCESS = 0&
Const ERROR_BADDB = 1009&
Const ERROR_BADKEY = 1010&
Const ERROR_CANTOPEN = 1011&
Const ERROR_CANTREAD = 1012&
Const ERROR_CANTWRITE = 1013&
Const ERROR_REGISTRY_RECOVERED = 1014&
Const ERROR_REGISTRY_CORRUPT = 1015&
Const ERROR_REGISTRY_IO_FAILED = 1016&
Const ERROR_NOT_REGISTRY_FILE = 1017&
Const ERROR_KEY_DELETED = 1018&
Const ERROR_NO_LOG_SPACE = 1019&
Const ERROR_KEY_HAS_CHILDREN = 1020&
Const ERROR_CHILD_MUST_BE_VOLATILE = 1021&
Const ERROR_RXACT_INVALID_STATE = 1369&
' 自定义注册文件错误
Const REGAGENT_NOKEY = -1002
Const REGAGENT_NOSUBKEY = -1003
'用于操作注册表的常数定义   -end-

Function CheckRegKey(ByVal plKey As Long, ByVal psKey As String) As Long

'功    能：判断键是否存在
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'          输出:    lStatus                Long        状态值
    Dim hKey         As Long         '打开键的ID
    
    glStatus = ERROR_SUCCESS            '假设成功
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置（子键未设置则读默认值）
        glStatus = REGAGENT_NOKEY
        Exit Function
    End If
    
    glStatus = RegOpenKeyEx(plKey, psKey, 0, KEY_READ, hKey)
    
    CheckRegKey = glStatus
    
    glStatus = RegCloseKey(hKey)
End Function

Function gfsGetKeyStringValue(ByVal plKey As Long, ByVal psKey As String, _
    ByVal psSubKey As String) As String

'功    能：从注册表中取得串值
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'                   psSubKey                String      子键名
'          输出:    gfsGetKeyStringValue    String      取得的注册表串值
'          影响:    glStatus                Long        状态值
    Dim llKeyID         As Long         '打开键的ID
    Dim llBufferSize    As Long         '需读取串的串值长度
    Dim lsKeyValue      As String       '存放读取的串值
    
    '预先置为空
    gfsGetKeyStringValue = Empty
    
    glStatus = ERROR_SUCCESS        '假设成功
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置（子键未设置则读默认值）
        glStatus = REGAGENT_NOKEY
        Exit Function
    End If
       
    '首先打开主键
    glStatus = RegOpenKey(plKey, psKey, llKeyID)
    
    If glStatus = ERROR_SUCCESS Then    '成功则取需读取字串的串值大小
        glStatus = RegQueryValueEx(llKeyID, psSubKey, 0&, REG_SZ, 0&, llBufferSize)
        If llBufferSize < 2 Then    '空值
            glStatus = RegCloseKey(llKeyID)
        Else    '有值，正式读取串值
            lsKeyValue = String(llBufferSize + 1, " ")
            glStatus = RegQueryValueEx(llKeyID, psSubKey, 0&, REG_SZ, ByVal lsKeyValue, _
                llBufferSize)
            If glStatus = ERROR_SUCCESS Then
                gfsGetKeyStringValue = Left$(lsKeyValue, llBufferSize - 1)
            End If
            glStatus = RegCloseKey(llKeyID)
        End If
    End If
End Function

Function gflGetKeyBinaryValue(ByVal plKey As Long, ByVal psKey As String, _
    ByVal psSubKey As String) As Long

'功    能：从注册表中取得二进制值
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'                   psSubKey                String      子键名
'          输出:    gflGetKeyBinaryValue    Long        取得的注册表二进制值
'          影响:    glStatus                Long        状态值
    Dim llKeyID         As Long         '打开键的ID
    Dim llKeyValue      As Long         '存放读取的二进制值
    
    '预先置为空
    gflGetKeyBinaryValue = Empty
    
    glStatus = ERROR_SUCCESS        '假设成功
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置（子键未设置则读默认值）
        glStatus = REGAGENT_NOKEY
        Exit Function
    End If
       
    '首先打开主键
    glStatus = RegOpenKey(plKey, psKey, llKeyID)
    
    If glStatus = ERROR_SUCCESS Then    '成功则取二进制值
        glStatus = RegQueryValueEx(llKeyID, psSubKey, 0&, REG_BINARY, llKeyValue, _
            Len(llKeyValue))
        If glStatus = ERROR_SUCCESS Then
            gflGetKeyBinaryValue = llKeyValue
        End If
        glStatus = RegCloseKey(llKeyID)
    End If
End Function

Function gflGetKeyDwordValue(ByVal plKey As Long, ByVal psKey As String, _
    ByVal psSubKey As String) As Long
'ok