求救！！关于写注册表问题！！

''Registry API Declarations...
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32" 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, _
    ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByRef phkResult As Long, _
    ByRef lpdwDisposition As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32" Alias "RegDeleteKeyA" _
    (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
    (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
    ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
    (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
    ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" _
    (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
    ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32" Alias "RegEnumValueA" _
    (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
    ByRef lpcbValueName As Long, ByVal lpReserved As Long, ByRef lpType As Long, _
    ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" _
    (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
    lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As Long, _
    ByVal lpcbClass As Long, lpftLastWriteTime As FileTime) As Long

先想好要在哪里写入，然后用上面说的API
打开
创建
写入
关掉
……

    VB中如何实现注册表的读写

---- “API”中专门提供了处理注册表的函数，不用说也知道，它们肯定功能强大（因为它们是API），但是它们的难度也是不小的。如果你是一个入门者的话，这大概会令你头痛一阵子。不过VB本身还提供了几个函数，专门用来处理注册表，相对来说它们就简单多了，所以我只对它们做一下说明： SaveSetting appname, section, key, value
---- 这句话的作用是将应用程序的信息存入注册表中。其中四个参数都是必要的，其含义分别为：应用程序名，区段，键，值。比如我们要为我们的程序（名为“测试”）的主窗体的位置进行存储，就可以写成： SaveSetting “测试”,”main”,”
    top”,frmMain.Top
SaveSetting “测试”,”main”,”
    Left”,frmMain.Left
SaveSetting “测试”,”main”,”
    Width”,frmMain.Width
SaveSetting “测试”,”main”,”
    Height”,frmMain.Height
---- 这样，就把当前的主窗体的位置进行了记录，在下次打开这个窗体的时候，我们就可以在把这些值取出来。那么如何才能把我们所存储的值取出来呢？这就要用到另一个函数：GetSetting，它的语法是： GetSetting(appname, section, key[, default])
---- 该函数的各部分的意义均和上面的函数的意义相同，所不同的是多了一个default而少了一个value。这个函数最后返回的结果即value值，而default指的是如果所指定的键不存在时，则以default指定的值为返回结果。如果没指定default，则default的默认值是””，即0长度的字符串。接上例，在程序刚开始的时候，我们应该取出上一次所存储的主窗体的位置，可以写成： frmMain.Top = GetSetting
    (“测试”,”main”,”top”)
frmMain.Left = GetSetting
    (“测试”,”main”,”Left”)
frmMain.Height = GetSetting
   (“测试”,”main”,”Height”)
frmMain.Width = GetSetting
    (“测试”,”main”,”Width”)
---- 好了，到此为止，可以暂且告一段落，让我们打开注册表，看一看我们把信息是记录在什么地方了。按照下面的路径打开： HKEY_CURRENT_USER\Software\VB And VBA Program Settings 你会看到你的“测试”就在里边放着。 ---- 当你的应用程序最终被卸载时，你应该考虑（而且你应该这样做）把你写入注册表中的内容清除掉，因为离开了你的应用程序，它们无疑就是一推垃圾而已。要想将它们删掉，我们可以用函数：DeleteSetting，它的语法如下：DeleteSetting appname, [section[, key]] 在几个参数中，只有appname是必须地，其它两项均可选。比如我们要删除窗体的“高”这键，则可以写成：DeleteSetting “测试”,”main”,”Height”如果我们要将”main”这个段整个去掉，则可以写成DeleteSetting “测试”,”main” 如果我们再彻底一些，想将整个应用程序去掉的话，就干脆直接写成： DeleteSetting  “测试”
---- 这种方法的不足之处是只能把信息记录在指定的位置，即 HKEY_CURRENT_USER\Software\VB
    And VBA Program Settings
---- 如果要写入到别的地方，就要借助于API了。

　

Option ExplicitConst REG_SZ As Long = 1
Const REG_DWORD As Long = 4Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003Const ERROR_NONE = 0
Const ERROR_BADDB = 1
Const ERROR_BADKEY = 2
Const ERROR_CANTOPEN = 3
Const ERROR_CANTREAD = 4
Const ERROR_CANTWRITE = 5
Const ERROR_OUTOFMEMORY = 6
Const ERROR_INVALID_PARAMETER = 7
Const ERROR_ACCESS_DENIED = 8
Const ERROR_INVALID_PARAMETERS = 87
Const ERROR_NO_MORE_ITEMS = 259Const KEY_ALL_ACCESS = &H3FConst REG_OPTION_NON_VOLATILE = 0Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
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
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
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
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
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
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
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
Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)'删除键
Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)    Dim lRetVal As Long
    Dim hKey As Long
    lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
    lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
    RegCloseKey (hKey)End Function'删除键值
Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)       Dim lRetVal As Long
       Dim hKey As Long       lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
       lRetVal = RegDeleteValue(hKey, sValueName)
       RegCloseKey (hKey)End Function'赋值(下一层)
Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long    Dim lValue As Long
    Dim sValue As String    Select Case lType
        Case REG_SZ
            sValue = vValue
            SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
        Case REG_DWORD
            lValue = vValue
            SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
        End SelectEnd Function'获取值(下一层)
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long    Dim cch As Long
    Dim lrc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String    On Error GoTo QueryValueExError    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
    If lrc <> ERROR_NONE Then Error 5    Select Case lType
        Case REG_SZ:
            sValue = String(cch, 0)
            lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
            If lrc = ERROR_NONE Then
                vValue = Left$(sValue, cch)
            Else
                vValue = Empty
            End If        Case REG_DWORD:
            lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
            If lrc = ERROR_NONE Then vValue = lValue
        Case Else
            lrc = -1
    End SelectQueryValueExExit:        QueryValueEx = lrc
        Exit FunctionQueryValueExError:        Resume QueryValueExExitEnd Function'建立新键
Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)    Dim hNewKey As Long
    Dim lRetVal As Long

    lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
    RegCloseKey (hNewKey)
End Function'Sub main()
'    '函数在注册表的"HKEY_CURRENT_USER\Software"中建立了
'    '一个SubKey1项并在其中建立了值，并在显示后删除建立
'    '的值，如果你想通过RegEdit看到结果，可以将最后两句
'    '删除，不过要记得手动删除建立的键值
'    CreateNewKey HKEY_CURRENT_USER, "Software\SubKey1\SubKey2"
'    SetKeyValue HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test", "This is just a test", REG_SZ
'    MsgBox QueryValue(HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test")
'    DeleteValue HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test"
'    DeleteKey HKEY_CURRENT_USER, "Software\SubKey1\SubKey2"
'End Sub'给指定的键值赋值
Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)       Dim lRetVal As Long
       Dim hKey As Long       lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
       lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
       RegCloseKey (hKey)End Function'获取指定的键值
Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String) As String       Dim lRetVal As Long
       Dim hKey As Long
       Dim vValue As Variant
       lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
       lRetVal = QueryValueEx(hKey, sValueName, vValue)
       QueryValue = vValue
       RegCloseKey (hKey)
End Function

呵呵,使用savesetting,getsetting吧,很方便的回去自己使用向導建立一個工程,你可以在form_load里看到GetSetting了

用 SaveSetting 很方便的。

'用简单的吗？dim s
s = GetSetting("ll ", "mm", "nn", "")'读，如果没有值，s就等于""
SaveSetting "ll ", "mm", "nn", Text1.Text
'写，将text1中的文本写入
'对应注册表的位置是HKEY_CURRENT_USER\Software\VB and VBA Program Settings\ll\mm\nn
'll mm nn 自己搞个名字吧。

给个思路：'>>>>>>>>>>>>>>>>>>>>>进入系统>>>
Sub Main()
    Dim dblRunCount As Double           '是否为首次运行系统，从注册表内取得入口参数,数值为系统运行次数
    On Error Resume Next
    dblRunCount = CDbl(GetSetting(AppName:=App.Title, section:="System", Key:="RunCount", Default:="0"))
    dblRunCount = dblRunCount + 1       '运行次数累加
    SaveSetting AppName:=App.Title, section:="System", Key:="RunCount", setting:=CStr(dblRunCount) '保存运行次数
    XiTongInit                          '系统初始化，设置等
    frmGYChaXunSys.Show   '加载主界面
End Sub

'给你个简单的代码
Option Explicit
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private 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 ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_DYN_DATA = &H80000006
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_USERS = &H80000003Private Sub Command1_Click()
Dim r As Long, path As String
path = "c:\mydata.mdb"
RegCreateKey HKEY_CURRENT_USER, "AddressOfDataBase", r
RegSetValueEx r, "path", 0, 1, ByVal path, LenB(StrConv(path, vbFromUnicode)) + 1
End Sub

调试易

求救！！关于写注册表问题！！

解决方案 »