moduleregest.bas

用于SQL数据的登陆连接

Attribute VB_Name = "ModuleRegest"
Option Explicit
Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
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 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 Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
    Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
    '得到键值的内容
    lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
    If lResult = 0 Then
        If lValueType = REG_SZ Then
            '建立缓冲区
            strBuf = String(lDataBufSize, Chr$(0))
            '得到键值的内容
            lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
            If lResult = 0 Then
                '移除多余的空值
                RegQueryStringValue = Trim(strBuf)
                'RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
            End If
        ElseIf lValueType = REG_BINARY Then
            Dim strData As Integer
            '得到键值的内容
            lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
            If lResult = 0 Then
                RegQueryStringValue = strData
            End If
        End If
    End If
End Function

Public Function GetString(hKey As Long, strPath As String, strValue As String)
    Dim Ret
    '打开键值
    RegOpenKey hKey, strPath, Ret
    '得到键值
    GetString = RegQueryStringValue(Ret, strValue)
    '关闭键值
    RegCloseKey Ret
End Function

Public Sub SaveString(hKey As Long, strPath As String, strValue As String, strData As String)
    Dim Ret
    '建立新的键值
    RegCreateKey hKey, strPath, Ret
    '保存字符串到键值
    RegSetValueEx Ret, strValue, 0, REG_SZ, ByVal strData, Len(strData) * 2
    '关闭键值
    RegCloseKey Ret
End Sub

Public Sub SaveStringLong(hKey As Long, strPath As String, strValue As String, strData As String)
    Dim Ret
    '建立新的键值
    RegCreateKey hKey, strPath, Ret
    '保存数值到键值
    RegSetValueEx Ret, strValue, 0, REG_BINARY, CByte(strData), 4
    '关闭键值
    RegCloseKey Ret
End Sub

Public Sub DelSetting(hKey As Long, strPath As String, strValue As String)
    Dim Ret
    '建立新的键值
    RegCreateKey hKey, strPath, Ret
    '删除键值
    RegDeleteValue Ret, strValue
    '关闭键值
    RegCloseKey Ret
End Sub