您现在的位置是：网站首页> 编程资料编程资料
好玩的vbs特色代码第1/6页_vbs_
2023-05-25
300人已围观
简介 好玩的vbs特色代码第1/6页_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项是一个一维数组。
这两种个数据结构的原理我用到了一个游戏题目里：
四人欲过一座河，且只有一个氧气瓶(每次最多能容两人同时游过).
甲单独过河需1分钟,乙需2分钟,丙需5分钟,丁需7分钟. 则四人全部通过的最短时间是多少.
过河
'本题属于决策树类型问题
'难点在于数据的描述上
'决策树的数据关键是：初始状态，操作步骤，结束状态
'每次递归的输入值--初始状态，是上次运算的结果--结束状态
'因此经过反复推敲，决定用：岸边状态+操作步骤编码+时间结果+开关状态来描述
'技巧：关于搭档方式的描述，采用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= ""
re=re & "行号 过河方案 花费时间 左岸状态 右岸状态 过河开关
for each key in D.Keys
re=re & "" & i & " " & PforRead(key) & ""
for each a in D.Item(key)
re=re & "" & a & " "
next
re=re & "
i=i+1
next
re=re & ""
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
硬盘的权限就是一个例子，参考脚本手册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项是一个一维数组。
这两种个数据结构的原理我用到了一个游戏题目里：
四人欲过一座河，且只有一个氧气瓶(每次最多能容两人同时游过).
甲单独过河需1分钟,乙需2分钟,丙需5分钟,丁需7分钟. 则四人全部通过的最短时间是多少.
'本题属于决策树类型问题
'难点在于数据的描述上
'决策树的数据关键是：初始状态，操作步骤，结束状态
'每次递归的输入值--初始状态，是上次运算的结果--结束状态
'因此经过反复推敲，决定用：岸边状态+操作步骤编码+时间结果+开关状态来描述
'技巧：关于搭档方式的描述，采用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= "
re=re & "
for each key in D.Keys
re=re & "
for each a in D.Item(key)
re=re & "
next
re=re & "
i=i+1
next
re=re & ""
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
