VB将程序加入启动组

发布: 2007-6-21 21:57 | 作者: | 来源: yesky | 查看: 39次 | 进入软件测试论坛讨论

　　本文介绍如何编程设置扫雷程序为开机自运行程序。

　　模块文件registry.bas

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
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Enum RootKey
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
Enum ErrorCode
ERROR_SUCCESS = 0&
ERROR_MORE_DATA = 234&
End Enum

Enum ValueType
REG_NONE = 0
REG_SZ = 1
REG_EXPAND_SZ = 2
REG_BINARY = 3
REG_DWORD = 4
REG_DWORD_BIG_ENDIAN = 5
REG_MULTI_SZ = 7
End Enum

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

Function GetDefaultValue(ByVal hKey As Long, ByVal Subkey As String, Value As String) As Boolean
Dim ret As Long, lenS As Long, S As String
'读取default value的字符串长度
ret = RegQueryValue(hKey, Subkey, "", lenS)
If ret <> 0 And ret <> ERROR_MORE_DATA
Then GetDefaultValue = False
Exit Function
End If
S = String(lenS, Chr(0)) '再根据上一个RegQueryValue返回的lenS值来配置字符串。
ret = RegQueryValue(hKey, Subkey, S, lenS)
If ret <> 0 Then
GetDefaultValue = False
Exit Function
End If
Value = Left(S, lenS - 1)
GetDefaultValue = True
End Function

　　然后在form中放置两个命令按钮command1和command2.

'command1_click要做的事就是设置扫雷程序为开机自启动程序。若操作成功，显示success对话框。
Private Sub Command1_Click()
Dim ret As Boolean
Dim disp As String
ret = SetDefaultValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", "c:\windows\winmine.exe")
If ret Then
disp = "Sucess!"
Else disp = "Fail"
End If
MsgBox disp, , "结果"
End Sub
'command2_click要做的事情就是读入HKEY_CLASSES_ROOT\.txt这个SubKey的Default Value。

Private Sub Command2_Click()
Dim S As String, ret As Boolean
Dim hKey As Long
Dim tmpstr As String
Dim disp As String
tmpstr = "The defaultvalue of HKEY_CLASSES_ROOT\.txt is: "
ret = RegOpenKey(HKEY_CLASSES_ROOT, ".txt", hKey)
ret = GetDefaultValue(hKey, "", S)
If ret Then
If S <> "" Then
disp = tmpstr & S
Else
disp = tmpstr & "NoDefaultValue"
End If
End If
MsgBox disp, , "结果"
End Sub