AdvanceVB

'---------------------------------------------------------------------------------------
' Module    : mProcessInformation
' Author    : Karcrack
' Now       : 26/08/2010 15:00
' Purpose   : Native Process Enumeration
' History   : 26/08/2010 First cut .........................................................
'---------------------------------------------------------------------------------------

Option Explicit
Option Base 0

Public Type PROCESS
    sName           As String
    lPID            As Long
End Type

'NTDLL
Private Declare Function NtQuerySystemInformation Lib "NTDLL" (ByVal SystemInformationClass As Long, ByRef SystemInformation As Any, ByVal SystemInformationLength As Long, ByRef ReturnLength As Long) As Long
Private Declare Sub RtlMoveMemory Lib "NTDLL" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Const SystemProcessesAndThreadsInformation  As Long = 5&
Private Const STATUS_INFO_LENGTH_MISMATCH           As Long = &HC0000004

Public Function RetrieveProcesses() As PROCESS()
    Dim bvSPI(17)           As Long 'As SYSTEM_PROCESS_INFORMATION
    Dim bvTmp()             As PROCESS
    Dim bvBuffer()          As Byte
    Dim cbBuffer            As Long
    Dim lRet                As Long
    Dim lPos                As Long
    Dim lSize               As Long

    ReDim bvTmp(0)
    cbBuffer = 1
    Do
        cbBuffer = cbBuffer * 2
        ReDim bvBuffer(cbBuffer)
        lRet = NtQuerySystemInformation(SystemProcessesAndThreadsInformation, bvBuffer(0), cbBuffer, lSize)
    Loop While lRet = STATUS_INFO_LENGTH_MISMATCH

    If lRet < 0 Then Exit Function

    lPos = VarPtr(bvBuffer(0))

    Do
        Call RtlMoveMemory(bvSPI(0), ByVal lPos, 18 * 4)
        With bvTmp(UBound(bvTmp))
            .lPID = bvSPI(17)
            .sName = ReadUStr(bvSPI(15))
        End With
        lPos = lPos + bvSPI(0)
        If bvSPI(0) = 0 Then Exit Do
        ReDim Preserve bvTmp(UBound(bvTmp) + 1)
    Loop

    RetrieveProcesses = bvTmp
    Erase bvBuffer
End Function

Private Function ReadUStr(ByVal lPtr As Long) As String
    Dim i                   As Long
    Dim uChar               As Integer

    If Not lPtr > 0 Then Exit Function
    i = lPtr
    Do
        Call RtlMoveMemory(uChar, ByVal i, &H2)
        If uChar = 0 Then Exit Do
        ReadUStr = ReadUStr & ChrW$(uChar)
        i = i + 2
    Loop
End Function

Sample call:

Private Sub Form_Load()
    Dim x()     As PROCESS
    Dim i       As Long

    x = RetrieveProcesses

    For i = 0 To UBound(x)
        Debug.Print x(i).lPID, "->", x(i).sName
    Next i
End Sub

This code allow you to call APIs without declaring them, but the best of it is that only uses VB6 functions!!! (aka funcs @ MSVBVM60) :)

'---------------------------------------------------------------------------------------
' Module    : mZombieInvoke
' Author    : Karcrack
' Now       : 09/08/2010 13:37
' Purpose   : Calling API without declaring
'             Only uses VB6 functions :)
' History   : 20100908 First cut .......................................................
'---------------------------------------------------------------------------------------

Option Explicit

Private Type Zombie_STRUCT1
    cNull       As Currency 'Must be 0
    ppS2        As Long 'Pointer to pointer to Zombie_STRUCT2
End Type

Private Type Zombie_STRUCT2
    lNull       As Long 'Must be 0
    lAddr       As Long 'The Addr
End Type

Private Type tAPICall
    ptsLIB      As Long ' Pointer to ANSI String that contains Library (NULL TERMINATED!)
    ptsProc     As Long ' Pointer to ANSI String that contains Procedure(NULL TERMINATED!)
    lReserved   As Long ' Just reserved...
    lPointer    As Long ' Pointer to the buffer that will contain temp variables from DllFunctionCall
    lpBuffer(3) As Long ' Buffer that will contain temp variables
End Type

Private Type DUMB_LONG
    lLNG        As Long
End Type

Private Type BYTES_LONG
    b1          As Byte:    b2          As Byte
    b3          As Byte:    b4          As Byte
End Type

'MSVBVM60
Private Declare Function DllFunctionCall Lib "MSVBVM60" (ByRef typeAPI As tAPICall) As Long
Private Declare Function Zombie_AddRef Lib "MSVBVM60" (ByRef tStructure As Zombie_STRUCT1) As Long

Private bvASM(&HFF) As Byte

Public Function Invoke(ByVal sLibName As String, ByVal sProcName As String, ParamArray vParams() As Variant) As Long
    Dim hMod        As Long
    Dim S1          As Zombie_STRUCT1
    Dim S2          As Zombie_STRUCT2
    Dim i           As Long
    Dim iCount      As Long

    hMod = GetPointer(sLibName, sProcName)

    '//POP EAX                  '//POP EBX                  '//PUSH EAX
    Call AddByte(&H58, iCount): Call AddByte(&H5B, iCount): Call AddByte(&H50, iCount)

    For i = UBound(vParams) To LBound(vParams) Step -1
        '//PUSH CLng(vParams(i))
        Call AddPush(CLng(vParams(i)), iCount)
    Next i

    '//CALL hMod                '//RET
    Call AddCall(hMod, iCount): Call AddByte(&HC3, iCount)

    S2.lAddr = VarPtr(bvASM(0))
    S1.ppS2 = VarPtr(VarPtr(S2))

    Invoke = Zombie_AddRef(S1)
End Function

Private Function GetPointer(ByVal sLib As String, ByVal sProc As String) As Long
    Dim tAPI        As tAPICall
    Dim bvLib()     As Byte
    Dim bvMod()     As Byte

    bvLib = StrConv(sLib + vbNullChar, vbFromUnicode):  bvMod = StrConv(sProc + vbNullChar, vbFromUnicode)

    With tAPI
        .ptsLIB = VarPtr(bvLib(0)):     .ptsProc = VarPtr(bvMod(0))
        .lReserved = &H40000:           .lPointer = VarPtr(.lpBuffer(0))
    End With

    GetPointer = DllFunctionCall(tAPI)
End Function

Private Sub AddCall(ByVal lpPtrCall As Long, ByRef iCount As Long)
    Call AddByte(&HB8, iCount)                  '//MOV EAX, ________
    Call AddLong(lpPtrCall, iCount)             '//_______, XXXXXXXX
    Call AddByte(&HFF, iCount)                  '//CALL EXX
    Call AddByte(&HD0, iCount)                  '//____ EAX
End Sub

Private Sub AddPush(ByVal lLong As Long, ByRef iCount As Long)
    Call AddByte(&H68, iCount)                  '//PUSH, ________
    Call AddLong(lLong, iCount)                 '//____, XXXXXXXX
End Sub

Private Sub AddLong(ByVal lLong As Long, ByRef iCount As Long)
    'Swap Endian (Ej: 0xDEADBEEF <-> 0xEFBEADDE)
    Dim tDL         As DUMB_LONG
    Dim tBL         As BYTES_LONG

    tDL.lLNG = lLong
    LSet tBL = tDL

    Call AddByte(tBL.b1, iCount):   Call AddByte(tBL.b2, iCount)
    Call AddByte(tBL.b3, iCount):   Call AddByte(tBL.b4, iCount)
End Sub

Private Sub AddByte(ByVal bByte As Byte, ByRef iCount As Long)
    bvASM(iCount) = bByte:    iCount = iCount + 1
End Sub

Sample:

Invoke "USER32", "MessageBoxW", 0, StrPtr("Karcrack FTW!!!"), StrPtr("Fuck yeah!"), 0

Some people asked for a TLB, so here is:Zombie.zip

Option Explicit

'---------------------------------------------------------------------------------------
' Module    : mAntiVMWare
' Author    : Karcrack
' Now$      : 020810
' Used for? : Known if being Virtualized inside VMWARE
' Original C source:
'    bool IsVMWare()
'    {
'      unsigned long _EBX;
'      __try
'      {
'        __asm
'        {
'          // Run the magic code sequence
'          push ebx
'          mov eax, 0x564D5868
'          mov ebx, 0x8685D465 // Ensure EBX doesn't contain 0x564D5868 :)
'          mov ecx, 10 // The command for obtaining VMWare version information
'          mov dx, 0x5658
'          in eax, dx
'          mov _EBX, ebx
'          pop ebx
'        };
'      }
'      __except(1)
'      {
'        // An exception occured, we ain't in VMWare
'        return false;
'      }
'      // The code was executed successfuly, check for the magic value
'      return _EBX == 0x564D5868;
'    }
'---------------------------------------------------------------------------------------

'KERNEL32
Private Declare Function SetUnhandledExceptionFilter Lib "KERNEL32" (ByVal lpTopLevelExceptionFilter As Long) As Long
'USER32
Private Declare Function CallWindowProcW Lib "USER32" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private m_bFlag                 As Boolean

Public Function IsVMWare() As Boolean
    On Error Resume Next
    Dim cCode(2)                As Currency
    Dim lOldSEH                 As Long
    Dim lRet                    As Long

    If App.LogMode = 0 Then MsgBox "Test only compiled": Exit Function

    m_bFlag = True
    lOldSEH = SetUnhandledExceptionFilter(AddressOf ExceptionHandler)

    cCode(0) = 733054770867134.2675@
    cCode(1) = 4606227.4004@
    cCode(2) = 661819130486985.3798@

    lRet = CallWindowProcW(VarPtr(cCode(0)), 0&, 0&, 0&, 0&)

    Call SetUnhandledExceptionFilter(lOldSEH)

    If m_bFlag = True Then IsVMWare = (lRet = &H564D5868)
End Function

Public Function ExceptionHandler(ByRef uException As Long) As Long
    m_bFlag = False: ExceptionHandler = -1
    ' VB Will process our error :P
    Call Mid$(vbNullString, 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

More info

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

Sample:

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

Private Type SUBROUTINE
    lNull           As Long '// Must be 0
    lPtr            As Long
End Type

Private Declare Function GoSubReturn Lib "MSVBVM60" Alias "__vbaGosubReturn" (ByRef lpSubRoutine As Long) As Long

'---------------------------------------------------------------------------------------
' Procedure : GoToPtr
' Author    : Karcrack
' Date      : 08/05/2010
' Purpose   : GoTo a pointer
' Warning   : It's not a JMP, is a GoTo, so the execution of the program won't continue
'           where you made the GoTo...
'---------------------------------------------------------------------------------------
'
Public Sub GoToPtr(ByVal lPtr As Long)
    Dim tSubRoutine As SUBROUTINE

    tSubRoutine.lPtr = lPtr
    Call GoSubReturn(VarPtr(tSubRoutine))
End Sub

Due some problems with Stack you won’t be able to return the place you call this function… So generally you will need to close process in the code pointed by lPtr :)

Example:

Sub Main()
    Call GoToPtr(gP(AddressOf RMain))
End Sub

Function gP(ByVal lPtr As Long) As Long
    gP = lPtr
End Function

Sub RMain()
    MsgBox "Hi!"
    End
End Sub

Well, i’ve noticed that cInvoke coded by Cobein isn’t working on Windows 7 because W7 load first NTDLL and then KERNEL32 so when we read Peb->InInitOrder[0]->BaseAddress it isnt’ KERNEL32 base address… it’s NTDLL base address….
So i’ve coded that shellcode that retrieves K32 base address in any W$ NT system…

Code in PasteBin

If you want to use that Shellcode in the RunPe/cInvoke/… you just need to replace the const called THUNK_KERNELBASE with these ASM Opcodes:

8B4C2408565531C0648B70308B760C8B761C8B6E088B7E208B3638471875F3803F6B7407803F4B7402EBE789295D5EC3

'NTDLL
Private Declare Sub NtDelayExecution Lib "NTDLL" (ByVal Alertable As Boolean, ByRef Interval As Any)

Private Sub NtSleep(ByVal lMs As Long)
    Call NtDelayExecution(False, CCur(-(lMs)))
End Sub