鬼(ONI) 发表于 2007-10-12 10:56:13

【无聊】发个vbs,读心术

请将以下代码复制到一个空白文本文档中,另存为一个扩展名为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

任天堂世界 发表于 2007-10-12 11:06:42

玩了,意义不明

鬼(ONI) 发表于 2007-10-12 11:09:53

这个程序理念挺简单的,你用个123就知道怎么回事了

GUANG0706 发表于 2007-10-12 11:23:46

排除法吧……

鬼(ONI) 发表于 2007-10-12 11:25:01

LS正解
页: [1]
查看完整版本: 【无聊】发个vbs,读心术