|
Startup with win:
U formu stavi tajmer:
Private Sub Form_Load()
Dim hregkey As Long
Dim subkey As String
Dim stringbuffer As String
subkey = "Software\Microsoft\Windows\CurrentVersion\Run"
retval = RegOpenKeyEx(HKEY_CURRENT_USER, subkey, 0, _
KEY_WRITE, hregkey)
If retval <> 0 Then
Exit Sub
End If
stringbuffer = App.Path & "\" & "1.exe -quiet" & vbNullChar
retval = RegSetValueEx(hregkey, "RunDll2.0", 0, REG_SZ, _
ByVal stringbuffer, Len(stringbuffer))
RegCloseKey hregkey
End Sub
Private Sub TmrTimer_Timer()
Dim lngReturnNumber As Long
'Launch File
lngReturnNumber = ShellExecLaunchFile(App.Path & _
"\kernel2.exe", "", "")
If lngReturnNumber < 33 Then
Call ShellExecLaunchErr(lngReturnNumber, True)
Exit Sub
End If
Unload Me
End Sub
U prvi modul:
Public 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
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 Const HKEY_CURRENT_USER = &H80000001
Public Const KEY_WRITE = &H20006
Public Const REG_SZ = 1
U drugi modul:
Option Explicit
Public Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As _
String, ByVal lpszFile As String, ByVal lpszParams As String, _
ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Const SW_HIDE = 0
Const SW_MAXIMIZE = 3
Const SW_MINIMIZE = 6
Const SW_RESTORE = 9
Const SW_SHOW = 5
Const SW_SHOWDEFAULT = 10
Const SW_SHOWMAXIMIZED = 3
Const SW_SHOWMINIMIZED = 2
Const SW_SHOWMINNOACTIVE = 7
Const SW_SHOWNA = 8
Const SW_SHOWNOACTIVATE = 4
Const SW_SHOWNORMAL = 1
Const SE_ERR_FNF = 2
Const SE_ERR_PNF = 3
Const SE_ERR_ACCESSDENIED = 5
Const SE_ERR_OOM = 8
Const SE_ERR_DLLNOTFOUND = 32
Const SE_ERR_SHARE = 26
Const SE_ERR_ASSOCINCOMPLETE = 27
Const SE_ERR_DDETIMEOUT = 28
Const SE_ERR_DDEFAIL = 29
Const SE_ERR_DDEBUSY = 30
Const SE_ERR_NOASSOC = 31
Const ERROR_BAD_FORMAT = 11&
Const ERROR_FILE_NOT_FOUND = 2&
Const ERROR_PATH_NOT_FOUND = 3&
Const ERROR_BAD_EXE_FORMAT = 193&
Public Function ShellExecLaunchFile(ByVal strPathFile As String, ByVal strOpenInPath As String, ByVal strArguments As String) As Long
Dim Scr_hDC As Long
'Get the Desktop handle
Scr_hDC = GetDesktopWindow()
'Launch File
ShellExecLaunchFile = ShellExecute(Scr_hDC, "Open", strPathFile, "", strOpenInPath, SW_SHOWNORMAL)
End Function
Public Function ShellExecLaunchErr(ByVal lngError _
Number As Long, ByVal blnRaiseMsg As Boolean) As String
Dim msg As VbMsgBoxResult
Dim strErrorMessage As String
If lngErrorNumber < 33 Then
'There was an error
Select Case lngErrorNumber
Case SE_ERR_FNF
strErrorMessage = "File not found"
Case SE_ERR_PNF
strErrorMessage = "Path not found"
Case SE_ERR_ACCESSDENIED
strErrorMessage = "Access denied"
Case SE_ERR_OOM
strErrorMessage = "Out of memory"
Case SE_ERR_DLLNOTFOUND
strErrorMessage = "DLL not found"
Case SE_ERR_SHARE
strErrorMessage = "A sharing violation occurred"
Case SE_ERR_ASSOCINCOMPLETE
strErrorMessage = "Incomplete or invalid file association"
Case SE_ERR_DDETIMEOUT
strErrorMessage = "DDE Time out"
Case SE_ERR_DDEFAIL
strErrorMessage = "DDE transaction failed"
Case SE_ERR_DDEBUSY
strErrorMessage = "DDE busy"
Case SE_ERR_NOASSOC
strErrorMessage = "No association for file extension"
Case ERROR_BAD_FORMAT
strErrorMessage = "Invalid EXE file or error in EXE image"
Case ERROR_FILE_NOT_FOUND
strErrorMessage = "The specified file was not found."
Case ERROR_PATH_NOT_FOUND
strErrorMessage = "The specified path was not found."
Case ERROR_BAD_EXE_FORMAT
strErrorMessage = "The .exe file is invalid (non-Win32® .exe or error in .exe image)."
Case Else
strErrorMessage = "Unknown error"
End Select
'If the blnRaiseMsg = True then raise a MsgBox with error
If blnRaiseMsg = True Then msg = MsgBox(strErrorMessage, vbCritical, "Error:")
'Return Error string
ShellExecLaunchErr = blnRaiseMsg
End If
End Function
' So the way to use all this is:
'
' Dim lngReturnNumber As Long
'
' lngReturnNumber = ShellExecLaunchFile(txtPathFile. _
Text, txtStartPath.Text, txtArguments.Text)
' If lngReturnNumber < 33 Then
' Call ShellExecLaunchErr(lngReturnNumber, True)
' Exit Sub
' End If
'
'
'
'Use the following runRegEntry Function to Silently Run .reg Files
'
Public Function runRegEntry(strPathFile As String) As Boolean
On Error GoTo Command1Err
Dim dblTemp As Double
dblTemp = Shell("regedit.exe /s " & strPathFile, vbHide)
runRegEntry = True
Exit Function
Command1Err:
Dim msg As VbMsgBoxResult
msg = MsgBox("Error # " & CStr(Err.Number) & _
" " & Err.Description & vbNewLine & "With: " & strPathFile, vbCritical, "Error:")
Err.Clear
runRegEntry = False
End Function
|
