vb.net - vb 2010 - 我需要异步发布 1000 个 http 帖子。

Question

使用 VB.NET 2010 - 我对此有点陌生，正在尝试构建负载测试器。这是我到目前为止所拥有的(它正在工作，但不是异步发布。我正在遍历我在数组中的帖子(500 左右)。这是从服务器异步返回信息。我如何设置它在循环时同步推送 2 个或更多文件？

Imports System.Data
Imports System.IO
Imports System.Net
Imports System.Text
Imports System.Threading

Public Class Form1

    Private Sub btnStart_Click(sender As System.Object, e As System.EventArgs) Handles btnStart.Click
        lblError.Text = ""
        lblStatusMsg.Text = "Send Status..."
        lblConnectionStatus.Text = "Connection Status..."
        getData("test_post_data_1000.csv")

    End Sub

    Private strQuery As New StringBuilder
    Private path As String
    Private myPosts(999) As String          ' an array of the parsed csv which is ready to be posted
    Private csvDS As New DataSet
    Private loopCount As Integer            ' keeps track of the number of csv rows parsed
    Private connectionLimit As String
    Private currentConnections As String
    Private postsSent As Integer            ' keeps track of the number of posts sent in the loop

    Public Sub SendAsynchRequest()

        Dim request As HttpWebRequest
        Dim thePost As String
        Dim hashcode As Integer = 0

        Try
            Dim myURI As New Uri("http://myImportSite.aspx")

            ' For x = 0 To myPosts.Length - 1
            For x = 0 To 9
                ' Create the request
                request = CType(WebRequest.Create(myURI), HttpWebRequest)
                request.Method = "POST"
                request.ContentType = "application/x-www-form-urlencoded"

                Dim currentServicePoint As ServicePoint = request.ServicePoint

                ' Display new service point properties.
                Dim currentHashCode As Integer = currentServicePoint.GetHashCode()
                lblConnectionStatus.Text = "New service point hashcode: " + currentHashCode.ToString() & vbCr
                lblConnectionStatus.Text = lblConnectionStatus.Text & "New service point max idle time: " + currentServicePoint.MaxIdleTime.ToString() & vbCr

                ' Check that a new ServicePoint instance has been created.
                If hashcode = currentHashCode Then
                    lblConnectionStatus.Text = lblConnectionStatus.Text & "Service point reused.  Count = " & request.ServicePoint.CurrentConnections
                Else
                    lblConnectionStatus.Text = lblConnectionStatus.Text & "Service Point - Current Connections = " & request.ServicePoint.CurrentConnections
                End If
                Me.Refresh()

                request.ServicePoint.ConnectionLimit = 10 ' default is 2 and will only allow 2 posts
                request.ServicePoint.MaxIdleTime = 2000 'sets the maximum idle time to 2 seconds

                thePost = myPosts(x)
                ' Convert the string into a byte array
                Dim bytes As Byte()
                bytes = System.Text.Encoding.UTF8.GetBytes(thePost)

                ' Assign the content length
                request.ContentLength = bytes.Length ' byle length should be about 378 for first record


                ' Write the postData bytes to request stream
                request.GetRequestStream.Write(bytes, 0, bytes.Length)
                postsSent = x + 1

                Dim result As IAsyncResult
                Dim state As WebRequestState
                Dim timeout As Integer

                ' Create the state object used to access the web request
                state = New WebRequestState(request)

                ' Begin the async request
                connectionLimit = request.ServicePoint.ConnectionLimit
                currentConnections = request.ServicePoint.CurrentConnections
                result = request.BeginGetResponse(New AsyncCallback(AddressOf RequestComplete), state)

                ' Set timeout at 30 seconds
                timeout = 1000 * 60

                ' Register a timeout for the async request
                ThreadPool.RegisterWaitForSingleObject(result.AsyncWaitHandle, New WaitOrTimerCallback(AddressOf TimeoutCallback), state, timeout, True)
            Next
        Catch e As Exception
            lblError.Text = "Source : " + e.Source & vbCr & _
                "Message : " + e.Message
        Finally
            'If Not (request Is Nothing) Then
            '    request.close()
            'End If
        End Try


    End Sub

    ' Method called when a request times out
    Private Sub TimeoutCallback(ByVal state As Object, ByVal timeOut As Boolean)
        If (timeOut) Then
            lblError.Text = "Your request timed out!"
            ' Abort the request
            CType(state, WebRequestState).Request.Abort()

        End If
    End Sub

    ' Method called when the request completes
    Private Sub RequestComplete(ByVal result As IAsyncResult)
        ' Get the request

        Dim request As WebRequest
        request = DirectCast(result.AsyncState, WebRequestState).Request

        lblStatusMsg.Text = "Your request is processing..." & vbCr & "Looping through .CSV = " & loopCount & vbCr & vbCr & "Connection Limit = " & connectionLimit & _
            vbCr & vbCr & "Posts sent = " & postsSent & vbCr & "Current Connections = " & currentConnections
        If postsSent = 39 Then
            btnStart.Text = "DONE!"
            btnStart.BackColor = Color.Fuchsia
        End If
        Me.Refresh()
        Me.Focus()
    End Sub

    ' Stores web request for access during async processing
    Private Class WebRequestState
        ' Holds the request object
        Public Request As WebRequest

        Public Sub New(ByVal newRequest As WebRequest)
            Request = newRequest
        End Sub
    End Class
End Class

Answer 1

线程池或一般的线程是您所需要的。

ThreadPool 方式对后台工作任务进行排队的示例。

Public Sub Queue1000WorkTasks()
    Threading.ThreadPool.SetMaxThreads(1000, 1000)
    For iQ As Integer = 1 To 1000
        Threading.ThreadPool.QueueUserWorkItem(New Threading.WaitCallback(AddressOf DoWork_Async), Nothing)
    Next
End Sub

Public Sub DoWork_Async(notUsed As Object)
    'process something here...
End Sub

与普通线程相同...

Public Sub Queue1000WorkTasks()
    For iQ As Integer = 1 To 1000
        Dim th As New Threading.Thread(AddressOf DoWork_Async, Nothing)
        th.Start()
    Next
End Sub

Public Sub DoWork_Async(notUsed As Object)
    'process something here...
End Sub

以前从未像这样同时排队 1000 个项目，所以不知道您可以从系统中得到什么。可能先尝试较小的数字。