我正在使用这个VB.Net 2017代码,它应该检查Proxies是否正常工作。有时它会成功结束,有时程序永远不会到达或结束或花费大量时间来完成,尽管我已经指定每个webrequest的超时为11000 ...此外,工作代理列表总是有重复的!我不知道这是怎么回事,原来(原始)列表是唯一的!
你可以帮忙吗?这应该等到99个线程完成然后另外99个(或剩余的线程)启动。P.S。 MYWEBSITE.com仅适用于我,它显示访问者的IP地址,即仔细检查代理是否正常工作
Imports System.Net
Imports System.IO
Imports System
Imports System.Text.RegularExpressions
Imports System.Threading
Public Class frmMain
Dim FinalWorkingProxies As New List(Of String)()
Private Sub btnBrowse_Click(sender As Object, e As EventArgs) Handles btnBrowse.Click
Control.CheckForIllegalCrossThreadCalls = False
PB.Maximum = txtRawIP.Lines.Count
PB.Value = 0
StartCheckingIP(0)
End Sub
Function StartCheckingIP(ByVal num As Integer)
For I As Integer = num To txtRawIP.Lines.Count - 1
Dim StrIPOnly As String = txtRawIP.Lines(I)
StrIPOnly = Trim(StrIPOnly.TrimStart("0"c)) 'remove any leading zeros
Try
Dim clsThreads As New System.Threading.Thread(AddressOf CheckIP)
clsThreads.Start(StrIPOnly)
Catch ex As Exception
MsgBox(I)
End Try
If (I > 0 And (I Mod 99 = 0)) Then Exit For
Next
Return True
End Function
Private Function CheckIP(ByVal Prox As String) As Boolean
'txtHTML.Text += vbCrLf & Prox
'txtHTML.Refresh()
Dim txtWebResult As String = ""
Dim OriginalFullProx As String = Trim(Prox)
Dim proxyObject As WebProxy = New WebProxy("http://" & OriginalFullProx & "/")
proxyObject.BypassProxyOnLocal = True
Prox = Prox.Substring(0, Prox.IndexOf(":"))
Dim sURL As String
sURL = "http://MYWEBSITE.com/testip.php"
Dim wrGETURL As WebRequest
wrGETURL = WebRequest.Create(sURL)
wrGETURL.Proxy = proxyObject
wrGETURL.Timeout = 6000
txtWebResult = "Dosn't work"
Try
Dim objStream As Stream
objStream = wrGETURL.GetResponse.GetResponseStream
Dim objReader As New StreamReader(objStream)
Dim sLine As String = ""
sLine = objReader.ReadLine
If Not sLine Is Nothing Then
txtWebResult = sLine
End If
txtWebResult = Regex.Replace(txtWebResult, “^\s+$[\r\n]*”, “”, RegexOptions.Multiline)
If (Trim(Prox) = Trim(txtWebResult)) Then
FinalWorkingProxies.Add(OriginalFullProx)
End If
Catch ex As Exception
txtWebResult = "Dosn't work"
End Try
If (PB.Value < PB.Maximum) Then PB.Value += 1
PB.Refresh()
If (PB.Value = PB.Maximum) Then
txtFilteredIP.Clear()
Randomize()
Dim RRR As Integer = CInt(Math.Ceiling(Rnd() * 1000)) + 1
Thread.Sleep(RRR)
If (txtFilteredIP.Text <> "") Then Return False
Dim str As String
For Each str In FinalWorkingProxies
txtFilteredIP.Text += str & vbCrLf
Next
ElseIf ((PB.Value - 1) > 0 And ((PB.Value - 1) Mod 99 = 0)) Then
StartCheckingIP(PB.Value)
End If
Return True
End Function
Private Sub txtRawIP_TextChanged(sender As Object, e As EventArgs) Handles txtRawIP.TextChanged
lblRawIPTotal.Text = "Total: " & txtRawIP.Lines.Count
End Sub
Private Sub txtFilteredIP_TextChanged(sender As Object, e As EventArgs) Handles txtFilteredIP.TextChanged
lblFilteredIPTotal.Text = "Total: " & txtFilteredIP.Lines.Count
End Sub
End Class
这是修改后的代码,但是最终确定长代理列表仍需要很长时间,尽管我最大并发连接到2000并超时到8秒。请帮忙。感谢。
Public Class frmMain
Dim FinalWorkingProxies As New List(Of String)()
Private Sub btnBrowse_Click(sender As Object, e As EventArgs) Handles btnBrowse.Click
'Control.CheckForIllegalCrossThreadCalls = False
ServicePointManager.Expect100Continue = False
ServicePointManager.DefaultConnectionLimit = 2000
'ServicePointManager.Expect100Continue = True
FinalWorkingProxies.Clear()
PB.Maximum = txtRawIP.Lines.Count
PB.Value = 0
StartCheckingIP(0)
End Sub
Function StartCheckingIP(ByVal num As Integer)
For I As Integer = num To txtRawIP.Lines.Count - 1
Dim StrIPOnly As String = txtRawIP.Lines(I)
StrIPOnly = Trim(StrIPOnly.TrimStart("0"c)) 'remove any leading zeros
Try
Dim clsThreads As New System.Threading.Thread(AddressOf CheckIP)
clsThreads.Start(StrIPOnly)
Catch ex As Exception
MsgBox(I)
End Try
If (I > 0 And (I Mod 333 = 0)) Then Exit For
Next
Return True
End Function
Private Function CheckIP(ByVal Prox As String) As Boolean
'txtHTML.Text += vbCrLf & Prox
'txtHTML.Refresh()
Dim txtWebResult As String = ""
Dim OriginalFullProx As String = Trim(Prox)
Dim proxyObject As WebProxy = New WebProxy("http://" & OriginalFullProx & "/")
proxyObject.BypassProxyOnLocal = True
Prox = Prox.Substring(0, Prox.IndexOf(":"))
Dim sURL As String
sURL = "http://MYWEBSITE.com/testip.php"
Dim wrGETURL As WebRequest
wrGETURL = WebRequest.Create(sURL)
wrGETURL.Proxy = proxyObject
wrGETURL.Timeout = 8000
txtWebResult = "Dosn't work"
Try
Dim objStream As Stream
objStream = wrGETURL.GetResponse.GetResponseStream
Dim objReader As New StreamReader(objStream)
Dim sLine As String = ""
sLine = objReader.ReadLine
If Not sLine Is Nothing Then
txtWebResult = sLine
End If
txtWebResult = Regex.Replace(txtWebResult, “^\s+$[\r\n]*”, “”, RegexOptions.Multiline)
If (Trim(Prox) = Trim(txtWebResult)) Then
'Now know exact country
sURL = "http://ip-api.com/xml/" & Prox
wrGETURL = WebRequest.Create(sURL)
wrGETURL.Proxy = proxyObject
wrGETURL.Timeout = 8000
objStream = wrGETURL.GetResponse.GetResponseStream
Dim objReader2 As New StreamReader(objStream)
Dim FullCODEOFAPI As String = objReader2.ReadToEnd()
Dim XMLR As XmlReader
XMLR = XmlReader.Create(New StringReader(FullCODEOFAPI))
XMLR.ReadToFollowing("country")
XMLR.Read()
OriginalFullProx += "-" + XMLR.Value
FinalWorkingProxies.Add(OriginalFullProx)
End If
Catch ex As Exception
txtWebResult = "Dosn't work"
End Try
If (PB.Value < PB.Maximum) Then UpdatePB(1)
If (PB.Value = PB.Maximum) Then
UpdateFilteredList(1)
ElseIf ((PB.Value - 1) > 0 And ((PB.Value - 1) Mod 333 = 0)) Then
StartCheckingIP(PB.Value)
End If
Return True
End Function
Private Delegate Sub UpdatePBDelegate(ByVal PBVal As Integer)
Private Sub UpdatePB(ByVal PBVal As Integer)
If PB.InvokeRequired Then
PB.Invoke(New UpdatePBDelegate(AddressOf UpdatePB), New Object() {PBVal})
Else
PB.Value += PBVal
PB.Refresh()
End If
End Sub
Private Delegate Sub UpdateFilteredListDelegate()
Private Sub UpdateFilteredList(ByVal TMP As Integer)
If txtFilteredIP.InvokeRequired Then
txtFilteredIP.Invoke(New UpdatePBDelegate(AddressOf UpdateFilteredList), New Object() {TMP})
Else
txtFilteredIP.Clear()
Dim str As String
For Each str In FinalWorkingProxies
txtFilteredIP.Text += str & vbCrLf
Next
End If
End Sub
Private Sub txtRawIP_TextChanged(sender As Object, e As EventArgs) Handles txtRawIP.TextChanged
lblRawIPTotal.Text = "Total: " & txtRawIP.Lines.Count
End Sub
Private Sub txtFilteredIP_TextChanged(sender As Object, e As EventArgs) Handles txtFilteredIP.TextChanged
lblFilteredIPTotal.Text = "Total: " & txtFilteredIP.Lines.Count
End Sub
Private Sub btnLoadList_Click(sender As Object, e As EventArgs) Handles btnLoadList.Click
OFD.ShowDialog()
If (OFD.FileName <> "") Then
txtRawIP.Text = File.ReadAllText(OFD.FileName)
End If
End Sub
End Class