vbreg.bas

使用modem实现的来电显示程序,可以用参考串口编程

    ReDim hKey(0)
    Dim dwIndex As Long
    hKey(0) = HKEYMAIN
    i = 0
    dx = InStr(Key$, "\")
    Do While dx <> 0
        ReDim Preserve hKey(UBound(hKey) + 1)
        lResult = RegOpenKeyEx(hKey(i), Mid(Key$, 1, dx - 1), 0, KEY_ALL_ACCESS, hKey(i + 1))
        '递归打开键值
        If hKey(i + 1) = 0 Then     '不存在此键值时返回
            GoTo DeleteToExit
        End If
        i = i + 1
        Key$ = Mid(Key$, dx + 1)
        dx = InStr(Key$, "\")
    Loop
    '存在键值时删除
    lpName = Space(50)
    lnName = 50
    lpClass = Space(50)
    lnClass = 50
    dwIndex = 0
    Do
        lpresult = RegEnumValue(hKey(i), dwIndex, lpName, lnName, 0, REG_SZ, StrPtr(lpClass), lnClass)
        
        dwIndex = dwIndex + 1
    Loop Until lpresult = ERROR_NO_MORE_ITEMS
'关闭主键
DeleteToExit:
    For i = UBound(hKey) To 1 Step -1
        If hKey(i) <> 0 Then RegCloseKey hKey(i)
    Next i
End Sub
' 函数名: ReadKey_String
'-----------------------------------------------------
' 创建: 1997-10-22   By: 陈
' 修改:              By:
'=====================================================
'从Registy 中读串值
'
'Key       关键字
    ' 例 software\FK\COMM\settings 中
    'software\FK\COMM\ 为主键
    'settings 为配置
'返回字符串
'
Function ReadKey_String(ByVal Key As String) As String
Dim hKey() As Long, lResult As Long
ReDim hKey(0)
Dim szBuffer As String
Dim lBuffSize As Long
Dim SA As SECURITY_ATTRIBUTES
Dim i   As Integer
Dim dx  As Integer

    hKey(0) = HKEYMAIN
    szBuffer = Space(150)
    lBuffSize = Len(szBuffer)
    i = 0
    dx = InStr(Key$, "\")
    Do While dx <> 0
        ReDim Preserve hKey(UBound(hKey) + 1)
        lResult = RegOpenKeyEx(hKey(i), Mid(Key$, 1, dx - 1), 0, 1, hKey(i + 1))
        '递归打开键值
        If hKey(i + 1) = 0 Then     '不存在此键值时返回
            ReadKey_String = ""
            GoTo CloseToExit
        End If
        i = i + 1
        Key$ = Mid(Key$, dx + 1)
        dx = InStr(Key$, "\")
    Loop
    
    '存在键值时读取
    If Key <> "" Then
        lResult = RegQueryValueExStr(hKey(i), Key, 0, REG_SZ, szBuffer, lBuffSize)
        If lResult Then
            'lResult = RegSetValueExStr(hKey(i), Key, 0, REG_SZ, szBuffer, Len(szBuffer))
        End If
        '获取返回值
        If lResult = 0 Then ReadKey_String = Mid(szBuffer, 1, lBuffSize - 1)
    End If
    
'关闭主键
CloseToExit:
    For i = UBound(hKey) To 1 Step -1
        If hKey(i) <> 0 Then RegCloseKey hKey(i)
    Next i
End Function

' 函数名: WriteKey_Binary
'-----------------------------------------------------
' 创建: 1997-10-22   By: 陈
' 修改:              By:
'=====================================================
'向Registy 中写入值
'
'Key       关键字
    ' 例 software\FK\COMM\settings 中
    'software\FK\COMM\ 为主键
    'settings 为配置
'szBuffer  设置的二进制数据单元
'lBuffSize 单元长度
Sub WriteKey_Binary(ByVal Key As String, ByVal szBuffer As String)
Dim hKey() As Long, lResult As Long, i As Integer
ReDim hKey(0)
Dim SA As SECURITY_ATTRIBUTES
Dim dx  As Integer
    hKey(0) = HKEYMAIN
    i = 0
    
    dx = InStr(Key$, "\")
    Do While dx <> 0
        ReDim Preserve hKey(UBound(hKey) + 1)
        lResult = RegOpenKeyEx(hKey(i), Mid(Key$, 1, dx - 1), 0, 1, hKey(i + 1))
        If hKey(i + 1) = 0 Then
            lResult = RegCreateKeyEx(hKey(i), Mid(Key$, 1, dx - 1), 0, "", REG_OPTION_NON_VOLATILE, _
            KEY_ALL_ACCESS, SA, hKey(i + 1), REG_CREATED_NEW_KEY)
        End If
        i = i + 1
        Key$ = Mid(Key$, dx + 1)
        dx = InStr(Key$, "\")
    Loop
    If Key <> "" Then
        lResult = RegSetValueExStr(hKey(i), Key, 0, REG_BINARY, szBuffer, Len(szBuffer))
    End If
    For i = UBound(hKey) To 1 Step -1
        If hKey(i) <> 0 Then RegCloseKey hKey(i)
    Next i
End Sub

' 函数名: WriteKey_DWORD
'-----------------------------------------------------
' 创建: 1997-10-22   By: 陈
' 修改:              By:
'=====================================================
'向Registy 中写入值
'
'Key       关键字
    ' 例 software\FK\COMM\settings 中
    'software\FK\COMM\ 为主键
    'settings 为配置
'szBuffer  设置的 DWORD
'
Sub WriteKey_DWORD(ByVal Key As String, ByVal szBuffer As Long)
Dim hKey() As Long, lResult As Long
Dim i   As Integer
Dim dx  As Integer
    ReDim hKey(0)
    Dim SA As SECURITY_ATTRIBUTES
    hKey(0) = HKEYMAIN
    i = 0
    
    dx = InStr(Key$, "\")
    Do While dx <> 0
        ReDim Preserve hKey(UBound(hKey) + 1)
        lResult = RegOpenKeyEx(hKey(i), Mid(Key$, 1, dx - 1), 0, 1, hKey(i + 1))
        If hKey(i + 1) = 0 Then
            lResult = RegCreateKeyEx(hKey(i), Mid(Key$, 1, dx - 1), 0, "", REG_OPTION_NON_VOLATILE, _
            KEY_ALL_ACCESS, SA, hKey(i + 1), REG_CREATED_NEW_KEY)
        End If
        i = i + 1
        Key$ = Mid(Key$, dx + 1)
        dx = InStr(Key$, "\")
    Loop
    If Key <> "" Then
        lResult = RegSetValueEx(hKey(i), Key, 0, REG_DWORD, szBuffer, 4)
    End If
    For i = UBound(hKey) To 1 Step -1
        If hKey(i) <> 0 Then RegCloseKey hKey(i)
    Next i
End Sub

' 函数名: WriteKey_String
'-----------------------------------------------------
' 创建: 1997-10-22   By: 陈
' 修改:              By:
'=====================================================
'向Registy 中写入值
'
'Key       关键字
    ' 例 software\FK\COMM\settings 中
    'software\FK\COMM\ 为主键
    'settings 为配置
'szBuffer  设置的字符串值
'
Sub WriteKey_String(ByVal Key As String, ByVal szBuffer As String)
Dim hKey() As Long, lResult As Long
ReDim hKey(0)
Dim SA As SECURITY_ATTRIBUTES
Dim i   As Integer
Dim dx  As Integer
    hKey(0) = HKEYMAIN
    i = 0
    
    dx = InStr(Key$, "\")
    Do While dx <> 0
        ReDim Preserve hKey(UBound(hKey) + 1)
        lResult = RegOpenKeyEx(hKey(i), Mid(Key$, 1, dx - 1), 0, 1, hKey(i + 1))
        If hKey(i + 1) = 0 Then
            lResult = RegCreateKeyEx(hKey(i), Mid(Key$, 1, dx - 1), 0, "", REG_OPTION_NON_VOLATILE, _
            KEY_ALL_ACCESS, SA, hKey(i + 1), REG_CREATED_NEW_KEY)
        End If
        i = i + 1
        Key$ = Mid(Key$, dx + 1)
        dx = InStr(Key$, "\")
    Loop
    If Key <> "" Then
        lResult = RegSetValueExStr(hKey(i), Key, 0, REG_SZ, szBuffer, Len(szBuffer))
    End If
    For i = UBound(hKey) To 1 Step -1
        If hKey(i) <> 0 Then RegCloseKey hKey(i)
    Next i
End Sub

' 函数名: ReadKey_Binary
'-----------------------------------------------------
' 创建: 1997-10-22   By: 陈
' 修改:              By:
'=====================================================
'从Registy 中读串值
'
'Key       关键字
    ' 例 software\FK\COMM\settings 中
    'software\FK\COMM\ 为主键
    'settings 为配置
'返回字符串
'
Function ReadKey_Binary(ByVal Key As String) As String
Dim hKey() As Long, lResult As Long
ReDim hKey(0)
Dim szBuffer(250) As Byte
Dim lBuffSize As Long
Dim SA As SECURITY_ATTRIBUTES
Dim i   As Integer
Dim dx  As Integer

    hKey(0) = HKEYMAIN
    'szBuffer = Space(200)
    'lBuffSize = Len(szBuffer)
    lBuffSize = 250
    i = 0
    dx = InStr(Key$, "\")
    Do While dx <> 0
        ReDim Preserve hKey(UBound(hKey) + 1)
        lResult = RegOpenKeyEx(hKey(i), Mid(Key$, 1, dx - 1), 0, 1, hKey(i + 1))
        '递归打开键值
        If hKey(i + 1) = 0 Then     '不存在此键值时返回
            ReadKey_Binary = ""
            GoTo CloseToExit
        End If
        i = i + 1
        Key$ = Mid(Key$, dx + 1)
        dx = InStr(Key$, "\")
    Loop
    
    '存在键值时读取
    If Key <> "" Then
        lResult = RegQueryValueEx(hKey(i), Key, 0, REG_BINARY, szBuffer(0), lBuffSize)
        '获取返回值
        If lResult = 0 Then ReadKey_Binary = MidB(szBuffer, 1, lBuffSize)
    End If
    
'关闭主键
CloseToExit:
    For i = UBound(hKey) To 1 Step -1
        If hKey(i) <> 0 Then RegCloseKey hKey(i)
    Next i
End Function

' 函数名: ReadKey_DWORD
'-----------------------------------------------------
' 创建: 1997-10-22   By: 陈
' 修改:              By:
'=====================================================
'从Registy 中读串值
'
'Key       关键字
    ' 例 software\FK\COMM\settings 中
    'software\FK\COMM\ 为主键
    'settings 为配置
'返回字符串
'
Function ReadKey_DWORD(ByVal Key As String) As Long
Dim hKey() As Long, lResult As Long
ReDim hKey(0)
Dim szBuffer As Long
Dim SA As SECURITY_ATTRIBUTES
Dim i   As Integer
Dim dx  As Integer

    hKey(0) = HKEYMAIN
    
    i = 0
    dx = InStr(Key$, "\")
    Do While dx <> 0
        ReDim Preserve hKey(UBound(hKey) + 1)
        lResult = RegOpenKeyEx(hKey(i), Mid(Key$, 1, dx - 1), 0, 1, hKey(i + 1))
        '递归打开键值
        If hKey(i + 1) = 0 Then     '不存在此键值时返回
            ReadKey_DWORD = 0
            GoTo CloseToExit
        End If
        i = i + 1
        Key$ = Mid(Key$, dx + 1)
        dx = InStr(Key$, "\")
    Loop
    
    '存在键值时读取
    If Key <> "" Then
        lResult = RegQueryValueEx(hKey(i), Key, 0, REG_DWORD, szBuffer, 4)
        '获取返回值
        If lResult = 0 Then ReadKey_DWORD = szBuffer
    End If
    
'关闭主键
CloseToExit:
    For i = UBound(hKey) To 1 Step -1
        If hKey(i) <> 0 Then RegCloseKey hKey(i)
    Next i
End Function