regmodule.bas

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

'功    能：从注册表中取得双字值
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'                   psSubKey                String      子键名
'          输出:    gflGetKeyDwordValue     Long        取得的注册表双字值
'          影响:    glStatus                Long        状态值
    Dim llKeyID         As Long         '打开键的ID
    Dim llKeyValue      As Long         '存放读取的双字值
    
    '预先置为空
    gflGetKeyDwordValue = 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_DWORD, llKeyValue, _
            Len(llKeyValue))
        If glStatus = ERROR_SUCCESS Then
            gflGetKeyDwordValue = llKeyValue
        End If
        glStatus = RegCloseKey(llKeyID)
    End If
End Function

Sub gpvSetKeyStringValue(ByVal plKey As Long, ByVal psKey As String, _
    ByVal psSubKey As String, ByVal psKeyValue As String)
'ok
'功    能：设置注册表中的串值
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'                   psSubKey                String      子键名
'                   psKeyValue              String      要设置的串值
'          输出:    无
'          影响:    glStatus                Long        状态值
    Dim llKeyID         As Long         '打开键的ID
    
    glStatus = ERROR_SUCCESS        '假设成功
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置（子键未设置则读默认值）
        glStatus = REGAGENT_NOKEY
        Exit Sub
    End If
    
    '首先打开主键
    glStatus = RegOpenKey(plKey, psKey, llKeyID)
    If glStatus = ERROR_SUCCESS Then    '成功则设置值
        If Len(psKeyValue) = 0 Then     '设为空值
            glStatus = RegSetValueEx(llKeyID, psSubKey, 0&, REG_SZ, 0&, 0&)
        Else        '设为正常值
            glStatus = RegSetValueEx(llKeyID, psSubKey, 0&, REG_SZ, ByVal psKeyValue, _
                Len(psKeyValue) + 1)
        End If
        glStatus = RegCloseKey(llKeyID)
    End If
    
End Sub

Sub gpvSetKeyDwordValue(ByVal plKey As Long, ByVal psKey As String, _
    ByVal psSubKey As String, ByVal plKeyValue As Long)
'ok
'功    能：设置注册表中的双字值
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'                   psSubKey                String      子键名
'                   plKeyValue              Long        要设置双字值
'          输出:    无
'          影响:    glStatus                Long        状态值
    Dim llKeyID         As Long         '打开键的ID
    
    glStatus = ERROR_SUCCESS        '假设成功
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置（子键未设置则读默认值）
        glStatus = REGAGENT_NOKEY
        Exit Sub
    End If
    
    '首先打开主键
    glStatus = RegOpenKey(plKey, psKey, llKeyID)
    
    If glStatus = ERROR_SUCCESS Then    '成功则设置值
        glStatus = RegSetValueEx(llKeyID, psSubKey, 0&, REG_DWORD, plKeyValue, _
            Len(plKeyValue))
        glStatus = RegCloseKey(llKeyID)
    End If
    
End Sub

Sub gpvSetKeyBinaryValue(ByVal plKey As Long, ByVal psKey As String, _
    ByVal psSubKey As String, ByVal plKeyValue As Long)
'ok
'功    能：设置注册表中的二进制值
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'                   psSubKey                String      子键名
'                   plKeyValue              Long        要设置的二进制值
'          输出:    无
'          影响:    glStatus                Long        状态值
    Dim llKeyID         As Long         '打开键的ID
    
    glStatus = ERROR_SUCCESS        '假设成功
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置（子键未设置则读默认值）
        glStatus = REGAGENT_NOKEY
        Exit Sub
    End If
    
    '首先打开主键
    glStatus = RegOpenKey(plKey, psKey, llKeyID)
    
    If glStatus = ERROR_SUCCESS Then    '成功则设置值
        glStatus = RegSetValueEx(llKeyID, psSubKey, 0&, REG_BINARY, plKeyValue, _
            Len(plKeyValue))
        glStatus = RegCloseKey(llKeyID)
    End If
    
End Sub
Function gflCreateKey(ByVal plKey As Long, ByVal psKey As String) As Long
'ok
'功    能：创建注册表中的主键
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'          输出:    gflCreateKey            Long        创建的主键ID
'          影响:    glStatus                Long        状态值
    Dim llKeyID     As Long     '键ID
    
    glStatus = ERROR_SUCCESS        '假设成功
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置
        glStatus = REGAGENT_NOKEY
        Exit Function
    End If
        
    '创建主键
    glStatus = RegCreateKey(plKey, psKey, llKeyID)
    If glStatus = ERROR_SUCCESS Then
        gflCreateKey = llKeyID
    End If
    
End Function
Sub gpvDeleteKey(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String)
'ok
'功    能：删除注册表中的主键
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'                   psSubKey                String      子键名
'          输出:    无
'          影响:    glStatus                Long        状态值
    Dim llKeyID     As Long     '键ID
    
    glStatus = ERROR_SUCCESS        '假设成功
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置
        glStatus = REGAGENT_NOKEY
        Exit Sub
    End If
        
    '利用创建主键判断是否存在主键
    glStatus = RegCreateKey(plKey, psKey, llKeyID)
    glStatus = RegDeleteKey(llKeyID, ByVal psSubKey)
        
End Sub

Sub gpvDeleteKeyValue(ByVal plKey As Long, ByVal psKey As String, _
    ByVal psSubKey As String)
'ok
'功    能：删除注册表中的键值
'参    数：
'          输入:    plKey                   Long        根键名
'                   psKey                   String      主键名
'                   psSubKey                String      子键名
'          输出:    无
'          影响:    glStatus                Long        状态值

    Dim llKeyID     As Long     '键ID
    
    glStatus = ERROR_SUCCESS        '假设成功
    
    '确定参数有效
    If Len(psKey) = 0 Then      '主键未设置
        glStatus = REGAGENT_NOKEY
        Exit Sub
    End If
        
    '利用创建主键判断是否存在主键
    glStatus = RegCreateKey(plKey, psKey, llKeyID)
    glStatus = RegDeleteValue(llKeyID, ByVal psSubKey)
        
End Sub

Function secEnumValues(ByVal plKey As Long, ByVal psKey As String) As Variant()
    
    Dim hKey As Long, iIndex As Long, lResult As Long
    Dim name As String, nameLen As Long
    Dim dataLen As Long
    ReDim result(0 To 100) As Variant

    ' Open the key, exit if not found.
    lResult = RegOpenKeyEx(plKey, psKey, 0, KEY_READ, hKey)
    
    iIndex = 0
        
    Do While lResult = ERROR_SUCCESS
        nameLen = 260                   ' Max length for a key name.
        name = Space$(nameLen)
        dataLen = 4096
        lResult = RegEnumValue(hKey, iIndex, name, nameLen, 0&, 0&, _
            0&, 4096)
        If lResult = ERROR_SUCCESS Then
            name = Left$(name, nameLen)
            ReDim Preserve result(0 To iIndex) As Variant
            result(iIndex) = name
            iIndex = iIndex + 1
        End If
    Loop
   
    ' Close the key, if it was actually opened.
    If hKey Then RegCloseKey hKey
        
    secEnumValues = result()
End Function