读心术...（VBS版） - 中国DOS联盟论坛 - 中国DOS联盟之联合DOS论坛

以前写过的一个脚本，今天看到后重新修改了一下，发出来逗大家一笑...


n="☆★○◎◇◆■△▲※⊙→←↑↓〓〖〗【】『』≡∑∈∵∴"
do
    n=inputbox("注意："_
    & vbcrlf & "1、不能输入空格。" _
    & vbcrlf & "2、也不能输入相同的字符。" _
    & vbcrlf & "==============================" _
    & vbcrlf & "请输入3个以上的字符:","读心术",n)
    if n=false then wscript.quit
    n=replace(n," ","")
    if len(n)<3 then
        msgbox "最少输入3个字符！",16+4096,"错误"
    elseif not instrre(n) then 
        msgbox "有重复字符，请重新输入！",16+4096,"错误"
    else
        exit do
    end if
loop
n=jkg(n) & " ":s=Split(n):l=cint(ubound(s)):i=0
if msgbox("请在以下符号中选择一个牢记在心中。记住后请点“确定”，退出程序请点“取消”。" & vbcrlf & vbcrlf & replace(n,";"," "),vbokcancel+4096,"读心术")=vbcancel then wscript.quit
do
    if i<1 then i=1
    if i<l then
        a=msgbox("以下符号中有你选择的符号吗？如果有请点“是”没有点“否”，退出程序请点“取消”。" & vbcrlf & vbcrlf & sm(i),vbyesnocancel+4096,"读心术")
        if a=vbyes then
            num=num+i
        elseif a=vbcancel then
            wscript.quit
        end if
    end if
    i=i*2
loop until i>l

if num<>0 and num<=l then
    msgbox "您选择的符号是:"&s(num),4096,"读心术"
else
    msgbox "您没有记住您选择的符号！",16+4096,"读心术"
end if

function jkg(a)
    for b=1 to len(a)
        jkg=jkg & " " & mid(a,b,1)
    next
end function

function sm(a)
    for h=a to l
        if h<>a and h mod a=0 then h=h+a
        if h>l then exit for
        sm=sm & s(h) & " "
    next
end function

function instrre(aa)
    ll=len(aa)
    for ii=1 to ll
        for jj=ii+1 to ll
            ss=ss & chr(34) & mid(aa,ii,1) & chr(34) & "<>" & chr(34) & mid(aa,jj,1) & chr(34) & " and "
            if mid(aa,ii,1)=mid(aa,jj,1) then tt=1:exit for   
        next
        if tt=1 then tt=0:exit for
    next
    ss=left(ss,len(ss)-4):ss=replace(ss,"""""","""""""")
    instrre=eval(ss)
end function

第1楼　jmz573515	发表于 2007-10-01 17:25
银牌会员　发帖 464　积分 1,212
[原创]读心术...（VBS版）以前写过的一个脚本，今天看到后重新修改了一下，发出来逗大家一笑... n="☆★○◎◇◆■△▲※⊙→←↑↓〓〖〗【】『』≡∑∈∵∴" do n=inputbox("注意："_ & vbcrlf & "1、不能输入空格。" _ & vbcrlf & "2、也不能输入相同的字符。" _ & vbcrlf & "==============================" _ & vbcrlf & "请输入3个以上的字符:","读心术",n) if n=false then wscript.quit n=replace(n," ","") if len(n)<3 then msgbox "最少输入3个字符！",16+4096,"错误" elseif not instrre(n) then msgbox "有重复字符，请重新输入！",16+4096,"错误" else exit do end if loop n=jkg(n) & " ":s=Split(n):l=cint(ubound(s)):i=0 if msgbox("请在以下符号中选择一个牢记在心中。记住后请点“确定”，退出程序请点“取消”。" & vbcrlf & vbcrlf & replace(n,";"," "),vbokcancel+4096,"读心术")=vbcancel then wscript.quit do if i<1 then i=1 if i<l then a=msgbox("以下符号中有你选择的符号吗？如果有请点“是”没有点“否”，退出程序请点“取消”。" & vbcrlf & vbcrlf & sm(i),vbyesnocancel+4096,"读心术") if a=vbyes then num=num+i elseif a=vbcancel then wscript.quit end if end if i=i*2 loop until i>l if num<>0 and num<=l then msgbox "您选择的符号是:"&s(num),4096,"读心术" else msgbox "您没有记住您选择的符号！",16+4096,"读心术" end if function jkg(a) for b=1 to len(a) jkg=jkg & " " & mid(a,b,1) next end function function sm(a) for h=a to l if h<>a and h mod a=0 then h=h+a if h>l then exit for sm=sm & s(h) & " " next end function function instrre(aa) ll=len(aa) for ii=1 to ll for jj=ii+1 to ll ss=ss & chr(34) & mid(aa,ii,1) & chr(34) & "<>" & chr(34) & mid(aa,jj,1) & chr(34) & " and " if mid(aa,ii,1)=mid(aa,jj,1) then tt=1:exit for next if tt=1 then tt=0:exit for next ss=left(ss,len(ss)-4):ss=replace(ss,"""""","""""""") instrre=eval(ss) end function

第2楼　wudixin96	发表于 2007-10-01 17:37
银牌会员　发帖 931　积分 1,928
牛人牛人

第3楼　Nickey	发表于 2007-10-01 18:08
初级用户　发帖 59　积分 132　来自 GuangZhou
超好玩 ※……×（）％※※……（）※）％

第4楼　htun	发表于 2007-10-09 12:06
初级用户　发帖 25　积分 53
挺好玩哈哈

第5楼　ldr2zjj	发表于 2007-10-09 15:28
初级用户　发帖 95　积分 167
黑框一闪而过`~~什么也没看到`~

第6楼　jmz573515	发表于 2007-10-11 07:35
银牌会员　发帖 464　积分 1,212
不会吧?! 怎么会有黑框??

第7楼　hdzc	发表于 2007-10-24 22:19
初级用户　发帖 86　积分 146
太牛了