Malicious Office (OLE) / .XLS — malware analysis report

Static analysis result for SHA-256 ed41c0a372a6dda6…

MALICIOUS

Office (OLE) / .XLS

4.76 MB Created: 2006-11-08 15:21:05 Authoring application: Microsoft Excel First seen: 2026-06-22
MD5: 0683ddb962934e70671331b8c970b9e2 SHA-1: 75b22efe334edb43ce2700f4381bc3843b87e1ab SHA-256: ed41c0a372a6dda643ae823c00fc294f1e4e4a8be34ee14e7c84616587427f1d
646 Risk Score

Heuristics 18

  • VBA macros detected medium 12 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
               W_RET = Shell("explorer.exe " & W_ADPATH, vbNormalFocus)
  • WScript.Shell usage critical OLE_VBA_WSCRIPT
    WScript.Shell usage
    Matched line in script
      W_XLBPATH = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%APPDATA%") & "\Microsoft\Excel\Excel" & W_XLVER & ".xlb"
  • VBA ActiveX event launches decoded Excel4 macro critical OLE_VBA_ACTIVEX_XLM_STAGER
    VBA code attached to an auto-firing ActiveX/UserForm control event (e.g. _Layout/_Change/_Painted) decodes a string with Replace/Split/Join/StrReverse/Chr and passes the recovered formula text to ExecuteExcel4Macro. This bridges VBA event activation into XLM formula execution to call Win32 APIs / drop payloads while evading AutoOpen and Shell keyword detection — a high-confidence macro stager, not a specific Office parser CVE.
    Matched line in script
      W_APAGE = Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")
  • 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.VBE.VBProjects(V).VBComponents(S).CodeModule.ReplaceLine L, W_STR
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
            Set Locator = CreateObject("WbemScripting.SWbemLocator")
  • GetObject call high OLE_VBA_GETOBJ
    GetObject call
    Matched line in script
      Set XL1 = GetObject(, "Excel.Application")
  • CallByName call high OLE_VBA_CALLBYNAME
    CallByName call
    Matched line in script
         Set W_OBJ(I + 2) = CallByName(W_OBJ(I + 1), AR_OBJ(I), VbGet)
  • VBA polls global keyboard state (keylogger) high OLE_VBA_KEYLOGGER_SPYWARE
    The macro declares or calls a Win32 keystroke-monitoring API (GetAsyncKeyState, SetWindowsHookEx WH_KEYBOARD, or GetKeyboardState) to capture keystrokes system-wide. No legitimate document automation polls global key state; this is the core of a VBA keylogger, usually paired with active-window capture (GetForegroundWindow) and a log file. A high-confidence spyware behaviour independent of any download / Shell evidence.
    Matched line in script
    Private Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer
  • 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.
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    Private Sub Workbook_Open()
  • 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 Auto_Close()
  • x86 GetPC stub (CALL $+5; POP EBP) high SC_GETPC_CALL
    x86 GetPC stub (CALL $+5; POP EBP)
    Disassembly hidden — these bytes score as degenerate, not coherent x86 code (single mnemonic 'add' is 64% of instructions — a sled or padding/filler run, not program logic).
  • Reference to ShellExecute API high SC_STR_SHELLEXEC
    Reference to ShellExecute API
  • Reference to Windows Script Host high SC_STR_WSCRIPT
    Reference to Windows Script Host
  • PHP webshell / backdoor source high WEBSHELL_PHP
    The file contains PHP server-side code with the signature of a webshell/backdoor (request input fed to a command/code-exec sink). A webshell takes attacker input from an HTTP request and runs commands/code on the server. Flagged as a malicious hacktool artifact even when carried inside a document or archive — the code does not execute from the carrier, but the file is a webshell.
  • 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://srcedit.pekori.jp/tool/share_e.txt In document text (OLE body)
    • http://srcedit.pekori.jp/tool/share.txtIn document text (OLE body)
    • http://srcedit.pekori.jp/tool/method_e.txtIn document text (OLE body)
    • http://srcedit.pekori.jp/tool/method.txtIn document text (OLE body)
    • http://srcedit.pekori.jp/In document text (OLE body)
    • http://news.yahoo.co.jp/In document text (OLE body)

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 8388608 bytes
SHA-256: ac4fa1928f9fb8fa13f9a68cd51799ca8cb16a1cce9b3b47e9be3d261fa39fd8
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "shFunctions"
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 = "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
Option Explicit
Option Compare Text
'関連付けられたアプリケーションでファイルを実行
#If Win64 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
   ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
   ByVal lpParameters As String, ByVal lpDirectory As String, _
   ByVal nShowCmd As Long) As Long
#Else
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
   ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
   ByVal lpParameters As String, ByVal lpDirectory As String, _
   ByVal nShowCmd As Long) As Long
#End If

#If Win64 Then
Private Declare PtrSafe Function IsUserAnAdmin Lib "shell32.dll" Alias "#680" () As Boolean
#Else
Private Declare Function IsUserAnAdmin Lib "shell32.dll" Alias "#680" () As Boolean
#End If

#If Win64 Then
Private Declare PtrSafe Function DwmIsCompositionEnabled Lib "dwmapi" (ByRef pfEnabled As Long) As Long
#Else
Private Declare Function DwmIsCompositionEnabled Lib "dwmapi" (ByRef pfEnabled As Long) As Long
#End If

#If Win64 Then
Private Declare PtrSafe Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Type SYSTEM_INFO
  wProcessorArchitecture As Integer
  wReserved As Integer
  dwPageSize As Long
  lpMinimumApplicationAddress As LongPtr
  lpMaximumApplicationAddress As LongPtr
  dwActiveProcessorMask As LongPtr
  dwNumberOfProcessors As Long
  dwProcessorType As Long
  dwAllocationGranularity As Long
  wProcessorLevel As Integer
  wProcessorRevision As Integer
End Type
#Else
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Type SYSTEM_INFO
  dwOemId As Long
  dwPageSize As Long
  lpMinimumApplicationAddress As Long
  lpMaximumApplicationAddress As Long
  dwActiveProcessorMask As Long
  dwNumberOfProcessors As Long
  dwProcessorType As Long
  dwAllocationGranularity As Long
  wProcessorLevel As Integer
  wProcessorRevision As Integer
End Type
#End If

Dim SW_AI As Boolean

Private Sub Workbook_Open()
  
  Dim Locator As Object
  Dim Service As Object
  Dim OsSet As Object
  Dim os As Variant
  Dim W_OSV As String
  Dim I As Long
  Dim W_README As String
  Dim W_GREP As String
  
  Dim W_LONG As Long
  Dim SW_AERO As Boolean
  
  Dim FSO As Object
  Dim MSOPATH As String
  Dim XL2010V As String
  
  Dim P As Long
  Dim XL1 As Application
  
  Dim SYSTEM As SYSTEM_INFO
  Dim SW_UPD As Boolean
  
  
  Call INST_CHK_RTN

  'インストール直後
  If Dir(W_DIR & "\e") <> "" Then
     SW_ENGLISH = True
  Else
     If Dir(W_DIR2 & "\e") <> "" Then
        SW_ENGLISH = True
     End If
  End If
  
  If Dir(W_DIR & "\inst") <> "" Then
     Call INST_AFT_RTN
  Else
     If Dir(W_DIR2 & "\inst") <> "" Then
        W_ADPATH = W_ADPATH2
        W_DIR = W_DIR2
        Call INST_AFT_RTN
     End If
  End If
  
  SW_UPD = False
  
  '自動更新中
  If Dir(ThisWorkbook.path & "\auto.vbs") <> "" Then
     Kill ThisWorkbook.path & "\auto.vbs"
     SW_UPD = True
     SW_INST = True
  End If
  
  '更新中
  If Dir(ThisWorkbook.path & "\upd.vbs") <> "" Then
     Kill ThisWorkbook.path & "\upd.vbs"
     SW_UPD = True
     SW_INST = True
  End If
  
  Set XL1 = GetObject(, "Excel.Application")
  If XL1 Is Application Then
     If Dir(ThisWorkbook.path & "\grep*.vbs") <> "" Then
        On Error Resume Next
        Kill (ThisWorkbook.path & "\grep*.vbs")
        On Error GoTo 0
     End If
     If Dir(ThisWorkbook.path & "\idx*.vbs") <> "" Then
        On Error Resume Next
        Kill (ThisWorkbook.path & "\idx*.vbs")
        On Error GoTo 0
     End If
     If Dir(ThisWorkbook.path & "\bgf*.*") <> "" Then
        On Error Resume Next
        Kill (ThisWorkbook.path & "\bgf*.*")
        On Error GoTo 0
     End If
     If Dir(ThisWorkbook.path & "\pwc*.*") <> "" Then
        On Error Resume Next
        Kill (ThisWorkbook.path & "\pwc*.*")
        On Error GoTo 0
     End If
  End If
  Set XL1 = Nothing
  
  'Excel2013以降
  If Val(Application.Version) >= 15 Then
     If Dir(ThisWorkbook.path & "\grep1.vbs") <> "" Or _
        Dir(ThisWorkbook.path & "\grep2.vbs") <> "" Or _
        Dir(ThisWorkbook.path & "\grep3.vbs") <> "" Or _
        Dir(ThisWorkbook.path & "\grep4.vbs") <> "" Or _
        Dir(ThisWorkbook.path & "\grep5.vbs") <> "" Or _
        Dir(ThisWorkbook.path & "\grep6.vbs") <> "" Or _
        Dir(ThisWorkbook.path & "\grep7.vbs") <> "" Or _
        Dir(ThisWorkbook.path & "\grep8.vbs") <> "" Or _
        Dir(ThisWorkbook.path & "\grep9.vbs") <> "" Or _
        Dir(ThisWorkbook.path & "\grepA.vbs") <> "" Or _
        Dir(ThisWorkbook.path & "\grepB.vbs") <> "" Or _
        Dir(ThisWorkbook.path & "\grepD.vbs") <> "" Or _
        Dir(ThisWorkbook.path & "\idx.vbs") <> "" Or _
        Dir(ThisWorkbook.path & "\bgf.vbs") <> "" Or _
        Dir(ThisWorkbook.path & "\pwc.vbs") <> "" Then
        Call EXCEL2013APPHIDE
        SW_INST = True
     End If
  End If
  
  '高速モード
  If Application.Visible = False Then
     SW_INST = True
  End If
  
  'インストール済
  If SW_INST = True Or _
     SW_AI = True Then
     
     W_EXCNT = 0
     If ThisWorkbook.ReadOnly = True Then
        Call CNT_READ_RTN
     End If
     W_EXCNT = W_EXCNT + 1
     Call CNT_WRITE_RTN
        
     Call SETTING_DFT
     If Application.Visible = False Then
        SW_MM = False
     End If
     
     If Dir(W_INI) <> "" Then
        SW_OPEN = True
        Call INI_READ_RTN
     Else
     '初回起動
        If Dir(W_DIR & "\e") <> "" Then
           Kill W_DIR & "\e"
        Else
           If Dir(W_DIR2 & "\e") <> "" Then
              Kill W_DIR2 & "\e"
           End If
        End If
            
        If SW_ENGLISH = True Then
           W_RET = MsgBox(" Is function that use internet on?" & vbCrLf & _
                          "(You can change the setting later.)", vbYesNo + vbInformation, "Regular Expression Find")
        Else
           W_RET = MsgBox("インターネット通信系の機能を全て有効にしますか？" & vbCrLf & _
                          "（設定は後で変更できます。）", vbYesNo + vbInformation, "正規表現検索")
        End If
            
        If W_RET = vbYes Then
           SW_NETALLOFF = False
        Else
           SW_NETALLOFF = True
        End If
     
        'WINDOWSバージョン取得
        Set Locator = CreateObject("WbemScripting.SWbemLocator")
        Set Service = Locator.ConnectServer
        Set OsSet = Service.ExecQuery("Select * From Win32_OperatingSystem")
        For Each os In OsSet
           W_OSV = os.Version
        Next os
        Set Service = Nothing
        Set OsSet = Nothing
        Set Locator = Nothing
     
        If CLng(Left$(W_OSV, InStr(W_OSV, ".") - 1)) < 6 Then
        Else
           SW_MEIRYO = True
        End If
        
        If Dir(ThisWorkbook.path & "\inst.vbs") <> "" Then
           Kill ThisWorkbook.path & "\inst.vbs"
        End If
     
        If ThisWorkbook.path = W_DIR Or _
           ThisWorkbook.path = W_DIR2 Then
           If SW_ENGLISH = True Then
              W_RET = MsgBox("Has completed install." & vbCrLf & _
                             "Show Regular Expression Find dialog by Ctrl+Shift+R." & vbCrLf & vbCrLf & _
                             ThisWorkbook.path & vbCrLf & vbCrLf & _
                             "Because copied to, you may delete files that you executed.", _
                             vbInformation)
           Else
              W_RET = MsgBox("インストールが完了しました。" & vbCrLf & _
                             "Ctrl+Shift+Rで正規表現検索ダイアログを表示します。" & vbCrLf & vbCrLf & _
                             ThisWorkbook.path & vbCrLf & vbCrLf & _
                             "にコピーしましたので、実行したファイルは削除しても構いません。", _
                             vbInformation)
           End If
        Else
           If SW_ENGLISH = True Then
              W_RET = MsgBox("Has completed install." & vbCrLf & _
                             "Show Regular Expression Find dialog by Ctrl+Shift+R.", _
                             vbInformation)
           Else
              W_RET = MsgBox("インストールが完了しました。" & vbCrLf & _
                             "Ctrl+Shift+Rで正規表現検索ダイアログを表示します。", _
                             vbInformation)
           End If
        End If
     
        Call INI_WRITE_RTN
        
        SW_INST = True
     End If
        
     W_STRVER = ""
     If SW_UPDCHK = False And _
        SW_NETALLOFF = False Then
        Call VER_GET_RTN1
     End If
        
     If W_KEYF <> "" Then
        W_ONKEYF = SET_ONKEY(SW_SHIFTF, SW_CTRLF, SW_ALTF, W_KEYF, False)
        Application.OnKey W_ONKEYF, "SHOWF_RTN"
     Else
        W_ONKEYF = SET_ONKEY(SW_SHIFTF, SW_CTRLF, SW_ALTF, W_KEYF, True)
        Application.OnKey W_ONKEYF, "SHOWF_RTN"
     End If
     If W_KEYR <> "" Then
        W_ONKEYR = SET_ONKEY(SW_SHIFTR, SW_CTRLR, SW_ALTR, W_KEYR, False)
        Application.OnKey W_ONKEYR, "SHOWR_RTN"
     End If

     If Val(Application.Version) >= 15 Then
     Else
        Call RMENU_DEL
        Call RMENU_ADD
     End If

     SW_AUTOUPD = False

     Application.ScreenUpdating = False
     On Error Resume Next
     AppActivate (Application.Caption)
     On Error GoTo 0
     Application.ScreenUpdating = True

     If Val(Application.Version) >= 15 Then
        Call RMENU_DEL
        Call RMENU_ADD
     End If
        
     'WINDOWSバージョン取得
     Set Locator = CreateObject("WbemScripting.SWbemLocator")
     Set Service = Locator.ConnectServer
     Set OsSet = Service.ExecQuery("Select * From Win32_OperatingSystem")
     For Each os In OsSet
        W_OSV = os.Version
     Next os
     Set Service = Nothing
     Set OsSet = Nothing
     Set Locator = Nothing
     
     On Error Resume Next
     DwmIsCompositionEnabled W_LONG
     SW_AERO = CBool(W_LONG)
     On Error GoTo 0
     
     If CLng(Left$(W_OSV, InStr(W_OSV, ".") - 1)) < 6 Or _
        SW_AERO = False Then
        W_TP0 = 5
     Else
        W_TP0 = 1
     End If
     
     W_MAXP = 5
     
     If Application.Visible = False Then
        W_GREP = ThisWorkbook.path & "\bgf.vbs"
        If Dir(W_GREP) <> "" Then
           Kill W_GREP
           W_GREP = ThisWorkbook.path & "\bgf2.vbs"
           Open W_GREP For Output As #1
           Close #1
           Call HIDE_BGF
        End If
        
        W_GREP = ThisWorkbook.path & "\idx.vbs"
        If Dir(W_GREP) <> "" Then
           Call HIDE_IDX
           Kill W_GREP
              
           Call CNT_READ_RTN
           W_EXCNT = W_EXCNT - 1
           Call CNT_WRITE_RTN
           
           Application.Quit
        End If
        
        For P = 1 To W_MAXP
           W_GREP = ThisWorkbook.path & "\grep5_" & P & ".vbs"
           If Dir(W_GREP) <> "" Then
              On Error Resume Next
              Kill W_GREP
              On Error GoTo 0
              Call HS_GREP1(P)
              
              Call CNT_READ_RTN
              W_EXCNT = W_EXCNT - 1
              Call CNT_WRITE_RTN
              
              Application.Quit
           End If
        Next P

        For P = 1 To W_MAXP
           W_GREP = ThisWorkbook.path & "\grep6_" & P & ".vbs"
           If Dir(W_GREP) <> "" Then
              On Error Resume Next
              Kill W_GREP
              On Error GoTo 0
              Call HS_GREP2(P)
              
              Call CNT_READ_RTN
              W_EXCNT = W_EXCNT - 1
              Call CNT_WRITE_RTN
              
              Application.Quit
           End If
        Next P

        For P = 1 To W_MAXP
           W_GREP = ThisWorkbook.path & "\grep7_" & P & ".vbs"
           If Dir(W_GREP) <> "" Then
              On Error Resume Next
              Kill W_GREP
              On Error GoTo 0
              Call HS_GREP3(P)
              
              Call CNT_READ_RTN
              W_EXCNT = W_EXCNT - 1
              Call CNT_WRITE_RTN
              
              Application.Quit
           End If
        Next P

        For P = 1 To W_MAXP
           W_GREP = ThisWorkbook.path & "\grep8_" & P & ".vbs"
           If Dir(W_GREP) <> "" Then
              On Error Resume Next
              Kill W_GREP
              On Error GoTo 0
              Call HS_GREP4(P)
              
              Call CNT_READ_RTN
              W_EXCNT = W_EXCNT - 1
              Call CNT_WRITE_RTN
              
              Application.Quit
           End If
        Next P
     
        For P = 1 To W_MAXP
           W_GREP = ThisWorkbook.path & "\grep9_" & P & ".vbs"
           If Dir(W_GREP) <> "" Then
              On Error Resume Next
              Kill W_GREP
              On Error GoTo 0
              Call HS_GREP5(P)
              
              Call CNT_READ_RTN
              W_EXCNT = W_EXCNT - 1
              Call CNT_WRITE_RTN
              
              Application.Quit
           End If
        Next P
     
        For P = 1 To W_MAXP
           W_GREP = ThisWorkbook.path & "\grepA_" & P & ".vbs"
           If Dir(W_GREP) <> "" Then
              On Error Resume Next
              Kill W_GREP
              On Error GoTo 0
              Call HS_GREP6(P)
              
              Call CNT_READ_RTN
              W_EXCNT = W_EXCNT - 1
              Call CNT_WRITE_RTN
              
              Application.Quit
           End If
        Next P
     
        For P = 1 To W_MAXP
           W_GREP = ThisWorkbook.path & "\pwc" & P & ".vbs"
           If Dir(W_GREP) <> "" Then
              On Error Resume Next
              Kill W_GREP
              On Error GoTo 0
              Call PWC(P)
              
              Call CNT_READ_RTN
              W_EXCNT = W_EXCNT - 1
              Call CNT_WRITE_RTN
              
              Application.Quit
           End If
        Next P
     
        W_GREP = ThisWorkbook.path & "\grep1.vbs"
        If Dir(W_GREP) <> "" Then
           Call HIDE_GREP1
           On Error Resume Next
           Kill W_GREP
           On Error GoTo 0
           Exit Sub
        End If
        W_GREP = ThisWorkbook.path & "\grep2.vbs"
        If Dir(W_GREP) <> "" Then
           Call HIDE_GREP2
           On Error Resume Next
           Kill W_GREP
           On Error GoTo 0
           Exit Sub
        End If
        W_GREP = ThisWorkbook.path & "\grep3.vbs"
        If Dir(W_GREP) <> "" Then
           Call HIDE_GREP3
           On Error Resume Next
           Kill W_GREP
           On Error GoTo 0
           Exit Sub
        End If
        W_GREP = ThisWorkbook.path & "\grep4.vbs"
        If Dir(W_GREP) <> "" Then
           Call HIDE_GREP4
           On Error Resume Next
           Kill W_GREP
           On Error GoTo 0
           Exit Sub
        End If
        W_GREP = ThisWorkbook.path & "\grepB.vbs"
        If Dir(W_GREP) <> "" Then
           Call HIDE_GREP5
           On Error Resume Next
           Kill W_GREP
           On Error GoTo 0
           Exit Sub
        End If
        W_GREP = ThisWorkbook.path & "\grepD.vbs"
        If Dir(W_GREP) <> "" Then
           Call HIDE_GREP6
           On Error Resume Next
           Kill W_GREP
           On Error GoTo 0
           Exit Sub
        End If
     End If

     If Val(Application.Version) >= 15 Then
        If Application.Visible = True And _
           SW_UPD = False Then
           If SW_BAR = True Then
              Call BAR15_TM_STR
           End If
        End If
     End If
     
     If SW_AI = False Then
        If SW_STOPBGF2 = False Then
           Call BGFK_TM_STR
        End If
     End If
     
     If SW_STOPBGIU = False Then
        Call GetSystemInfo(SYSTEM)
        If SYSTEM.dwNumberOfProcessors > 1 And _
           SW_HSGREP = True And _
           SW_UPD = False Then
           Call IXUK_TM_STR
        End If
     End If
  '未インストール
  Else
     W_RET = MsgBox("Language? Yes then English, No then Japanese.", vbYesNo + vbInformation)
     If W_RET = vbYes Then
        SW_ENGLISH = True
     Else
        SW_ENGLISH = False
     End If
     
     'readmeチェック
     W_README = ThisWorkbook.path & "\readme.txt"
  
     If Dir(W_README) = "" Then
        If SW_ENGLISH = True Then
           W_RET = MsgBox("Try Regular Expression Find.", vbOKCancel + vbInformation)
        Else
           W_RET = MsgBox("正規表現検索を試用します。", vbOKCancel + vbInformation)
        End If
        If W_RET = vbOK Then
           SW_TRY = True
     
           Call SETTING_DFT
     
           'WINDOWSバージョン取得
           Set Locator = CreateObject("WbemScripting.SWbemLocator")
           Set Service = Locator.ConnectServer
           Set OsSet = Service.ExecQuery("Select * From Win32_OperatingSystem")
           For Each os In OsSet
              W_OSV = os.Version
           Next os
           Set Service = Nothing
           Set OsSet = Nothing
           Set Locator = Nothing
     
           If CLng(Left$(W_OSV, InStr(W_OSV, ".") - 1)) < 6 Then
           Else
              SW_MEIRYO = True
           End If
     
           If CLng(Left$(W_OSV, InStr(W_OSV, ".") - 1)) < 6 Or _
              SW_AERO = False Then
              W_TP0 = 5
           Else
              W_TP0 = 1
           End If
     
           Call SHOWF_RTN
           Exit Sub
        Else
           ThisWorkbook.Close
        End If
     End If
          
     If Val(Application.Version) = 14 Then
        XL2010V = ""
        Set FSO = CreateObject("Scripting.FileSystemObject")
        MSOPATH = Replace(Application.path, "Microsoft Office", "Common Files\microsoft shared") & "\MSO.dll"
        On Error Resume Next
        XL2010V = FSO.GetFileVersion(MSOPATH)
        On Error GoTo 0
        Set FSO = Nothing
  
        If XL2010V <> "" Then
           If XL2010V < "14.0.7015.1000" Then
              If SW_ENGLISH = True Then
                 W_RET = MsgBox(W_DIR2 & vbCrLf & vbCrLf & _
                                "is set trusted locations? No, then you can't install. " & vbCrLf & _
                                "Continue?", vbOKCancel + vbInformation)
              Else
                 W_RET = MsgBox(W_DIR2 & vbCrLf & vbCrLf & _
                                "を信頼できる場所に設定していないとインストールできません。" & vbCrLf & _
                                "続行しますか？", vbOKCancel + vbInformation)
              End If
              If W_RET = vbOK Then
              Else
                 ThisWorkbook.Close
              End If
           End If
        End If
     End If
     
     'WINDOWSバージョン取得
     Set Locator = CreateObject("WbemScripting.SWbemLocator")
     Set Service = Locator.ConnectServer
     Set OsSet = Service.ExecQuery("Select * From Win32_OperatingSystem")
     For Each os In OsSet
        W_OSV = os.Version
     Next os
     Set Service = Nothing
     Set OsSet = Nothing
     Set Locator = Nothing
     
     If CLng(Left$(W_OSV, InStr(W_OSV, ".") - 1)) >= 6 Then
        If IsUserAnAdmin() Then
           If SW_ENGLISH = True Then
              W_RET = MsgBox("Executed by admin authority. Continue?", vbOKCancel + vbInformation)
           Else
              W_RET = MsgBox("管理者権限で実行されています。続行しますか？", vbOKCancel + vbInformation)
           End If
           If W_RET = vbOK Then
           Else
              ThisWorkbook.Close
           End If
        End If
     End If
     
     If SW_ENGLISH = True Then
        W_RET = MsgBox("Install Regular Expression Find.", vbOKCancel + vbInformation)
     Else
        W_RET = MsgBox("正規表現検索をインストールします。", vbOKCancel + vbInformation)
     End If
     If W_RET = vbOK Then
        INST_RTN
     Else
        ThisWorkbook.Close
     End If
  End If

  Exit Sub
  
End Sub

Private Sub Workbook_AddinInstall()
 
  If SW_AUTOUPD = False Then
     W_NAME = Left$(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
     W_INI = ThisWorkbook.path & "\" & W_NAME & ".ini"
     If Dir(W_INI) <> "" Then
        Call INI_READ_RTN
        If SW_BAR = True Then
           Call MK_BAR
        End If
     End If
  End If

  SW_AI = True

  Call REGISTER

  Call CB_DEL

End Sub

Private Sub Workbook_AddinUninstall()
   
  Call CB_DEL
  
  If Dir(ThisWorkbook.path & "\inst.vbs") <> "" Then
     Exit Sub
  End If
  
  Call INI_WRITE_RTN

#If Win64 Then
#Else
  Call UNREGISTER2
  SW_AU = True
#End If

  Call NRUNREG

  Call RMENU_DEL
  If SW_AUTOUPD = False Then
     Call RMV_BAR
  End If

  If W_ONKEYF <> "" Then
     Application.OnKey W_ONKEYF
  End If
  If W_ONKEYR <> "" Then
     Application.OnKey W_ONKEYR
  End If

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

  Dim XL1 As Object
  Dim W_IDXC As String
  Dim B As Long
  Dim W_CNT As Long
  
  
  SW_WBC = True
   
  If SW_HSGREP = True And _
     W_PNO > 0 Then
     Exit Sub
  ElseIf W_PNO > 0 Then
     Exit Sub
  End If
   
  If Dir(ThisWorkbook.path & "\pwc*.vbs") <> "" Then
     If SW_ENGLISH = True Then
        W_RET = MsgBox("Analyzing password. Stop?", vbYesNo + vbQuestion)
     Else
        W_RET = MsgBox("パスワード解析中です。中止しますか？", vbYesNo + vbQuestion)
     End If
     If W_RET = vbYes Then
        Open ThisWorkbook.path & "\pwcE.vbs" For Output As #1
        Close #1
     Else
        Cancel = True
        Exit Sub
     End If
  End If
   
  On Error GoTo L_ERR
  Set XL1 = GetObject(, "Excel.Application")
  On Error GoTo 0
  If XL1 Is Application Then
     If Dir(ThisWorkbook.path & "\bgf2.vbs") <> "" Then
        W_IDXC = ThisWorkbook.path & "\bgfC.vbs"
        Open W_IDXC For Output As #1
        Close #1
     End If
     
     If Dir(ThisWorkbook.path & "\idx.vbs") <> "" Then
        W_IDXC = ThisWorkbook.path & "\idxC.vbs"
        Open W_IDXC For Output As #1
        Close #1
     End If
  ElseIf Application.Visible = True Then
     On Error GoTo L_ERR
     W_CNT = 0
     Do While Not (XL1 Is Application)
        If XL1.Visible = True Then
           Exit Do
        End If
        If W_CNT > 10 Then
           Exit Do
        End If
        For B = XL1.Workbooks.count To 1 Step -1
           XL1.Workbooks(B).Close False
        Next B
        XL1.Quit
        DoEvents
        Set XL1 = Nothing
        Set XL1 = GetObject(, "Excel.Application")
        DoEvents
        W_CNT = W_CNT + 1
     Loop
     On Error GoTo 0
  End If
  Set XL1 = Nothing
  
  Call CB_DEL
   
  If Dir(ThisWorkbook.path & "\inst.vbs") <> "" Then
     Exit Sub
  End If
  
  If Dir(W_DIR & "\inst.vbs") <> "" Then
     Exit Sub
  End If
  
  If SW_INST = True Or _
     SW_AI = True Then
     Call CNT_READ_RTN
     
     If Application.Visible = True Then
        Call INI_WRITE_RTN
     End If
     
     W_EXCNT = W_EXCNT - 1
     Call CNT_WRITE_RTN
     
     Call KILL_XLB
     
     '自動更新
     If SW_AUTOUPD = True Then
        Call ResetHook
        Call AUTO_WRITE_RTN
        W_RET = ShellExecute(0, "open", ThisWorkbook.path & "\auto.vbs", vbNull, vbNull, 1)
        Exit Sub
     End If
     
     On Error GoTo L_ERR
     Set XL1 = GetObject(, "Excel.Application")
     On Error GoTo 0
     If XL1 Is Application Then
        On Error Resume Next
        Kill ThisWorkbook.path & "\*.bak"
        On Error GoTo 0
     End If
     Set XL1 = Nothing
     
     '削除
     If SW_UNINST = True Then
        Call ResetHook
        ThisWorkbook.Saved = True
        If ThisWorkbook.ReadOnly = False Then
           ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
        End If
        Call NRUNREG
        On Error Resume Next
        Kill ThisWorkbook.path & "\*.*"
        On Error GoTo 0
        If Dir(ThisWorkbook.path & "\*.*") = "" Then
           On Error Resume Next
           RmDir ThisWorkbook.path
           On Error GoTo 0
        End If
        W_ADPATH = Left$(ThisWorkbook.path, InStrRev(ThisWorkbook.path, "\"))
        W_NAME = Right$(ThisWorkbook.path, Len(ThisWorkbook.path) - InStrRev(ThisWorkbook.path, "\"))
        
        If Dir(ThisWorkbook.path, vbDirectory) = "" Then
        Else
           If SW_ENGLISH = True Then
              W_RET = MsgBox("There were files that couldn't be deleted.'" & vbCrLf & _
                             "After finishing Excel please delete manually " & vbCrLf & _
                             W_NAME & vbCrLf & _
                             "folder in" & vbCrLf & _
                             Left$(W_ADPATH, Len(W_ADPATH) - 1) & vbCrLf & _
                             "(Click OK, then open the folder.)", vbExclamation)
           Else
              W_RET = MsgBox("削除できないファイルがありました。" & vbCrLf & _
                             "お手数をおかけしますが、Excel終了後に、" & vbCrLf & _
                             Left$(W_ADPATH, Len(W_ADPATH) - 1) & vbCrLf & _
                             "の" & vbCrLf & _
                             W_NAME & vbCrLf & _
                             "フォルダを手動で削除してください。" & vbCrLf & _
                             "（OKを押すとフォルダを開きます。）", vbExclamation)
           End If
           'フォルダの表示
           W_RET = Shell("explorer.exe " & W_ADPATH, vbNormalFocus)
        End If
     Else
        If SW_VBE = True Then
           Call VBE_OC
        End If
     End If
  End If

L_ERR:

End Sub

Attribute VB_Name = "M02EXCEL2000"
Option Explicit
Option Private Module
Option Base 1
#If Win64 Then
Public Declare PtrSafe Function SetTimer Lib "user32" _
  (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
   ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
#Else
Public Declare Function SetTimer Lib "user32" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long, _
   ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
#End If
#If Win64 Then
Public Declare PtrSafe Function KillTimer Lib "user32" _
  (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
Public Declare Function KillTimer Lib "user32" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If

'関連付けられたアプリケーションでファイルを実行
#If Win64 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
   ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
   ByVal lpParameters As String, ByVal lpDirectory As String, _
   ByVal nShowCmd As Long) As Long
#Else
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
   ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
   ByVal lpParameters As String, ByVal lpDirectory As String, _
   ByVal nShowCmd As Long) As Long
#End If

Function FIND2000(TRNG As Range, ByVal W_FW As String, W_AFT As Variant, ByVal W_LI As Variant, ByVal W_SO As Variant, ByVal W_SD As Variant, ByVal W_MC As Boolean, ByVal W_MB As Boolean) As Range

  On Error GoTo LABEL_ERROR
  Set FIND2000 = TRNG.Find(W_FW, W_AFT, W_LI, xlPart, W_SO, W_SD, W_MC, W_MB)
  On Error GoTo 0
  Exit Function

LABEL_RESUME:
  On Error Resume Next
  Set FIND2000 = TRNG.Find(W_FW, W_AFT, W_LI, xlPart, W_SO, W_SD, W_MC, W_MB)
  On Error GoTo 0
  Exit Function

LABEL_ERROR:
  On Error GoTo 0
  Set W_AFT = ActiveCell
  Resume LABEL_RESUME

End Function

Sub ADPATH2000_RTN()

  W_ADPATH = Application.UserLibraryPath

End Sub

Sub SHOW_MODELESS(W_USERFORM As Object)

  W_USERFORM.Show vbModeless

End Sub

Sub TM_BGF_STR()

  Dim W_MS As Long

  W_MS = 600000
  W_TMID_BGF = SetTimer(0, 0, W_MS, AddressOf BGF_EXE_CTRL)

End Sub

Sub TM_BGF_END()

  KillTimer 0, W_TMID_BGF

End Sub

Sub BGF_EXE_CTRL()

  Dim W_CAN As Long
  
  On Error GoTo L_ERR
  
  Call TM_BGF_END

  SW_HIDE = True
  UserForm1.Hide
  SW_HIDE = False
  W_CAN = 0
  
  Call UserForm1.BGF_EXE(W_CAN)
  Unload UserForm1

  If W_CAN = 0 Then
     Call TM_BGF_STR
  ElseIf W_CAN = 1 Then
     Application.Quit
  End If

  Exit Sub

L_ERR:

…

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