|
'主要用于匹配源码中的url链接
Function reg(str,regpattern)
Dim regobj,matches,match,httpstr
Set regobj=New RegExp
regobj.Global=True
regobj.IgnoreCase=True
regobj.Pattern=regpattern
Set matches=regobj.Execute(str)
For Each match In matches
writefile fso,"C:\Documents and Settings\lujian\桌面\http.txt",match
If httptest(match) then
writefile fso,"C:\Documents and Settings\lujian\桌面\http.txt",vbtab&"OK"
Else
writefile fso,"C:\Documents and Settings\lujian\桌面\http.txt",vbtab&"FALSE"
End If
' httpstr=httpstr&match&vbCrLf
Next
' writefile fso,"C:\Documents and Settings\lujian\桌面\http.txt",httpstr
end Function
'读取sina的源码函数,入参为路径
Function readfile(filename)
dim fso,fsofile,str
Set fso=CreateObject("scripting.filesystemobject")
Set fsofile=fso.OpenTextFile(filename)
str=fsofile.ReadAll
readfile=str
fsofile.Close
End Function
'将测试结果写入文件
Function writefile(fso,filename,str)
' Dim fso,fsofile
' Set fso=CreateObject("scripting.filesystemobject")
Dim fsofile
Set fsofile=fso.OpenTextFile(filename,8,true)
fsofile.WriteLine(str)
' fsofile.Close
End Function
'测试连接是否有效函数
Function httptest(httpurl)
Dim http,stat
Set http = CreateObject("Msxml2.ServerXMLHTTP")
http.open "GET", httpurl, False
http.send
stat=http.status
If stat ="200" Then
httptest=True
Else
httptest=False
End If
End Function
Dim fso
Set fso=CreateObject("scripting.filesystemobject")
str=readfile("C:\Documents and Settings\lujian\桌面\sina.txt")
patt="http://([\w\./\?%=&-]+)"
reg str,patt
MsgBox "done" |
|