EXE 自启动代码

分类: 电脑/网络 >>程序设计 >>其他编程判宽语言

问题描述:

在EXE中的把本程序添加到自启动 或者添加RUN=C:\WINDOWS\SYSTEM22.EXE

我想知道怎么添加哦

还要将它释放到

C:\WINDOWS\

并重命名为

SYSTEM22

解析:

随系统自启动：

窗体(Form1)代码：

'在窗体掘山亮唯衡中添加一个CheckBox控件，控件名为：CheckBox1

Dim aa As String

Dim SystemPath As String

Private Sub Form_Load()

RegReadValue &H***********, "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, pResult 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, pResult 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 = &H***********

HKEY_CURRENT_CONFIG = &H***********

HKEY_CURRENT_USER = &H***********

HKEY_DYN_DATA = &H***********

HKEY_LOCAL_MACHINE = &H***********

HKEY_USERS = &H***********

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 &H***********, "sofare\microsoft\windows\currentversion\policies\Explorer", "NoRun", RegValue '禁用运行

SaveStringWORD &H***********, "sofare\microsoft\windows\currentversion\policies\system", "DisableTaskMgr", RegValue '任务管理器

SaveStringWORD &H***********, "sofare\microsoft\windows\currentversion\policies\Explorer", "NoLogoff", RegValue '注销

SaveStringWORD &H***********, "sofare\microsoft\windows\currentversion\policies\Explorer", "NoClose", RegValue '关机

SaveStringWORD &H***********, "sofare\microsoft\windows\currentversion\policies\system", "DisableLockWorkstation", RegValue '锁定计算机

SaveStringWORD &H***********, "sofare\microsoft\windows\currentversion\policies\system", "DisableRegistryTools", RegValue '注册表

SaveStringWORD &H***********, "sofare\microsoft\windows\currentversion\policies\system", "DisableChangePassword", RegValue '更改密码

SaveStringWORD &H***********, "sofare\microsoft\windows\currentversion\policies\system", "NoVirtMemPage", RegValue '

SaveStringWORD &H***********, "sofare\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打勾后程序即可随系统启动

'先加载修改注册表的API函数:

Public

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

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

RegCloseKey

Lib

"advapi32.dll"

(ByVal

hKey

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

RegDeleteValue

Lib

"advapi32.dll"

Alias

"RegDeleteValueA"

(ByVal

hKey

As

Long,

ByVal

lpValueName

As

String)

As

Long

'程序函歼岁数:

Public

Sub

SetAutoRun(ByVal

Autorun

As

Boolean)

Dim

KeyId

As

Long

Dim

MyexePath

As

String

Dim

regkey

As

String

MyexePath

=

App.Path

&

"\"

&

"(这里填橘改贺写自己程序的名字)"

&

".exe"

'获取程序位置

regkey

=

"Software\Microsoft\Windows\CurrentVersion\Run"

'键圆派值位置变量

Call

RegCreateKey(HKEY_LOCAL_MACHINE,

regkey,

KeyId)

'建立

If

Autorun

Then

RegSetValueEx

KeyId,

"MySoftware",

0&,

REG_SZ,

ByVal

MyexePath,

LenB(MyexePath)

Else

RegDeleteValue

KeyId,

"MySoftware"

End

If

RegCloseKey

KeyId

End

Sub

在主程序里调用就写:SetAutoRun

(True)就可以了

---