VB.Net后台工作人员在我的代码中?

VB.Net后台工作人员在我的代码中?,vb.net,httpwebrequest,backgroundworker,Vb.net,Httpwebrequest,Backgroundworker,我对vb.net很在行,我制作了这个应用程序,它可以执行大量http请求和流读取。但当它这样做时,它总是冻结我的应用程序 所以我做了一些研究,发现我可以用背景工作者来解决这个问题。但我不知道从哪里开始。因此,如果你能看看我的代码,告诉我在哪里以及如何添加后台工作人员来防止冻结,那将是非常棒的 Imports mshtml Imports System.Net Imports System.Threading Imports System.Text Imports System.IO Import

我对vb.net很在行,我制作了这个应用程序,它可以执行大量http请求和流读取。但当它这样做时,它总是冻结我的应用程序

所以我做了一些研究,发现我可以用背景工作者来解决这个问题。但我不知道从哪里开始。因此,如果你能看看我的代码,告诉我在哪里以及如何添加后台工作人员来防止冻结,那将是非常棒的

Imports mshtml
Imports System.Net
Imports System.Threading
Imports System.Text
Imports System.IO
Imports System.Web

Public Class Form1
    Inherits Form

    Private Delegate Sub MyDelegate(show As Boolean)
    Private demoThread As System.Threading.Thread = Nothing
    Private demoThread2 As System.Threading.Thread = Nothing

    Private Sub ShowProgressOnThread()
        Dim newProgressWindow As New Form2
        newProgressWindow.Show()
    End Sub

    Public Function GetTableText(ByVal sHTML As String) As String
       Dim myDoc As mshtml.IHTMLDocument2 = New mshtml.HTMLDocument
        Dim mElement As mshtml.IHTMLElement
        Dim mElement2 As mshtml.IHTMLElement
        Dim mECol As mshtml.IHTMLElementCollection

        'initialize the document object within the HTMLDocument class...
        myDoc.close()
        myDoc.open("about:blank")
        'write the HTML to the document using the MSHTML "write" method...

        Dim clsHTML() As Object = {sHTML}
        myDoc.write(clsHTML)
        clsHTML = Nothing
        mElement = myDoc.body()
        mECol = mElement.getElementsByTagName("TD")

        Dim gData As ListViewItem

        For A = 3 To mECol.length - 1 Step +6

            mElement2 = mECol.item(A)

            gData = Me.ListView1.Items.Add(mElement2.innerText)

            mElement2 = mECol.item(A - 1)

            gData.SubItems.Add(mElement2.innerText.ToUpper)

            'Frm.Close()



            ' lstResults.Items.Add("Game : " & mElement2.innerText)
        Next
    End Function

    Private Sub wait(ByVal interval As Integer)
        Dim sw As New Stopwatch
        sw.Start()
        Do While sw.ElapsedMilliseconds < interval
            ' Allows UI to remain responsive
            Application.DoEvents()
        Loop
        sw.Stop()
    End Sub

    Private Sub Button__()
        Me.ResetText()
        Me.ToolStripStatusLabel1.Text = "Loading..."
        Me.Text = "Game Finder | By Unh0ly | Loading..."
        ' Me.demoThread = New Thread( _
        'New ThreadStart(AddressOf Me.Loader))

        ' Me.demoThread.Start()

        'Me.Invoke(New MethodInvoker(AddressOf Me.Loader))



        'Me.Frm.Show()
        'Application.Run(Frm)


        Dim srchText As String
        srchText = TextBox1.Text.Replace(" ", "%20")

        Dim request As HttpWebRequest = HttpWebRequest.Create("****" & srchText)
        'Dim response As HttpWebResponse

        Dim response As HttpWebResponse = request.GetResponse()

        Dim sr As System.IO.StreamReader = New System.IO.StreamReader(response.GetResponseStream())

        Dim sourcecode As String = sr.ReadToEnd()


        If sourcecode.Contains("<td>") Then
            GetTableText(sourcecode)

            Me.ResetText()
            Me.Text = "Game Finder | By Unh0ly"
            Me.ToolStripStatusLabel1.Text = "Done"
            Call wait(2500)
            Me.ToolStripStatusLabel1.Text = "Status.."
            'newProgressWindow.Hide()
            'newProgressWindow.Dispose()
            'Form2.Refresh()
        ElseIf Not sourcecode.Contains("<td>") Then
            ' newProgressWindow.Hide()
            ' Progress.Dispose()
            MessageBox.Show("No Results Found For: " + TextBox1.Text)
        End If
        'Dim sHTML = sourcecode
        'For I = 2 To mECol.length - 1 Step +6


    End Sub

    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click

        'Frm.Show()

        Me.Invoke(New MethodInvoker(AddressOf Button__))

        'Dim demoThread As System.Threading.Thread
    End Sub

    Private Sub CopyToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles CopyToolStripMenuItem.Click, IDAndGameNameToolStripMenuItem.Click
        Try

            Dim s As String


            Dim lsvrow
            lsvrow = ListView1.SelectedItems(0)

            s = "Game Name: " + lsvrow.Text + ControlChars.NewLine + "ID: " + TextBox2.Text



            Clipboard.SetDataObject(s)
        Catch ex As System.Exception
            MessageBox.Show("Error: " + ex.Message)
        Finally
            ' Perform any tidy up code.
        End Try
    End Sub
    Private Sub CopyIDToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles CopyIDToolStripMenuItem.Click, IDToolStripMenuItem.Click
        Try
            Dim s As String


            Dim lsvrow
            lsvrow = ListView1.SelectedItems(0)

            s = TextBox2.Text



            Clipboard.SetDataObject(s)

        Catch ex As System.Exception
            MessageBox.Show("Error: " + ex.Message)
        Finally
            ' Perform any tidy up code.
        End Try
    End Sub


    Private Sub ListView1_ItemActivate(sender As System.Object, e As System.Windows.Forms.ListViewItemSelectionChangedEventArgs) Handles ListView1.ItemSelectionChanged

        TextBox2.Text = e.Item.SubItems(1).Text
    End Sub

    Private Sub TextBox1_KeyDown(sender As System.Object, e As System.Windows.Forms.KeyEventArgs) Handles TextBox1.KeyDown
        If e.KeyCode = Keys.Enter Then
            'Runs the Button1_Click Event
            Button1_Click(Me, EventArgs.Empty)
        End If
    End Sub

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load

    End Sub



    Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click, ClearToolStripMenuItem.Click
        ListView1.Items.Clear()
    End Sub

    Private Sub DownloadGPDToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles DownloadGPDToolStripMenuItem.Click, DownloadGPDToolStripMenuItem1.Click

        Dim gpds As ArrayList = New ArrayList()

        Const YOUR_DIRECTORY As String = "****"

        ' Get the object used to communicate with the server.
        Dim request As FtpWebRequest = CType(WebRequest.Create(YOUR_DIRECTORY), FtpWebRequest)
        request.Method = WebRequestMethods.Ftp.ListDirectoryDetails
        ' This example assumes the FTP site uses anonymous logon.
        request.Credentials = New NetworkCredential("****", "****")

        Call wait(1500)

        Dim response As FtpWebResponse = CType(request.GetResponse, FtpWebResponse)
        Dim responseStream As Stream = response.GetResponseStream
        Dim reader As StreamReader = New StreamReader(responseStream)
        Dim s = reader.ReadToEnd

        reader.Close()
        response.Close()

        If Len(TextBox2.Text) > 0 Then
            If s.Contains(TextBox2.Text + ".gpd") Then
                FolderBrowserDialog1.ShowDialog()

                If Not FolderBrowserDialog1.SelectedPath = Nothing Then

                    Me.Text = "Game Finder | By Unh0ly | Downloading..."
                    Me.ToolStripStatusLabel1.Text = "Downloading..."
                    My.Computer.Network.DownloadFile("****" + TextBox2.Text + ".gpd", FolderBrowserDialog1.SelectedPath + "\" + TextBox2.Text + ".gpd", "", "", False, "100", True)
                    Me.ResetText()
                    Me.ToolStripStatusLabel1.Text = "Status.."
                ElseIf FolderBrowserDialog1.SelectedPath = Nothing Then

                Else
                    MessageBox.Show("No GPD for Selected Game")
                End If
            Else
                MessageBox.Show("No GPD for Selected Game")
            End If
        Else
            ' Do Nothing
        End If
    End Sub

    Private Sub ExitToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles ExitToolStripMenuItem.Click
        Application.Exit()
    End Sub

    Private Sub CheckForUpdatesToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles CheckForUpdatesToolStripMenuItem.Click
        Dim request As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create("****")
        Dim response As System.Net.HttpWebResponse = request.GetResponse()

        Dim sr As System.IO.StreamReader = New System.IO.StreamReader(response.GetResponseStream())

        Dim newestversion As String = sr.ReadToEnd()
        Dim currentversion As String = Application.ProductVersion

        Dim request1 As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create("****")
        Dim response1 As System.Net.HttpWebResponse = request1.GetResponse()

        Dim sr1 As System.IO.StreamReader = New System.IO.StreamReader(response1.GetResponseStream())

        Dim updurl As String = sr1.ReadToEnd()

        If newestversion.Contains(currentversion) Then
            MessageBox.Show("You have the current version", "Up to date", MessageBoxButtons.OK, MessageBoxIcon.Information)
        Else
            Dim result1 As DialogResult = MessageBox.Show("Newer version available" & vbCrLf & "Please Goto *** to check" + vbCrLf + "Do you want to go there now?", "Update Available", MessageBoxButtons.YesNo, MessageBoxIcon.Information)

            If result1 = DialogResult.Yes Then
                Process.Start(updurl)
            Else
                ' Do Nothing
            End If
        End If
    End Sub

    Private Sub AboutToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles AboutToolStripMenuItem.Click
        Dim gpds As ArrayList = New ArrayList()

        Const YOUR_DIRECTORY As String = "****"


        Dim request As FtpWebRequest = CType(WebRequest.Create(YOUR_DIRECTORY), FtpWebRequest)
        request.Method = WebRequestMethods.Ftp.ListDirectoryDetails

        request.Credentials = New NetworkCredential("****", "****")

        Call wait(100)

        Dim response As FtpWebResponse = CType(request.GetResponse, FtpWebResponse)
        Dim responseStream As Stream = response.GetResponseStream
        Dim reader As StreamReader = New StreamReader(responseStream)
        Dim s = reader.ReadToEnd

        reader.Close()
        response.Close()

        Dim Lines() As String = s.Split(New String() {Environment.NewLine}, StringSplitOptions.RemoveEmptyEntries)

        MessageBox.Show("Made By Unh0ly aka Nickdudego3" & vbCrLf & "Number of GPD's: " & Lines.Length - 5 & vbCrLf & "Version: " & Application.ProductVersion, "About", MessageBoxButtons.OK, MessageBoxIcon.Asterisk)
    End Sub
End Class
导入mshtml
导入系统.Net
导入系统线程
导入系统文本
导入System.IO
导入系统.Web
公开课表格1
继承形式
私有委托子MyDelegate(显示为布尔值)
私有降级线程为System.Threading.Thread=Nothing
私有demoThread2作为System.Threading.Thread=Nothing
私有子节目ProgressOnThread()
将newProgressWindow变暗为新窗体2
newProgressWindow.Show()
端接头
公共函数GetTableText(ByVal sHTML作为字符串)作为字符串
将myDoc设置为mshtml.IHTMLDocument2=新的mshtml.HTMLDocument
Dim mElement作为mshtml.IHTMLElement
Dim mElement2作为mshtml.IHTMLElement
Dim mECol作为mshtml.IHTMLElementCollection
'初始化HTMLDocument类中的文档对象。。。
myDoc.close()
myDoc.open(“关于:空白”)
'使用MSHTML“write”方法将HTML写入文档。。。
Dim clsHTML()作为对象={sHTML}
myDoc.write(clsHTML)
clsHTML=无
mElement=myDoc.body()
mECol=mElement.getElementsByTagName(“TD”)
将gData设置为ListViewItem
对于A=3到mECol.length-1步+6
mElement2=mECol.项目(A)
gData=Me.ListView1.Items.Add(mElement2.innerText)
mElement2=mECol.项目(A-1)
gData.SubItems.Add(mElement2.innerText.ToUpper)
'Frm.Close()
'lstResults.Items.Add(“游戏:&mElement2.innerText”)
下一个
端函数
专用子等待(ByVal间隔为整数)
将sw调暗为新秒表
sw.Start()
当sw.ElapsedMilliseconds<间隔时执行
'允许用户界面保持响应
Application.DoEvents()
环
sw.Stop()
端接头
专用子按钮
Me.ResetText()
Me.ToolStripStatusLabel1.Text=“正在加载…”
Me.Text=“游戏查找器|通过Unh0ly |加载…”
'Me.demohread=新线程(_
'New ThreadStart(AddressOf Me.Loader))
'Me.demohread.Start()
'Me.Invoke(新MethodInvoker(AddressOf Me.Loader))
“我是我的朋友
'应用程序运行(Frm)
Dim srchText作为字符串
srchText=TextBox1.Text.Replace(“,“%20”)
Dim请求作为HttpWebRequest=HttpWebRequest.Create(“****”&srchText)
'作为HttpWebResponse的Dim响应
Dim响应为HttpWebResponse=request.GetResponse()
Dim sr As System.IO.StreamReader=新的System.IO.StreamReader(response.GetResponseStream())
Dim源代码为String=sr.ReadToEnd()
如果sourcecode.Contains(“”),则
GetTableText(源代码)
Me.ResetText()
Me.Text=“游戏查找器|由Unh0ly提供”
Me.ToolStripStatusLabel1.Text=“完成”
呼叫等待(2500)
Me.ToolStripStatusLabel1.Text=“状态..”
'newProgressWindow.Hide()
'newProgressWindow.Dispose()
'Form2.Refresh()
如果不是源代码,则包含(“”)
'newProgressWindow.Hide()
'Progress.Dispose()
MessageBox.Show(“未找到以下项的结果:”+TextBox1.Text)
如果结束
'Dim sHTML=源代码
'对于I=2至mECol.length-1步+6
端接头
私有子按钮1\u单击(发送者作为System.Object,e作为System.EventArgs)处理按钮1。单击
'Frm.Show()
调用(新方法调用器(按钮的地址)
'将线程降级为System.Threading.Thread
端接头
私有子CopyToolStripMenuItem\u Click(发件人作为System.Object,e作为System.EventArgs)处理CopyToolStripMenuItem。Click,IDAndGameNameToolStripMenuItem。Click
尝试
像线一样变暗
昏暗的迷雾
lsvrow=ListView1。选择编辑项(0)
s=“游戏名称:”+lsvrow.Text+ControlChars.NewLine+“ID:”+TextBox2.Text
剪贴板。SetDataObject(个)
捕获ex作为系统异常
MessageBox.Show(“错误:+ex.Message”)
最后
'执行任何整理代码。
结束尝试
端接头
私有子CopyIDToolStripMenuItem\u Click(发件人作为System.Object,e作为System.EventArgs)处理CopyIDToolStripMenuItem。Click,IDToolStripMenuItem。Click
尝试
像线一样变暗
昏暗的迷雾
lsvrow=ListView1。选择编辑项(0)
s=TextBox2.Text
剪贴板。SetDataObject(个)
捕获ex作为系统异常
MessageBox.Show(“错误:+ex.Message”)
最后
'执行任何整理代码。
结束尝试
端接头
私有子ListView1\u ItemActivate(发件人作为System.Object,e作为System.Windows.Forms.ListViewItemSelectionChangedEventArgs)处理ListView1.ItemSelectionChanged
TextBox2.Text=e.Item.SubItems(1).Text
端接头
私有子textbox1u KeyDown(发送方作为System.Object,e作为System.Windows.Forms.KeyEventArgs)处理TextBox1.KeyDown
如果e.KeyCode=Keys,则输入
'运行按钮1\u单击事件
按钮1\u单击(Me,EventArgs.Empty)
如果结束
端接头
私有子表单1_Load(发送方作为System.Object,e作为System.EventArgs)处理MyBase.Load
端接头
私有子按钮2\u单击(发件人作为System.Object,e作为System.EventArgs)处理按钮2。单击,ClearToolStripMenuItem。单击
ListView1.Items.Clear()
端接头
私有子下载GPDToolStripMenuItem\u单击(发件人作为System.Object,e作为System.EventArgs)
    Friend WithEvents myWorker As System.ComponentModel.BackgroundWorker
    Me.myWorker = New System.ComponentModel.BackgroundWorker()

  Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
     myWorker.RunWorkerAsync()
  End Sub

  Private Sub myWorker_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles myWorker.DoWork
  'do your stuff here...
  End Sub