I am working with a proprietary VB6 COM library. The library has some functions which fire and I get the results once complete through Events.
Container Class:
Private WithEvents myObj As proprietaryObj
Public status as Integer
Set myObj = new proprietaryObj
status = 1
Call myObj.DoIt1()
...
' Call back event function
Private Sub myObj_Done(ByVal Code As Long)
...
MsgBox "Finished"
status = 2
End Sub
So everything works well (verified). What I want to do is encapsulate the above code + more in a class, so that I wrap multiple functions which need to stack, or get executed consecutively after a successful callback report.
So I went ahead and did this:
Call myObj.DoIt1()
Do
If myObj.Status = 2 Then Exit Do
If myObj.Status = -1 Then Exit Do 'Error
DoEvents
Loop
call myObj.DoIt2()
I get the "Finished" dialog box, but DoIt2 never fires. In fact, if I pause my code while running debug after I see the "Finished" message, the code is currently executing the DoEvents, and the myObj.Status = 1 as if it were never touched.
It almost seems as if a different instance of the object was created for a separate thread? How do I safely and correctly wait for the event callback to fire before continuing execution with the next DoIt2() ?
You need to use your local status variable, because that is what you are setting to 2:
Call myObj.DoIt1()
Do
If status = 2 Then Exit Do
If status = -1 Then Exit Do 'Error
DoEvents
Loop
call myObj.DoIt2()
Else you could also try to set status = 2 before the call to MsgBox "Finished".
Related
My VB.NET winforms app runs a timer which creates a background worker to update the objects in an ObjectListView.
In the timer loop, a number of 'device' objects are added to an observable collection (in the backgroundworker_progresschanged event) and (in the backgroundworker_complete event), I use an OLV.SetObjects(allDevices, true) to populate them.
This all works flawlessly. However, the currently selected items in the OLV are lost during the OLV.setobjects so I need to restore them.
To do this, (in the backgroundworker_complete event), I want to access the selecteditems property of the OLV but I keep getting a "Cross-thread operation not valid: Control 'DeviceListView1' accessed from a thread other than the thread it was created on." All attempts at trying to read the selected listviewitems (either by OLV.selecteditems or a loop reading them from the OLV) fail with the cross-thread exception.
I may misunderstand but I thought I could access GUI elements on the backgroundworker_progresschanged and backgroundworker_complete events?
Here's the relevant code:
The PopulateDevices sub is called when the timer is started and will not run again until a specific time has passed. It runs the RunWorkerAsync of the Worker.
Public Sub PopulateDevices()
' Debug
_UpdateCount += 1
' Pause the Update Timer
UpdateTimer.Stop()
' Get the Starting Time of this Update
StartTime = DateTime.Now
' Stop updating the DeviceListView1 ObjectListView
ControlHelper.ControlInvoke(DeviceListView1, Sub() DeviceListView1.BeginUpdate())
' Clear Existing Devices from the List
AllDevices = New TrulyObservableCollection(Of DeviceItem)
' Get the selected devices
'_SelectedDevices = GetSetSelectedDevices(DeviceListView1)
' Prep the BackgroundWorker
PopulateDevicesWorker = New BackgroundWorker
PopulateDevicesWorker.WorkerReportsProgress = True
' Add the Event Handlers
AddHandler PopulateDevicesWorker.DoWork, AddressOf PopulateDevicesWorkerDoWork
AddHandler PopulateDevicesWorker.ProgressChanged, AddressOf PopulateDevicesWorkerProgressChanged
AddHandler PopulateDevicesWorker.RunWorkerCompleted, AddressOf PopulateDevicesWorkerCompleted
' Start the BackgroundWorker
If Not PopulateDevicesWorker.IsBusy Then
PopulateDevicesWorker.RunWorkerAsync()
End If
End Sub
The worker will read a list of devices from a SQLite DB and (in the progresschanged event) populate an observable collection (AllDevices):
Private Sub PopulateDevicesWorkerDoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs)
' We only continue if the \Clients\_Cache File exists and can be read
If Not File.Exists(CacheFilePath) Then
Exit Sub
End If
' Create a new SQLite Connection & Connect to database
Dim DBC As SQLiteDatabase = OpenDB(CacheFilePath)
If Not IsNothing(DBC) Then
' Count the Rows in the \Clients\_Cache file
Dim RowCount As Integer = CountTableRows(DBC, "_Cache")
' Set the SQL Query
SqlQuery = "SELECT * FROM _Cache WHERE Archived = #Archived"
' Create the SQLite Command
Using SQLitecmd As SQLiteCommand = New SQLiteCommand(SqlQuery, DBC.Connection)
SQLitecmd.Parameters.AddWithValue(String.Empty & "Archived", IIf(fMain.ButtonItem_VIEWARCHIVE.Checked, "True", "False"))
Using SQLiteReader = SQLitecmd.ExecuteReader()
Dim Counter As Integer = 0
' Read All Properties into the Array
While SQLiteReader.Read()
Using DeviceItem As New DeviceItem
With DeviceItem
' Get the Device Info here
End With
' Report progress at regular intervals
PopulateDevicesWorker.ReportProgress(CInt(100 * Counter / RowCount), DeviceItem)
' Increment the Counter (for Progress)
Counter += 1
End Using
End While
End Using
End Using
End If
CloseDB(DBC)
End Sub
Here is the WorkerProgressChanged event. It adds the current device (from the worker) into the observable collection (AlLDevices)
Private Sub PopulateDevicesWorkerProgressChanged(sender As Object, e As ProgressChangedEventArgs)
' Update Status
LabelItem_STATUS.Text = "Working.. (" & e.ProgressPercentage & "%)"
' Add the Device to Collection
AllDevices.Add(TryCast(e.UserState, DeviceItem))
End Sub
The WorkerCompleted event will set the objects in AllDevices to the OLV (DeviceListView1)
Private Sub PopulateDevicesWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) ' Handles PopulateDevicesWorker.RunWorkerCompleted
' This is producing Cross-Thread error
If Not IsNothing(_SelectedDevices) Then
For Each item As ListViewItem In _SelectedDevices
Debug.Print(item.Text)
Next
End If
' Populate the ObjectListView
ControlHelper.ControlInvoke(DeviceListView1, Sub() DeviceListView1.SetObjects(AllDevices, True))
' Re-enable Form Updates
ControlHelper.ControlInvoke(DeviceListView1, Sub() DeviceListView1.EndUpdate())
' If the refresh rate isn't already set, set it to the time taken to complete the Update PLUS the Seconds specified in the SETTINGS.INI File
Dim difference As TimeSpan = DateTime.Now.Subtract(StartTime)
If UpdateTimeInSeconds = -1 Then
UpdateTimer.Interval = (RefreshRate + difference.TotalSeconds) * 1000
End If
' Restart the Update Timer
UpdateTimer.Start()
End Sub
I was under the impression, that I can update the GUI (get the OLV selecteditems, etc.) from the WorkerProgressChanged and WorkerCompleted backgroundworker events but I get the darn cross-thread error.
I'm also having to INVOKE the BEGIN\END UPDATE as calling them directly produces error.
I have read that the olv.setobjects in ObjectListView 2.91 (the version I am using) should persist the selections but I haven't seen this at all.
Please! What am I missing? Its probably something daft or is there another way of doing this?
If you are not using a Forms.Timer (but Timers.Timer or Threading.Timer) for your UpdateTimer, anything called from the timer "tick" event will run on a different thread.
Thus, PopulateDevices would also be called from a non GUI thread and the BackgroundWorker will run on that thread as well.
I have a module with a function similar to this:
MainModule
Sub Test()
On Error Resume Next
Dim O1 As New Class1
O1.DoSomething
On Error GoTo 0
End Sub
and a few classes similar to this:
Class1
Sub DoSomething()
FindStuff
'create similar objects who perform similar operations and raise similar errors
Dim O2 As New Class2
O2.DoSomething
End Sub
Function FindStuff() As Stuff
'scan the WorkBook, the file system, etc. and organize the members of the object
If CorruptedFileSystem Then Err.Raise 514, "File system corrupted"
If CorruptedWorkBook Then Err.Raise 515, "WorkBook corrupted"
If Found Then Set FindStuff = FoundStuff
End Function
If I set the error trapping to Break in Class Module then the On Error Resume Next will be ignored and every Err.Raise will stop the execution inside the class.
If I set the error trapping to Break on Unhandled Errors then the Err.Raise will stop the execution at the call on the main module, not inside the class.
So in one case I can't execute the code with handled errors, in the other case I can't debug unhandled errors.
The problem becomes unmanageable when the project grows and the main module creates an object that opens a form (which is another object) that creates more objects. Some of the methods handle their own errors and some are designed to abort and raise the error to be managed by the caller.
Is there a way to handle and debug errors in classes?
EDIT
Apparently my question wasn't clear enough. I changed the title and I will try with a clearer example.
Module1
Sub Test1()
Dim O As New Class1
O.UnhandledCall
End Sub
Sub Test2()
On Error Resume Next
Debug.Print 1 / 0
Dim O As New Class1
O.HandledCall
On Error GoTo 0
End Sub
Class1
Sub UnhandledCall()
Debug.Print 2 / 0
End Sub
Sub HandledCall()
Debug.Print 3 / 0
End Sub
Test1
Set Error Trapping = Break on Unhandled Errors and execute Test1. The debugger will not stop at the unhandled error 2 / 0. Instead it will stop at O.UnhandledCall, making it impossible to know what line caused the error, what were the local variable values, the stack, etc.
Test2
Set Error Trapping = Break in Class Module and execute Test2. The debugger will not stop at 1 / 0, good, because the error is handled. But it will stop at 3 / 0 inside the class even if the error is handled inside the caller function, at the same level as 1 / 0.
Sad summary
So with the first setting I can't see where en error is trhown, with the second setting I cant run a macro that cleanly handles errors.
This is obviously an oversimplified example. The real world case I'm dealing with at this moment is a form that creates dozens of objects, some objects check some text files, other objects open drawings on a CAD via COM, other objects talk to a database, etc. If any of the conditions is inconsistent I want to abort the form opening.
As the objects are created, they execute thousands of lines of code, with hundreds of managed errors. When they find something unmanageable in a file, in a drawing or in a database, they defer the error handling to their caller, climbing the stack up to the form that should fail to open and up to the caller that should detect the error and do something about it.
I would expect the debugger to run smoothly through the managed errors and stop when there is an unmanaged error at the offending line. Instead the debugger works as expected in modules, but in classes it either stops at all the error or it never stops, regardless of whether they are managed or not.
For example if I set Error Trapping = Break in Class Module all the managed errors will break the execution as in Test2, and my debugging session will never end.
While if I set Error Trapping = Break on Unhandled Errors then I will never know what triggered the error, because the debugger will climb through all the classes up to the first object and tell me that that's the line that caused the error as in Test1.
As you've noticed, you can't bubble up runtime errors raised in a class module and debug on-the-spot just by tweaking the IDE/debugger settings.
There's another way though. Define a project-wide conditional compilation value, say DEBUG_MODE:
In your class modules' error handlers, use conditional compilation logic to make a programmatic break:
Public Function FetchResults(ByVal filter As String) As Collection
On Error GoTo CleanFail
Dim results As Collection
Set results = this.Repository.Where(filter)
CleanExit:
Set FetchResults = results
Exit Function
CleanFail:
#If DEBUG_MODE = 1 Then
Stop
#Else
Err.Raise Err.Number 'rethrows with same source and description
#End If
Set results = Nothing
Resume CleanExit
End Sub
If you don't mind the VBE popping up on your puzzled users then you could also use Debug.Assert statements to break execution when a condition is not met:
Public Function FetchResults(ByVal filter As String) As Collection
On Error GoTo CleanFail
Dim results As Collection
Set results = this.Repository.Where(filter)
CleanExit:
Set FetchResults = results
Exit Function
CleanFail:
Debug.Assert Err.Number <> 0 ' will definitely break here
Set results = Nothing
Resume CleanExit
End Sub
i have an automation that performs a few different actions which definitely requires a login, so i coded all the actions in modules and have 1 main login script that will call upon the different modules base on the codes that was sent by the buttons.
Buttons
Sub Button_Click()
Call LoginPhase(F1Function1)
DoEvents
End Sub
Function
Public Function LoginPhase(FunctionKey)
....
If FunctionKey = "F1Function1" Then
Call Scrape(intX)
ElseIf FunctionKey = "F2Function2" Then
Call BuyBuyBuy(intX, Epin)
Call Scrape(intX)
ElseIf FunctionKey = "F3Function3" Then
Call BuyBuyBuy2(intX, Epin)
Call Scrape(intX)
Else
MsgBox "Not Relevant."
End If
....
End Function
But it seem that it never recognize any of the FunctionKey value and goes straight to MsgBox "Not Relevant". Anyone have any idea how i can solve this ?
I have a flexgrid within a Multipage under Main_Window.MultiPage2.Value = 2 this flexgrid has 8000 rows and I don't want those to load unless this page is actually clicked on. The code I have does just that, but the problem is is that it loads every single time and not just once. Is there a way to make it load on the first change, and then that's it?
Private Sub MultiPage2_Change()
If Main_Window.MultiPage2.Value = 2 Then
Call form_segment_carrier_auto
End If
End Sub
in form_segment_carrier_auto is a module that populates the flexgrid.
If I understand you correctly, you could declare a Public Boolean variable, for example:
Public ChangedOnce As Boolean
This should be in some standard code module.
Then change your event handler to:
Private Sub MultiPage2_Change()
If ChangedOnce Then Exit Sub
ChangedOnce = True
If Main_Window.MultiPage2.Value = 2 Then
Call form_segment_carrier_auto
End If
End Sub
The event handler will still be called on multiple occasions if the event occurs on multiple occasions, but only the first call will do anything.
I have a set of numerically intensive routines (each takes up to 1 minute to complete) bundled in a COM object, implementing IDispatch cleanly.
I can therefore use them from an Excel worksheet, those routines will be called by VBA macros triggered by buttons.
Now, when one of these routines is called, the Excel user interface is frozen, which is quite uncomfortable for the end users of the sheet.
I'd like to find any mechanism to alleviate this problem.
This could be for instance launching the computation in another thread launched on the COM side, returning immediately, the spawned thread calling back a VBA procedure when results are computed.
Or something simpler, since I only need one computation to be performed at a time.
Now, there may be a lot of issues with calling VBA routines from other threads. I must confess that I am not that experienced with COM, that I only treat as a black box between my code and Excel (I use ATL).
So,
Is it possible to call back VBA routines from another thread ?
Is there a better way to do what I want to achieve ?
UPDATE
After weighing the options and reading a lot of stuff on the internet, I will do cooperative multithreading: in the COM object, instead of having one routine, I shall have three:
class CMyObject : ...
{
...
STDMETHOD(ComputationLaunch)(...); // Spawn a thread and return immediately
STDMETHOD(ComputationQuery)(DOUBLE* progress, BOOL* finished);
STDMETHOD(ComputationResult)(VARIANT* out);
private:
bool finished, progress;
boost::mutex finished_lock, progress_lock;
ResultObject result; // This will be marshaled to out
// when calling ComputationResult
};
And in the VBA:
Private computeActive as Boolean ' Poor man's lock
Public Sub Compute()
OnError GoTo ErrHandler:
If computeActive Then Exit Sub
computeActive = True
Dim o as MyObject
call o.ComputationLaunch
Dim finished as Boolean, progress as Double
While Not o.ComputationQuery(progress)
DoEvents
' Good place also to update a progress display
End While
Dim result as Variant
result = o.ComputationResult
' Do Something with result (eg. display it somewhere)
computeActive = False
Exit Sub
ErrHandler:
computeActive = False
Call HandleErrors
End Sub
Indeed, by doing a depth-first-search on the internet for COM Add-Ins, I realized that VBA macros run in the same event loop as Excel's GUI, that you have the DoEvents facility, and that it is not safe (or at least very tricky) to call back VBA procedures from other threads. This would require eg. tricking the Accesibility facilities to obtain a synchronized handle to an Excel.Application object, and call the OnTime method to set up an asynchronous event handler. Not worth the trouble.
If you want to do this well you need to give up on VBA and write a COM add-in.
Posting my comment as an answer...
You could implement an event in your COM object and have it call back when done. See http://www.dailydoseofexcel.com/archives/2006/10/09/async-xmlhttp-calls/ for an example of how to run a COM object asynchronously.
My dirty hack is: create a new instance of Excel, run the code there.
Another option is to schedule the run for later, have the user say when. (In the example below, I've just hard-coded 5 seconds.) This will still freeze the user interface, but at a scheduled, later time.
Sub ScheduleIt()
Application.OnTime Now + TimeValue("00:00:05"), "DoStuff"
End Sub
Sub DoStuff()
Dim d As Double
Dim i As Long
d = 1.23E+302
For i = 1 To 10000000#
' This loop takes a long time (several seconds).
d = Sqr(d)
Next i
MsgBox "done!"
End Sub