瑞星卡卡安全论坛技术交流区系统软件 请教关于VB注册表编程的问题

12   1  /  2  页   跳转

请教关于VB注册表编程的问题

请教关于VB注册表编程的问题

我在使用VB进行注册表编程,调用API函数时,系统总是提示溢出错误,不知道是我的语法有问题还是什么没做好,请高手指点指点。
以下是代码和界面:

Private Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type

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, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long


Private Sub CreateNewKey(sNewKeyName As String, lPredefinedKey As Long)
    Dim hNewKey As Long
    Dim lRetVal As Long
    Dim sa As SECURITY_ATTRIBUTES
   
    lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0, vbNullString, reg_option_volatile, key_all_access, sa, hNewKey, nsize)
    MsgBox lRetVal

    If lRetVal = error_success Then
        MsgBox "OK"
    End If
   
    RegCloseKey (hNewKey)
   
End Sub


Private Sub Command1_Click()
    CreateNewKey "htsuna", 2

End Sub

附件附件:

下载次数:336
文件类型:image/pjpeg
文件大小:
上传时间:2007-4-18 12:48:10
描述:



最后编辑2007-04-25 11:01:19
分享到:
gototop
 

因该是这里吧 MsgBox lRetVal
lRetVal 是个LONG类型
MSGBOX 显示lRetVal 的内容 可要STRING的类型啊
所以要转化吧
gototop
 

建议你在加个IF语句来
判断成功后显示的内容
CHAR
要不可能会跳出两个MSGBOX
gototop
 

MSGBOX语句是特意写入的,目的是为了监视对注册表写入的返回值,就是通过这两个对话框看到注册表的写入错误的。
翻看工具书和思考后,经过修改的程序如下,但还是提示错误,有没有高手指点一下啊……


'定义程序调用的常数
Private Const STANDARD_RIGHTS_ALL = &H1F0000

Private Const KEY_QUERY_VALUE = &H1

Private Const KEY_SET_VALUE = &H2

Private Const KEY_CREATE_SUB_KEY = &H4

Private Const KEY_ENUMERATE_SUB_KEYS = &H8

Private Const KEY_NOTIFY = &H10

Private Const KEY_CREATE_LINK = &H20

Private Const SYNCHRONIZE = &H100000

Private 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))

Private Const HKEY_LOCAL_MACHINE = &H80000002

Private Const REG_OPTION_NON_VOLATILE = 0      ' Key is preserved when system is rebooted

Private Const REG_OPTION_VOLATILE = 1          ' Key is not preserved when system is rebooted

Private Const REG_SZ = 1                        ' Unicode nul terminated string

Private Const ERROR_SUCCESS = 0&



'定义程序使用的全局变量
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type


'对函数进行声明
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, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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.



'子函数定义(功能函数)
Private Sub CreateNewKey(LPredefinedKey As Long, sNewKeyName As String, aaa As String)
    Dim hnewkey As Long
    Dim lRetVal As Long
    Dim nSize As Long
    Dim Sa As SECURITY_ATTRIBUTES
   
    '建立htsuna键
    lRetVal = RegCreateKeyEx(LPredefinedKey, sNewKeyName, 0, "", REG_OPTION_VOLATILE, KEY_ALL_ACCESS, Sa, hnewkey, nSize)
    '提示注册表调用返回值,若是错误代码并显示错误信息
    MsgBox lRetVal & ":" & Error(lRetVal)
   
    '设置该键键值为123
    lRetVal = RegSetValueEx(LPredefinedKey, sNewKeyName, 0, REG_SZ, aaa, CLng(Len(aaa)))
    '提示注册表调用返回值,若是错误代码并显示错误信息
    MsgBox lRetVal & ":" & Error(lRetVal)
   
    '若设置成功,提示OK
    If lRetVal = ERROR_SUCCESS Then
        MsgBox "OK"
    End If
   
    '关闭对注册表的调用
    RegCloseKey (hnewkey)
   
End Sub



'主程序,点击command1按钮则执行子程序CreateNEWkey
Private Sub Command1_Click()
    '在HKEY_LOCAL_MACHINE根键下建立htsuna键,并将键值设置为123
    CreateNewKey HKEY_LOCAL_MACHINE, "htsuna", "123"

End Sub
gototop
 

兄弟我以前学过点VB 现在在搞....
我帮你看了一下你的代码
应该不存在什么问题
messagebox可能我理解成delphi中的语法去了VB6可以LONG
问题在CreateNewKey HKEY_LOCAL_MACHINE, "htsuna", "123"
我只知道在HKEY_LOCAL_MACHINE是无法写入项的,但可以创建值
你可以CreateNewKey HKEY_LOCAL_MACHINE, "SOFTWARE\htsuna", "123" 试试 看!
gototop
 

恩,修改后,可以正确在SOFTWARE项里通过CREATENEWKEY命令建立HTSUNA子项了!表示感谢,这是第一次成功建立了一个子项,哈哈哈哈~~~~
但是REGSETVALUEEX命令还是不能正确执行,如调用你说的三个参数,会在HKEY_LOCAL_MACHINE主键下,建立“software\htsuna”的值(而不是在SOFTWARE子项下建立HTSUNA值),但是这个建立出来这个值的内容不是123,而是乱码- -!!
gototop
 

RegSetValueEx 的缓冲区应该是任意类型啊!
我现在有事去了 以后在来仔细看哈
gototop
 

恩,感谢GHRH的持续关注。
经过将RegSetValueEx函数的第一个参数修改为hNewKey,已经正确的在SoftWare\htsuna项下建立了"SoftWare\htsuna"值。
观察RegSetValueEx函数的声明形式,发现最后有一行注释“' Note that if you declare the lpData parameter as String, you must pass it By Value.”,于是,我将函数的使用形式中,最后一个参数的定义变成了“ByVal aaa As String”,程序是能够在指定的值里写入内容了,但是所写出来的值的内容还是乱码,无法正确显示"123"。
不知道问题出在哪。

附当前子程序段:

'子函数定义(功能函数)
Private Sub CreateNewKey(LPredefinedKey As Long, sNewKeyName As String, ByVal aaa As String)
    Dim lRetVal As Long
    Dim hNewkey As Long
    Dim nSize As Long
    Dim Sa As SECURITY_ATTRIBUTES
   
    '建立htsuna键
    lRetVal = RegCreateKeyEx(LPredefinedKey, sNewKeyName, 0, "", REG_OPTION_VOLATILE, KEY_ALL_ACCESS, Sa, hNewkey, nSize)
    '提示注册表调用返回值,若是错误代码并显示错误信息
    MsgBox lRetVal & ":" & Error(lRetVal)
   
    '设置该键键值为123
    lRetVal = RegSetValueEx(hNewkey, sNewKeyName, 0, REG_SZ, aaa, CLng(Len(aaa)))
    '提示注册表调用返回值,若是错误代码并显示错误信息
    MsgBox lRetVal & ":" & Error(lRetVal)
   
    '若设置成功,提示OK
    If lRetVal = ERROR_SUCCESS Then
        MsgBox "OK"
    End If
   
    '关闭对注册表的调用
    RegCloseKey (hNewkey)
   
End Sub
gototop
 

把这里修改成Private Sub CreateNewKey(LPredefinedKey As Long, sNewKeyName As String,  aaa As String)

然后把这里改成
lRetVal = RegSetValueEx(hNewkey, sNewKeyName, 0, REG_SZ, aaa,ByVal CLng(Len(aaa)))
试试 我很久没....
所以也只是根据传值和传址来做分析 呵呵
gototop
 

可以这样使用函数的吗?还没试过,试试。
gototop
 
12   1  /  2  页   跳转
页面顶部
Powered by Discuz!NT