求一个VBS随机打开网址的示例 - 中国DOS联盟论坛

增加了一个函数来增强兼容性，首尾可以包含空白(空格，TAB等)，网址可以不包含 http:// 、www 前缀。

信息存在数组中


'存放网址的数组
URLs=Array( _
"WWW.QQ.COM", _
"WWW.163.COM", _
"WWW.SOHU.COM", _
"WWW.SINA.COM")

Set ching=CreateObject("Wscript.Shell")
Dim URL
Randomize
URL=formatURL(URLs(Int(UBound(URLs) * Rnd) + 1))
ching.Run URL


'获取此行中的有效网址(剔除首尾空白部分)
Function formatURL(textString)
Set regEx = New RegExp
regEx.Pattern = "^\s*(.+\:\/\/)?(.*)\s*$"
regEx.IgnoreCase = True
Set matches = regEx.Execute(textString)
Set match1=matches(0)
formatURL=match1.SubMatches(0)&match1.SubMatches(1)
If formatURL="" Then formatURL="about:blank"
End Function

存在文件中


'存放网址的文件
Const fileName="a.txt"

Set fso=CreateObject("Scripting.FileSystemObject")
Set ching=CreateObject("Wscript.Shell")
Dim URL
Randomize
URL=formatURL(getStringAtLine(fileName, Int((getLines(fileName) * Rnd) + 1)))
ching.Run URL


'获取行数
Function getLines(fileName)
Dim lines
lines=0
set f=fso.OpenTextFile(fileName)
While not f.AtEndOfStream
f.SkipLine()
lines=lines+1
Wend
f.Close()
set f=Nothing
getLines=lines
End Function


'得到指定行的字符串
Function getStringAtLine(fileName, lineNumber)
Dim str
set f=fso.OpenTextFile(fileName)
ON ERROR RESUME NEXT
For i=2 to lineNumber
f.SkipLine()
Next
str=f.Readline()
f.Close()
set f=Nothing
getStringAtLine=str
End Function


'获取此行中的有效网址(剔除首尾空白部分)
Function formatURL(textString)
Set regEx = New RegExp
regEx.Pattern = "^\s*(.+\:\/\/)?(.*)\s*$"
regEx.IgnoreCase = True
Set matches = regEx.Execute(textString)
Set match1=matches(0)
formatURL=match1.SubMatches(0)&match1.SubMatches(1)
If formatURL="" Then formatURL="about:blank"
End Function

[ Last edited by qinchun36 on 2009-9-6 at 23:45 ]

第1楼　hackhd	发表于 2009-09-06 22:09
中级用户　发帖 102　积分 231
求一个VBS随机打开网址的示例脚本里给几个网址比如 WWW.QQ.COM WWW.163.COM WWW.SOHU.COM WWW.SINA.COM 有这几个网址运行VBS时会随机打开其中一个网址

第2楼　qinchun36	发表于 2009-09-06 23:27
高级用户　发帖 400　积分 609
增加了一个函数来增强兼容性，首尾可以包含空白(空格，TAB等)，网址可以不包含 http:// 、www 前缀。信息存在数组中 '存放网址的数组 URLs=Array( _ "WWW.QQ.COM", _ "WWW.163.COM", _ "WWW.SOHU.COM", _ "WWW.SINA.COM") Set ching=CreateObject("Wscript.Shell") Dim URL Randomize URL=formatURL(URLs(Int(UBound(URLs) * Rnd) + 1)) ching.Run URL '获取此行中的有效网址(剔除首尾空白部分) Function formatURL(textString) Set regEx = New RegExp regEx.Pattern = "^\s(.+\:\/\/)?(.)\s$" regEx.IgnoreCase = True Set matches = regEx.Execute(textString) Set match1=matches(0) formatURL=match1.SubMatches(0)&match1.SubMatches(1) If formatURL="" Then formatURL="about:blank" End Function 存在文件中 '存放网址的文件 Const fileName="a.txt" Set fso=CreateObject("Scripting.FileSystemObject") Set ching=CreateObject("Wscript.Shell") Dim URL Randomize URL=formatURL(getStringAtLine(fileName, Int((getLines(fileName) Rnd) + 1))) ching.Run URL '获取行数 Function getLines(fileName) Dim lines lines=0 set f=fso.OpenTextFile(fileName) While not f.AtEndOfStream f.SkipLine() lines=lines+1 Wend f.Close() set f=Nothing getLines=lines End Function '得到指定行的字符串 Function getStringAtLine(fileName, lineNumber) Dim str set f=fso.OpenTextFile(fileName) ON ERROR RESUME NEXT For i=2 to lineNumber f.SkipLine() Next str=f.Readline() f.Close() set f=Nothing getStringAtLine=str End Function '获取此行中的有效网址(剔除首尾空白部分) Function formatURL(textString) Set regEx = New RegExp regEx.Pattern = "^\s(.+\:\/\/)?(.)\s$" regEx.IgnoreCase = True Set matches = regEx.Execute(textString) Set match1=matches(0) formatURL=match1.SubMatches(0)&match1.SubMatches(1) If formatURL="" Then formatURL="about:blank" End Function [ Last edited by qinchun36 on 2009-9-6 at 23:45* ]

第3楼　keen	发表于 2009-09-07 01:05
初级用户　发帖 29　积分 58
re 2楼 URL=formatURL(URLs(Int(UBound(URLs) * Rnd) + 1)) 你采用加1，是无法取到第一个地址吧，也就是说你的取数组中的值，最小都是URLs(1)，无法取到URLs(0)。

第4楼　hackhd	发表于 2009-09-07 02:28
中级用户　发帖 102　积分 231
我想让程序在后台的方式打开网页呢，，打开网页时看不到 [ Last edited by hackhd on 2009-9-7 at 02:35 ]

第5楼　qinchun36	发表于 2009-09-08 22:54
高级用户　发帖 400　积分 609
re 3楼: 的确，失误，从文件那段直接粘过来的。。。 re 4楼: 想要隐藏的话需要指定打开网页的程序，然后加上参数 0，比如 ching.Run "iexplore "&chr(34)&URL&chr(34), 0