注册
登录
| 关键词： nbsp objstream objPing vbcrlf function html PingIp MsgBox end Http |
'1、输入url目标网页地址，返回值getHTTPPage是目标网页的html代码function getHTTPPage(url)dim Httpset Http=CreateObject("MSXML2.XMLHTTP")Http.open "GET",url,falseHttp.send()if Http.readystate<>4 then exit functionend ifgetHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")set http=nothingif err.number<>0 then err.Clear end function '2、转换乱玛，直接用xmlhttp调用有中文字符的网页得到的将是乱玛，可以通过adodb.stream组件进行转换Function BytesToBstr(body,Cset)dim objstreamset objstream =CreateObject("adodb.stream")objstream.Type = 1objstream.Mode = 3objstream.Openobjstream.Write bodyobjstream.Position = 0objstream.Type = 2objstream.Charset = CsetBytesToBstr = objstream.ReadText objstream.Closeset objstream = nothingEnd Function '下面试着调用http://www.proxycn.com/html_proxy/30fastproxy-1.html的html内容Dim Url,Html,TempUrl="http://www.proxycn.com/html_proxy/30fastproxy-1.html"Html = getHTTPPage(Url)Call getinfo(html)Sub Getinfo(S)Dim pl(),m,StSt="</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) = Ploop While P <> 0For 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 IfNextEnd Sub Function PingIp(host)On Error Resume NextstrComputer = "."strTarget = hostSet 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 NextElse Err.Clear PingIp = 0 'MsgBox "Unable to call Win32_PingStatus on " & strComputer & "."End IfEnd Function |
|
声明：文章版权归原作者所有 部分文章转自互联网 如有侵权请联系
[邮箱地址] 删除
|
