AdvanceVB

I got several comments in different posts, so if you want to drop an off topic line try to do it here =)

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

Im a happy mofucka!!!! Yeah some good bands in town =D

I’ve seen so many posts from ppl complaining about CopyMemory, vbaCopyBytes and so on being dettected by Avira and some other AVs but there are many more APIs to do the same.

Here is a simple example, moving 4 bytes using lstrcpynW, more than enough to patch an address and do whatever we want.

Private Declare Function lstrcpynW Lib “kernel32″ (ByVal lDstVal As Long, ByVal lSrcVal As Long, ByVal iMaxLength As Long) As Long

Private Sub Form_Load()
Dim lSource As Long
Dim lDst As Long

lDst = 0
lSource = 123
lstrcpynW VarPtr(lDst), VarPtr(lSource), 4
Debug.Print lSource = lDst

End Sub

Im not working on this anymore so, here it goes, its a multi-thread module, no ocx, dlls, timers or anything like that just API and black magic. Its 100% stable when compiled. Tested on W7. Im not taking full credit for this, I did coded it but is entirely based on a source that ntaryl gave me a week ago (I guess is from vbgood, but no author name was included)

OK,  the author is izero from slovakia.  =D

Download

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

Im reposting this here cause Ive been asked many times for this document.

This is a small tuto Ive made to explain a basic way to add some APIs and constants to your VB.
Hope you understand the basic concept and find this at least funny if not useful.
Have Funk!

Accessing MSVBVM60 API

A simple module to read Environment Variables from a remote process. Tested on XP and 7.

'---------------------------------------------------------------------------------------
' Module      : mRemoteGetEnviron
' DateTime    : 23/02/2010 21:29
' Author      : Cobein
' Mail        : cobein27@hotmail.com
' WebPage     : http://www.advancevb.com.ar
' Purpose     : Read remote process environment variables.
' Usage       : At your own risk
' Requirements: None
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
'
' Reference   : http://www.codeproject.com/KB/threads/ReadProcEnv.aspx
'
' History     : 23/02/2010 First Cut....................................................
'---------------------------------------------------------------------------------------
Option Explicit

Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const PROCESS_VM_READ           As Long = 16&

Public Type PROCESS_BASIC_INFORMATION
    ExitStatus                      As Long
    PEBBaseAddress                  As Long
    AffinityMask                    As Long
    BasePriority                    As Long
    UniqueProcessId                 As Long
    InheritedFromUniqueProcessId    As Long
End Type

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function NtQueryInformationProcess Lib "ntdll.dll" (ByVal ProcessHandle As Long, ByVal ProcessInformationClass As Long, ByVal ProcessInformation As Long, ByVal ProcessInformationLength As Long, ReturnLength As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32.dll" (ByVal hProcess As Long, ByRef lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long
Private Declare Function RtlAdjustPrivilege Lib "ntdll" (ByVal Privilege As Long, ByVal bEnablePrivilege As Long, ByVal bCurrentThread As Long, ByRef OldState As Long) As Long

Public Function ReadEnviron(ByVal lPid As Long) As Collection
    Dim lPtr            As Long
    Dim lProc           As Long
    Dim cData           As New Collection

    Set ReadEnviron = cData

    Call RtlAdjustPrivilege(20, 1, 0, 0)

    lPtr = GetPEB(lPid)

    lProc = OpenProcess(PROCESS_VM_READ, 0, lPid)

    If lProc Then

        If Not ReadProcessMemory(lProc, ByVal lPtr + &H10, lPtr, &H4, 0&) = 0 Then 'RTL_USER_PROCESS_PARAMETERS

            If Not ReadProcessMemory(lProc, ByVal lPtr + &H48, lPtr, &H4, 0&) = 0 Then 'environment variables block

                Dim bData As Byte
                Dim sData As String
                Dim lOffset As Long

                Do
                    lOffset = lOffset + 2
                    If bData = 0 Then
                        If Not sData = vbNullString Then cData.Add sData
                        sData = vbNullString
                        Call ReadProcessMemory(lProc, ByVal lPtr + lOffset, bData, &H1, 0&)
                        If bData = 0 Then
                            Exit Do
                        End If
                    Else
                        Call ReadProcessMemory(lProc, ByVal lPtr + lOffset, bData, &H1, 0&)
                    End If
                    sData = sData & Chr$(bData)
                Loop
            End If

        End If

        Call CloseHandle(lProc)

    End If

    Set ReadEnviron = cData

End Function

Private Function GetPEB(ByVal lPid As Long) As Long
    Dim tPBI    As PROCESS_BASIC_INFORMATION
    Dim lRet    As Long
    Dim lProc   As Long

    lProc = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lPid)
    If lProc Then
        If NtQueryInformationProcess(lProc, 0, VarPtr(tPBI), Len(tPBI), lRet) = 0 Then
            GetPEB = tPBI.PEBBaseAddress
        End If
        CloseHandle lProc
    End If

End Function

I got three things bouncing in my head to do,  but time is pretty limited, I want to implement a sysenter class,  a module to use activex objects without registration and a cool interface (using one DC to handle everything). Any ideas are welcome, Ill try to go for any of them soon.