用于检查代理的多线程代码

Question

我正在使用这个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