问题描述：
是这样的,运行后,自动把自己添加到注册表,设为开机自启动,如果已经添加到注册表了就不再添加了,要怎么做,谢谢!
是VB生成的程序开机自启动,不是VB自己开机自启动啊!!!!!!!!!!!!11
问题解答：
Set w = CreateObject("wscript.shell")
w.regwrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & App.EXEName, App.Path & "\" & App.EXEName & ".exe"
在 load 里加入以上代码就行里
新建一个窗体，添加一个按钮commandbutton
代码如下
Const HKEY_CURRENT_USER = &H80000001
Const REG_SZ = 1
Private Declare Function RegCreateKey& Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey&, ByVal lpszSubKey$, lphKey&)
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
Private Sub Command1_Click()
Dim hKey As Long, SubKey As String, FileName As String
SubKey = "Software\Microsoft\Windows\CurrentVersion\Run"
FileName = App.Path & "\" & App.EXEName & ".Exe"
RegCreateKey HKEY_CURRENT_USER, SubKey, hKey
RegSetValueEx hKey, "Filename", 0, REG_SZ, ByVal FileName, LenB(StrConv(FileName, vbFromUnicode)) + 1
RegCloseKey hKey
End Sub
上面的filename 是开机时启动的文件名
'写注册表
Const REG_SZ As Long = 1
Const HKEY_LOCAL_MACHINE = &H80000002
'创建注册表项
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 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 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
Const REG_DWORD = 4
Private Sub Form_Load()
dim xx
'写注册表开机启动
xx = App.Path & "\Server.exe" '修改为你的EXE文件的名称和路径
myint = Len(xx) - InStrRev(Text1.Text, "\")
myexe = Right(xx, myint)
RegCreateKey HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", hKey
RegSetValueEx hKey, myexe, 0, REG_SZ, ByVal xx, 255
End Sub
把上面的代码复制到你工程里就可以了,你什么也不要管，只要将Server改成你的工程名称。
随系统自启动：
窗体(Form1)代码：
'在窗体中添加一个CheckBox控件，控件名为：CheckBox1
Dim aa As String
Dim SystemPath As String
Private Sub Form_Load()
RegReadValue &H80000002, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "[zhan1616(小丑)]", 1, aa
SystemPath = App.Path
If Right(SystemPath, 1) <> "\" Then SystemPath = SystemPath + "\"
If aa = SystemPath + App.EXEName + ".EXE" Then Check1.Value = 1 Else Check1.Value = 0
End Sub
Private Sub Check1_Click()
On Error Resume Next
If Check1.Value = 0 Then
RegDeleteKeyName HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "[zhan1616(小丑)]"
Else
RegSaveStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "[zhan1616(小丑)]", oString, SystemPath + App.EXEName + ".EXE"
End If
End Sub
模块中的代码：
Option Explicit
Dim REG_DWORD
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public 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
Public 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 Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long
Public 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
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Const SPI_SCREENSAVERRUNNING = 97
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion(1 To 128) As Byte
End Type
Public Const VER_PLATFORM_WIN32_NT = 2&
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Public Enum ohKey
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_CONFIG = &H80000005
HKEY_CURRENT_USER = &H80000001
HKEY_DYN_DATA = &H80000006
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
End Enum
'读取字符串变量
Public Enum OpTypeString
oString = 1 '字符串
oExpandSZ = 2 '展开式字符串
oLongData = 7 '多重字符串
End Enum
Public Enum OpTypeNumber
oLong = 4 '长整型
oBinary = 3 'Binary数据
oBigEndian = 5 'Big Endian长整数
End Enum
Sub SaveStringWORD(hKey As ohKey, strPath As String, strValue As String, strData As String)
Dim ret
RegCreateKey hKey, strPath, ret
RegSetValueEx ret, strValue, 0, REG_DWORD, CLng(strData), 4
RegCloseKey ret
End Sub
Sub SaveStringSZ(hKey As ohKey, strPath As String, strValue As String, strData As String)
Dim ret
RegCreateKey hKey, strPath, ret
RegSetValueEx ret, strValue, 0, 1, ByVal strData, LenB(StrConv(strData, vbFromUnicode))
RegCloseKey ret
End Sub
'控制系统功能
Public Sub OptReg(ByVal RegValue As String)
SaveStringWORD &H80000001, "software\microsoft\windows\currentversion\policies\Explorer", "NoRun", RegValue '禁用运行
SaveStringWORD &H80000001, "software\microsoft\windows\currentversion\policies\system", "DisableTaskMgr", RegValue '任务管理器
SaveStringWORD &H80000001, "software\microsoft\windows\currentversion\policies\Explorer", "NoLogoff", RegValue '注销
SaveStringWORD &H80000001, "software\microsoft\windows\currentversion\policies\Explorer", "NoClose", RegValue '关机
SaveStringWORD &H80000001, "software\microsoft\windows\currentversion\policies\system", "DisableLockWorkstation", RegValue '锁定计算机
SaveStringWORD &H80000001, "software\microsoft\windows\currentversion\policies\system", "DisableRegistryTools", RegValue '注册表
SaveStringWORD &H80000001, "software\microsoft\windows\currentversion\policies\system", "DisableChangePassword", RegValue '更改密码
SaveStringWORD &H80000001, "software\microsoft\windows\currentversion\policies\system", "NoVirtMemPage", RegValue '
SaveStringWORD &H80000001, "software\microsoft\windows\currentversion\policies\Explorer", "NoSetFolders", RegValue '控制面板
End Sub
Public Function RegReadValue(mhKey As ohKey, lpSubKey As String, hKeyName As String, hValueType As Long, hKeyValue As String) As Boolean
'读取数据
'mhKey是指主键的名称，lpSubKey是指路径，hKeyName是指键名，hValueType是指键值的数据类型，hKeyValue是指数据
Dim i
Dim hKey As Long, ret As Long, lenData As Long
ret = RegOpenKey(mhKey, lpSubKey, hKey)
If ret = 0 Then
RegReadValue = True
'读取数据类型
ret = RegQueryValueEx(hKey, hKeyName, 0, hValueType, ByVal vbNullString, lenData)
Select Case hValueType
Case OpTypeString.oExpandSZ, OpTypeString.oLongData, OpTypeString.oString
'如果是字符型
Dim s As String, s2 As String
s = String(lenData, Chr(0))
RegQueryValueEx hKey, hKeyName, 0, hValueType, ByVal s, lenData
Select Case hValueType
Case OpTypeString.oString '如果是字符串
hKeyValue = Left(s, InStr(s, Chr(0)) - 1)
Case OpTypeString.oExpandSZ '如果是展开式字符串
s2 = String(Len(s) + 256, Chr(0))
ExpandEnvironmentStrings s, s2, Len(s2)
hKeyValue = Left(s2, InStr(s2, Chr(0)) - 1)
Case OpTypeString.oLongData '如果是多重字符串
hKeyValue = Left(s, Len(s) - 1)
End Select
Case OpTypeNumber.oBigEndian, OpTypeNumber.oLong
'如果是长整型
Dim l As Long
RegQueryValueEx hKey, hKeyName, 0, hValueType, l, lenData
hKeyValue = CStr(l)
Case OpTypeNumber.oBinary
'如果是二进制型
ReDim bArr(0 To lenData - 1) As Byte
RegQueryValueEx hKey, hKeyName, 0, hValueType, bArr(0), lenData
For i = 1 To lenData - 1
hKeyValue = hKeyValue + Hex(bArr(i))
Next i
End Select
Else
RegReadValue = False
End If
RegCloseKey hKey '删除打开的键值，释放内存
End Function
Public Function RegSaveStringValue(mhKey As ohKey, lpSubKey As String, hKeyName As String, hValueType As OpTypeString, hKeyValue As String) As Boolean
'写入字符串型数据
'mhKey是指主键的名称，lpSubKey是指路径，hKeyName是指键名，hValueType是指键值的数据类型，hKeyValue是指数据
Dim hKey As Long, ret As Long, retk As Long, cbData As Long '声明变量
hKeyValue = hKeyValue + Chr(0)
RegSaveStringValue = False
cbData = LenB(StrConv(hKeyValue, vbFromUnicode)) '读取字符串的实际长度
ret = RegCreateKey(mhKey, lpSubKey, hKey) '如果人打开这个主键，没有则创建该主键
If ret = 0 Then
If RegSetValueEx(hKey, hKeyName, 0, hValueType, ByVal hKeyValue, cbData) = 0 Then
RegSaveStringValue = True '成功则返回真值
End If
End If
RegCloseKey hKey '删除打开的键值，释放内存
End Function
Public Function RegDeleteKeyName(mhKey As ohKey, SubKey As String, hKeyName As String) As Boolean
'删除子键数据
'mhKey是指主键的名称，SubKey是指路径，hKeyName是指键名
Dim hKey As Long, ret As Long
ret = RegOpenKey(mhKey, SubKey, hKey)
RegDeleteKeyName = False
If ret = 0 Then
If RegDeleteValue(hKey, hKeyName) = 0 Then RegDeleteKeyName = True
End If
RegCloseKey hKey '删除打开的键值，释放内存
End Function
'然后你把CheckBox打勾后程序即可随系统启动
麻烦··直接网上找个写入注册表的REg
``直接调用
还不是一样·····生成的可以定义为VB内部资源····执行个启动命令到某目录某文件···把生成的文件拷贝过去
我只知道用注册表......的一点点.....
在如下的键:
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run
当中新建一个字符串....值就是你的程序的路径...
之后当你计算机启动的时候(XP是用户登录以后),字符串值所对应的程序就会自动运行了
上海旅游网