增加了一个函数来增强兼容性,首尾可以包含空白(空格,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 ]
re 3楼: 的确,失误,从文件那段直接粘过来的。。。
re 4楼: 想要隐藏的话需要指定打开网页的程序,然后加上参数 0,比如
ching.Run "iexplore "&chr(34)&URL&chr(34), 0