、作者: 没翅膀的飞鱼 时间: 2012-11-9 21:31
不能用工具，有点难度，可以尝试6楼的方法作者: lb3942148 时间: 2012-11-20 22:51
我猜想，获得连接地址，批处理应该时间够。勿喷，纯粹的新手作者: victorzifeng 时间: 2012-12-4 15:32
我认为：将新浪Ctrl+a，复制，粘贴在记事本，整理记事本，用正则表达式早出每一项（也就是可以链接的标题），然后编写vbs脚本，干之。作者: lujian2036 时间: 2012-12-24 01:12
'主要用于匹配源码中的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"作者: lujian2036 时间: 2012-12-24 01:14 本帖最后由 lujian2036 于 2012-12-24 10:35 编辑
