用VB在注册表中新建一项

[fooltutu]

我想在"HKEY_LOCAL_USER\SOFTWARE\Microsoft\Internet Explorer\MenuExt"下新建一项"AA".AA下有一个字符串值-STR和DWORD值-Contexts,并给他俩赋值.STR=C:\Program Files\Thunder Network\Thunder\geturl.htm,STR=255.
我怎么实现?

[SYSSZ]

不知道LZ用的是什么系统,我用的是Xp,在我的注册表里就没有HKEY_LOCAL_USER这样的主键,只有HKEY_CuRRENT_User.可否再检查一下.

[SYSSZ]

我用你的代码改了改,在我的机子成功了

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
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Const REG_SZ As Long = 1
Private Const HKEY_CURRENT_USER = &H80000001
Private Sub Command1_Click()
Dim lReturn As Long '储存返回值以判断是否成功
Dim hKey As Long '储存该键句柄


'打开键(此处用RegCreateKey而不用RegOpenKey是因为若键存在,则两者效果相同;若不存在,则前者创建该键,后者报错)
lReturn = RegCreateKey(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Internet Explorer\MenuExt\AA", hKey)

'检测是否为成功(0)
If lReturn = 0 Then

lReturn = RegSetValueEx(hKey, "Contexts", 0, REG_SZ, "C:\Program Files\Thunder Network\Thunder\geturl.htm", 255)
'检测是否失败
If lReturn <> 0 Then MsgBox "失败"
Else
MsgBox "成功"
End If
RegCloseKey hKey

End Sub

[jhone99]

给你一点提示，你可以搜一下

Private Declare Function fCreateShellLink Lib "vb6stkit.dll" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrlinkarguments As String, ByVal fprivate As Long, ByVal sparent As String) As Long


Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_SZ = 1 ' Unicode nul terminated string

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



Private Sub oCmdCancel_Click()
Unload Me

End Sub

Private Sub oCmdYes_Click()
Dim strFrom As String
Dim strTo As String

Dim ret
Dim strPath As String
Dim strValue As String
Dim b() As Byte


strFrom = App.Path & "\remind.exe"
strTo = "c:\mywork\remind.exe"
FileCopy strFrom, strTo


'添加到桌面
If oChkDesktop.Value Then
fCreateShellLink "..\..\桌面", "remind", "c:\mywork\remind.exe", "", ture, "$(Programs)"
End If

'添加到启动
If oChkStart.Value Then
strPath = "software\microsoft\windows\currentversion\run"
strValue = "remind"
strdata = "c:\mywork\remind.exe" & vbNullChar
b = StrConv(strdata, vbFromUnicode)
RegCreateKey HKEY_LOCAL_MACHINE, strPath, ret
length = UBound(b) + 1
RegSetValueEx ret, strValue, 0, REG_SZ, b(0), length
RegCloseKey ret
End If

oLblDisplay.Caption = " 安装完成"
oChkStart.Visible = False
oChkDesktop.Visible = False
oCmdYes.Enabled = False
oCmdCancel.Caption = "关闭"

End Sub

[SYSSZ]

API函数RegCreateKey就是用来创建注册表项的,先学会 RegCreateKey 函数的用法,再看几个实例,APIguide上有实例,到网上搜一搜,一搜一大堆.

[fooltutu]

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

Private Const HKEY_LOCAL_USER = &H80000002

Const REG_SZ As Long = 1




Private Sub Command1_Click()
Dim lReturn As Long '储存返回值以判断是否成功
Dim hKey As Long '储存该键句柄



'打开键(此处用RegCreateKey而不用RegOpenKey是因为若键存在,则两者效果相同;若不存在,则前者创建该键,后者报错)
lReturn = RegCreateKey(HKEY_LOCAL_USER, "SOFTWARE\Microsoft\Internet Explorer\MenuExt\AA", hKey)

'检测是否为成功(0)
If lReturn = 0 Then

lReturn = RegSetValueEx(hKey, "Contexts", 0, REG_SZ, "C:\Program Files\Thunder Network\Thunder\geturl.htm", 255)

'检测是否失败
If lReturn <> 0 Then MsgBox "失败"
Else
MsgBox "失败"
End If

End Sub



这是我在搜到的一段代码,自己改了下.可以正常运行,但注册表中没有新建成功.