0

I have an application that calls a method that does some query calls to AS400 through SQL. long story short i started a thread and put this method into this thread. but the rest of the buttons are unresponsive i need the application to be responsive while this loop is completed. for instance if the user needs to close the application i need to to shutdown the open threads and close the app. how would i do this properly? i read some about making another thread of UI functionality, but it doesnt work. how do i set this up?

Imports Microsoft.VisualBasic
Imports System.Threading

Public Class frmAbsenceTracking

Public Sub ScheduledToday()
    Dim yr, wk, dy, i As Integer

    Dim dbconn As New WES.Core.Database.SQLConnection
    Dim Empdbconn As New WES.Core.Database.SQLConnection
    Dim sql, empSQL As String
    Dim ds As DataSet
    Dim empds As DataSet


    dbconn("@DTDDWD") = DateAdd("d", -1, Now).Day
    dbconn("@DTMMWD") = DateAdd("d", -1, Now).Month
    dbconn("@DTCCWD") = ((DateAdd("d", -1, Now).Year).ToString).Substring(0, 2)
    dbconn("@DTYYWD") = ((DateAdd("d", -1, Now).Year).ToString).Substring(2)

    sql = "SELECT yearwd, wk#wd, day#wd From ISERIES.WES.WQDATA.PRWKDAPF WHERE DTDDWD = @DTDDWD AND DTMMWD = @DTMMWD AND DTYYWD = @DTYYWD AND DTCCWD = @DTCCWD"
    ds = dbconn.FillDataSet(sql)

    yr = ds.Tables(0).Rows(0)("yearwd")
    wk = ds.Tables(0).Rows(0)("wk#wd")
    dy = ds.Tables(0).Rows(0)("day#wd")

    Empdbconn("@year") = yr
    Empdbconn("@week") = wk
    Empdbconn("@day") = dy

    empSQL = "SELECT emp#sd FROM ISERIES.WES.WQDATA.PRSDTll9 WHERE yearsd = @year and wk#sd = @week and day#sd = @day"
    empds = Empdbconn.FillDataSet(empSQL)

    Dim Employee(empds.Tables(0).Rows.Count) As Integer

    If Label2.InvokeRequired Then
        Label2.BeginInvoke(New ScheduledTodayDelegate(AddressOf ScheduledToday))
    Else
        Label2.Text = "Last Scan Started: " + Now
        Label2.Refresh()
    End If

    Dim Absentees(empds.Tables(0).Rows.Count) As Integer
    'may throw out of bounds for i
    For i = 0 To empds.Tables(0).Rows.Count - 1
        Employee(i) = CInt(empds.Tables(0).Rows(i)("emp#sd"))

        If EmpList.InvokeRequired Then
            EmpList.BeginInvoke(New ScheduledTodayDelegate(AddressOf ScheduledToday))
        Else
            EmpList.Items.Add("Scannning Employee:" + Employee(i).ToString)
            EmpList.Refresh()
        End If

        If hasAbsences((Employee(i)), yr, wk, dy) = True Then
            Absentees(i) = Employee(i)
            ' BuildReport(Absentees(i))
        End If
    Next




    Label1.Text = "Last Completed Scan: " + Now
    If EmpList.Items.Count > 10000 Then
        EmpList.Items.Clear()
    End If
End Sub
Public Sub BuildReport(Employee As Integer)

End Sub

Private Delegate Sub ScheduledTodayDelegate()
Private Delegate Function exitAppDelegate()
Public Function hasAbsences(empNumber As Integer, yr As Integer, wk As Integer, dy As Integer) As Boolean
    Dim dbconn As New WES.Core.Database.SQLConnection
    Dim dbconn2 As New WES.Core.Database.SQLConnection
    Dim sql, sql2 As String
    Dim ds, ds2 As DataSet
    Dim Parts = Split(Now.ToShortDateString, "/")
    dbconn("@Employee") = empNumber
    dbconn("@year") = yr
    dbconn("@week") = wk
    dbconn("@day") = dy


    ' Dim ReturnDataStuff = returnDateStuff(yr, wk, dy)
    '  Dim Assemble = AssembleDate(CInt(Parts(2).Substring(0, 2)), CInt(Parts(2).Substring(2)), CInt(Parts(0)), CInt(Parts(1)))
    sql = "SELECT yearsd, wk#sd, day#sd FROM ISERIES.WES.WQDATA.PRSDTll7 WHERE (emp#sd = @Employee AND yearsd < @year) OR (emp#sd = @Employee AND yearsd = @year AND wk#sd < @week) OR (emp#sd = @Employee AND yearsd = @year AND wk#sd = @week AND day#sd < @day) ORDER BY yearsd asc, wk#sd asc, day#sd asc"
    ds = dbconn.FillDataSet(sql)

    dbconn2("@Employee") = empNumber
    dbconn2("@StartDate") = returnDateStuff(ds.Tables(0).Rows(ds.Tables(0).Rows.Count - 2)("yearsd"), ds.Tables(0).Rows(ds.Tables(0).Rows.Count - 2)("wk#sd"), ds.Tables(0).Rows(ds.Tables(0).Rows.Count - 2)("day#sd"))
    dbconn2("endDate") = AssembleDate(CInt(Parts(2).Substring(0, 2)), CInt(Parts(2).Substring(2)), CInt(Parts(0)), CInt(Parts(1)))

    sql2 = "SELECT * FROM ISERIES.WES.WQDATA.PRWKPNl7 WHERE emp#wp = @Employee and pdatwp > @StartDate AND pdatwp < @endDate"


    ds2 = dbconn2.FillDataSet(sql2)

    If ds2.Tables(0).Rows.Count <= 0 Then
        If EmpList.InvokeRequired Then
            EmpList.BeginInvoke(New ScheduledTodayDelegate(AddressOf ScheduledToday))
        Else
            EmpList.Items.Add(empNumber.ToString + "out for 2 or more days")
            EmpList.Refresh()
        End If

        Return True
        Else
            Return False
    End If

End Function

Public Function returnDateStuff(yr As Integer, wk As Integer, dy As Integer) As Long
    Dim ccx, yyx, mmx, ddx As Integer
    Dim ds As DataSet
    Dim sql As String
    Dim dbconn As New WES.Core.Database.SQLConnection
    dbconn("@year") = yr
    dbconn("@week") = wk
    dbconn("@day") = dy

    sql = "SELECT DTDDWD, DTMMWD, DTYYWD, DTCCWD FROM ISERIES.WES.WQDATA.PRWKDAPF WHERE yearwd = @year AND wk#wd = @week AND day#wd = @day"
    ds = dbconn.FillDataSet(sql)
    ddx = ds.Tables(0).Rows(0)("DTDDWD")
    mmx = ds.Tables(0).Rows(0)("DTMMWD")
    yyx = ds.Tables(0).Rows(0)("DTYYWD")
    ccx = ds.Tables(0).Rows(0)("DTCCWD")

    Return AssembleDate(ccx, yyx, mmx, ddx)

End Function

Public Function AssembleDate(cc As Integer, yy As Integer, mm As Integer, dd As Integer) As Long
    Dim t, tc, ty, tm, td As String

    tc = CStr(cc)
    ty = CStr(yy)
    tm = CStr(mm)
    td = CStr(dd)

    If Len(ty) = 1 Then
        ty = "0" & ty
    End If

    If Len(tm) = 1 Then
        tm = "0" & tm
    End If

    If Len(td) = 1 Then
        td = "0" & td
    End If

    t = tc + ty + tm + td

    Return CLng(t)

End Function
Private Sub exitApp()
    If ExitBtn.InvokeRequired Then
        ExitBtn.BeginInvoke(New ScheduledTodayDelegate(AddressOf exitApp))
    Else
        Application.Exit()
    End If

End Sub
Private Sub ForceBtn_Click(sender As Object, e As EventArgs) Handles ForceBtn.Click
    Dim t1 As System.Threading.Thread = New System.Threading.Thread(AddressOf Me.ScheduledToday)
    t1.Start()
    'ScheduledToday()
End Sub

Private Sub ExitBtn_Click(sender As Object, e As EventArgs) Handles ExitBtn.Click
    Dim t2 As System.Threading.Thread = New System.Threading.Thread(AddressOf Me.exitApp)
    t2.Start()
End Sub
End Class
Gio
  • 41
  • 1
  • 9
  • 2
    Some of your "InvokeRequired" code just runs the same code again on the UI thread, which has the long running queries you were trying to avoid in the first place. Now you are running the same long running code ... two times. – LarsTech Oct 05 '17 at 21:30
  • Like @LarsTech says you are only re-running your `ScheduledToday()` method on the UI thread. The purpose of invoking is to only invoke the part that actually **updates the UI thread**. See this answer of mine for examples and guidance (scroll down to _**Accessing the UI thread**_): https://stackoverflow.com/a/45571728/3740093 – Visual Vincent Oct 05 '17 at 21:52

1 Answers1

0

You could use a Task like this...

Imports System.Threading.Tasks

....

Dim t = Task.Factory.StartNew(Function() 
                                 Return SomeFunctionYouWantToCallInTheBackground()
                              End Function)

To do any UI updates inside that function use Invoke or BeginInvoke to call another function that will update the UI. Invoke and BeginInvoke force the call to happen in the UI thread.

If you need to wait for the task to end, just use:

Dim result = t.Result

If your background task has no return value you can use a Sub instead of a Function like this:

Dim t = Task.Factory.StartNew(Sub() 
                                  SomeFunctionYouWantToCallInTheBackground()
                              End Sub)

And use t.Wait() to wait for it to finish since there will be no Result.

For more information, Google "System.Threading.Tasks.Task"

dwilliss
  • 862
  • 7
  • 19