VB.Net允许一定的时间来完成任务

时间:2015-06-12 12:16:03

标签: vb.net multithreading timer backgroundworker

我试图给我的程序一定的时间来与远程驱动器建立连接,但是我很难理解可用的不同选项。我已尝试过计时器等,但该程序仍然挂在与数据库联系的部分。我已经研究过并且读过我需要运行一个后台工作者,或者在另一个线程中运行它,但是目前这还不是我的理解。

这是我到目前为止所拥有的:

    Public Sub Initialise_View()
        Dim I As Integer = 0
        Dim Fault As Boolean = False
        Main.VIEW_SavingMessage.Visible = False

        Main.VIEW_Title.Text = "Establishing Connecion To Database... Please Wait"
        Main.Refresh()

        DataGridView_Setup.Set_Datasource(0) 'This subroutine opens a connection to
    'the database and will pass a fault variable back if the database is not found,
    'however this hangs for ages if the system is having trouble accessing the
    'network drive, upwards of 5mins sometimes!


        If Fault = True Then Main.VIEW_Title.Text = "Error In Connection..."
        Main.Refresh()

    End Sub

What I'd really like is something like:

    If Connection is not established within 30 seconds Then
         Msgbox "Error, Unable to establish connection"
         Exit Sub
    End If

Which would be easy, using a timer, as long as the program didn't hang when trying to actually connect.

So my question is, is there any way around this? If so, what's the best way of going about it?

TIA

**Update**

Following Answers, I have updated to the following:

Imports System.Threading

Module View_Initialise
    Public t1 As Threading.Thread
    Public Sub Initialise_View()
        Main.Timer1.Interval = 20 * 1000
        Main.Timer1.Start()

        t1 = New Thread(New ThreadStart(AddressOf Run_Datasource))
        t1.Start()

    End Sub

    Public Sub Run_Datasource()
        Dim I As Integer = 0
        Dim Fault As Boolean = False
        Main.VIEW_SavingMessage.Visible = False

        Main.VIEW_Title.Text = "Establishing Connecion To Database... Please Wait"
        Main.Refresh()

        DataGridView_Setup.Set_Datasource(0)
        DataGridView_Setup.BindingUpdates()

        If Fault = True Then Main.VIEW_Title.Text = "Error In Connection..."
        Main.Refresh()
    End Sub



End Module

这看似有效,因为它确实触发了所有代码,但Set_Datasource(0)例程没有正确触发,在告诉userform用信息更新的部分代码中,这种情况不会发生。这是Set_Datasource(0)的代码:(抱歉,它的长度)

  Public Sub Set_Datasource(mode As Integer)

        Try
            Main.DataGridView1.DataSource.clear()
        Catch ex As Exception

        End Try

        Dim connString As String = My.Settings.Database_String
        Dim myConnection As OleDbConnection = New OleDbConnection
        myConnection.ConnectionString = connString
        ' create a data adapter 
        Dim da As OleDbDataAdapter = New OleDbDataAdapter("SELECT ID, [Name Of Person], [SAP Job Number], [Site Name], [Asset Description], [Spares Supplier], [Supplier Contact Name], [Supplier Contact Phone Number], [Supplier Contact Email], [Spares Description], [Part Number], [Quantity To Order], Cost, [Comments], [Request Date], [Date Ordered], [Ordered By], [Invoice Received], [Invoice Paid], [Method Of Payment], [Date Item Received], [Quote Attatchment] FROM Spares", myConnection)

        'create a new dataset 
        Dim ds As DataSet = New DataSet
        'fill DataSet

        Try
            da.Fill(ds, "Spares")
        Catch ex As Exception
            MsgBox("Sorry, An Error Occurred" & vbNewLine & _
                   "Database contents could not be loaded" & vbNewLine & vbNewLine & _
                   "Error Message: " & ex.Message, MsgBoxStyle.OkOnly, "Could Not Load Database Information")
            Exit Sub
        End Try


        Main.DataGridView1.DataSource = ds.Tables(0)

        Main.DataGridView1.AllowUserToAddRows = False

        'Set Site Listbox

        Dim SiteString = My.Settings.SETTINGS_SiteNames
        Dim SiteBox = Main.VIEW_Site.Items

        SiteBox.Clear()

        Do Until SiteString = ""
            Dim ActiveSiteName = Left(SiteString, InStr(SiteString, "¦"))
            ActiveSiteName = ActiveSiteName.Remove(ActiveSiteName.Length - 1)

            With SiteBox
                .Add(ActiveSiteName)
            End With

            SiteString = Replace(SiteString, ActiveSiteName + "¦", "")

        Loop


        'Set DataBindings
        Main.VIEW_Ref.DataBindings.Clear()
        Main.VIEW_Ref.DataBindings.Add(New Binding("Text", ds, "Spares.ID", False, DataSourceUpdateMode.Never))

        Main.VIEW_NameOfPerson.DataBindings.Clear()
        Main.VIEW_NameOfPerson.DataBindings.Add(New Binding("Text", ds, "Spares.Name Of Person", False, DataSourceUpdateMode.Never))

        Main.VIEW_SAPJobNo.DataBindings.Clear()
        Main.VIEW_SAPJobNo.DataBindings.Add(New Binding("Text", ds, "Spares.SAP Job Number", False, DataSourceUpdateMode.Never))

        Main.VIEW_Site.DataBindings.Clear()
        Main.VIEW_Site.DataBindings.Add(New Binding("Text", ds, "Spares.Site Name", False, DataSourceUpdateMode.Never))

        Main.VIEW_AssetDesc.DataBindings.Clear()
        Main.VIEW_AssetDesc.DataBindings.Add(New Binding("Text", ds, "Spares.Asset Description", False, DataSourceUpdateMode.Never))

        Main.VIEW_SparesSupplier.DataBindings.Clear()
        Main.VIEW_SparesSupplier.DataBindings.Add(New Binding("Text", ds, "Spares.Spares Supplier", False, DataSourceUpdateMode.Never))

        Main.VIEW_SupplierContactName.DataBindings.Clear()
        Main.VIEW_SupplierContactName.DataBindings.Add(New Binding("Text", ds, "Spares.Supplier Contact Name", False, DataSourceUpdateMode.Never))

        Main.VIEW_SupplierContactNumber.DataBindings.Clear()
        Main.VIEW_SupplierContactNumber.DataBindings.Add(New Binding("Text", ds, "Spares.Supplier Contact Phone Number", False, DataSourceUpdateMode.Never))

        Main.VIEW_SupplierContactNumber.DataBindings.Clear()
        Main.VIEW_SupplierContactNumber.DataBindings.Add(New Binding("Text", ds, "Spares.Supplier Contact Phone Number", False, DataSourceUpdateMode.Never))

        Main.VIEW_SupplierContactEmail.DataBindings.Clear()
        Main.VIEW_SupplierContactEmail.DataBindings.Add(New Binding("Text", ds, "Spares.Supplier Contact Email", False, DataSourceUpdateMode.Never))

        Main.VIEW_SparesDesc.DataBindings.Clear()
        Main.VIEW_SparesDesc.DataBindings.Add(New Binding("Text", ds, "Spares.Spares Description", False, DataSourceUpdateMode.Never))

        Main.VIEW_PartNumber.DataBindings.Clear()
        Main.VIEW_PartNumber.DataBindings.Add(New Binding("Text", ds, "Spares.Part Number", False, DataSourceUpdateMode.Never))

        Main.VIEW_QuantityToOrder.DataBindings.Clear()
        Main.VIEW_QuantityToOrder.DataBindings.Add(New Binding("Text", ds, "Spares.Quantity To Order", False, DataSourceUpdateMode.Never))

        Main.VIEW_CostEach.DataBindings.Clear()
        Main.VIEW_CostEach.DataBindings.Add(New Binding("Text", ds, "Spares.Cost", False, DataSourceUpdateMode.Never))

        Main.VIEW_DateRequested.DataBindings.Clear()
        Main.VIEW_DateRequested.DataBindings.Add(New Binding("Text", ds, "Spares.Request Date", False, DataSourceUpdateMode.Never))

        Main.VIEW_DateOrdered.DataBindings.Clear()
        Main.VIEW_DateOrdered.DataBindings.Add(New Binding("Text", ds, "Spares.Date Ordered", False, DataSourceUpdateMode.Never))

        Main.VIEW_OrderedBy.DataBindings.Clear()
        Main.VIEW_OrderedBy.DataBindings.Add(New Binding("Text", ds, "Spares.Ordered By", False, DataSourceUpdateMode.Never))

        Main.VIEW_InvoiceReceivedDate.DataBindings.Clear()
        Main.VIEW_InvoiceReceivedDate.DataBindings.Add(New Binding("Text", ds, "Spares.Invoice Received", False, DataSourceUpdateMode.Never))

        Main.VIEW_InvoicePaidDate.DataBindings.Clear()
        Main.VIEW_InvoicePaidDate.DataBindings.Add(New Binding("Text", ds, "Spares.Invoice Paid", False, DataSourceUpdateMode.Never))

        Main.View_MethodOfPayment.DataBindings.Clear()
        Main.View_MethodOfPayment.DataBindings.Add(New Binding("Text", ds, "Spares.Method Of Payment", False, DataSourceUpdateMode.Never))

        Main.VIEW_DateReceived.DataBindings.Clear()
        Main.VIEW_DateReceived.DataBindings.Add(New Binding("Text", ds, "Spares.Date Item Received", False, DataSourceUpdateMode.Never))

        Main.VIEW_AdditionalComments.DataBindings.Clear()
        Main.VIEW_AdditionalComments.DataBindings.Add(New Binding("Text", ds, "Spares.Comments", False, DataSourceUpdateMode.Never))

   DataGridView_Setup.BindingUpdates() 'CALL BELOW SUB HERE
        Main.VIEW_Title.Text = "View / Update Received Spares"
    End Sub

    Public Sub BindingUpdates()
        Dim curr As New DataGridViewRow
        curr = Main.DataGridView1.CurrentRow '**THIS LINE FAILS TO GET THE CURRENT ROW, HOWEVER, IF RUN WITHOUT A NEW THREAD, IT WORKS FINE??**




        Main.VIEW_Ref.Text = curr.Cells("ID").Value
        Main.VIEW_NameOfPerson.Text = curr.Cells("Name Of Person").Value
        Main.VIEW_SAPJobNo.Text = curr.Cells("SAP Job Number").Value
        Main.VIEW_Site.Text = curr.Cells("Site Name").Value
        Main.VIEW_AssetDesc.Text = curr.Cells("Asset Description").Value
        Main.VIEW_SparesSupplier.Text = curr.Cells("Spares Supplier").Value
        Main.VIEW_SupplierContactName.Text = curr.Cells("Supplier Contact Name").Value
        Main.VIEW_SupplierContactNumber.Text = curr.Cells("Supplier Contact Phone Number").Value
        Main.VIEW_SupplierContactEmail.Text = curr.Cells("Supplier Contact Email").Value
        Main.VIEW_SparesDesc.Text = curr.Cells("Spares Description").Value
        Main.VIEW_PartNumber.Text = curr.Cells("Part Number").Value
        Main.VIEW_QuantityToOrder.Text = curr.Cells("Quantity To Order").Value
        Main.VIEW_CostEach.Text = "£" + CStr(curr.Cells("Cost").Value)
        Main.VIEW_DateRequested.Text = curr.Cells("Request Date").Value


        'Handle DBNULL From now on

        If IsDBNull(curr.Cells("Date Ordered").Value) = True Or _
            IsNothing(curr.Cells("Date Ordered").Value) = True Or _
            curr.Cells("Date Ordered").Value = "" Or _
            curr.Cells("Date Ordered").Value = "Not Ordered Yet" Then

            With Main.VIEW_DateOrdered
                .Text = "Not Ordered Yet"
                .BackColor = Color.LightPink
            End With

        Else
            With Main.VIEW_DateOrdered
                .Text = curr.Cells("Date Ordered").Value
                .BackColor = Color.White
            End With

        End If

        If IsDBNull(curr.Cells("Ordered By").Value) = True Or _
            IsNothing(curr.Cells("Ordered By").Value) = True Or _
            curr.Cells("Ordered By").Value = "" Or _
            curr.Cells("Ordered By").Value = "Not Ordered Yet" Then
            With Main.VIEW_OrderedBy
                .Text = "Not Ordered Yet"
                .BackColor = Color.LightPink
            End With
        Else
            With Main.VIEW_OrderedBy
                .Text = curr.Cells("Ordered By").Value
                .BackColor = Color.White
            End With

        End If

        If IsDBNull(curr.Cells("Invoice Received").Value) = True Or _
            IsNothing(curr.Cells("Invoice Received").Value) = True Or _
            curr.Cells("Invoice Received").Value = "" Or _
            curr.Cells("Invoice Received").Value = "No Invoice" Then
            With Main.VIEW_InvoiceReceivedDate
                .Text = "No Invoice"
                .BackColor = Color.LightPink
            End With
        Else
            With Main.VIEW_InvoiceReceivedDate
                .Text = curr.Cells("Invoice Received").Value
                .BackColor = Color.White
            End With

        End If

        If IsDBNull(curr.Cells("Invoice Paid").Value) = True Or _
            IsNothing(curr.Cells("Invoice Paid").Value) = True Or _
            curr.Cells("Invoice Paid").Value = "" Or _
            curr.Cells("Invoice Paid").Value = "Not Paid" Then
            With Main.VIEW_InvoicePaidDate
                .Text = "Not Paid"
                .BackColor = Color.LightPink
            End With
        Else
            With Main.VIEW_InvoicePaidDate
                .Text = curr.Cells("Invoice Paid").Value
                .BackColor = Color.White
            End With

        End If

        If IsDBNull(curr.Cells("Method Of Payment").Value) = True Or _
            IsNothing(curr.Cells("Method Of Payment").Value) = True Or _
            curr.Cells("Method Of Payment").Value = "" Or _
            curr.Cells("Method Of Payment").Value = "Not Paid" Then
            With Main.View_MethodOfPayment
                .Text = "Not Paid"
                .BackColor = Color.LightPink
            End With
        Else
            With Main.View_MethodOfPayment
                .Text = curr.Cells("Method Of Payment").Value
                .BackColor = Color.White
            End With

        End If
        If IsDBNull(curr.Cells("Date Item Received").Value) = True Or _
            IsNothing(curr.Cells("Date Item Received").Value) = True Or _
            curr.Cells("Date Item Received").Value = "" Or _
            curr.Cells("Date Item Received").Value = "Not Received" Then
            With Main.VIEW_DateReceived
                .Text = "Not Received"
                .BackColor = Color.LightPink
            End With
        Else
            With Main.VIEW_DateReceived
                .Text = curr.Cells("Date Item Received").Value
                .BackColor = Color.White
            End With

        End If

        If IsDBNull(curr.Cells("Comments").Value) = True Or _
            IsNothing(curr.Cells("Comments").Value) = True Or _
            curr.Cells("Comments").Value = "" Or _
            curr.Cells("Comments").Value = "No Comments Added" Then
            With Main.VIEW_AdditionalComments
                .Text = "No Comments Added"
                '.BackColor = Color.LightPink
            End With
        Else
            With Main.VIEW_AdditionalComments
                .Text = curr.Cells("Comments").Value
                '.BackColor = Color.White
            End With

        End If



    End Sub

End Module

如上面的代码所述,错误似乎是新线程无法从表单中访问信息?

感谢。

2 个答案:

答案 0 :(得分:0)

您需要将Connecting Sub-Routine作为新线程运行。线程的一个常见示例是:

首先创建新线程:

Public t1 As Threading.Thread

现在从你的函数调用线程

Private Sub Initialise_View()
    'Run your connecting Sub-Routine
    t1 = New Thread(New ThreadStart(AddressOf Set_Datasource))
    t1.Start()
End sub

现在连接Sub-Routine

Sub Set_Datasource()
    'Your code here
End sub 

现在你的应用程序不会挂起。

同时你可以启动一个Timer,让它在30秒后关闭连接,现在是Thread,然后显示你的错误。

答案 1 :(得分:0)

  

我需要运行一个后台工作程序,或者在另一个程序中运行它,但目前我的理解还不够。

实际上,一旦你理解了这个概念,背景工作者就会非常直截了当。它们实际上只是第二个线程,包含在一个开箱即用的优化类中,已经包含完成任务所需的方法,而不会冻结主线程。

我曾多次使用的简单实现看起来像这样:

Imports System.ComponentModel

Public Class BGWexample
    Sub MainProgram()
        '   delcare your bgWoker-object
        Dim BgWorker As BackgroundWorker

        '   initialization and basic setup of your bgWorker
        BgWorker = New BackgroundWorker()
        BgWorker.WorkerReportsProgress = False
        BgWorker.WorkerSupportsCancellation = False

        '   tell the bgWorker where it will find the code for it's already implemented methods
        AddHandler BgWorker.DoWork, AddressOf BgWorkerDoesHisThing
        AddHandler BgWorker.RunWorkerCompleted, AddressOf BgWorkerHasFinished

        '   to start your background thread, just execute the bgWoker by calling its .RunWorkerAsync-method instead of calling your already implemented method to load your data from the database
        BgWorker.RunWorkerAsync()
    End Sub

    Private Sub BgWorkerDoesHisThing(ByVal sender As Object, ByVal e As DoWorkEventArgs)
        '   this will host the code to load the data from the database, e.g. declaration of your Data-Access-Object, querying, populating DataTables etc.
    End Sub

    Private Sub BgWorkerHasFinished(ByVal sender As Object, ByVal e As RunWorkerCompletedEventArgs)
        '   use this method to hide any loading screens, enable some controls etc.
    End Sub
End Class

只需将Set_Datasource(mode As Integer)的代码放在BgWorkerDoesHisThing() - 方法中,然后执行BgWorker.RunWorkerAsync()方法而不是Set_Datasource(mode As Integer)方法。

这将导致BgWorker执行BgWorkerDoesHisThing() - Sub,它已附加到.DoWork - 事件,方法是在声明块中添加相应的Handler。

请注意:如果涉及从后台线程与GUI交互,使用后台线程会有点痒。

在这个例子中,BgWorkerDoesHisThing() - Sub作为一个不同的线程执行,不允许修改主线程的GUI控件,而BgWorkerHasFinished() - Sub将被执行再次在主线程内,这意味着它可以再次完全访问GUI控件。

所以现在,我建议将您的GUI放入加载屏幕,并在BgWorkerHasFinished() - 方法中隐藏该加载屏幕。

请记住,如果您的主要线程取决于后台线程的结果,而不是等待它完成其工作,那么您可能遇到Race Hazard。这就是BackgroundWorker.RunWorkerCompleted - 事件的用途,这就是我为此事件添加了一个EventHandler的原因,它将在BgWorker完成其工作后立即执行专用的BgWorkerHasFinished()方法。