| 标题 | vbs 搜索代理地址实现代码 |
| 内容 | 将下面的代码，直接保存为getproxy.vbs即可。 代码如下: '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""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 |
| 随便看 |
|
在线学习网考试资料包含高考、自考、专升本考试、人事考试、公务员考试、大学生村官考试、特岗教师招聘考试、事业单位招聘考试、企业人才招聘、银行招聘、教师招聘、农村信用社招聘、各类资格证书考试等各类考试资料。