复制代码 代码如下:
'1、输入url目标网页地址,返回值getHTTPPage是目标网页的html代码
function getHTTPPage(url)
dim Http
set Http=CreateObject("MSXML2.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then
exit function
end if
getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
set http=nothing
if err.number<>0 then err.Clear
end function
'2、转换乱玛,直接用xmlhttp调用有中文字符的网页得到的将是乱玛,可以通过adodb.stream组件进行转换
Function BytesToBstr(body,Cset)
dim objstream
set objstream =CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode = 3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function
'下面试着调用http://www.proxycn.com/html_proxy/30fastproxy-1.html的html内容
Dim Url,Html,Temp
Url="http://www.proxycn.com/html_proxy/30fastproxy-1.html"
Html = getHTTPPage(Url)
Call getinfo(html)
Sub Getinfo(S)
Dim pl(),m,St
St="</TD><TD class=" & """list""" & ">"
Do
m = m + 1
n = P + Len(St)
P = InStr(n,S,St)
ReDim Preserve pl(m-1)
pl(m-1) = P
loop While P <> 0
For o = 0 to m-1
If o+1 < m-1 Then
T_S=Mid(S,pl(o)+Len(St),pl(o+1)-pl(o)-Len(St))
If Len(T_S) < 30 Then
t=t+1
Select Case t
Case 1
temp = temp & "端口 : " & T_S & vbcrlf
Case 2
temp = temp & "类型 : " & T_S & vbcrlf
Case 3
temp = temp & "地址 : " & T_S & vbcrlf
Case 4
temp = temp & "时间 : " & Now & vbcrlf
Case 5
t=0
Str_Sip = "whois.php?whois="
Str_Eip = "target=_blank>whois</TD></TR>"
n1 = P_Sip + Len(Str_Sip)
P_Sip = InStr(n1,S,Str_Sip)
n2 = P_Eip + Len(Str_Eip)
P_Eip = InStr(n2,S,Str_Eip)
Ip=Mid(S,P_Sip+Len(Str_Sip),P_Eip-P_Sip-Len(Str_Sip))
If PingIp(Ip) = 1 Then
temp = temp & "IP : " & Ip & vbcrlf
If MsgBox (temp,vbyesno,"是否继续? " )=vbno Then
WScript.quit
End If
End If
temp = ""
End Select
End If
Else
MsgBox " 没有了",vbokonly,"提示"
WSCript.quit
End If
Next
End Sub
Function PingIp(host)
On Error Resume Next
strComputer = "."
strTarget = host
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colPings = objWMIService.ExecQuery _
("Select * From Win32_PingStatus where Address = '" & strTarget & "'")
If Err = 0 Then
Err.Clear
For Each objPing in colPings
If Err = 0 Then
Err.Clear
If objPing.StatusCode = 0 Then
PingIp = 1
temp = temp & "速度 : " & objPing.ResponseTime & " 毫秒" & vbcrlf
'MsgBox strTarget & " responded to ping." & vbcrlf &_
'"Responding Address: " & objPing.ProtocolAddress & vbcrlf &_
'"Responding Name: " & objPing.ProtocolAddressResolved & vbcrlf &_
'"Bytes Sent: " & objPing.BufferSize & vbcrlf &_
'"Time: " & objPing.ResponseTime & " ms" & vbcrlf &_
'"TTL: " & objPing.ResponseTimeToLive & " seconds"
Else
PingIp = 0
'MsgBox strTarget & " did not respond to ping." &_
'"Status Code: " & objPing.StatusCode
End If
Else
Err.Clear
PingIP = 0
'MsgBox "Unable to call Win32_PingStatus on " & strComputer & "."
End If
Next
Else
Err.Clear
PingIp = 0
'MsgBox "Unable to call Win32_PingStatus on " & strComputer & "."
End If
End Function
免责声明:本站资源来自互联网收集,仅供用于学习和交流,请遵循相关法律法规,本站一切资源不代表本站立场,如有侵权、后门、不妥请联系本站删除!
更新日志
- 刘欢.2004-经典20年珍藏锦集【新索】【WAV+CUE】
- 中唱唱片群星《好歌珍藏-游子情深》2CDWAV
- CD圣经上榜天碟1995-乌仁娜-《蒙古草原之歌》[WAV+CUE].
- 【电影原声】武满彻《旭日东升》1993[WAV+CUE整轨]
- Taylor Swift《THE TORTURED POETS DEPARTMENT》[320K/MP3][148.54MB]
- Taylor Swift《THE TORTURED POETS DEPARTMENT》[FLAC/分轨][405.72MB]
- Joyce Jonathan《法式松弛感 漫步香榭丽舍》[320K/MP3][80.8MB]
- 女神异闻录5佐仓双叶coop攻略 p5r佐仓双叶对话选项攻略
- 【民谣】张智《尼勒克小镇》[FLAC]
- 林一峰2018-TRAVELOGUE4ESCAPE[香港首版][WAV+CUE]
- MollyLewis《OnTheLips》(2024)[Hi-Res96kHz_24bitFLAC]
- Joyce Jonathan《法式松弛感 漫步香榭丽舍》[FLAC/分轨][230.77MB]
- 群星《影视剧 春色寄情人 原声带》[320K/MP3][394.18MB]
- 吴牧野《强者独白II 李斯特巅峰作品选》[320K/MP3][216.01MB]
- 女神异闻录5御船千早coop攻略 p5r御船千早对话选项攻略