一个提取HTTP代理的VBS脚本

页面导航:首页 > 软件编程 > vb.net > 一个提取HTTP代理的VBS脚本

一个提取HTTP代理的VBS脚本

来源: 作者: 时间:2016-01-21 10:23 【

/*========================================================================= * Intro:自动从各大代理网站提取花刺代理不能识别的HTTP代理,然后用花刺进行验证,一般情况下都可以提取一千多个可用代理

/*=========================================================================
* Intro:自动从各大代理网站提取花刺代理不能识别的HTTP代理,然后用花刺进行验证,一般情况下都可以提取一千多个可用代理
* Usage:在命令提示符下输入:Cscript.exe SearchProxy.vbs.VBS
* FileName:SearchProxy.vbs.VBS
* Author:雨中风铃
* Version:v1.0
* WEB:
* MadeTime:2009-12-22 08:51
*==========================================================================*/

On Error Resume Next

Dim N, strPattern(3), iSleepTime
N = 0
iSleepTime = 200 脚本不稳定请增加此值

strPattern(0) = "((d{1,2}|1dd|2[0-4]d|25[0-5])(.(1dd|2[0-4]d|25[0-5]|d{1,2})){3}):(d+)"
strPattern(1) = "((d{1,2}|1dd|2[0-4]d|25[0-5])(.(1dd|2[0-4]d|25[0-5]|d{1,2})){3}).*?(d+)<"
strPattern(2) = "((d{1,2}|1dd|2[0-4]d|25[0-5])(.(1dd|2[0-4]d|25[0-5]|d{1,2})){3})[sS]*?s(d+)"
strPattern(3) = "((d{1,2}|1dd|2[0-4]d|25[0-5])(.(1dd|2[0-4]d|25[0-5]|d{1,2})){3})[sS]*?(d+)"

Call ExtracProxyByIE("", 0, 1, 0)
Call ExtracProxyByIE("", 0, 1, 0)
Call ExtracProxyByIE("", 1, 1, 0)

Call ExtracProxyByXML("", "q=&a=ABCD&s=host", 1, 0, 0, 0)
Call ExtracProxyByXML("", , 0, 0, 0, 1)
Call ExtracProxyByXML("", , 0, 0, 2, 1)

Call ExtracProxyByXML("", , 0, 0, 1, 0) Not Open
Call ExtracProxyByXML("x?show=3&indexPage=NNNN">http://info.hustonline.net/proxy/prolist.aspx?show=3&indexPage=NNNN", , 0, 0, 1, 2) So Bad

Wscript.Echo "提取完毕"

Function ExtracProxyByXML(strSite, strPost, bPost, bPrefix, iBegin, iRegExp)
Dim I
Do While True
If bPrefix Then
I = Right("0" & iBegin, 2)
Else
I = iBegin
End If
strUrl = Replace(strSite, "NNNN", I)
If bPost then
strData = PostData(strUrl, strPost)
Else
strData = GetData(strUrl)
End If
iBegin = iBegin + 1
strResult = getContents(strData, iRegExp)
If strResult <> "" Then
Call SaveToLog(strResult)
Wscript.Echo "已经提取" & N & "个代理"
Else
Exit Do
End If
If InStr(strSite, "NNNN") <= 0 Then
Exit Do
End If
Wscript.Sleep iSleepTime
Loop
End Function

Function ExtracProxyByIE(strSite, bPrefix, iBegin, iRegExp)
Dim I
Do While True
If bPrefix Then
I = Right("0" & iBegin, 2)
Else
I = iBegin
End If
strUrl = Replace(strSite, "NNNN", I)
Set ie=WScript.CreateObject("InternetExplorer.Application")
ie.visible = False
ie.navigate strUrl
Do
Wscript.Sleep 500
Loop Until ie.ReadyState=4
strData = ie.document.body.innerText
ie.Quit
iBegin = iBegin + 1
strResult = getContents(strData, iRegExp)
If strResult <> "" Then
Call SaveToLog(strResult)
Wscript.Echo "已经提取" & N & "个代理"
Else
Exit Do
End If
If InStr(strSite, "NNNN") <= 0 Then
Exit Do
End If
Wscript.Sleep iSleepTime
Loop
End Function

Function GetData(PostUrl)
Dim Http
Set Http = CreateObject("msxml2.serverXMLHTTP")
With Http
.Open "GET",PostUrl,False
.Send ()
GetData = .ResponseBody
End With
Set Http = Nothing
GetData =bytes2BSTR(GetData)
End Function

Function PostData(PostUrl,PostStr)
Dim Http
Set Http = CreateObject("msxml2.serverXMLHTTP")
With Http
.Open "POST",PostUrl,False
.SetRequestHeader "Content-Length",Len(PostStr)
.SetRequestHeader "Content-Type","application/x-www-form-urlencoded"
.Send PostStr
PostData = .ResponseBody
End With
Set Http = Nothing
PostData =bytes2BSTR(PostData)
End Function

Function bytes2BSTR(vIn)
Dim strReturn
Dim I, ThisCharCode, NextCharCode
strReturn = ""
For I = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn, I, 1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn, I + 1, 1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
I = I + 1
End If
Next
bytes2BSTR = strReturn
End Function

Function getContents(Str, iRegExp)
Set re = New RegExp
re.Pattern = strPattern(iRegExp)
re.Global = True
re.IgnoreCase = True
Set Contents = re.Execute(Str)
For Each Match in Contents 遍历匹配集合。
N = N + 1
getContents = getContents & Match.SubMatches(0) & ":" & Match.SubMatches(4) & vbCrLf
Next
End Function

Sub SaveToLog(strContent)
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("proxy.txt", ForAppending, True)
f.Write strContent
f.Close
Set fso = Nothing
End Sub

Tags:

文章评论

最 近 更 新
热 点 排 行
Js与CSS工具
代码转换工具

<