.开机启动: 是通过写这个键值做到HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run 具体代码: 窗体申明部分: 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 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. '具体实现部分 Dim AppName As String Dim re As Long AppName = App.Path & "\" & App.EXEName & ".exe" re = RegOpenKeyEx(HKEY_LOCAL_MACHINE, RegKeyAutoRun, 0, KEY_ALL_ACCESS, hKey) re = RegSetValueEx(hKey, "MYAPP", 0, REG_SZ, ByVal AppName, Len(AppName) + 10) If re <> ERROR_SUCCESS Then Call RegCloseKey(hKey) End If2.打开制定网址: 申明部分: Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long 实现部分: Dim RetVal As Long RetVal = ShellExecute(hwnd, "open", "http://insoft.51.net", "", "", 5)
3.关机:(API的方法)以下代码放在一个标准摸块中: Option Explicit Public Declare Function SetSystemPowerState Lib "kernel32" (ByVal fSuspend As Long, ByVal fForce As Long) As Long Enum HowExitConst EWX_FORCE = 4 ' 强制关机 EWX_LOGOFF = 0 ' 登出 EWX_REBOOT = 2 ' 重开机 EWX_SHUTDOWN = 1 ' 关机 EWX_POWEROFF = 8 '关闭电源 End Enum Const TOKEN_ADJUST_PRIVILEGES = &H20 Const TOKEN_QUERY = &H8 Const SE_PRIVILEGE_ENABLED = &H2 Const ANYSIZE_ARRAY = 1 Public Type LUID lowpart As Long highpart As Long End Type Public Type LUID_AND_ATTRIBUTES pLuid As LUID Attributes As Long End Type Public Type TOKEN_PRIVILEGES PrivilegeCount As Long Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES End Type Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, _ ByVal dwReserved As Long) As Long Public Declare Function GetCurrentProcess Lib "kernel32" () As Long Public Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias _ "LookupPrivilegeValueA" (ByVal lpSystemName As String, _ ByVal lpName As String, lpLuid As LUID) As Long Public Declare Function AdjustTokenPrivileges Lib "advapi32.dll" _ (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, _ NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, _ PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long Public Declare Function OpenProcessToken Lib "advapi32.dll" _ (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, _ TokenHandle As Long) As Long '**************WIN2000安全机制关机************************* Public Sub AdjustToken() Dim hdlProcessHandle As Long Dim hdlTokenHandle As Long Dim tmpLuid As LUID Dim tkp As TOKEN_PRIVILEGES Dim tkpNewButIgnored As TOKEN_PRIVILEGES Dim lBufferNeeded 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 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.
'具体实现部分
Dim AppName As String
Dim re As Long
AppName = App.Path & "\" & App.EXEName & ".exe"
re = RegOpenKeyEx(HKEY_LOCAL_MACHINE, RegKeyAutoRun, 0, KEY_ALL_ACCESS, hKey)
re = RegSetValueEx(hKey, "MYAPP", 0, REG_SZ, ByVal AppName, Len(AppName) + 10)
If re <> ERROR_SUCCESS Then
Call RegCloseKey(hKey)
End If2.打开制定网址:
申明部分:
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
实现部分:
Dim RetVal As Long
RetVal = ShellExecute(hwnd, "open", "http://insoft.51.net", "", "", 5)
Option Explicit
Public Declare Function SetSystemPowerState Lib "kernel32" (ByVal fSuspend As Long, ByVal fForce As Long) As Long
Enum HowExitConst
EWX_FORCE = 4 ' 强制关机
EWX_LOGOFF = 0 ' 登出
EWX_REBOOT = 2 ' 重开机
EWX_SHUTDOWN = 1 ' 关机
EWX_POWEROFF = 8 '关闭电源 End Enum Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Const ANYSIZE_ARRAY = 1
Public Type LUID
lowpart As Long
highpart As Long
End Type Public Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type Public Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, _
ByVal dwReserved As Long) As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias _
"LookupPrivilegeValueA" (ByVal lpSystemName As String, _
ByVal lpName As String, lpLuid As LUID) As Long
Public Declare Function AdjustTokenPrivileges Lib "advapi32.dll" _
(ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, _
NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, _
PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Public Declare Function OpenProcessToken Lib "advapi32.dll" _
(ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, _
TokenHandle As Long) As Long
'**************WIN2000安全机制关机*************************
Public Sub AdjustToken() Dim hdlProcessHandle As Long
Dim hdlTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long
hdlProcessHandle = GetCurrentProcess()
OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), _
hdlTokenHandle LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
tkp.PrivilegeCount = 1
tkp.Privileges(0).pLuid = tmpLuid
tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), _
tkpNewButIgnored, lBufferNeeded
End Sub
'具体实现部分AdjustToken
Call ExitWindowsEx(EWX_POWEROFF, 0)
SHELL ("HTTP:\\WWW.21CN.COM")