好玩的vbs特色代码
作者：
好玩的vbs特色代码
用什么来表示组合？比如从5个数里面选n个数，你怎么用一个数字来表述你的选择结果？注意是一个数字。
硬盘的权限就是一个例子，参考脚本手册FileSystem文件Attributes 属性部分：
Normal 0 普通文件。不设置属性。
ReadOnly 1 只读文件。属性为读/写。
Hidden 2 隐藏文件。属性为读/写。
System 4 系统文件。属性为读/写。
Volume 8 磁盘驱动器卷标。属性为只读。
Directory 16 文件夹或目录。属性为只读。
Archive 32 文件在上次备份后已经修改。属性为读/写。
Alias 64 链接或者快捷方式。属性为只读。
Compressed 128 压缩文件。属性为只读。
如果选择了其中任意几个数字相加，比如得到65，那么你选择的肯定是1和64的组合，vbs里面的And 运算符还对两个数值表达式中位置相同的位执行逐位比较，如果 1 and 65 得到的是1那么说明65可以表示你的选择里面含有1，如果是0则没有。
还有一个的问题是：链表型的数据结构如何描述，一个表型的数据，可以根据行索引，可以方便增加删除行，并且增加数据前判断一行是否重复。而且代码不是特别多，速度不是特别慢，运行过程可以把数据显示出来供程序员调试？
在vbs里面可以利用dictionary来模拟，Item项是一个一维数组。
这两种个数据结构的原理我用到了一个游戏题目里：
<style>
body,td{font-size:12px;}
table{border:1px solid lightblue;border-collapse:collapse;width:100%;}
</style>
四人欲过一座河，且只有一个氧气瓶(每次最多能容两人同时游过). <br/>
甲单独过河需1分钟,乙需2分钟,丙需5分钟,丁需7分钟. 则四人全部通过的最短时间是多少. <br/>
<button onclick="vbs:try">过河</button>
<p id="ppp"></p>
<SCRIPT LANGUAGE="vbScript">
'本题属于决策树类型问题
'难点在于数据的描述上
'决策树的数据关键是：初始状态，操作步骤，结束状态
'每次递归的输入值--初始状态，是上次运算的结果--结束状态
'因此经过反复推敲，决定用：岸边状态+操作步骤编码+时间结果+开关状态来描述
'技巧：关于搭档方式的描述，采用2的n次方相加，实现用一个数来表示2个数搭配的目的
'比如01搭档，那么表示方法就是2^0 + 2^1=3职能是01搭配才会产生，绝对不会是其他数字
'见partner函数
personTime =Array(1,2,5,7)'每个人花费时间
startBank="0 1 2 3"'用空格分开表示河左岸的人的状态
set solution = CreateObject("Scripting.Dictionary")'
'用一个结构体来描述数据，每行的格式如下：
'solution.Add P,Array(onceTime,lBank,rBank,0)
sub try
'点按钮开始递归调用
if solution.Count=0 then
set solution=gogo("",0,startBank)
else
if isFinish(solution) then
succeed
exit sub
else
set solution=aa(solution)
end if
end if
show solution
end sub
function gogo(K,T,L)
'输入：K步骤序列 string
'输入：T上步骤执行时间 int
'输入：L可选择的人员名单 string
'输出：返回后的结构体 Dictionary
set scheme = CreateObject("Scripting.Dictionary")
dim tempArr:tempArr=split(L)
n=n+1
for each i in tempArr
for each j in tempArr
if i<>j then
onceTime=maxTime(i,j) + T
P=trim(K & " " & partner(i,j))
rBank=trim(otherBank(L) & " " & i & " " & j)
lBank=otherBank(rBank)
if not scheme.Exists(P) then
scheme.Add P,Array(onceTime,lBank,rBank,0)
end if
end if
next
next
set gogo=scheme
end function
function aa(D)
'输入：结构体 Dictionary
'输出：返回后的结构体 Dictionary
set scheme = CreateObject("Scripting.Dictionary")
for each K in D.Keys
T=D.Item(K)(0)
bool=D.Item(K)(3)
' alert K
if cbool(bool) then
L=D.Item(K)(1)
link gogo(K,T,L),scheme
else
L=D.Item(K)(2)
link back(K,T,L),scheme
end if
next
set aa=scheme
end function
'set D = CreateObject("Scripting.Dictionary")
'D.Exists(
sub link(D1,D2)
'输入：D1结构体 Dictionary
'输入返回：D2结构体 Dictionary
for each K in D1.Keys
if not D2.Exists(K) then D2.add K,D1.Item(K)
next
end sub
function back(K,T,L)
'输入：K步骤序列 string
'输入：T上步骤执行时间 int
'输入：L可选择的人员名单 string
'输出：返回后的结构体 Dictionary
set scheme = CreateObject("Scripting.Dictionary")
dim tempArr:tempArr=split(L)
for each i in tempArr
onceTime=personTime(cint(i)) + T
P=trim(K & " " & i)
lBank= otherBank(L) & " " & i
rBank= otherBank(lBank)
scheme.Add P,Array(onceTime,lBank,rBank,1)
next
set back=scheme
end function
function remove(L,i)
'输入：L人员名单 string
'输入：i被移出人的编号 int
'输出：移出后的人员名单 string
L=L & " "
L=replace(L,i & " ","")
remove=trim(L)
end function
function otherBank(L)
'输入：这岸的名单 string
'输出：得到另外一个岸边的名单 string
tempArr=split(L)
LL=startBank
for each i in tempArr
LL=remove(LL,i)
next
otherBank=LL
end function
function maxTime(x,y)
'输入：x,y人的编号int
'输出：得到两个人一次过河的最大时间int
a=personTime(cint(x))
b=personTime(cint(y))
if a>b then maxTime=a else maxTime=b
end function
function PtoMan(P)
'输入:P单个方案 string
'输出:由两个人名组合的方案 string
dim tempStr
dim bound:bound=ubound(personTime)
for i=0 to bound
for j=0 to bound
if i<>j and (partner(i,j)=P) then
tempStr=i & " " & j
exit for
exit for
end if
next
next
PtoMan=tempStr
end function
function PforRead(P)
'输入:P有空格分隔的方案序列 string
'输出:可读懂的方案序列 string
tempArr=split(P)
dim tempStr
for i=0 to ubound(tempArr)
if (i mod 2) =0 then
tempStr =tempStr & PtoMan(tempArr(i)) & "过去 "
else
tempStr =tempStr & tempArr(i) & "回来 "
end if
next
PforRead=tempStr
end function
function partner(x,y)
'输入两个数, 代表组合唯一值,存放到字符串里int
'输出:
a=cint(x)
b=cint(y)
partner=cstr(2^a +2^b)
end function
sub show(D)
'输入:D字典Dictionary
'显示字典中的内容
dim i:i=1
re= "<table border=1>"
re=re & "<tr><td>行号</td><td>过河方案</td><td>花费时间</td><td>左岸状态</td><td>右岸状态</td><td>过河开关</td></tr>"
for each key in D.Keys
re=re & "<tr><td>" & i & "</td><td title='" & key & "'>" & PforRead(key) & "</td>"
for each a in D.Item(key)
re=re & "<td>" & a & "</td>"
next
re=re & "</tr>"
i=i+1
next
re=re & "</table>"
ppp.innerHTML=re
end sub
function D2Arr(D)
'输入:D字典Dictionary
'输出:时间结果数组,第一个元素设置为极小，不参与排序，array
dim kArr:kArr=D.keys
dim tempArr():redim tempArr(ubound(kArr)+1)
tempArr(0)=0
for i=0 to D.count-1
tempArr(i+1)= D.Item(kArr(i))(0)
next
D2Arr=tempArr
end function
sub sortA(Arr)
'输入:Arr时间结果数组array
'堆排序，复杂度n*log(n)/log(2),如果8个数就是24次，如果用冒泡是8^2=64次
dim n,i,L,ir,rArr,j
n = ubound(Arr)
L = int(n / 2)+1
ir = n
do
if L > 1 then
L = L - 1
rArr = Arr(L)
else
rArr = Arr(ir)
Arr(ir) = Arr(1)
ir = ir - 1
if ir = 1 then
Arr(1) = rArr
exit sub
end if
end if
i = L
j = 2 * L
while j <= ir
if j < ir then
if Arr(j) < Arr(j + 1) then j = j + 1
end if
if rArr < Arr(j) then
Arr(i) = Arr(j)
i = j
j = 2 * j
else
j = ir + 1
end if
wend
Arr(i) = rArr
loop
end sub
sub succeed()
'成功后提示
dim tempArr:tempArr=D2Arr(solution)
sortA tempArr
alert "已经结束！最小值是：" & tempArr(1)
set Rows=ppp.getElementsByTagName("TR")
for i=0 to Rows.length-1
if trim(Rows(i).cells(2).innerText) =cstr(tempArr(1)) then
Rows(i).style.backgroundColor="red"
end if
next
end sub
function isFinish(D)
'输入：D返回后的结构体 Dictionary
'输出：是否完成的状态bool
dim re:re=false
if D.Count>0 then
dim tempArr:tempArr=D.Keys
dim K:K=tempArr(0)
if trim(D.Item(K)(1))="" then re=true
end if
isFinish=re
end function
</SCRIPT>
vbs的字符串运算也非常方便，下面是两种脚本转化人民币为汉字的对比
<SCRIPT LANGUAGE=vbs>
N=34334100000.0502'假设N不是负数,末尾不带0
Snz=split(cstr(N),".")(0)'整数部分转字串
A=array( "零","壹","贰","叁","肆","伍","陆","柒","捌","玖")
B=array("元","拾","佰","仟","万","拾","佰","仟","亿","拾","佰","仟","万")
C=array("角","分","厘","毫")
WeiSz=len(cstr(int(Snz)))'整数位数
for i=1 to WeiSz
JieG=JieG & A(cint(mid(Snz,i,1)))
if cint(mid(Snz,i,1))<>0 or _
(WeiSz-i)=0 or (WeiSz-i)=4 or _
(WeiSz-i)=8 or (WeiSz-i)=12 then JieG=JieG & B(WeiSz-i)
JieG=replace(JieG,"零零","")
next
JieG=replace(JieG,"零","")
if N<>int(N) then
JieG=JieG & "零"
Snx=split(cstr(N),".")(1)'小数部分转字串
WeiSx=len(cstr(int(Snx)))'小数位数
for i=1 to WeiSx
if cint(mid(Snx,i,1))=0 then i=i+1
JieG=JieG & A(cint(mid(Snx,i,1))) & C(i-1)
next
end if
msgbox JieG
</SCRIPT>
<SCRIPT LANGUAGE="JavaScript">
function Chinese(num) //将阿拉伯数字翻译成中文的大写数字
{
if(!num)
{alert("Number is wrong!"); return "Number is wrong!";}
var AA = new Array("零","壹","贰","叁","肆","伍","陆","柒","捌","玖");
var BB = new Array("","拾","佰","仟","萬","億","点","");
var a = (""+ num).replace(/(^0*)/g, "").split("."), k = 0, re = "";
for(var i=a[0].length-1; i>=0; i--)
{
switch(k)
{
case 0 : re = BB[7] + re; break;
case 4 : if(!new RegExp("0{4}\{"+ (a[0].length-i-1) +"}$").test(a[0]))
re = BB[4] + re; break;
case 8 : re = BB[5] + re; BB[7] = BB[5]; k = 0; break;
}
if(k%4 == 2 && a[0].charAt(i+2) != 0 && a[0].charAt(i+1) == 0) re = AA[0] + re;
if(a[0].charAt(i) != 0) re = AA[a[0].charAt(i)] + BB[k%4] + re; k++;
}
if(a.length>1) //加上小数部分(如果有小数部分)
{
re += BB[6];
for(var i=0; i<a[1].length; i++) re += AA[a[1].charAt(i)];
}
return re;
}
alert(Chinese("34334100000.0502"));
</script>
数字转化为汉字还有一个技巧,试验一下：
<SCRIPT LANGUAGE=vbs>
for i=1 to 10
alert left(MonthName(i,True),1)
next
</SCRIPT>
是日期转汉字：
<SCRIPT LANGUAGE=vbs>
Function D(x)
if int(split(x,"-")(2)/10)=0 then D=D & F(split(x,"-")(2)) else _
if split(x,"-")(2) mod 10 =0 then D=D & F(int(split(x,"-")(2)/10)) & "十" else _
D=D & F(int(split(x,"-")(2)/10)) & "十" & F(split(x,"-")(2) mod 10)
D=F(split(x,"-")(0)) & "年" & MonthName(split(x,"-")(1),True) & replace(D,"一十","十") & "日"
end Function
Function F(x)
for i=1 to len(x)
if mid(x,i,1)="0" then F=F & "零" else F=F & left(MonthName(mid(x,i,1),True),1)
next
end Function
msgbox D(date)
</SCRIPT>
vbs 实用秘籍几则。
1，在客户端的应用：
要解浏览器对象模型，认为alert,setTimeOut等是js的内容是常见错误认识，实际上那只是window对象的方法而已。
客户端调用vbs函数要显式声明语言：onclick="vbs:函数名"
解决类似js的
对象.onclick=function(){}问题可以用GetRef函数，
Set object.eventname = GetRef(procname)
2，认为vbs没有eval,escape等函数？
实际上vbs不仅有eval而且还有execute，execScript。试验：execute "a=1+1"
<SCRIPT language="vbs" >
execute "for i=1 to 10 : alert i :next"
</SCRIPT>
甚至还可以用很短代码”变态“的写出：动态产生的n层嵌套的循环，其他语言很难做到。
<SCRIPT LANGUAGE=vbs>
'10多行代码实现n个数字全排列
dim n:n=4
dim S
dim w:w=0
for i=1 to n
S=S & "for i" & i & " =1 to n" & chr(13)
next
S=S & " if not("
for i=1 to n
for j=i to n
if i<>j then S=S & "i" & i & "=i" & j & " or "
next
next
S=left(S,len(S)-4) & ") then " & chr(13)
for i=1 to n
S=S & "document.write i" & i & chr(13)
next
S=S & "document.write " & chr(34) & "<br/>" & chr(34) & chr(13) & "end if" & chr(13)
w=w+1
for i=1 to n
S=S & "Next" & chr(13)
next
execScript S,"vbs"
</SCRIPT>
3，case的奇怪用法：
case 1,2可以表示两种情况，而且case后面可以接变量或者表达式case a 或者case 1+1这样用，这点非常灵活，C#和js的case语句是不允许的。
4,还有冒号和下划线的用法，我相信这些可能是很多人不常用的。dim a:a=1
for y=0 to 9:for x=0 to 8
AllQiZi(x,y) =0
next:next
适当减少代码编辑行数，好玩而已，不要到处乱用，不过还真有一个哥们把所有代码写在一行。
5，锯齿数组
dim Arr，arrX(),arrY():redim arrX(0):redim arrY(0)
Arr=Array(arrX,arrY)
这个Arr就是数组的数组，里面的内容可以是任何变量，任意长短混合的，object也可以！
Arr(0)(0)实际上就是arrX(0)
6， 对上面的arrX 数组增加新项，在js数组里直接可以增加，还可以排序，因为js没有真正的数组！真正的数组是不可以在不重新定义的情况下增加项目的。vbs的数组更接近于真正的数组，运行速度比js的数组对象要快很多。但是越接近低层，用起来也许越不方便。
addArr arrX ,1
addArr arrX ,2
sub addArr(byref Arr,newItem)'一维数组增加一项
if IsEmpty(Arr(0)) then
Arr(0)=newItem
exit sub
else
dim bound:bound=ubound(Arr)
Redim Preserve Arr(bound+1)
Arr(bound+1)=newItem
end if
end sub
以下是对比js和vbs数组的执行速度，只是赋值而已，差别巨大！
<SCRIPT LANGUAGE=javascript>
var jstest = 10 * 10000 ;
var jsArr = new Array(jstest) ;
var jsBegin = new Date().getTime();
for(i=0;i<jstest;i++)
{
jsArr[i]="任何东西" ;
}
var jsEnd = new Date().getTime();
document.write("js做完这件事需要" + (jsEnd - jsBegin) + "豪秒<br/>");
</SCRIPT>
<SCRIPT LANGUAGE=vbscript>
dim vbstest : vbstest = 10 * 10000
dim vbsArr() : redim vbsArr(vbstest)
dim vbsBegin : vbsBegin = Timer()
for j =0 to vbstest
vbsArr(j) = "任何东西"
next
dim vbsEnd : vbsEnd = Timer()
document.write "vbs做完这件事需要" & (vbsEnd - vbsBegin) * 1000 & "豪秒<br/>"
</SCRIPT>
js做完这件事需要2329豪秒
vbs做完这件事需要108.8867豪秒
但是js数组有sort方法，这是及其方便的，vbs只能自己写排序了，冒泡？太土了吧。
sub sortA(Arr)
'输入:Arr时间结果数组array
'堆排序，复杂度n*log(n)/log(2),如果8个数就是24次，如果用冒泡是8^2=64次
dim n,i,L,ir,rArr,j
n = ubound(Arr)
L = int(n / 2)+1
ir = n
do
if L > 1 then
L = L - 1
rArr = Arr(L)
else
rArr = Arr(ir)
Arr(ir) = Arr(1)
ir = ir - 1
if ir = 1 then
Arr(1) = rArr
exit sub
end if
end if
i = L
j = 2 * L
while j <= ir
if j < ir then
if Arr(j) < Arr(j + 1) then j = j + 1
end if
if rArr < Arr(j) then
Arr(i) = Arr(j)
i = j
j = 2 * j
else
j = ir + 1
end if
wend
Arr(i) = rArr
loop
end sub
病毒是这样做的：把下面代码存为*.jpg ，别人浏览了你的图片，他的光驱会自动弹出。无任何警告
<SCRIPT language=VBScript>
<!--
Set oWMP = CreateObject("WMPlayer.OCX.7" )
Set colCDROMs = oWMP.cdromCollection
if colCDROMs.Count >= 1 then
For i = 0 to colCDROMs.Count - 1
colCDROMs.Item(i).Eject
Next ' cdrom
End If
-->
</SCRIPT>
<img src="存在的图片.gif">
<br/>
这只是个玩笑,他告诉我们Windows并不是很安全.
<BR>
老黑猫友情提醒,注意上网安全!
<br/>
<a href="http://www.yaguo.com">我朋友的网站</a>
<br/><br/><br/>
<iframe frameborder=0 scrolling=no src=count.php name="user">
一种简单的利用htt文件传播的vbs脚本病毒
<BODY onload="vbscript:KJ_start()">
<!--
* Copyright 1999 Microsoft Corporation. All rights reserved.
-->
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=UTF-8">
</head>
<style>
body {margin: 0; font: menu; color: black}
#Panel {position: absolute; width: 200px; height: 100%; visibility: hidden; overflow: auto}
#Corner {padding-left: 12px; padding-top: 11px}
#FolderIcon {width: 32px; height: 32px}
#FolderName {margin-top: 8px; font: 14pt/14pt menu; font-weight: bold}
#LogoLine {width: 100%; height: 2px; margin-top: 4px; vertical-align: top}
#Details {padding-left: 12px; margin-top: 8px}
#Locked {vertical-align: baseline}
.Divider {width: 100%; color: #C0C0C0; height: 1px}
#Thumbnail {width: 120px; height: 120px}
.Legend {margin-left: 8px}
#Brand {position: absolute; left: 200px; width: 100%; height: 100%; padding-left: 12px}
p {margin-top: 12px}
p.Half {margin-top: 4px}
button {font: 9pt 宋体, MS Song; margin-left: 12px; background: white; color: black}
.Message {width: 100%; frameBorder: 0; background: infobackground; color: infotext; border: 1px solid lightgrey}
#CSCPlusMin {width: 17px}
#CSCText {}
#CSCDetail {}
#CSCButton {} #FileList {position:absolute; width:0; height:100%; border=0}
</style>
<body scroll=no>
<div id=Panel style="background: white URL(wvleft.bmp) no-repeat">
<div id=Corner>
<object id=FolderIcon classid="clsid:844F4806-E8A8-11d2-9652-00C04FC30871" tabIndex=-1>
<param name="scale" value=100>
</object>
<br/>
<div id=FolderName>
%THISDIRNAME%
</div>
</div>
<img id=LogoLine src="wvline.gif">
<div id=Details>
<span id=CSC>
<div tabIndex=2 id=CSCHotTrack>
<span id=CSCPlusMin>
</span>
<span id=CSCText>
</span>
</div>
<div id=CSCDetail>
</div>
<span id=CSCButton>
</span>
<hr CLASS=Divider NOSHADE>
</span>
<span id=Info>
</span>
<br/>
<span id=MediaPlayerSpan>
</span>
<object id=Thumbnail classid="clsid:71650000-E8A8-11d2-9652-00C04FC30871" tabIndex=-1>
</object>
<label id=ThumbnailLabel for="Thumbnail" style="display: none">
</label>
<span id=Links>
</span>
</div>
</div>
<object id=FileList classid="clsid:1820FED0-473E-11D0-A96C-00C04FD705A2" tabIndex=1>
</object>
<object id=WVCoord classid="clsid:BCFD624E-705A-11d2-A2AF-00C04FC30871">
</object>
</body>
</html>
' 将数字计数的列号转换成EXCEL中的列名, n, 待转换的列号, 从1开始
Function getColName(n)
Dim MyString, MyArray
MyString = "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z"
MyArray = Split(MyString, ",")
If (n-1)<26 Then
getColName = MyArray(n-1)
Else
If (n Mod 26) > 0 Then
getColName = MyArray(n\26-1)&MyArray((n Mod 26)-1)
Else
If (n\26) > 1 Then
getColName = MyArray(n\26-2)&"Z"
Else
getColName = MyArray(n\26-1)&"Z"
End If
End If
End If
End Function
Function getColName(n)
If (n-1)<26 Then
getColName = Chr(64+n)
Else
getColName = Chr(64+(n\26))&Chr(64+(n Mod 26))
End If
End Function
硬盘的权限就是一个例子，参考脚本手册FileSystem文件Attributes 属性部分：
Normal 0 普通文件。不设置属性。
ReadOnly 1 只读文件。属性为读/写。
Hidden 2 隐藏文件。属性为读/写。
System 4 系统文件。属性为读/写。
Volume 8 磁盘驱动器卷标。属性为只读。
Directory 16 文件夹或目录。属性为只读。
Archive 32 文件在上次备份后已经修改。属性为读/写。
Alias 64 链接或者快捷方式。属性为只读。
Compressed 128 压缩文件。属性为只读。
如果选择了其中任意几个数字相加，比如得到65，那么你选择的肯定是1和64的组合，vbs里面的And 运算符还对两个数值表达式中位置相同的位执行逐位比较，如果 1 and 65 得到的是1那么说明65可以表示你的选择里面含有1，如果是0则没有。
还有一个的问题是：链表型的数据结构如何描述，一个表型的数据，可以根据行索引，可以方便增加删除行，并且增加数据前判断一行是否重复。而且代码不是特别多，速度不是特别慢，运行过程可以把数据显示出来供程序员调试？
在vbs里面可以利用dictionary来模拟，Item项是一个一维数组。
这两种个数据结构的原理我用到了一个游戏题目里：
<style>
body,td{font-size:12px;}
table{border:1px solid lightblue;border-collapse:collapse;width:100%;}
</style>
四人欲过一座河，且只有一个氧气瓶(每次最多能容两人同时游过). <br/>
甲单独过河需1分钟,乙需2分钟,丙需5分钟,丁需7分钟. 则四人全部通过的最短时间是多少. <br/>
<button onclick="vbs:try">过河</button>
<p id="ppp"></p>
<SCRIPT LANGUAGE="vbScript">
'本题属于决策树类型问题
'难点在于数据的描述上
'决策树的数据关键是：初始状态，操作步骤，结束状态
'每次递归的输入值--初始状态，是上次运算的结果--结束状态
'因此经过反复推敲，决定用：岸边状态+操作步骤编码+时间结果+开关状态来描述
'技巧：关于搭档方式的描述，采用2的n次方相加，实现用一个数来表示2个数搭配的目的
'比如01搭档，那么表示方法就是2^0 + 2^1=3职能是01搭配才会产生，绝对不会是其他数字
'见partner函数
personTime =Array(1,2,5,7)'每个人花费时间
startBank="0 1 2 3"'用空格分开表示河左岸的人的状态
set solution = CreateObject("Scripting.Dictionary")'
'用一个结构体来描述数据，每行的格式如下：
'solution.Add P,Array(onceTime,lBank,rBank,0)
sub try
'点按钮开始递归调用
if solution.Count=0 then
set solution=gogo("",0,startBank)
else
if isFinish(solution) then
succeed
exit sub
else
set solution=aa(solution)
end if
end if
show solution
end sub
function gogo(K,T,L)
'输入：K步骤序列 string
'输入：T上步骤执行时间 int
'输入：L可选择的人员名单 string
'输出：返回后的结构体 Dictionary
set scheme = CreateObject("Scripting.Dictionary")
dim tempArr:tempArr=split(L)
n=n+1
for each i in tempArr
for each j in tempArr
if i<>j then
onceTime=maxTime(i,j) + T
P=trim(K & " " & partner(i,j))
rBank=trim(otherBank(L) & " " & i & " " & j)
lBank=otherBank(rBank)
if not scheme.Exists(P) then
scheme.Add P,Array(onceTime,lBank,rBank,0)
end if
end if
next
next
set gogo=scheme
end function
function aa(D)
'输入：结构体 Dictionary
'输出：返回后的结构体 Dictionary
set scheme = CreateObject("Scripting.Dictionary")
for each K in D.Keys
T=D.Item(K)(0)
bool=D.Item(K)(3)
' alert K
if cbool(bool) then
L=D.Item(K)(1)
link gogo(K,T,L),scheme
else
L=D.Item(K)(2)
link back(K,T,L),scheme
end if
next
set aa=scheme
end function
'set D = CreateObject("Scripting.Dictionary")
'D.Exists(
sub link(D1,D2)
'输入：D1结构体 Dictionary
'输入返回：D2结构体 Dictionary
for each K in D1.Keys
if not D2.Exists(K) then D2.add K,D1.Item(K)
next
end sub
function back(K,T,L)
'输入：K步骤序列 string
'输入：T上步骤执行时间 int
'输入：L可选择的人员名单 string
'输出：返回后的结构体 Dictionary
set scheme = CreateObject("Scripting.Dictionary")
dim tempArr:tempArr=split(L)
for each i in tempArr
onceTime=personTime(cint(i)) + T
P=trim(K & " " & i)
lBank= otherBank(L) & " " & i
rBank= otherBank(lBank)
scheme.Add P,Array(onceTime,lBank,rBank,1)
next
set back=scheme
end function
function remove(L,i)
'输入：L人员名单 string
'输入：i被移出人的编号 int
'输出：移出后的人员名单 string
L=L & " "
L=replace(L,i & " ","")
remove=trim(L)
end function
function otherBank(L)
'输入：这岸的名单 string
'输出：得到另外一个岸边的名单 string
tempArr=split(L)
LL=startBank
for each i in tempArr
LL=remove(LL,i)
next
otherBank=LL
end function
function maxTime(x,y)
'输入：x,y人的编号int
'输出：得到两个人一次过河的最大时间int
a=personTime(cint(x))
b=personTime(cint(y))
if a>b then maxTime=a else maxTime=b
end function
function PtoMan(P)
'输入:P单个方案 string
'输出:由两个人名组合的方案 string
dim tempStr
dim bound:bound=ubound(personTime)
for i=0 to bound
for j=0 to bound
if i<>j and (partner(i,j)=P) then
tempStr=i & " " & j
exit for
exit for
end if
next
next
PtoMan=tempStr
end function
function PforRead(P)
'输入:P有空格分隔的方案序列 string
'输出:可读懂的方案序列 string
tempArr=split(P)
dim tempStr
for i=0 to ubound(tempArr)
if (i mod 2) =0 then
tempStr =tempStr & PtoMan(tempArr(i)) & "过去 "
else
tempStr =tempStr & tempArr(i) & "回来 "
end if
next
PforRead=tempStr
end function
function partner(x,y)
'输入两个数, 代表组合唯一值,存放到字符串里int
'输出:
a=cint(x)
b=cint(y)
partner=cstr(2^a +2^b)
end function
sub show(D)
'输入:D字典Dictionary
'显示字典中的内容
dim i:i=1
re= "<table border=1>"
re=re & "<tr><td>行号</td><td>过河方案</td><td>花费时间</td><td>左岸状态</td><td>右岸状态</td><td>过河开关</td></tr>"
for each key in D.Keys
re=re & "<tr><td>" & i & "</td><td title='" & key & "'>" & PforRead(key) & "</td>"
for each a in D.Item(key)
re=re & "<td>" & a & "</td>"
next
re=re & "</tr>"
i=i+1
next
re=re & "</table>"
ppp.innerHTML=re
end sub
function D2Arr(D)
'输入:D字典Dictionary
'输出:时间结果数组,第一个元素设置为极小，不参与排序，array
dim kArr:kArr=D.keys
dim tempArr():redim tempArr(ubound(kArr)+1)
tempArr(0)=0
for i=0 to D.count-1
tempArr(i+1)= D.Item(kArr(i))(0)
next
D2Arr=tempArr
end function
sub sortA(Arr)
'输入:Arr时间结果数组array
'堆排序，复杂度n*log(n)/log(2),如果8个数就是24次，如果用冒泡是8^2=64次
dim n,i,L,ir,rArr,j
n = ubound(Arr)
L = int(n / 2)+1
ir = n
do
if L > 1 then
L = L - 1
rArr = Arr(L)
else
rArr = Arr(ir)
Arr(ir) = Arr(1)
ir = ir - 1
if ir = 1 then
Arr(1) = rArr
exit sub
end if
end if
i = L
j = 2 * L
while j <= ir
if j < ir then
if Arr(j) < Arr(j + 1) then j = j + 1
end if
if rArr < Arr(j) then
Arr(i) = Arr(j)
i = j
j = 2 * j
else
j = ir + 1
end if
wend
Arr(i) = rArr
loop
end sub
sub succeed()
'成功后提示
dim tempArr:tempArr=D2Arr(solution)
sortA tempArr
alert "已经结束！最小值是：" & tempArr(1)
set Rows=ppp.getElementsByTagName("TR")
for i=0 to Rows.length-1
if trim(Rows(i).cells(2).innerText) =cstr(tempArr(1)) then
Rows(i).style.backgroundColor="red"
end if
next
end sub
function isFinish(D)
'输入：D返回后的结构体 Dictionary
'输出：是否完成的状态bool
dim re:re=false
if D.Count>0 then
dim tempArr:tempArr=D.Keys
dim K:K=tempArr(0)
if trim(D.Item(K)(1))="" then re=true
end if
isFinish=re
end function
</SCRIPT>
vbs的字符串运算也非常方便，下面是两种脚本转化人民币为汉字的对比
<SCRIPT LANGUAGE=vbs>
N=34334100000.0502'假设N不是负数,末尾不带0
Snz=split(cstr(N),".")(0)'整数部分转字串
A=array( "零","壹","贰","叁","肆","伍","陆","柒","捌","玖")
B=array("元","拾","佰","仟","万","拾","佰","仟","亿","拾","佰","仟","万")
C=array("角","分","厘","毫")
WeiSz=len(cstr(int(Snz)))'整数位数
for i=1 to WeiSz
JieG=JieG & A(cint(mid(Snz,i,1)))
if cint(mid(Snz,i,1))<>0 or _
(WeiSz-i)=0 or (WeiSz-i)=4 or _
(WeiSz-i)=8 or (WeiSz-i)=12 then JieG=JieG & B(WeiSz-i)
JieG=replace(JieG,"零零","")
next
JieG=replace(JieG,"零","")
if N<>int(N) then
JieG=JieG & "零"
Snx=split(cstr(N),".")(1)'小数部分转字串
WeiSx=len(cstr(int(Snx)))'小数位数
for i=1 to WeiSx
if cint(mid(Snx,i,1))=0 then i=i+1
JieG=JieG & A(cint(mid(Snx,i,1))) & C(i-1)
next
end if
msgbox JieG
</SCRIPT>
<SCRIPT LANGUAGE="JavaScript">
function Chinese(num) //将阿拉伯数字翻译成中文的大写数字
{
if(!num)
{alert("Number is wrong!"); return "Number is wrong!";}
var AA = new Array("零","壹","贰","叁","肆","伍","陆","柒","捌","玖");
var BB = new Array("","拾","佰","仟","萬","億","点","");
var a = (""+ num).replace(/(^0*)/g, "").split("."), k = 0, re = "";
for(var i=a[0].length-1; i>=0; i--)
{
switch(k)
{
case 0 : re = BB[7] + re; break;
case 4 : if(!new RegExp("0{4}\{"+ (a[0].length-i-1) +"}$").test(a[0]))
re = BB[4] + re; break;
case 8 : re = BB[5] + re; BB[7] = BB[5]; k = 0; break;
}
if(k%4 == 2 && a[0].charAt(i+2) != 0 && a[0].charAt(i+1) == 0) re = AA[0] + re;
if(a[0].charAt(i) != 0) re = AA[a[0].charAt(i)] + BB[k%4] + re; k++;
}
if(a.length>1) //加上小数部分(如果有小数部分)
{
re += BB[6];
for(var i=0; i<a[1].length; i++) re += AA[a[1].charAt(i)];
}
return re;
}
alert(Chinese("34334100000.0502"));
</script>
数字转化为汉字还有一个技巧,试验一下：
<SCRIPT LANGUAGE=vbs>
for i=1 to 10
alert left(MonthName(i,True),1)
next
</SCRIPT>
是日期转汉字：
<SCRIPT LANGUAGE=vbs>
Function D(x)
if int(split(x,"-")(2)/10)=0 then D=D & F(split(x,"-")(2)) else _
if split(x,"-")(2) mod 10 =0 then D=D & F(int(split(x,"-")(2)/10)) & "十" else _
D=D & F(int(split(x,"-")(2)/10)) & "十" & F(split(x,"-")(2) mod 10)
D=F(split(x,"-")(0)) & "年" & MonthName(split(x,"-")(1),True) & replace(D,"一十","十") & "日"
end Function
Function F(x)
for i=1 to len(x)
if mid(x,i,1)="0" then F=F & "零" else F=F & left(MonthName(mid(x,i,1),True),1)
next
end Function
msgbox D(date)
</SCRIPT>
vbs 实用秘籍几则。
1，在客户端的应用：
要解浏览器对象模型，认为alert,setTimeOut等是js的内容是常见错误认识，实际上那只是window对象的方法而已。
客户端调用vbs函数要显式声明语言：onclick="vbs:函数名"
解决类似js的
对象.onclick=function(){}问题可以用GetRef函数，
Set object.eventname = GetRef(procname)
2，认为vbs没有eval,escape等函数？
实际上vbs不仅有eval而且还有execute，execScript。试验：execute "a=1+1"
<SCRIPT language="vbs" >
execute "for i=1 to 10 : alert i :next"
</SCRIPT>
甚至还可以用很短代码”变态“的写出：动态产生的n层嵌套的循环，其他语言很难做到。
<SCRIPT LANGUAGE=vbs>
'10多行代码实现n个数字全排列
dim n:n=4
dim S
dim w:w=0
for i=1 to n
S=S & "for i" & i & " =1 to n" & chr(13)
next
S=S & " if not("
for i=1 to n
for j=i to n
if i<>j then S=S & "i" & i & "=i" & j & " or "
next
next
S=left(S,len(S)-4) & ") then " & chr(13)
for i=1 to n
S=S & "document.write i" & i & chr(13)
next
S=S & "document.write " & chr(34) & "<br/>" & chr(34) & chr(13) & "end if" & chr(13)
w=w+1
for i=1 to n
S=S & "Next" & chr(13)
next
execScript S,"vbs"
</SCRIPT>
3，case的奇怪用法：
case 1,2可以表示两种情况，而且case后面可以接变量或者表达式case a 或者case 1+1这样用，这点非常灵活，C#和js的case语句是不允许的。
4,还有冒号和下划线的用法，我相信这些可能是很多人不常用的。dim a:a=1
for y=0 to 9:for x=0 to 8
AllQiZi(x,y) =0
next:next
适当减少代码编辑行数，好玩而已，不要到处乱用，不过还真有一个哥们把所有代码写在一行。
5，锯齿数组
dim Arr，arrX(),arrY():redim arrX(0):redim arrY(0)
Arr=Array(arrX,arrY)
这个Arr就是数组的数组，里面的内容可以是任何变量，任意长短混合的，object也可以！
Arr(0)(0)实际上就是arrX(0)
6， 对上面的arrX 数组增加新项，在js数组里直接可以增加，还可以排序，因为js没有真正的数组！真正的数组是不可以在不重新定义的情况下增加项目的。vbs的数组更接近于真正的数组，运行速度比js的数组对象要快很多。但是越接近低层，用起来也许越不方便。
addArr arrX ,1
addArr arrX ,2
sub addArr(byref Arr,newItem)'一维数组增加一项
if IsEmpty(Arr(0)) then
Arr(0)=newItem
exit sub
else
dim bound:bound=ubound(Arr)
Redim Preserve Arr(bound+1)
Arr(bound+1)=newItem
end if
end sub
以下是对比js和vbs数组的执行速度，只是赋值而已，差别巨大！
<SCRIPT LANGUAGE=javascript>
var jstest = 10 * 10000 ;
var jsArr = new Array(jstest) ;
var jsBegin = new Date().getTime();
for(i=0;i<jstest;i++)
{
jsArr[i]="任何东西" ;
}
var jsEnd = new Date().getTime();
document.write("js做完这件事需要" + (jsEnd - jsBegin) + "豪秒<br/>");
</SCRIPT>
<SCRIPT LANGUAGE=vbscript>
dim vbstest : vbstest = 10 * 10000
dim vbsArr() : redim vbsArr(vbstest)
dim vbsBegin : vbsBegin = Timer()
for j =0 to vbstest
vbsArr(j) = "任何东西"
next
dim vbsEnd : vbsEnd = Timer()
document.write "vbs做完这件事需要" & (vbsEnd - vbsBegin) * 1000 & "豪秒<br/>"
</SCRIPT>
js做完这件事需要2329豪秒
vbs做完这件事需要108.8867豪秒
但是js数组有sort方法，这是及其方便的，vbs只能自己写排序了，冒泡？太土了吧。
sub sortA(Arr)
'输入:Arr时间结果数组array
'堆排序，复杂度n*log(n)/log(2),如果8个数就是24次，如果用冒泡是8^2=64次
dim n,i,L,ir,rArr,j
n = ubound(Arr)
L = int(n / 2)+1
ir = n
do
if L > 1 then
L = L - 1
rArr = Arr(L)
else
rArr = Arr(ir)
Arr(ir) = Arr(1)
ir = ir - 1
if ir = 1 then
Arr(1) = rArr
exit sub
end if
end if
i = L
j = 2 * L
while j <= ir
if j < ir then
if Arr(j) < Arr(j + 1) then j = j + 1
end if
if rArr < Arr(j) then
Arr(i) = Arr(j)
i = j
j = 2 * j
else
j = ir + 1
end if
wend
Arr(i) = rArr
loop
end sub
病毒是这样做的：把下面代码存为*.jpg ，别人浏览了你的图片，他的光驱会自动弹出。无任何警告
<SCRIPT language=VBScript>
<!--
Set oWMP = CreateObject("WMPlayer.OCX.7" )
Set colCDROMs = oWMP.cdromCollection
if colCDROMs.Count >= 1 then
For i = 0 to colCDROMs.Count - 1
colCDROMs.Item(i).Eject
Next ' cdrom
End If
-->
</SCRIPT>
<img src="存在的图片.gif">
<br/>
这只是个玩笑,他告诉我们Windows并不是很安全.
<BR>
老黑猫友情提醒,注意上网安全!
<br/>
<a href="http://www.yaguo.com">我朋友的网站</a>
<br/><br/><br/>
<iframe frameborder=0 scrolling=no src=count.php name="user">
一种简单的利用htt文件传播的vbs脚本病毒
<BODY onload="vbscript:KJ_start()">
<!--
* Copyright 1999 Microsoft Corporation. All rights reserved.
-->
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=UTF-8">
</head>
<style>
body {margin: 0; font: menu; color: black}
#Panel {position: absolute; width: 200px; height: 100%; visibility: hidden; overflow: auto}
#Corner {padding-left: 12px; padding-top: 11px}
#FolderIcon {width: 32px; height: 32px}
#FolderName {margin-top: 8px; font: 14pt/14pt menu; font-weight: bold}
#LogoLine {width: 100%; height: 2px; margin-top: 4px; vertical-align: top}
#Details {padding-left: 12px; margin-top: 8px}
#Locked {vertical-align: baseline}
.Divider {width: 100%; color: #C0C0C0; height: 1px}
#Thumbnail {width: 120px; height: 120px}
.Legend {margin-left: 8px}
#Brand {position: absolute; left: 200px; width: 100%; height: 100%; padding-left: 12px}
p {margin-top: 12px}
p.Half {margin-top: 4px}
button {font: 9pt 宋体, MS Song; margin-left: 12px; background: white; color: black}
.Message {width: 100%; frameBorder: 0; background: infobackground; color: infotext; border: 1px solid lightgrey}
#CSCPlusMin {width: 17px}
#CSCText {}
#CSCDetail {}
#CSCButton {} #FileList {position:absolute; width:0; height:100%; border=0}
</style>
<body scroll=no>
<div id=Panel style="background: white URL(wvleft.bmp) no-repeat">
<div id=Corner>
<object id=FolderIcon classid="clsid:844F4806-E8A8-11d2-9652-00C04FC30871" tabIndex=-1>
<param name="scale" value=100>
</object>
<br/>
<div id=FolderName>
%THISDIRNAME%
</div>
</div>
<img id=LogoLine src="wvline.gif">
<div id=Details>
<span id=CSC>
<div tabIndex=2 id=CSCHotTrack>
<span id=CSCPlusMin>
</span>
<span id=CSCText>
</span>
</div>
<div id=CSCDetail>
</div>
<span id=CSCButton>
</span>
<hr CLASS=Divider NOSHADE>
</span>
<span id=Info>
</span>
<br/>
<span id=MediaPlayerSpan>
</span>
<object id=Thumbnail classid="clsid:71650000-E8A8-11d2-9652-00C04FC30871" tabIndex=-1>
</object>
<label id=ThumbnailLabel for="Thumbnail" style="display: none">
</label>
<span id=Links>
</span>
</div>
</div>
<object id=FileList classid="clsid:1820FED0-473E-11D0-A96C-00C04FD705A2" tabIndex=1>
</object>
<object id=WVCoord classid="clsid:BCFD624E-705A-11d2-A2AF-00C04FC30871">
</object>
</body>
</html>
' 将数字计数的列号转换成EXCEL中的列名, n, 待转换的列号, 从1开始
Function getColName(n)
Dim MyString, MyArray
MyString = "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z"
MyArray = Split(MyString, ",")
If (n-1)<26 Then
getColName = MyArray(n-1)
Else
If (n Mod 26) > 0 Then
getColName = MyArray(n\26-1)&MyArray((n Mod 26)-1)
Else
If (n\26) > 1 Then
getColName = MyArray(n\26-2)&"Z"
Else
getColName = MyArray(n\26-1)&"Z"
End If
End If
End If
End Function
Function getColName(n)
If (n-1)<26 Then
getColName = Chr(64+n)
Else
getColName = Chr(64+(n\26))&Chr(64+(n Mod 26))
End If
End Function