VB中碰到的几个小问题

[csdn204]

帮忙看一下，为何单击Command1总是弹出"Fail":

--------------------------------------------------------
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long


Function SetDefaultValue(ByVal hKey As Long, ByVal Subkey As String, ByVal Value As String) As Boolean
Dim ret As Long, lenS As Long, S As String
ret = RegSetValue(hKey, Subkey, REG_SZ, Value, LenB(StrConv(Value, vbFromUnicode)) + 1)
SetDefaultValue = (ret = 0)
End Function


Private Sub Command1_Click()
Dim ret As Boolean
Dim disp As String
ret = SetDefaultValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", "c:\windows\1.exe")
If ret Then
disp = "Sucess!"
Else: disp = "Fail"
End If
MsgBox disp, , "结果"
End Sub
------------------------------------------------------------

2.
我如何在VB中编程执行如http://www.js.net/CheckOk.asp程序。

[csdn204]

自己顶

[华芸智森]

'下面函数可实现 基本的注册表操作.(如建立子键,删除子键,保存值,删除值等),你只需要将其粘贴到一个模块中即可.

Option Explicit

'类型.
Public Enum RegDataType
'REG_NONE = 0 ' No value type
REG_SZ = 1 ' Unicode nul terminated string
'REG_EXPAND_SZ = 2 ' Unicode nul terminated string
REG_BINARY = 3 ' Free form binary
'REG_DWORD = 4 ' 32-bit number
'REG_DWORD_LITTLE_ENDIAN = 4 ' 32-bit number (same as REG_DWORD)
'REG_DWORD_BIG_ENDIAN = 5 ' 32-bit number
End Enum

Public Enum RegMainKey
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_CURRENT_CONFIG = &H80000005
HKEY_DYN_DATA = &H80000006
End Enum
'
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_ALL = &H1F0000
'----------------------------------------------------------------
Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) _
And (Not SYNCHRONIZE))
Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or _
KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
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))
Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Const ERROR_SUCCESS = 0&
'-----------------------------------------------------------------
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
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 RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private 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
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

'建立子键.
Public Function RegCreatesubKey(hKey As RegMainKey, subKey As String) As Variant
Dim Ret As Variant
If Left$(subKey, 1) = "\" Then subKey = Right$(subKey, Len(subKey) - 1)
If Right$(subKey, 1) = "\" Then subKey = Left$(subKey, Len(subKey) - 1)
RegCreateKey hKey, subKey, Ret
RegCreatesubKey = Ret
End Function

'删除子键
Public Function RegDeletesubKey(hKey As RegMainKey, subKey As String)
If Left$(subKey, 1) = "\" Then subKey = Right$(subKey, Len(subKey) - 1)
If Right$(subKey, 1) = "\" Then subKey = Left$(subKey, Len(subKey) - 1)
RegDeleteKey hKey, subKey
End Function

'保存值到注册表.
Public Function RegSaveData(hKey As RegMainKey, subKey As String, ValName As String, KeyVal As String, Optional ValType As RegDataType = REG_SZ) As Long
Dim Ret As Long

On Error Resume Next

Ret = 0
If Left$(subKey, 1) = "\" Then subKey = Right$(subKey, Len(subKey) - 1)
If Right$(subKey, 1) = "\" Then subKey = Left$(subKey, Len(subKey) - 1)
If ValType = RegDataType.REG_BINARY Then
Ret = SaveStringLong(hKey, subKey, ValName, KeyVal)
Else
Ret = SaveString(hKey, subKey, ValName, KeyVal)
End If
RegSaveData = Ret
End Function

'取注册表中的值.
Public Function RegGetVal(hKey As RegMainKey, subKey As String, ValName As String) As Variant
Dim Ret As Variant
If Left$(subKey, 1) = "\" Then subKey = Right$(subKey, Len(subKey) - 1)
If Right$(subKey, 1) = "\" Then subKey = Left$(subKey, Len(subKey) - 1)
Ret = GetString(hKey, subKey, ValName)
RegGetVal = Ret
End Function

'删除注册表中的值.
Public Function RegDelVal(hKey As RegMainKey, subKey As String, ValName As String)
DelSetting hKey, subKey, ValName
End Function

'===================================================================================

'以下函数为功能函数.
'取注册表中的值.
Function GetString(hKey As RegMainKey, subKey As String, ValName As String) As Variant
On Error Resume Next
Dim Ret As Variant
RegOpenKey hKey, subKey, Ret
GetString = RegQueryStringValue(Ret, ValName)
RegCloseKey Ret
End Function

'保存字符串.
Function SaveString(hKey As RegMainKey, subKey As String, ValName As String, strData As String)
Dim Ret As Variant
Dim ReturnVal As Long
On Error Resume Next
RegCreateKey hKey, subKey, Ret
ReturnVal = RegSetValueEx(Ret, ValName, 0, RegDataType.REG_SZ, ByVal strData, Len(strData))
RegCloseKey Ret
End Function

'保存值二进制值.
Function SaveStringLong(hKey As RegMainKey, subKey As String, ValName As String, strData As String) As Variant
Dim Ret As Variant
On Error Resume Next
RegCreateKey hKey, subKey, Ret
RegSetValueEx Ret, ValName, 0, RegDataType.REG_BINARY, CByte(strData), 1
RegCloseKey Ret
End Function

'删除值
Function DelSetting(hKey As RegMainKey, subKey As String, ValName As String)
Dim Ret As Variant

On Error Resume Next

RegCreateKey hKey, subKey, Ret
RegDeleteValue Ret, ValName
RegCloseKey Ret
End Function

[华芸智森]

关于你的第二个问题,调用以下函数:
'
'运行一个程序或文档.
'函数:RunFile
'参数:FilePath 要打开的文件路径
'返回值:无
'注:实际上是 [开始]==>[运行]
Public Function RunFile(FilePath As String)
Call Shell("rundll32.exe url.dll,FileProtocolHandler " & FilePath, 1)
End Function

[sqfeiyu]

问题2：
shell "explorer http://www.js.net/CheckOk.asp"

[csdn204]

如何让被访问的这个网页在后台运行呢