'Code By Pink|Danyfirex|Dany 27/02/2014
Option Explicit
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 Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, ByRef lpExitCode As Long) As Long
Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Long, lpThreadAttributes As Any, ByVal dwStackSize As Long, lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Public Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Const MEM_RELEASE = &H8000
Private Const MEM_COMMIT = &H1000
Private Const PAGE_READWRITE = &H4
Private Const PAGE_EXECUTE_READWRITE = &H40
Private Const PROCESS_CREATE_THREAD = &H2
Private Const PROCESS_VM_OPERATION = &H8
Private Const PROCESS_VM_WRITE = &H20
Private Const INFINITE = -1&
Const SEE_MASK_INVOKEIDLIST = &HC&
Public Const TH32CS_SNAPPROCESS As Long = 2&
Public Const MAX_PATH As Long = 260
Public Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Public Function RemoteShellExecuteEx(sFileToRun As String, sNameInject As String) As Boolean
Dim hKernel32 As Long
Dim pGetProcAddress As Long
Dim pLoadLibraryW As Long
Dim hProcess As Long
'========================Handle|Pointers============================
hKernel32 = GetModuleHandle("kernel32.dll")
pLoadLibraryW = GetProcAddress(hKernel32, "LoadLibraryW")
pGetProcAddress = GetProcAddress(hKernel32, "GetProcAddress")
'===================================================================
'===========================PID|Open Process========================
Dim lPID As Long
lPID = GetProcessId(sNameInject)
If lPID = 0 Then Exit Function
hProcess = OpenProcess(PROCESS_CREATE_THREAD + PROCESS_VM_OPERATION + PROCESS_VM_WRITE, False, lPID)
'===================================================================
If hProcess = 0 Then Exit Function
'==============sModule|sFunction|sVerb|sFile========================
Dim bData() As Byte
Dim sModule() As Byte
Dim sFunction() As Byte
Dim sVerb() As Byte
Dim sFile() As Byte
sModule() = StrConv(StrConv("Shell32.dll" & Chr(0) & Chr(0), vbFromUnicode), vbUnicode) 'Unicode
sFunction() = StrConv("ShellExecuteExW" & Chr(0), vbFromUnicode) 'ASCII
sVerb() = StrConv(StrConv("OPEN" & Chr(0) & Chr(0), vbFromUnicode), vbUnicode) 'Unicode
sFile() = StrConv(StrConv(sFileToRun & Chr(0) & Chr(0), vbFromUnicode), vbUnicode) 'Unicode
AddBytes bData(), sModule() 'Module Name
AddBytes bData(), sFunction() 'SFuction name
AddBytes bData(), sVerb() 'SVerb
AddBytes bData(), sFile() 'sFile Name
'==================================================================
'=========================SHELLEXECUTEINFO=========================
Dim pSHELLEXECUTEINFO As Long
Dim SHELLEXECUTEINFO() As Byte
pSHELLEXECUTEINFO = UBound(bData()) + 1
AddBytes SHELLEXECUTEINFO(), &H3C& 'cbSize
AddBytes SHELLEXECUTEINFO(), SEE_MASK_INVOKEIDLIST 'fMask
AddBytes SHELLEXECUTEINFO(), &H0& 'hwnd
AddBytes SHELLEXECUTEINFO(), &H0& 'lpVerb
AddBytes SHELLEXECUTEINFO(), &H0& 'lpFile
AddBytes SHELLEXECUTEINFO(), &H0& 'lpParameters
AddBytes SHELLEXECUTEINFO(), &H0& 'lpDirectory
AddBytes SHELLEXECUTEINFO(), &H0& 'nShow
AddBytes SHELLEXECUTEINFO(), &H0& 'hInstApp
AddBytes SHELLEXECUTEINFO(), &H0& 'lpIDList
AddBytes SHELLEXECUTEINFO(), &H0& 'lpClass
AddBytes SHELLEXECUTEINFO(), &H0& 'hkeyClass
AddBytes SHELLEXECUTEINFO(), &H0& 'dwHotKey
AddBytes SHELLEXECUTEINFO(), &H0& 'hIcon
AddBytes SHELLEXECUTEINFO(), &H0& 'hProcess
'==================================================================
'==========================Remote Data=============================
Dim RemoteData() As Byte
Dim pRemoteData As Long
Dim plpVerb As Long
Dim plpFile As Long
Dim rplpVerb As Long
Dim rplpFile As Long
plpVerb = pSHELLEXECUTEINFO + 12
plpFile = plpVerb + 4
AddBytes RemoteData(), bData() 'bData
AddBytes RemoteData(), SHELLEXECUTEINFO() 'SHELLEXECUTEINFO
'Allocate RemoteData Memory
pRemoteData = VirtualAllocEx(hProcess, 0&, UBound(RemoteData) + 1, MEM_COMMIT, PAGE_READWRITE)
If pRemoteData = 0 Then
CloseHandle hProcess
Exit Function
End If
'Remote Pointer
rplpVerb = pRemoteData + UBound(sModule()) + UBound(sFunction()) + 2
rplpFile = pRemoteData + UBound(sModule()) + UBound(sFunction()) + UBound(sVerb) + 3
'Copy to plpVerb
CopyMemory RemoteData(plpVerb), rplpVerb, 4
'copy to plpFile
CopyMemory RemoteData(plpFile), rplpFile, 4
'==================================================================
'============================Remote Code===========================
Dim RemoteCode() As Byte
Dim pRemoteCode As Long
Dim pModule As Long
Dim pFunction As Long
Dim rpSHELLEXECUTEINFO As Long
pModule = pRemoteData
pFunction = pModule + UBound(sModule()) + 1
rpSHELLEXECUTEINFO = pRemoteData + pSHELLEXECUTEINFO
AddBytes RemoteCode(), &H68: AddBytes RemoteCode(), pModule 'pModule
AddBytes RemoteCode(), &HB8: AddBytes RemoteCode(), pLoadLibraryW 'mov eax pLoadLibaryW
AddBytes RemoteCode(), &HFF: AddBytes RemoteCode(), &HD0 'Call eax
AddBytes RemoteCode(), &H68: AddBytes RemoteCode(), pFunction 'pFunction
AddBytes RemoteCode(), &H50 'Push eax
AddBytes RemoteCode(), &HB8: AddBytes RemoteCode(), pGetProcAddress 'mov eax,pGetProcAddress
AddBytes RemoteCode(), &HFF: AddBytes RemoteCode(), &HD0 'call eax
AddBytes RemoteCode(), &H68: AddBytes RemoteCode(), rpSHELLEXECUTEINFO 'rpSHELLEXECUTEINFO
AddBytes RemoteCode(), &HFF: AddBytes RemoteCode(), &HD0 'Call eax
AddBytes RemoteCode(), &HC3 'Ret
'Allocate RemoteCode Memory
pRemoteCode = VirtualAllocEx(hProcess, 0&, UBound(RemoteCode) + 1, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
If pRemoteCode = 0 Then
CloseHandle hProcess
Exit Function
End If
'====================================================================
'========================Copy Remote Data|Code=======================
WriteProcessMemory hProcess, ByVal pRemoteData, RemoteData(0), UBound(RemoteData()) + 1, ByVal 0&
WriteProcessMemory hProcess, ByVal pRemoteCode, RemoteCode(0), UBound(RemoteCode()) + 1, ByVal 0&
'====================================================================
'============================Thread===================================
Dim hThread As Long
hThread = CreateRemoteThread(hProcess, ByVal 0&, 0&, ByVal pRemoteCode, 0, 0, ByVal 0&)
If hThread = 0 Then
CloseHandle hProcess
Exit Function
End If
WaitForSingleObject hThread, INFINITE
'=====================================================================
'==========================Exit Code==================================
Dim lpExitCode As Long
Dim bRet As Boolean
bRet = GetExitCodeThread(hThread, lpExitCode)
If bRet = 0 Then
VirtualFreeEx hProcess, ByVal pRemoteCode, 0, MEM_RELEASE
VirtualFreeEx hProcess, ByVal pRemoteData, 0, MEM_RELEASE
CloseHandle hThread
CloseHandle hProcess
Exit Function
Else
RemoteShellExecuteEx = True
End If
'=====================================================================
'========================Clean========================================
VirtualFreeEx hProcess, ByVal pRemoteCode, 0, MEM_RELEASE
VirtualFreeEx hProcess, ByVal pRemoteData, 0, MEM_RELEASE
CloseHandle hThread
CloseHandle hProcess
'=====================================================================
End Function
Private Sub AddBytes(ByRef bArray() As Byte, Data As Variant)
Dim ArraySize As Long
Dim iType As Integer
Dim SizeData As Integer
Dim StrBytes() As Byte
If ((Not bArray) = -1) Then
ArraySize = 0
Else
ArraySize = UBound(bArray()) + 1
End If
iType = VarType(Data)
Select Case iType
Case Is = vbByte, vbInteger
SizeData = 1
ReDim Preserve bArray((ArraySize + SizeData) - 1)
CopyMemory bArray(ArraySize), CByte(Data), SizeData
Exit Sub
Case Is = vbLong
SizeData = 4
ReDim Preserve bArray((ArraySize + SizeData) - 1)
CopyMemory bArray(ArraySize), CLng(Data), SizeData
Exit Sub
Case Is = 8209
StrBytes() = Data
SizeData = UBound(StrBytes()) + 1
ReDim Preserve bArray((ArraySize + SizeData) - 1)
CopyMemory bArray(ArraySize), StrBytes(0), SizeData
Exit Sub
Case Is = vbString
StrBytes() = StrConv(CStr(Data), vbFromUnicode)
SizeData = UBound(StrBytes()) + 1
ReDim Preserve bArray((ArraySize + SizeData) - 1)
CopyMemory bArray(ArraySize), StrBytes(0), SizeData
Exit Sub
Case Else
Exit Sub
End Select
End Sub
'Coded by Randy Birch Mod by RhinoBull
Public Function GetProcessId(ByVal ProcessName As String) As Long
Dim hSnapShot As Long
Dim uProcess As PROCESSENTRY32
Dim success As Long
Dim ProcessId As Long
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
If hSnapShot = -1 Then Exit Function
uProcess.dwSize = Len(uProcess)
success = ProcessFirst(hSnapShot, uProcess)
If success = 1 Then
Do
If LCase(VBA.Left$(uProcess.szExeFile, InStr(1, uProcess.szExeFile, Chr(0)) - 1)) = LCase(ProcessName) Then
ProcessId = uProcess.th32ProcessID
Exit Do
End If
Loop While ProcessNext(hSnapShot, uProcess)
End If
Call CloseHandle(hSnapShot)
GetProcessId = ProcessId
End FunctionSaludos
