Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 cf10592e30557ed7…

MALICIOUS

Office (OLE)

217.5 KB Created: 2009-04-03 04:34:42 Authoring application: Microsoft Excel First seen: 2018-06-21
MD5: a640a96187c7d9a264eb9e212fc10157 SHA-1: a68723aa91b908387f8570002b5abdce47f36d70 SHA-256: cf10592e30557ed7f7b2ecdf12aa371504272f4f5ee686e0670c4f8f8f552528
108 Risk Score

Malware Insights

MITRE ATT&CK
T1566.001 Spearphishing Attachment T1059.005 Visual Basic T1204.002 Malicious File

The sample is an Excel file containing VBA macros, specifically a Workbook_Open macro, which is a common technique for malicious documents. The 'SE_CLIPBOARD_COMMAND_LURE' heuristic indicates the document instructs the user to copy and paste content into a command-line interface, a social engineering tactic to execute malicious commands. The Workbook_Open macro attempts to read data from a local file '登録番号.txt' and write it to a sheet, which could be part of a larger execution chain.

Heuristics 4

  • Reference to ShellExecute API high SC_STR_SHELLEXEC
    Reference to ShellExecute API
  • Clipboard command execution lure high SE_CLIPBOARD_COMMAND_LURE
    Document tells the user to copy or paste clipboard content into Run, PowerShell, cmd, or another shell-like execution context
  • VBA macros detected medium 1 related finding OLE_VBA_MACROS
    Document contains VBA macro code
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    Attribute VB_Customizable = True
Private Sub Workbook_Open()
    '20120210 kon

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 18601 bytes
SHA-256: 54de007a720d0953162dd67f543868790867afb4ef9eb3a3566ddecd20682689
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Private Sub Workbook_Open()
    '20120210 kon
    Sheets("疎明").Cells(7, 1).Value = Replace(GetTextData(1, ThisWorkbook.Path & "\登録番号.txt"), Chr(34), "")

End Sub

Attribute VB_Name = "Sheet1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Module1"
Option Explicit


Public Const AAA As String = "委任状"
Public Flag As Boolean
Sub 印刷()
    If MsgBox("プリンタの準備はよろしいですか？", 1 + 32, "印刷") <> 1 Then Exit Sub
    ActiveSheet.PrintOut
End Sub
Sub 戻る()
    Workbooks("被扶養者届.xls").Activate
    ThisWorkbook.Close False
    
End Sub
Sub 台帳読込へ()
    Flag = False
    台帳読込.Show
    If Flag = False Then Exit Sub
    委任者選択.Show 0

End Sub
Sub 委任者選択へ()
    委任者選択.Show
End Sub
Sub 終了()
    Dim wb  As Workbook
    Application.DisplayAlerts = False
    If MsgBox("終了しますか？", 1 + 32, "終了") <> 1 Then Exit Sub
Application.Run "DaAddin.xla!閉じる"

End Sub

Sub クリア()
Range("L22,L23:Y23,L25:Y25,L27:Y27,L29:Y29").Select
    Range("L29").Activate
    ActiveWindow.SmallScroll Down:=45
    Range( _
        "L22,L23:Y23,L25:Y25,L27:Y27,L29:Y29,O59,N59,N60:Y60,N62:W62,P63:W63,E58,G58,I58" _
        ).Select
    Range("I58").Activate
    Selection.ClearContents
    Cells(60, 13).Value = ""
End Sub
Sub 初期処理()
End Sub
Sub 疎明書()

    If Cells(38, 31).Value = True Then
        Cells(38, 3).Value = "退職後、出社不能により本人の確認が得られなかったため"
        Else
        Cells(38, 3).Value = ""
    End If
    
End Sub
Sub 画面切り替え()
    Select Case Cells(1, 2).Value
        Case 1
        Worksheets("MENU").Select
        Cells(1, 2).Value = 1
        Case 2
        Worksheets("離職票本人確認").Select
        Cells(1, 2).Value = 2
        Case 3
        Worksheets("疎明").Select
        Cells(1, 2).Value = 3
        Case 4
        Worksheets("確認書同意書").Select
        Cells(1, 2).Value = 4
        Case 5
        Worksheets("確認書").Select
        Cells(1, 2).Value = 5
    End Select
End Sub
'20120210 kon
Public Function GetTextData(ByVal i As Integer, ByVal filename As String) As String
  
    Dim buffer() As String '文字列受け取り用
    
    GetStringArray buffer, filename

    GetTextData = buffer(i - 1)

End Function

'20120210 kon
Public Sub GetStringArray(ByRef str() As String, ByVal filename As String)

    Dim FileNumber As Integer 'ファイル番号
    Dim LineCount As Integer '行数

    '初期処理
    FileNumber = FreeFile
    LineCount = 0

    'DOTO FreeFileで番号を得ること
    Open filename For Input As FileNumber

        Do While Not EOF(FileNumber)
            'ファイルの長さで配列をデータを保持しながら初期化
            ReDim Preserve str(LineCount)
    
            'ファイルをバイナリで読み込んで配列に格納
            Line Input #FileNumber, str(LineCount)
            LineCount = LineCount + 1
        Loop
           
    Close #FileNumber

End Sub


Attribute VB_Name = "台帳読込"
Attribute VB_Base = "0{98BB6056-F00C-4E97-A1CE-9FF8F16DD380}{2DEF29B9-E1BC-4FE0-B6C5-0E028589B3DC}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False


Option Explicit
Dim ファイル名 As String
Dim i As Integer
Dim n As Integer
Dim strg1 As String
Private Const PasswordString = "Mhlw0/SocialInsuranceLabourConsultant0/CheckTool0/sheet"
Private Sub CheckBox1_Click()
For i = 0 To ListBox1.ListCount - 1
    ListBox1.Selected(i) = CheckBox1.Value
Next
End Sub

Private Sub CheckBox2_Click()

End Sub

Private Sub CommandButton1_Click()
    n = 0
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            n = n + 1
            Exit For
        End If
    Next
    If n = 0 Then
        MsgBox "リストが選択されていません。", 16, "取込"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    'Workbooks.Add
    'Cells.NumberFormatLocal = "@"
    ファイル名 = ActiveWorkbook.Name
     With ThisWorkbook.ActiveSheet
    n = 1
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            Label3.Caption = ListBox1.List(i, 0) & "を処理しています。"
            Me.Repaint
            Workbooks.Open Workbooks("DaMenu.xls").Path & "\" & ListBox1.List(i, 0) & "da.xls"
            Sheets("会社情報").Select
             .Cells(25, 12).Value = Trim(Cells(8, 2).Value) '会社名
             .Cells(27, 12).Value = Trim(Cells(11, 2).Value) & " " & Trim(Cells(12, 2).Value)    '事業主名
             .Cells(22, 12).Value = "〒" & Trim(Cells(9, 2).Value)  '〒
             .Cells(23, 12).Value = Trim(Cells(10, 2).Value)        '所在地
             .Cells(29, 12).Value = Trim(Cells(13, 2).Value)        'TEL
             .Cells(60, 3).Value = ListBox1.List(i, 0) & "da.xls"
             Workbooks(ListBox1.List(i, 0) & "da.xls").Close False
              ThisWorkbook.Activate
              Range(Cells(17, 2), Cells(65, 25)).PrintOut
            
        End If
    Next
    End With
    Unload Me
End Sub


Private Sub CommandButton2_Click()
n = 0
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.List(i, 0) Like "*" & TextBox1.Value & "*" Then
    ListBox1.Selected(i) = True
    n = n + 1
    Else
    ListBox1.Selected(i) = False
    End If
    
Next
If n = 0 Then
MsgBox "見つかりませんでした。", 16, "検索"
Else
MsgBox n & "件見つかりました。", 64, "検索"
End If
End Sub
Private Sub CommandButton3_Click()
    n = 0
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            n = n + 1
            Exit For
        End If
    Next
    If n = 0 Then
        MsgBox "リストが選択されていません。", 16, "取込"
        Exit Sub
    End If
    'Workbooks.Add
    'Cells.NumberFormatLocal = "@"
    ファイル名 = ActiveWorkbook.Name
     With ThisWorkbook.ActiveSheet
    n = 1
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            Label3.Caption = ListBox1.List(i, 0) & "を読込んでいます。"
            Me.Repaint
            Workbooks.Open Workbooks("DaMenu.xls").Path & "\" & ListBox1.List(i, 0) & "da.xls"
            Sheets("会社情報").Select
             .Cells(23, 12).Value = Trim(Cells(8, 2).Value) '会社名
             .Cells(27, 12).Value = Trim(Cells(11, 2).Value) & " " & Trim(Cells(12, 2).Value)    '事業主名
             .Cells(24, 12).Value = "〒" & Trim(Cells(9, 2).Value)  '〒
             .Cells(25, 12).Value = Trim(Cells(10, 2).Value)        '所在地
             '.Cells(29, 12).Value = Trim(Cells(13, 2).Value)        'TEL
             .Cells(60, 3).Value = ListBox1.List(i, 0) & "da.xls"
             Workbooks(ListBox1.List(i, 0) & "da.xls").Close False
                 
              'Range(Cells(17, 2), Cells(65, 25)).PrintOut
              Flag = True
              Unload Me
        End If
    Next
    End With
    
End Sub

Private Sub UserForm_Initialize()
    ファイルリスト
    ComboFile.ListIndex = 0
    'WebWindow.Navigate ThisWorkbook.Path & "\" & "html\koyoudensi.html"
End Sub
Sub ファイルリスト()
    Dim textfilename As String
    Dim MyData(1) As String
    ComboFile.AddItem "すべて表示"
    textfilename = ThisWorkbook.Path & "\MyTool\FileList.dat"
    Open textfilename For Input As #1
        For i = 1 To 20
            Input #1, MyData(1)
            ComboFile.AddItem MyData(1)
        Next
    Close #1
End Sub
Private Sub ComboFile_Change()
    Dim ファイル名 As String
    ListBox1.Clear
    If ComboFile.ListIndex = 0 Then
        ファイル名 = Dir(Workbooks("DaMenu.xls").Path & "\*da.xls") '台帳ファイル
        Do While ファイル名 <> ""
            If ファイル名 Like "*セルズ*" Then '原本とセルズの台帳は飛ばす
            Else
            ListBox1.AddItem Left(ファイル名, Len(ファイル名) - 6)
            End If
        ファイル名 = Dir()
        Loop
    Else
        Dim textfilename As String
        Dim MyData(1) As String
        textfilename = Workbooks("DaMenu.xls").Path & "\DaProcess\MyTool\FileList" & ComboFile.ListIndex & ".dat"
        Open textfilename For Input As #1
            Do Until EOF(1)
                Input #1, MyData(1)
                If MyData(1) & "da.xls" = Dir(Workbooks("DaMenu.xls").Path & "\" & MyData(1) & "da.xls") Then
                    ListBox1.AddItem MyData(1)
                End If
            Loop
        Close #1
    End If
'    CheckBox1.Value = True
'    CheckBox1_Click
End Sub
Sub シートパスワード解除()
       '保護がかかっているシートでこれを実行すると保護が解除される（パスワードのロックも解除だぞ）
       ActiveSheet.Protect UserInterfaceOnly:=True
       ActiveCell.Copy Range("A1")
End Sub

Attribute VB_Name = "委任者選択"
Attribute VB_Base = "0{EAC40C26-B2CF-41A8-8529-2B68CE3C40A9}{F2979C10-88C1-422F-A72A-2D1902750230}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit
Private Declare Function GetForegroundWindow Lib "USER32" () As Long
Private Declare Function ShellExecute Lib "SHELL32" Alias "ShellExecuteA" _
(ByVal hwnd&, ByVal lpOperation$, ByVal lpFile$, ByVal lpParameters$, _
ByVal lpDirectory$, ByVal nShowCmd&) As Long

Dim MyFile As String
Dim i As Integer
Dim n As Integer
Dim Zce As Boolean
Dim 配偶者 As Integer

Private Sub UserForm_Activate()

   Dim iCnt        As Integer              '20080612 kon
   Dim wb As Workbook
   Dim KOSU As Integer
   
   If Cells(60, 3).Value = "" Then
    MsgBox "事業所が設定されていません。", 16, AAA
    Exit Sub
   End If
    '20130304 kon 2013
    If Application.Version = 15 Then
        Application.ScreenUpdating = False
    End If
  
''   Application.ScreenUpdating = False 20130328 kon 2013
   Application.Calculation = xlManual
   MyFile = Cells(60, 3).Value '読み込まれた台帳ファイル名
   
   For Each wb In Workbooks
        If wb.Name = MyFile Then
          wb.Activate
          Exit For
        End If
   Next
   If ActiveWorkbook.Name <> MyFile Then
       Workbooks.Open filename:=Workbooks("DaMenu.xls").Path & "\" & MyFile
   End If
   With Workbooks(MyFile).Worksheets("個人情報")
        n = 0
        For i = 6 To .Cells(10000, 2).End(xlUp).Row
            '取得日があって離職日がないデータ
            If IsDate(.Cells(i, 29).Value) = True Then
                ListBox1.AddItem i '行番号
                ListBox1.List(n, 1) = .Cells(i, 5).Value & " " & .Cells(i, 6).Value
                ListBox1.List(n, 2) = .Cells(i, 26).Value
                ListBox1.List(n, 3) = .Cells(i, 35).Value
                ListBox1.List(n, 4) = .Cells(i, 30).Value
                n = n + 1
            End If
        Next
    End With
    On Error Resume Next
'''    ThisWorkbook.Activate        20130328 kon 2013
    
    If ActiveSheet.Name = "離職票本人確認" Then OptionButton8.Value = True
    Application.ScreenUpdating = True
    
    '20130328 kon 2013
    Set wb = ThisWorkbook
    ThisWorkbook.Activate
    DoEvents
    wb.Activate
    
End Sub
Private Sub CommandButton4_Click()
     Dim i As Integer
    If Trim(TextBox9.Value) = "" Then
        MsgBox "検索する文字列を入力して下さい。", 16, AAA
        Exit Sub
    End If
    Dim MYn As Integer
     MYn = -1
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.List(i, 1) Like "*" & TextBox9.Value & "*" Then
            ListBox1.Selected(i) = True
        MYn = i
        Else
        ListBox1.Selected(i) = False
        End If
    Next
    If MYn = -1 Then
    MsgBox "見つかりません。", 64, AAA
    Else
    ListBox1.ListIndex = MYn
    End If
    'ListBox1_Change
End Sub
Private Sub CommandButton2_Click()
    Dim ii As Integer
    Dim nn As Integer
    Dim MyC As Integer
    
    n = ListBox1.ListIndex
    If n = -1 Then
        MsgBox "リストを選択してから実行してください。", 16, AAA
        Exit Sub
    End If
    n = 0
    For i = 1 To 10
        If Controls("OptionButton" & i).Value = True Then n = i
    Next
    If n = 0 And Cells(1, 2).Value = 1 Then
        MsgBox "手続きを選択してください。", 16, AAA
        Exit Sub
    End If
     
    '20120724 masa YBNO17338------------------------------
    If OptionButton8.Value = True Then Worksheets("離職票本人確認").Select
    If OptionButton9.Value = True Or OptionButton10.Value = True Then Worksheets("疎明").Select
    '----------------------------------------------------------
    
    Application.ScreenUpdating = False
    Me.Repaint
    
    ThisWorkbook.Activate
    If OptionButton8.Value = True Then
        Cells(44, 11).Value = ListBox1.List(ListBox1.ListIndex, 1)
        Cells(47, 11).Value = ListBox1.List(ListBox1.ListIndex, 2)
        Cells(50, 11).Value = ListBox1.List(ListBox1.ListIndex, 3)
        Cells(53, 11).Value = Format(ListBox1.List(ListBox1.ListIndex, 4), "gggee年mm月dd日")
    End If
    
    If OptionButton9.Value = True Then
        Cells(30, 11).Value = ListBox1.List(ListBox1.ListIndex, 1)
        Cells(33, 11).Value = ListBox1.List(ListBox1.ListIndex, 2)
        Cells(28, 11).Value = ListBox1.List(ListBox1.ListIndex, 3)
        Cells(24, 11).Value = Format(ListBox1.List(ListBox1.ListIndex, 4), "gggee年mm月dd日")
        Cells(18, 2).Value = "(事業主の疎明書)"
        Cells(41, 5).Value = " 私は、上記の離職者に係る雇用保険被保険者資格喪失届に添付する離職証明書の記"
        Cells(42, 5).Value = " 載内容について、上記の理由から、離職者本人の確認を得られませんでした。 "
        Cells(43, 5).Value = " 今後は、離職証明書の記載内容について、離職者本人の確認を得られるよう留意し "
        Cells(44, 5).Value = " ます。 "
    End If
    If OptionButton10.Value = True Then
        Cells(30, 11).Value = ListBox1.List(ListBox1.ListIndex, 1)
        Cells(33, 11).Value = ListBox1.List(ListBox1.ListIndex, 2)
        Cells(28, 11).Value = ListBox1.List(ListBox1.ListIndex, 3)
        Cells(24, 11).Value = Format(ListBox1.List(ListBox1.ListIndex, 4), "gggee年mm月dd日")
        Cells(18, 2).Value = "(社労士の疎明書)"
        Cells(41, 5).Value = " 上記の離職者に係る雇用保険被保険者資格喪失届に添付する離職証明書の記載内"
        Cells(42, 5).Value = " 容については、上記の理由から、離職者本人の確認を得られない旨、事業主から申し"
        Cells(43, 5).Value = " 出がありました。"
        Cells(44, 5).Value = " 今後は、離職証明書の記載内容について、離職者本人の確認を得られるよう留意します｡ "
    End If
    
      
    '20130302 masa YBNO21010------------------------------
    If ActiveSheet.Name = "MENU" Or ActiveSheet.Name = "確認書同意書" Or ActiveSheet.Name = "確認書" Then
        Cells(36, 5).Value = Controls("OptionButton" & n).Caption
        Cells(44, 11).Value = ListBox1.List(ListBox1.ListIndex, 1)
        Cells(47, 11).Value = ListBox1.List(ListBox1.ListIndex, 2)
    End If
'    If ActiveSheet.Name = "MENU" Then
'        Cells(36, 5).Value = Controls("OptionButton" & n).Caption
'        Cells(44, 11).Value = ListBox1.List(ListBox1.ListIndex, 1)
'        Cells(47, 11).Value = ListBox1.List(ListBox1.ListIndex, 2)
'    End If
    '----------------------------------------------------------
    
    
    '日付を本日にする
    If chkToday.Value Then
        Cells(19, 20).Value = Now
    End If
    
    Application.ScreenUpdating = True
    Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = False
    Workbooks(MyFile).Close False
    ThisWorkbook.Activate
    Application.ScreenUpdating = True
End Sub

Attribute VB_Name = "Sheet2"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Sheet3"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Sheet4"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Sheet5"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

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