VB6 Threading-Examples using the vbRichClient5 ThreadHandler

As the Title says, three Threading-Examples which make use of the vbRichClient5-cThreadHandler-Class.
(as requested in this thread here: http://www.vbforums.com/showthread.p...=1#post4991011)

Make sure (in addition to downloading the SourceCode), that you download and install a new RC5-version (>= 5.0.40)
first before running the second, more advanced example (since it requires SQLites support for "FileURIs",
which were not yet recognized in the cConnection.CreateNewDB-method in RC5-versions below 5.0.40).

Here's the SourceCode for the three examples:
Attachment 138289

The Zip contains three Project-Folders (_Hello World, ThreadedDirScan and AsyncFolderCopy) -
please make sure, before running the Main-VB-Projects in those Folders,
to compile the appropriate ThreadLib-Dlls from their own LibProject-SubFolders - then
placing the compiled Thread-Dll-Files in the ParentFolder (where the Main-Projects reside).

Ok, how does it work - best we start with the simpler Example, the one in the _Hello World-Folder:

VB6-Threading works best and most stable (since it was designed for that), when the
"threaded Routines" reside in a compiled ActiveX-Dll(Class) - that's the one thing which
is a bit of a "hurdle" for those who never used or compiled ActiveX-Dll-Projects so far.

But it's really quite simple... When you start out fresh - and plan to use threading
(because you have a routine which is a long-runner, blocking your UI) - then the
first step should be, to move that critical Function (and its Sub-Helper-Routines) into:
1) a Private Class in your Main-Project first
- test it there, so that you're sure everything works Ok
- also check that this Class gets everything over Function-Parameters and doesn't rely on "global Variables" outside of it

if you already have such a Class in your Main-Project - all the better - you can now move this Class:
2) as a Public Class into a new ActiveX-Dll-Project (setting its Class-Instancing-Property to 5 - MultiUse)

In case of the _Hello World-Demo, this ThreadClass' is named cThread and its Code-Content looks entirely normal:

Code:

---

Option Explicit

Public Function GetThreadID() As Long
  GetThreadID = App.ThreadID
End Function

Public Function StringReflection(S As String) As String
  StringReflection = StrReverse(S)
End Function

---

Just two simple Routines, you plan to execute on the new Thread, which
your compiled SimpleThreadLib.dll is later instantiated on (by the Main-Thread).

As already mentioned, you can now compile this ActiveX-Dll Project, placing the Dll-Binary
in its ParentFolder (_Hello World), where the Main-StdExe-Project resides.

This StdExe-Project (ThreadCall.vbp in _Hello World) contains only a single Form, which in turn has this code:

For instantiation of the above ThreadDll-ThreadClass (cThread)

Code:

---

Option Explicit
 
Private WithEvents TH As cThreadHandler 'the RC5-ThreadHandler will ensure the communication with the thread-STA

Private Sub Form_Load() 'first let's instantiate the ThreadClass (regfree) on its own thread, returning "a Handler" (TH)
  Set TH = New_c.RegFree.ThreadObjectCreate("MyThreadKey", App.Path & "\SimpleThreadLib.dll", "cThread")
End Sub

---

And for Execution of the two Thread-Functions (from within Form_Click) it contains:

Code:

---

Private Sub Form_Click()
Dim StrResult As String, ThreadID As Long
  Cls
  Print Now; " (ThreadID of the Main-Thread: " & App.ThreadID & ")"; vbLf
  Print "Let's perform a few calls against the ThreadClass which now runs on its own STA "; vbLf
 
  'first we demonstrate synchronous Calls against the Thread-Instance, which was created regfree in Form_Load
  StrResult = TH.CallSynchronous("StringReflection", "ABC")
  Print "Direct (synchronous) StringReflection-Call with result: "; StrResult
 
  ThreadID = TH.CallSynchronous("GetThreadID")
  Print "Direct (synchronous) GetThreadID-Call with result: "; ThreadID; vbLf
 
  'now the calls, which are more common in threading-scenarios - the asynchronous ones, which don't
  'make the caller wait for the result (instead the results will be received in the Event-Handler below)
  TH.CallAsync "StringReflection", "ABC"
  TH.CallAsync "GetThreadID"
 
  Print "The two async calls were send (now exiting the Form_Click-routine)..."; vbLf
End Sub
 
'Our TH-Object is the clientside ThreadHandler, who's able to communicate with the Thread
'raising appropriate Events here, when results come back (in case of the async-calls)
Private Sub TH_MethodFinished(MethodName As String, Result As Variant, ErrString As String, ErrSource As String, ByVal ErrNumber As Long)
  If ErrNumber Then Print "TH-Err:"; MethodName, ErrString, ErrSource, ErrNumber: Exit Sub
 
  Print "MethodFinished-Event of TH for: "; MethodName; " with Result: "; Result
End Sub

---

That's all - I hope the above code-comments are sufficient - feel free to ask, when something is not clear.

Forgot to attach a ScreenShot of the Output produced by the Form_Click-Event above:
http://vbRichClient.com/Downloads/SimpleThreading.png

Will describe the second, more advanced example in a follow-up post in this thread.

Edit: The Demo-Zip now contains a third example (in SubFolder \AsyncFolderCopy),
to show how a low-level copying of an entire Folder-structure (with full control at the File-Level) can be implemented.

Olaf

The second, more advanced Example resides in the Folder: ThreadedDirScan,
and covers a "useful real-world-scenario" which fullfills the following requirements:

- start a (deep, recursive) scanning for Files on the worker-thread, but ensure that:
- the Main-Thread reflects the current Scan-Results in a List, updating and prolonging it
- but this List shall in addition remain usable (scrollable, clickable) over the threaded scan-run...
- this way the Main-Thread can already make use of the (so far) found files from the threaded scan,
- which will happily proceed undisturbed, without blocking the GUI - until all Files were found

To make it even a bit harder, the scan shall be used (although usable on all FileTypes)
primarily to scan for Image-Files, which shall be visualized with a little ThumbNail in
the List-Control.

Here is a ScreenShot, how the GUI will look (showing the results of a completed scan,
but wouldn't look much different whilst a scan is still in progress):

http://vbRichClient.com/Downloads/ThreadedDirScan.png

To accomplish that conveniently, I've made use of primarily three things:
1) the Event-Support which is available with the RC5-Threading-Helpers
2) SQLites (InMemoryDB-) FileURIs, which allow working against a shared InMemory-DB across Threads
3) a Virtual-ListControl, which will render only its currently visible Rows - and has the Data sitting "outside" (in the MemDB)

The code which is related to 1) is sitting in the cThread-Class of the DirScanThreadLib-ActiveX-Dll-Project

Code:

---

Option Explicit

'two Event-Naming-Conventions, for communication with the vbRichClients hidden cThreadProxy-Class (not reaching the clients, when raised)
Event CancelCheck(Cancel As Boolean)  'ask the hosting cThreadProxy, whether a client demanded Job-Cancelling
Event GetFactory(Factory As cFactory) 'ask the cThreadProxy, to deliver a RichClient-Factory-Instance regfree (not used here in this Demo)

'but this is a true User-receivable Event (just define and raise it normally, as any other VB-Event)
Event ScanProgress(ByVal FilesCount As Long)

---

In the Main-Project, the above User-Event (ScanProgress) is received and handled this way:

Code:

---

'and here's the place, where User-Events will be received (when Raised from the Thread-Class)
Private Sub TH_ThreadEvent(MethodName As String, EventName As String, ByVal ParamCount As Long, P1 As Variant, P2 As Variant, P3 As Variant, P4 As Variant, P5 As Variant, P6 As Variant, P7 As Variant, P8 As Variant)
  If EventName = "ScanProgress" Then FilesCount = P1
End Sub

---

As for Code, related to 2) and 3), I will only show the code-snippet from the Main-Project, which
is responsible for the refresh of the (Rs-)Data beneath the "sliding-Window" of the virtual ListControl
(in the appropriate VList_OwnerDrawItem Event):

Code:

---

  If Rs Is Nothing Or CurTopIndex <> VList.TopIndex Or CurVisibleRows <> VList.VisibleRows Then
    CurTopIndex = VList.TopIndex
    CurVisibleRows = VList.VisibleRows
    'the Rs is retrieved with only as many Records as needed, to fill the currently "VisibleRows" of the VList (takes only 1 msec or so)
    Set Rs = Cnn.OpenRecordset("Select * From Scan Where ID > " & CurTopIndex & " Limit " & CurVisibleRows + 1)
  End If

---

Because that's the part which is perhaps surprising (to consider and undertake at all), since normally
one wouldn't perform an SQL-request on every single needed "List-Refresh" (as e.g. whilst Scrolling),
due to "performance considerations"... But an InMemory-DB is a different animal - very responsive
and "calculatable" in its response-times, because no "potentially blocking or slow HD-Device-IO" will
interfer when performing Selects against it.

Just ask, when there are more questions with regards to this example...

Edit: Here's an additional comment about the ucVList.ctl which is included in the Main-Project...
It will behave entirely flicker-free only, when the compiled Main-Application was "manifested"
(with a CommonControls-entry - that's why I've included an appropriate 'manifest.res' in the Project).

For flickerfree usage in the VB6-IDE itself, VB6.exe could be "manifested" as well... (I'm using
my VB6-IDE this way since Win7, without larger problems - aside from the "ColorDialogue-issue").

Olaf

This is an exciting demo - I wasn't aware of the new URI feature of SQLite, so that opens up some interesting possibilities for fast, query-able, and easily shared structured data.

Small comment, not a big deal - in the Dir scan demo, there's an unused form called frmThreadCall.frm. I first looked at the code in a text editor rather than open the demo i nVB6, and it threw me off temporarily because the URI filename is different compared to the one in the DLL. I was unsure as to how the data would be shared with a different filename. Figured it all out after actually opening the VBP though.

Thanks for the demo!

Quote:

---

Originally Posted by jpbro

I wasn't aware of the new URI feature of SQLite, so that opens up some interesting possibilities for fast, query-able, and easily shared structured data.

---

Yep - although the feature is available for quite some time now, I only stumbled about
it's relevance for cross-thread MemDB-usage in a discussion on the SQLite-Mailinglist
(a few weeks ago). It'll allow some interesting things also among the worker-threads
of the RichClients RPC-Server (without using any "RPC-Singletons").

Too bad I discovered it so late (just read, that it's in there since version 3.7.7 already).

Quote:

---

Originally Posted by jpbro

Small comment, not a big deal - in the Dir scan demo, there's an unused form called frmThreadCall.frm. I first looked at the code in a text editor rather than open the demo i nVB6, and it threw me off temporarily because the URI filename is different compared to the one in the DLL. I was unsure as to how the data would be shared with a different filename. Figured it all out after actually opening the VBP though.

---

Will clean-up the Zip-archive and re-upload - thanks for pointing it out.

Olaf

The demo is very helpful, especially the first one; the second is a bit tricky for me, but I will take my time to digest.

Thanks again, for the contribution you made for our community.

Supposing there is a method implementation like this:

Code:

---

Public Function Adding(x As Long, y as Long) as Long
End Function

---

And method calls like these:

Code:

---

dim x as long, y as long
TH.CallAsync "Adding", x, y

---

Code:

---

TH.CallAsync "Adding", clng(2), clng(3)

---

Code:

---

TH.CallAsync "Adding", 2, 3

---

The first two will work fine; However the third one will cause a type mismatch.

Maybe VB is assuming 2 and 3 are Integers since they fit in the Integer range? Try 2& and 3& to force Longs and see if that works.

Quote:

---

Originally Posted by jpbro

Maybe VB is assuming 2 and 3 are Integers since they fit in the Integer range? Try 2& and 3& to force Longs and see if that works.

---

I tried your method. Works.

Oh yes, there might be another problem but it's not fully tested.

Supposing you have this in your method implementation:

Code:

---

   
    dim cancel as boolean
    RaiseEvent BeforeExecuting(cancel)
    If cancel Then
        Exit Sub
    End If

---

Well, if even I set the cancel to true, in my event handler, it never goes to Exit Sub

Are you handling the event in the CThreadHandler ThreadEvent method? If so, make sure you don't have a typo when testing the EventName parameter value.

Quote:

---

Originally Posted by jpbro

Are you handling the event in the CThreadHandler ThreadEvent method? If so, make sure you don't have a typo when testing the EventName parameter value.

---

OK, I tested again today. The problem still remains.

The class implementation:

Code:

---

Option Explicit
Public Event BeforeExecuting(cancel As Boolean)
Function Adding(x As Long, y As Long) As Long
Dim cancel As Boolean
RaiseEvent BeforeExecuting(cancel)
If cancel Then
    Adding = 0
Else
    Adding = x + y
End If
End Function

---

The method call

Code:

---

Private WithEvents th As cThreadHandler
Private Sub Test()
    Set th = New_c.RegFree.ThreadObjectCreate("Key1", RegFree_mXlObjectsDllPath, RegFree_cAsyncTesting)
    th.CallAsync "Adding", 9&, 11&
End Sub
Private Sub th_MethodFinished(MethodName As String, Result As Variant, ErrString As String, ErrSource As String, ByVal ErrNumber As Long)
    Debug.Print MethodName, Result, ErrString, ErrSource, ErrNumber
End Sub
Private Sub th_ThreadEvent(MethodName As String, EventName As String, ByVal ParamCount As Long, P1 As Variant, P2 As Variant, P3 As Variant, P4 As Variant, P5 As Variant, P6 As Variant, P7 As Variant, P8 As Variant)
    Debug.Print MethodName, EventName, ParamCount, P1
    P1 = True
    Debug.Print MethodName, EventName, ParamCount, P1
End Sub

---

Immediate Window:

Code:

---

Adding        BeforeExecuting              1            False
Adding        BeforeExecuting              1            True
Adding        20                                        0

---

As I know, there is a .CancelExecuting Method already provided by cThreadHandler, so I don't, perhaps, have to implement a cancel mechanism in my own class implementation. I can just shut the whole thing down. But this demo is only to show the problem that comes with parameter passing in ThreadEvent.

I've tried your code here and I am getting the same results - not sure if the RC5 thread handler is designed to reflect ByRef values in events back to the thread that raised the event. I'm sure Olaf has the answer though.

That said, there is a special event called CancelCheck(Cancel As Boolean) that you can use and it will let you do exactly what you are trying to do with your BeforeExecuting event. I've tried substituting BeforeExecuting for CancelCheck and it works for me.

Quote:

---

Originally Posted by jpbro

I've tried your code here and I am getting the same results - not sure if the RC5 thread handler is designed to reflect ByRef values in events back to the thread that raised the event. I'm sure Olaf has the answer though.

That said, there is a special event called CancelCheck(Cancel As Boolean) that you can use and it will let you do exactly what you are trying to do with your BeforeExecuting event. I've tried substituting BeforeExecuting for CancelCheck and it works for me.

---

Well ... Why there is not a CancelCheck Event for my cThreadHandler. Perhaps we don't have the same version of RC5? Anyway, to find a bypass around this problem is not why I am here. In real application, I might just drop throwing values back to the event firing thread.

But here, I try to get to the bottom of the issue:p

Quote:

---

Originally Posted by jpbro

I've tried your code here and I am getting the same results - not sure if the RC5 thread handler is designed to reflect ByRef values in events back to the thread that raised the event.

---

For the sake of more speed in the (currently PipeBased) Thread-Communication,
I refrained from "reflecting "ByRef-Params back into the caller" (in both directions).

The RPC-Classes of the RC5 (which work over sockets, and don't need to save
every last micro-sec) *do* support ByRef - Reflection (for simple Types and Arrays) though...

Quote:

---

Originally Posted by jpbro

That said, there is a special event called CancelCheck(Cancel As Boolean) that you can use and it will let you do exactly what you are trying to do with your BeforeExecuting event. I've tried substituting BeforeExecuting for CancelCheck and it works for me.

---

@bPrice
Yep, the CancelCheck-mechanism is there, to be able to detect (from within the Thread),
whether the "TH-hosting-Class or -Form on the other end" (in the Main-Thread) wants to
"get rid of the Thread as soon as possible" (to be able to close the thread gracefully, instead
of calling ThreadTerminate as the "last measure" in case the Thread is "plowing on without noticing").

Though note, that sharing Data (behind a Variable or an UDT-Array) is quite easily
possible between the TH-hosting Class and the Thread-Class...

The easiest way (if it's only a few Bits you need) is by passing a Pointer to a
(Privately declared) LongFlag to the ThreadClass at Initialization-Time of the 'TH'
(using a synchronous call, to make sure it's there).

In the HostClass or -Form (in the Main-Thread):

Code:

---

Private Flag As Long

Private Sub InitThreadHandler()
  Set TH = ...' regfree-createthread etc.
  If Not TH.CallSynchronous("InitSharedMemory", VarPtr(Flag)) Then MsgBox "Shared Flag-Creation failed"
End Sub

---

And in the ThreadClass one can then just use 'Flag' this way (over a Private Property)

Code:

---

Option Explicit

Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Long)
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Long)

Private pFlag As Long

'one can call that Init-Function synchronously at TH-Creation-Time in the Host-Class
Public Function InitSharedMemory(VarPtrOfFlag As Long) As Boolean
  pFlag = VarPtrOfFlag
  If pFlag Then InitSharedMemory = True 'indicate success back to the caller
End Function

Private Property Get Flag() As Long
  If pFlag Then GetMem4 pFlag, Flag
End Property
Private Property Let Flag(ByVal RHS As Long)
  If pFlag Then PutMem4 pFlag, RHS
End Property

---

Olaf

Quote:

---

Originally Posted by bPrice

Supposing there is a method implementation like this:

Code:

---

Public Function Adding(x As Long, y as Long) as Long
End Function

---

And method calls like these:

Code:

---

dim x as long, y as long
TH.CallAsync "Adding", x, y

---

Code:

---

TH.CallAsync "Adding", clng(2), clng(3)

---

Code:

---

TH.CallAsync "Adding", 2, 3

---

The first two will work fine; However the third one will cause a type mismatch.

---

You don't need a Cross-Thread-Call to test the behaviour in this case...

E.g. when you put that into a simple Form...

Code:

---

Function DoAdd(x As Long, y as Long) as Long
  DoAdd = x + y
End Function

---

... and then test it (e.g. in Form_Click)

Code:

---

Private Sub Form_Click()
  Debug.Print DoAdd(1, 2)
End Sub

---

You will get the same error.

Edit: (and sorry) with regards to the above example...
There will be no error in the above call (because the compiler
will see that the "target-params" are of type Long - and then
is passing the correctly typed ("promoted") Literals into the Method.

To reproduce the error, you will have to do basically as I do in my
deserializing+calling-mechanism - where I detect the Types which
were contained in the serialized content - and then I pass those
Typed-Params (in this case the detected Integers) per IDispatch.Invoke
to the Thread-Method (somewhat comparable to VBs CallByName-call).

Code:

---


Private Sub Form_Click()
  'the deserializer will detect the Integers which were passed instead of Long
  Dim x As Integer: x = 1
  Dim y As Integer: y = 2
 
  'and then calls IDispatch.Invoke with them, basically as shown below
  Caption = CallByName(Me, "DoAdd", VbMethod, x, y)
End Sub
 
Public Function DoAdd(x As Long, y As Long) As Long
  DoAdd = x + y
End Function


---

Typewise Unspecified Integer-Literals (in the low range below -32768 to 32767),
are always treated by the VB-Compiler as being of type Integer (not Long).

You can check this yourself in the DirectWindow:
?TypeName(1) ... will print out Integer
?TypeName(32767) ... will print out Integer
?TypeName(32768) ... will print out Long

Olaf

hello Olaf
Can vbRichClient used in office vba IDE? do u have any demo?

You will have to check-in the reference to it in your VBA-Project -
then nearly all of the RC5-Classses should work in VBA as they do in VB6
(it's still COM after all).

Olaf

Quote:

---

Originally Posted by loquat

hello Olaf
Can vbRichClient used in office vba IDE? do u have any demo?

---

I *usually* use RC5 in my VBA projects. So far as it seems, it works great. As Olaf has pointed out that RC5 is COM, so basically you can utilize those classes in any other languages that has COM support. I even tested it in .Net once:p I don't use Java, or Python but I guess they all support COM to some degree.

It should be ideally used with VB6, though. And it's written in VB6, so perhaps registration of msvbvm60.dll is also required?

A small example for VBA usage.

1, First write your code for your class implementation in an ActiveX DLL Project in VB6. i.e. Inside class module cAsyncTesting, put the following code:

Code:

---

Option Explicit
Public Event BeforeSplit()
Public Event AfterSplit()
Public Function StringSplit(StrSource As String, Delimiter As String) As String()
    RaiseEvent BeforeSplit
    StringSplit = Split(StrSource, Delimiter)
    RaiseEvent AfterSplit
End Function

---

Attachment 136711



2, Give a Name to your ActiveX project, i.e. mXlObjects. Then compile it, so you get the DLL like below:


Attachment 136713



3, Reference the RC5 for your VBA project:


Attachment 136715



4, Make sure you put your method calling code in a "Class module", so the cThreadHandler is able to receive events. That said, in VBA, it should be the worksheet objects, or the workbook object.


Attachment 136717


Important Note: Unlike VB6, the VBA project will retain the instances(module level) that are created by a previous subroutine. So you might need to reset the project before running another test. Or you might run into errors.


5, The actual calling code, and the immediate window messages:

Code:

---

Option Explicit
Private Const RegFree_mXlObjectsDllPath As String = "C:\Users\Administrator\Desktop\Objects\mXlObjects.dll"
Private Const RegFree_mXlTestClassName As String = "cAsyncTesting"
Private Const RegFree_mXlTestMethodName As String = "StringSplit"
Private WithEvents th As cThreadHandler
Private Sub Test()
   
    Dim strSourceArr() As String, strSource As String
    Dim i As Long
   
    'Starting a counter. Once you have referenced RC5 in your project.
    'You will have a globally available "constructor" New_c, similar meaning to New keyword
    New_c.Timing True
   
    Debug.Print New_c.Timing, "Constructing a string for demo purposes"
    ReDim strSourceArr(0 To 9)
    For i = LBound(strSourceArr) To UBound(strSourceArr)
        strSourceArr(i) = CStr(i)
    Next
    strSource = Join(strSourceArr, "|")
   

    Debug.Print New_c.Timing, "Creating a cThreadHandler and making an asynchronous call"
    Set th = New_c.RegFree.ThreadObjectCreate("AnyUniqueKey", RegFree_mXlObjectsDllPath, RegFree_mXlTestClassName)
    th.CallAsync RegFree_mXlTestMethodName, strSource, "|"
    Debug.Print New_c.Timing, "End of the calling subroutine"
   
End Sub

Private Sub th_MethodFinished(MethodName As String, Result As Variant, ErrString As String, ErrSource As String, ByVal ErrNumber As Long)
    Debug.Print New_c.Timing, MethodName, "Result: " & Join(Result, "|")
End Sub

Private Sub th_ThreadEvent(MethodName As String, EventName As String, ByVal ParamCount As Long, P1 As Variant, P2 As Variant, P3 As Variant, P4 As Variant, P5 As Variant, P6 As Variant, P7 As Variant, P8 As Variant)
    Debug.Print New_c.Timing, MethodName, "EventName: " & EventName
End Sub

---

Code:

---

0.01msec    Constructing a string for demo purposes
 2.79msec    Creating a cThreadHandler and making an asynchronous call
 25.22msec    End of the calling subroutine
 30.52msec    StringSplit  EventName: BeforeSplit
 35.98msec    StringSplit  EventName: AfterSplit
 40.72msec    StringSplit  Result: 0|1|2|3|4|5|6|7|8|9

---

6, Note that the calling subroutine had ended before the method call finished. So it's asynchronous. Usually if you put your class in the same project, create an instance, and call its method, the end of subroutine will only be reached after everything is done for that method call.

Hello Olaf,

there is another problem with async method call:

Code:

---

    Debug.Print New_c.Timing, " PREPARE DB ", th.CallAsync("CreateNewRequests", SA, "YJ")

---

SA here is an object of a user defined class. The error message shows this:

Attachment 136883

I am not sure what it means. Could you please explain a little about the situation. Thanks in advance. :)

EDIT:

I know in the class property panel, I can set the item "persistable" to 1 - Persistable. However I never met the problem until applying Regfree method per RC5. So I just want to know more here. ;)

Things aren't going so well. After changing the properties to "Persistable", it's successful to make the async method call, but I keep getting unexpected errors. The whole thing is tested before porting to Regfree handling, though.

It seems that the object passed to the ThreadHandler is losing its values.

Quote:

---

Originally Posted by bPrice

Things aren't going so well. After changing the properties to "Persistable", it's successful to make the async method call, but I keep getting unexpected errors. The whole thing is tested before porting to Regfree handling, though.

It seems that the object passed to the ThreadHandler is losing its values.

---

Why do you want to pass an Object in this case - and not e.g. a VB(A)-String- or VariantArray directly?

For Objects to be allowed to be passed into the ThreadHandlers Param-Serializer,
those have to be (I)Persistable-support, but will also have to be "known"
(Interface-wise) on both ends of the ThreadCall - and this Interface-Knowledge
is drawn from the registry - meaning, when you want to write your own persistable
Objects, you will have to hos these Classes in (and then registering) an ActiveX-Dll.

Already "known" Objects are those which are registered in the System (e.g. ADO-Recordsets),
or are interface-wise accessible because they are part of the vbRichClient5.dll (e.g. cRecordsets,
cCollection).

But as said, since in your Err-Message I saw, that you apparently want to pass an
XL-Array, why not use e.g. a (two-dimensional) VariantArray for that, which you can
derive (directly within Excel) from e.g. a complete Cell-Range with one line of code.

Olaf

Quote:

---

Originally Posted by Schmidt

But as said, since in your Err-Message I saw, that you apparently want to pass an
XL-Array, why not use e.g. a (two-dimensional) VariantArray for that, which you can
derive (directly within Excel) from e.g. a complete Cell-Range with one line of code.

---

Well, I can do that. ;) The reason why the problem even occurred is that I took things for granted, "thought" it would work, and ran into an unexpected error. Obviously "things" turned out to be more than they looked. The object passing is not mandatory in my situation, and therefore I might just avoid doing it.

Quote:

---

For Objects to be allowed to be passed into the ThreadHandlers Param-Serializer,
those have to be (I)Persistable-support, but will also have to be "known"
(Interface-wise) on both ends of the ThreadCall - and this Interface-Knowledge
is drawn from the registry - meaning, when you want to write your own persistable
Objects, you will have to hos these Classes in (and then registering) an ActiveX-Dll.

Already "known" Objects are those which are registered in the System (e.g. ADO-Recordsets),
or are interface-wise accessible because they are part of the vbRichClient5.dll (e.g. cRecordsets,
cCollection).

---

Thanks again, for the explanation, though I am not so sure if you meant that if both the Atx-Dlls were registered on the system, there would be no errors, so here are some additions to the error:

Snapshot:

Attachment 136887

The mXlStringArray class is hosted, yes, in an ActiveX-Dll. I have set the class property to "Persistable" and recompiled, so it is registered to the system and is then referenced in my VB6 test project. The error message is gone and I CAN MAKE a call, but the object will lose its contained data, thus generating other errors, i.e. Subscript out of range.

Quote:

---

Originally Posted by bPrice

The mXlStringArray class is hosted, yes, in an ActiveX-Dll. I have set the class property to "Persistable" and recompiled, so it is registered to the system and is then referenced in my VB6 test project. The error message is gone and I CAN MAKE a call, but the object will lose its contained data, thus generating other errors, i.e. Subscript out of range.

---

Not having seen any code - I'm not sure where the error creeps in.

Here's an easy example you can use, that shows that VB6' persistable Class-Objects will work,
when passed as Parameters (or returned as Function-Results)... It is done as an extension
of the [_Hello World]-Example (as contained in the Source-Zip in the Opener-Posting of this thread).

The Dll you place your serializable class in, should be registered on the system.
To avoid more Dlls than necessary, I'm going to place a new Class cSerializable
within the SimpleThreadLib.dll-Project of above mentioned [_Hello World]-example:

Code:

---

Option Explicit 'ClassName: cSerializable - switch its properties to MultiUse and Persistable

Public L As Long, S As String, D As Date 'define 3 Public Properties

Private Sub Class_Initialize() 'init Default-Values
  L = 1
  S = "Some String 1"
  D = Now
End Sub

Private Sub Class_ReadProperties(PropBag As PropertyBag) 'implement Read-Props
  L = PropBag.ReadProperty("L", L)
  S = PropBag.ReadProperty("S", S)
  D = PropBag.ReadProperty("D", D)
End Sub

Private Sub Class_WriteProperties(PropBag As PropertyBag) 'implement Write-Props
  PropBag.WriteProperty "L", L
  PropBag.WriteProperty "S", S
  PropBag.WriteProperty "D", D
End Sub

---

Then, in the same SimpleThreadLib.dll-Project - extend the already existing cThread-Class with a new method:

Code:

---

Option Explicit 'ClassName: cThread - (should already be at MultiUse)
 
Public Function GetThreadID() As Long
  GetThreadID = App.ThreadID
End Function

Public Function StringReflection(S As String) As String
  StringReflection = StrReverse(S)
End Function
 
Public Function PassSerializableObjectAndReturnIt(SO As cSerializable) As cSerializable
  SO.L = SO.L + 1 'increment the Long-Property
  SO.S = Left$(SO.S, Len(SO.S) - 1) & SO.L 'change the last Char of the String-Property
  SO.D = SO.D + 1 'add one day to the Date-Property
  Set PassSerializableObjectAndReturnIt = SO 'return the changed SO-object
End Function

---

Now re-compile the SimpleThreadLib.dll-Project into the Folder, where the Main-Project is placed -
and then start up the Main-Project (ThreadCall.vbp):

In the Form, extend it to now this code:

Code:

---

Option Explicit
 
Private WithEvents TH As cThreadHandler

Private Sub Form_Load() 'first let's instantiate the ThreadClass (regfree) on its own thread, returning "a Handler"
  Set TH = New_c.RegFree.ThreadObjectCreate("MyThreadKey", App.Path & "\SimpleThreadLib.dll", "cThread")
End Sub

Private Sub Form_Click()
Dim StrResult As String, ThreadID As Long
  Cls
  Print Now; " (ThreadID of the Main-Thread: " & App.ThreadID & ")"; vbLf
  Print "Let's perform a few calls against the ThreadClass which now runs on its own STA "; vbLf
 
  'first we do synchronous Calls against the Thread-Instance, which was created regfree in Form_Load
  StrResult = TH.CallSynchronous("StringReflection", "ABC")
  Print "Direct (synchronous) StringReflection-Call with result: "; StrResult
 
  ThreadID = TH.CallSynchronous("GetThreadID")
  Print "Direct (synchronous) GetThreadID-Call with result: "; ThreadID; vbLf
 
  'now the calls, which are more common in threading-scenarios - the asynchronous ones, which don't
  'make the caller wait for the result (instead the results will be received in the Event-Handler below)
  TH.CallAsync "StringReflection", "ABC"
  TH.CallAsync "GetThreadID"
 
  Dim SO As Object: Set SO = CreateObject("SimpleThreadLib.cSerializable")
  Print "-> SO-content before the 3. call: "; SO.L; ", "; SO.S; ", "; SO.D
  TH.CallAsync "PassSerializableObjectAndReturnIt", SO
 
  Print "The three async calls were send (now exiting the Form_Click-routine)..."; vbLf
End Sub
 
'Our TH-Object is the clientside ThreadHandler, who's able to communicate with the Thread
'raising appropriate Events here, when results come back (in case of the async-calls)
Private Sub TH_MethodFinished(MethodName As String, Result As Variant, ErrString As String, ErrSource As String, ByVal ErrNumber As Long)
  If ErrNumber Then Print "TH-Err:"; MethodName, ErrString, ErrSource, ErrNumber: Exit Sub
 
  If IsObject(Result) Then
    Print "MethodFinished-Event of TH for: "; MethodName; " with Result: "
    Print "-> SO-content, returned from the call: "; Result.L; ", "; Result.S; ", "; Result.D
  Else
    Print "MethodFinished-Event of TH for: "; MethodName; " with Result: "; Result
  End If
End Sub

---

It should print out this:
http://vbRichClient.com/Downloads/ThreadCall2.png


That said (and demonstrated) - I wouldn't use this kind of VB6-serializing -
since it is error-prone (due to requiring registered typelibs/dlls) - and
there's easier methods to transport larger datablobs between threads
(e.g. JSON, a shareable SQLite-InMemory-DB, or simply Variant-Arrays).


Olaf

Tested and worked:

Attachment 136903

I see that to use a persistable object, one has to implement property read/write via a PropertyBag class, which is unknown to me by the way until this post. So basically to make my own objects persistable, I probably need a rewrite of them...

Quote:

---

a shareable SQLite-InMemory-DB, or simply Variant-Arrays

---

Guess this is where I am heading now. ;)

Hi Olaf,

I've done a few tests, and I suspect I know the answer, but I just wanted to confirm - the Sqlite file: URI spec is only good for cross-thread communication, not cross-process communication, correct?

Thanks.

Quote:

---

Originally Posted by jpbro

I've done a few tests, and I suspect I know the answer, but I just wanted to confirm - the Sqlite file: URI spec is only good for cross-thread communication, not cross-process communication, correct?

---

Yes, the feature relies on SQLites "Shared Cache"-allocation - and this is
only available "InProcess" (so, only cross-thread inside a given hosting-process).

Regards,

Olaf

Thanks for the confirmation :)

Having another question here:

Code:

---

Private Sub th_ThreadEvent(MethodName As String, EventName As String, ByVal ParamCount As Long, P1 As Variant, P2 As Variant, P3 As Variant, P4 As Variant, P5 As Variant, P6 As Variant, P7 As Variant, P8 As Variant)

---

The passed in MethodName is called "BroadCastedEvent", not exactly the method name that I am expecting, i.e. "NameOfTheMethodThatRaisedTheEvent". I guess this is not important but it's just a question.

Quote:

---

Originally Posted by jpbro

Thanks for the confirmation :)

---

Right, and this is what I got from SQLite documentation before using the URI spec:

Quote:

---

In version 3.5.0, shared-cache mode was modified so that the same cache can be shared across an entire process rather than just within a single thread.

---

Quote:

---

Enabling shared-cache for an in-memory database allows two or more database connections in the same process to have access to the same in-memory database.

---

Quote:

---

Shared-cache mode is enabled on a per-process basis.

---

Quote:

---

Originally Posted by bPrice

Having another question here:

Code:

---

Private Sub th_ThreadEvent(MethodName As String, EventName As String, ByVal ParamCount As Long, P1 As Variant, P2 As Variant, P3 As Variant, P4 As Variant, P5 As Variant, P6 As Variant, P7 As Variant, P8 As Variant)

---

The passed in MethodName is called "BroadCastedEvent", not exactly the method name that I am expecting, i.e. "NameOfTheMethodThatRaisedTheEvent". I guess this is not important but it's just a question.

---

I can only give the Name of the "MethodThatRaisedTheEvent", when it was triggered by a
synchronous or asynchronous request "from the outside" (because in this case the
MethodName came in as a Parameter from the TH of the MainThread).

For Methods which are jumped-to from the inside of the ThreadClass (e.g. by a Class-internal Timer),
I use the generic MethodName "BroadCastedEvent".

Olaf

Added a third example (AsyncFolderCopy) into the Demo-Zip of the Opener-Posting.

The Demo-GUI is relatively simple (sporting only Progress-Event-Handling in the Form.Caption and Start/Cancel-Buttons):
http://vbRichClient.com/Downloads/AsyncFolderCopy.png

The implementation-code that's needed in the cCopyThread-Class of the ThreadLib-ActiveX-Dll can be considered requiring "average skills",
and thus sitting somewhere between the other two example-Folders of the Demo-Zip which can be labelled:
- "easy" (_Hello World) -
- and "advanced" (ThreadedDirScan)
Note, that as with all other examples - the ThreadLib-ActiveX-Dll-Project needs to be compiled first into the Folder where the GUI-VB6-Project resides.

Code:

---

Option Explicit

'two Event-Naming-Conventions, for communication with the vbRichClients hidden cThreadProxy-Class (not reaching the clients, when raised)
Event CancelCheck(Cancel As Boolean)  'ask the hosting cThreadProxy, whether a client demanded Job-Cancelling
Event GetFactory(Factory As cFactory) 'ask the cThreadProxy, to deliver a RichClient-Factory-Instance regfree (not used here in this Demo)

'Userdefined-Event
Event Progress(ByVal Percent As Double, ByVal ProgrFileSizeInSrc As Currency, ByVal TotalFileSizeInSrc As Currency)

Private F As cFactory, New_c As cConstructor 'RC5-lib-related Constructor-Variables
Private mProgrFileSizeInSrc As Currency, mTotalFileSizeInSrc As Currency, mCancelled As Boolean 'Class-internal Helper-variables
 
Public Function CopyFolderTo(ByVal DstFolder As String, ByVal SrcFolder As String, Optional ByVal ApplyFileAttributesToDst As Boolean, Optional ByVal Filter As String, Optional ByVal Level As Long) As String
  On Error Resume Next 'we use "in-place-errorhandling" here, and accumulate the Errors in the return-value of this function (if there are any)
 
  If Level = 0 Then 'init (reset) the Private Variables, when we start a new "deep-copy" (at root-recursion-level Zero)
    If New_c Is Nothing Then 'when the New_c-constructor is not yet initialized,
      RaiseEvent GetFactory(F) 'retrieve a Factory over the built-in Event (to avoid specifying paths for regfree RC5-inits)
      Set New_c = F.C 'init the New_c-constructor-variable from the Factory-Property
    End If
    mCancelled = False 'reset the Cancel-Flag
    mProgrFileSizeInSrc = 0 'reset the Progress-FileSize
    mTotalFileSizeInSrc = GetTotalFileSize(SrcFolder, Filter) 'get the Total-Size of all Files (over a recursive-scan)
  End If
 
  Dim DL As cDirList, i As Long
  Set DL = New_c.FSO.GetDirList(SrcFolder, dlSortNone, Filter, True)
  If Err Then CopyFolderTo = CopyFolderTo & Err.Description & vbCrLf: Err.Clear: Exit Function
 

  New_c.FSO.EnsurePathEndSep DstFolder
  If Not New_c.FSO.FolderExists(DstFolder) Then New_c.FSO.CreateDirectory DstFolder
  If Err Then CopyFolderTo = CopyFolderTo & Err.Description & vbCrLf: Err.Clear: Exit Function

  For i = 0 To DL.FilesCount - 1 'copy the files from the current directory chunkwise
    CopyFileChunkWiseTo DstFolder & DL.FileName(i), DL.Path & DL.FileName(i)
    If Err Then CopyFolderTo = CopyFolderTo & "Error copying: " & DL.Path & DL.FileName(i) & " " & Err.Description & vbCrLf: Err.Clear
    If Cancelled Then Exit Function
   
    If ApplyFileAttributesToDst Then New_c.FSO.SetFileAttributesEx DstFolder & DL.FileName(i), DL.FileAttributes(i) And Not (FA_READONLY Or FA_HIDDEN), _
                                              DL.FileLastAccessTime(i), DL.FileLastWriteTime(i), DL.FileCreationTime(i)
    If Err Then CopyFolderTo = CopyFolderTo & Err.Description & vbCrLf: Err.Clear
  Next
  For i = 0 To DL.SubDirsCount - 1 'recursions into Sub-Directories
    CopyFolderTo = CopyFolderTo & CopyFolderTo(DstFolder & DL.SubDirName(i), DL.Path & DL.SubDirName(i), ApplyFileAttributesToDst, Filter, Level + 1)
    If Cancelled Then Exit Function
   
    If ApplyFileAttributesToDst Then New_c.FSO.SetFileAttributesEx DstFolder & DL.SubDirName(i), DL.SubDirAttributes(i) And Not (FA_READONLY Or FA_HIDDEN), _
                                            DL.SubDirLastAccessTime(i), DL.SubDirLastWriteTime(i), DL.SubDirCreationTime(i)
    If Err Then CopyFolderTo = CopyFolderTo & Err.Description & vbCrLf: Err.Clear
  Next
  If Level = 0 Then RaiseEvent Progress(1, mProgrFileSizeInSrc, mTotalFileSizeInSrc)
End Function

'Helper-Function, to determine the TotalSize (Sum of all Files in Bytes) of a given Directory (using a recursive scan)
Private Function GetTotalFileSize(ByVal SrcFolder As String, Optional ByVal Filter As String) As Currency
  On Error Resume Next
    Dim DL As cDirList
    Set DL = New_c.FSO.GetDirList(SrcFolder, dlSortNone, Filter, True)
    If Err = 0 Then GetTotalFileSize = GetTotalFileSize + DL.TotalFileSizeInDir
  On Error GoTo 0
 
  If Cancelled Then Exit Function
  Dim i As Long
  For i = 0 To DL.SubDirsCount - 1
    GetTotalFileSize = GetTotalFileSize + GetTotalFileSize(DL.Path & DL.SubDirName(i))
    If Cancelled Then Exit Function
  Next
End Function

'Helper-Function, which performs a low-level, chunk-wise copying of a file (to be able to cancel early, even when larger files >2GB are copied)
Private Function CopyFileChunkWiseTo(DstFile As String, SrcFile As String) As String
  Dim Src As cStream, Dst As cStream, BytesRead As Long
  Set Src = New_c.FSO.OpenFileStream(SrcFile, STRM_READ Or STRM_SHARE_DENY_NONE)
  Set Dst = New_c.FSO.CreateFileStream(DstFile, STRM_WRITE Or STRM_SHARE_DENY_NONE)
 
  Const BufSize As Long = 4194304: Static Buf(0 To BufSize - 1) As Byte
  Do Until Src.GetPosition = Src.GetSize
    BytesRead = Src.ReadToPtr(VarPtr(Buf(0)), BufSize)
    Dst.WriteFromPtr VarPtr(Buf(0)), BytesRead
    mProgrFileSizeInSrc = mProgrFileSizeInSrc + BytesRead
   
    Static T As Double, LastT As Double
    T = New_c.HPTimer
    If T - LastT > 0.2 Then 'ensure, that we don't raise ThreadEvents more than about 5 times per second
      If Cancelled Then Exit Function
      RaiseEvent Progress(mProgrFileSizeInSrc / mTotalFileSizeInSrc, mProgrFileSizeInSrc, mTotalFileSizeInSrc)
      LastT = T
    End If
  Loop
End Function
 
Private Function Cancelled() As Boolean 'helper-function to signalize early exits in the Job-Procedures...
  If Not mCancelled Then RaiseEvent CancelCheck(mCancelled) '...by raising the appropriate Helper-Event
  Cancelled = mCancelled
End Function

---

Olaf

Have a problem:

In the old times when I work with elements of a large array, the only way is to loop through the entire array and work on each element sequentially. Now with the advent of multi-threading, I came up with an idea that I might be able to split the array into parts each of which gets dealt with by a separate thread. Therefore, I thought, the performance could be boosted.

I experimented on it and it proved to be not the case. Due to the fact, I guess, that all data transfered between threads, over the cThreadHandler, is copied back and forth, the time cost for copying data well exceeds the time saved by using separate threads. Imagine copy arrays of millions of elements again, again, and again across threads...

I wish I could make all threads work on a same block data, is it possible? Otherwise all the copying & joining data are not going to get me what I want. :(

Quote:

---

Originally Posted by Resurrected

...I might be able to split the array into parts each of which gets dealt with by a separate thread. Therefore, I thought, the performance could be boosted.

I experimented on it and it proved to be not the case. Due to the fact, I guess, that all data transfered between threads, over the cThreadHandler, is copied back and forth, the time cost for copying data well exceeds the time saved by using separate threads. Imagine copy arrays of millions of elements again, again, and again across threads...

I wish I could make all threads work on a same block data, is it possible?

---

Of course...

To avoid unnecessary allocations (or copying) there's several approaches:

1) allocate (ReDim) the large Array once (in the Main-Thread)
1.1) pass only the Pointer to that Array (and its dimensions) into your ThreadClass
1.2) span a virtual Array over that pointer (using SafeArray-techniques)
1.3) important is, that from within the thread, you "unbind" the virtually spanned Array again at the end of processing

2) allocate (ReDim) a separate part of the large Array only once in the ThreadClass (in a useful WorkBuf-Size)
2.1) instruct the Threads, to each fill their "WorkBuf-Array-Part" (on their own, isolated Thread-Allocation)
2.1) when a Thread is finished with its part, it passes a Pointer to its WorkBufArray-area back to the MainThread
2.2) The MainThread then being able (along with additional Infos, where this part belongs) to copy over this part very fast (per CopyMemory) into the large MainArray-Allocation.

The latter approach is a bit safer to handle, because one wouldn't have to take care of proper "SafeArray-Unbinding" within the threads.

E.g. I was using something like that (as described in 2) in a Multithreaded MandelBrot-Rendering,
where the (ScreenPixel) size of the total MandelBrot-area was known - each thread then performing
MandelBrot-calculations on only a "stripe" of the total area - and then reporting back only
the pointer of such a "thread-internally filled stripe-buffer" to the MainThread.

The Mainthread then being able, to do a "Blit to a hDC in the MainThread" directly from that
passed Pointer (that's possible per StretchDIBits for example).

So, approach #1 (Spanning of Virtual-Arrays) is the least resource- and communication intensive - but approach #2
is also useful in some cases (where a kind of copying is involved anyways, as e.g. in a Screen-Blit-Operation).

To give a clear recommendation for one or the other, I'd need to know what your scenario is...

Olaf

Hello Olaf

For the time being, I think I will go for approach 1).

And sorry I didn't reply sooner because I was trying really hard to wrap my head around SAFEARRAY, VARIANT, BSTR, and related memory manipulation APIs like CopyMemory.

Before posting in this thread, I had no experience with them. So I studied them for a whole week. This site proved to be VERY helpful.

So far I have something like this (not perfect at all, but I will try to build upon the idea)

In the ActiveX DLL project, I have a modMemoryFuncs and cAccelerator:

Code:

---

'Standard Module
Option Explicit
Public Const VARIANT_STRUCTURE_LENGTH = 16
Public Const PTR_LENGTH_32BIT As Long = 4
Public Declare Function VarPtr Lib "msvbvm60.dll" (Var As Any) As Long
Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Var() As Any) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Sub FillMemory Lib "kernel32" Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte)
Private Type SAFEARRAYBOUND
    cElements As Long
    lLbound As Long
End Type
Private Type SAFEARRAY_VECTOR
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    rgsabound(0) As SAFEARRAYBOUND
End Type

---

Code:

---

'Class Module
Private vDataHolder As Variant
Private Sub Class_Terminate()
    FillMemory ByVal VarPtr(vDataHolder), PTR_LENGTH_32BIT, 0
End Sub
Public Sub InStrAccelerated(pData As Long, _
                            RangeStart As Long, _
                            RangeEnd As Long, _
                            Find As String, _
                            CompareMethod As Long)
    Dim i As Long
   
    On Error Resume Next
   
    CopyMemory ByVal VarPtr(vDataHolder), ByVal pData, VARIANT_STRUCTURE_LENGTH

    For i = RangeStart To RangeEnd
        vDataHolder(i, 2) = InStr(1, vDataHolder(i, 1), Find, CompareMethod)
    Next

End Sub

---

In the VBA Project, I have a cAccelelator(same name), which is a wrapper for multiple threadhandlers, and a modMain:

Code:

---

'Standard Module
Sub Test()

Dim ac As cAccelerator
Set ac = New cAccelerator

Dim v As Variant
v = Selection.Cells.Value
'get a variant array with several millions of rows and 2 columns

ac.InStrAccelerated v, "man", vbTextCompare
'process

Selection.Cells.Value = v
'show results

End Sub

---

Code:

---

'Class Module
Private ThreadPool As cCollection
Private ThreadOperateRanges() As tpOperateRange
Private ThreadHandlerInstance As cThreadHandler
Private Type tpOperateRange
    Start As Long
    End As Long
End Type
Private Const DLL_FILE_PATH As String = "C:\Users\Administrator\Desktop\cThread\cThread3.dll"
Private Const DLL_CLASS_NAME As String = "cAccelerator"

Public Sub InStrAccelerated(Data As Variant, Find As String, CompareMethod As VbCompareMethod)
    Dim RLB As Long, RUB As Long, I As Long
   
    New_c.Timing True
   
    RLB = LBound(Data, 1)
    RUB = UBound(Data, 1)
    GetOperateRange RLB, RUB
   
    For I = 0 To ThreadPool.Count - 1
        Set ThreadHandlerInstance = ThreadPool.ItemByIndex(I)

        ThreadHandlerInstance.CallAsync "InStrAccelerated", _
                                        VarPtr(Data), _
                                        ThreadOperateRanges(I).Start, _
                                        ThreadOperateRanges(I).End, _
                                        Find, _
                                        CompareMethod
    Next
   
    Debug.Print "Thread Calling Finished", New_c.Timing
    For I = 0 To ThreadPool.Count - 1
        Set ThreadHandlerInstance = ThreadPool.ItemByIndex(I)
        ThreadHandlerInstance.WaitForEmptyJobQueue
        Debug.Print "Thread " & I & " Ended", New_c.Timing
    Next
   

End Sub
Private Sub GetOperateRange(RangeStart As Long, RangeEnd As Long)
    Dim RangeTotalLength As Long, RangeAverageLength As Long, RangeCurStart As Long, I As Long
    RangeTotalLength = RangeEnd - RangeStart
    RangeAverageLength = CLng(RangeTotalLength / ThreadPool.Count)
    RangeCurStart = RangeStart
    For I = LBound(ThreadOperateRanges) To UBound(ThreadOperateRanges)
        ThreadOperateRanges(I).Start = RangeCurStart
        ThreadOperateRanges(I).End = RangeCurStart + RangeAverageLength
        RangeCurStart = RangeCurStart + RangeAverageLength + 1
    Next
    ThreadOperateRanges(UBound(ThreadOperateRanges)).End = RangeEnd
End Sub
Private Sub Class_Initialize()
    Dim cores As Long, I As Long
    cores = New_c.GetCPUCoresCount
    Set ThreadPool = New_c.Collection(False, BinaryCompare, True)
    If cores < 4 Then
        Err.Raise 999, , "Supported only for system with at least 4 CPU cores"
    Else
        For I = 0 To cores - 2
            ThreadPool.Add New_c.RegFree.ThreadObjectCreate(CStr(I), DLL_FILE_PATH, DLL_CLASS_NAME, THREAD_PRIORITY_NORMAL)
        Next
        ReDim ThreadOperateRanges(0 To cores - 2)
    End If
End Sub
Private Sub Class_Terminate()
    ThreadPool.RemoveAll
    Set ThreadPool = Nothing
End Sub

---

Code:

---

Thread Calling Finished      22.26msec
Thread 0 Ended              820.89msec
Thread 1 Ended              821.60msec
Thread 2 Ended              822.10msec

---

Attachment 140653

I am trying to simulate a quicker synchrounous calling by using multi-thread technique provided by RichClient.

Finally. Not new. Edit this post away. :)

Sorry there is a format error and I can't correct it since I am "new" and not allowed for editting.

Compare results. It's not working.

Code:

---

Thread Calling Finished 119.73msec
Thread 0 Ended 3,659.41msec
Thread 1 Ended 4,491.96msec
Thread 2 Ended 4,780.21msec

Synchrounous Start 0.00msec
Synchrounous End 4,602.77msec

---

Code:

---

Thread Calling Finished 0.14msec
Thread 0 Ended 3,048.75msec
Thread 1 Ended 6,056.63msec
Thread 2 Ended 6,058.44msec
Synchrounous Start 0.00msec
Synchrounous End 4,754.38msec

---

Olaf, I have tried a different way, still there is no performance gain at all. :(

Same stuff in the ActiveX DLL Project, but VBA project this time is different:

In the Workbook module:

Code:

---

Private WithEvents p As cThreadPool
Sub Test2()
    Set p = New cThreadPool

    Dim v As Variant
    v = Selection.Cells.Value
    'get a variant array with several millions of rows and 2 columns

    New_c.Timing True
    Dim i As Long, k As Long
    Debug.Print "Synchrounous Start", New_c.Timing
    For k = 1 To 5
        For i = LBound(v, 1) To UBound(v, 1)
            v(i, 2) = InStr(1, v(i, 1), "manuf", vbTextCompare)
        Next
    Next
    Debug.Print "Synchrounous End", New_c.Timing

    New_c.Timing True
    Debug.Print "Asynchrounous Start", New_c.Timing
    p.InstrAccelerated v, "manuf", vbTextCompare
    'process
   

End Sub
Private Sub p_MethodFinished(ResultData As Variant)
    Debug.Print "Asynchrounous End", New_c.Timing
    'Selection.Cells.Value = ResultData
End Sub

---

In the cThreadPool Module:

Code:

---

Option Explicit

Private Const DLL_FILE_PATH As String = "C:\Users\Administrator\Desktop\cThread\cThread3.dll"
Private Const DLL_CLASS_NAME As String = "cAccelerator"

Public Event MethodFinished(ResultData As Variant)
Private ThreadInstances As cCollection
Private ThreadOperateRanges() As tpOperateRange
Private Type tpOperateRange
    Start As Long
    End As Long
End Type
Private ThreadFinishedMethods() As Boolean
Private Data As Variant
Private Sub Class_Initialize()
    Dim cores As Long, i As Long, NewThreadInstance As cThreadWrapper
    cores = New_c.GetCPUCoresCount
    Set ThreadInstances = New_c.Collection(False, BinaryCompare, True)
    If cores < 4 Then
        Err.Raise 999, , "Supported only for system with at least 4 CPU cores"
    Else
        For i = 0 To cores - 2
            Set NewThreadInstance = New cThreadWrapper
            NewThreadInstance.CreateThread Me, i, DLL_FILE_PATH, DLL_CLASS_NAME
            ThreadInstances.Add NewThreadInstance
            Set NewThreadInstance = Nothing
        Next
        ReDim ThreadOperateRanges(0 To cores - 2)
        ReDim ThreadFinishedMethods(0 To cores - 2)
    End If
End Sub
Private Sub Class_Terminate()
    ThreadInstances.RemoveAll
    Set ThreadInstances = Nothing
End Sub
Friend Sub ThreadWrapperCallback(Idx As Long)
    Dim i As Long
    ThreadFinishedMethods(Idx) = True
    For i = LBound(ThreadFinishedMethods) To UBound(ThreadFinishedMethods)
        If Not ThreadFinishedMethods(i) Then Exit Sub
    Next
    RaiseEvent MethodFinished(Data)
End Sub
Private Sub GetOperateRange(RangeStart As Long, RangeEnd As Long)
    Dim RangeTotalLength As Long, RangeAverageLength As Long, RangeCurStart As Long, i As Long
    RangeTotalLength = RangeEnd - RangeStart
    RangeAverageLength = CLng(RangeTotalLength / ThreadInstances.Count)
    RangeCurStart = RangeStart
    For i = LBound(ThreadOperateRanges) To UBound(ThreadOperateRanges)
        ThreadOperateRanges(i).Start = RangeCurStart
        ThreadOperateRanges(i).End = RangeCurStart + RangeAverageLength
        RangeCurStart = RangeCurStart + RangeAverageLength + 1
    Next
    ThreadOperateRanges(UBound(ThreadOperateRanges)).End = RangeEnd
End Sub
Public Sub InstrAccelerated(SourceData As Variant, Find As String, CompareMethod As VbCompareMethod)
    Dim ThreadWrapper As cThreadWrapper, i As Long
    Data = SourceData
    GetOperateRange LBound(Data, 1), UBound(Data, 1)
    For i = 0 To ThreadInstances.Count - 1
        Set ThreadWrapper = ThreadInstances.ItemByIndex(i)
        ThreadWrapper.AccelerateInStr _
                    VarPtr(Data), _
                    ThreadOperateRanges(i).Start, _
                    ThreadOperateRanges(i).End, _
                    Find, CompareMethod
    Next
End Sub

---

In the cThreadWrapper Module:

Code:

---

Option Explicit

Public WithEvents TH As cThreadHandler
Private ThreadPool As cThreadPool, ThreadIdx As Long
Public Sub CreateThread(ByThreadPool As cThreadPool, ByVal ThreadIdxZeroBased As Long, _
                        ByVal ThreadLibPath As String, ByVal ThreadClass As String)
    ThreadIdx = ThreadIdxZeroBased
    Set ThreadPool = ByThreadPool
    Set TH = New_c.RegFree.ThreadObjectCreate(ObjPtr(Me), ThreadLibPath, ThreadClass)
End Sub
Private Sub Class_Terminate()
    If Not TH Is Nothing Then TH.WaitForEmptyJobQueue
    Set TH = Nothing
End Sub
Public Sub AccelerateInStr(pData As Long, _
                            RangeStart As Long, _
                            RangeEnd As Long, _
                            Find As String, _
                            CompareMethod As Long)

    If Not TH Is Nothing Then TH.CallAsync "AccelerateInStr", _
      pData, _
      RangeStart, _
      RangeEnd, _
      Find, _
      CompareMethod
End Sub
Private Sub TH_MethodFinished(MethodName As String, Result As Variant, ErrString As String, ErrSource As String, ByVal ErrNumber As Long)
    ThreadPool.ThreadWrapperCallback ThreadIdx
End Sub

---

No performance gain at all.. Maybe a little but I really think it's because I tested Synchorounous method first...

Code:

---

Synchrounous Start          0.00msec
Synchrounous End            3,247.98msec
Asynchrounous Start          0.00msec
Asynchrounous End            3,022.75msec

---

I start to think that the VARIANT can only be accessed by a single thread at a time.

I have tried yet another testing. This time, there is no passing Variant pointer. Just trying to generate some data:

Code:

---

Public Sub GenerateData()
    Dim i As Long, str As String
    For i = 1 To 9999999
        str = i
    Next
End Sub

---

I run GenerateData synchrounously for 3 times, and record time. Then I use 3 threads each of which runs GenerateData for 1 time simultaneously. The result is still not satisfying, but there is some improvements:

Code:

---

Synchrounous Start          0.00msec
Synchrounous End            4,929.96msec

Asynchrounous Start          0.00msec
Asynchrounous End            3,388.14msec

---

I thought that running 3 threads to generate the same amount of data would only take approximately 1/3 time. But it turned out to be only slightly faster.

To process same variant array, there is no time saved, however.

so 30% faster by using 3 threads instead of 1. Are you saying that's not as good as it should be?
What CPU model do you have?

Tested on both AMD Athlon X4 730 Quad Core and Intel Core i5-3210M.

I used GetCPUCoresCount method here. In both cases I got a return value of 4.

30% faster is only when the threads are generating their own data rather than operating on a same variant structure (by passing pointer of the variant accross threads) . The latter proved to be no performance gain at all.

Quote:

---

To avoid unnecessary allocations (or copying) there's several approaches:

1) allocate (ReDim) the large Array once (in the Main-Thread)
1.1) pass only the Pointer to that Array (and its dimensions) into your ThreadClass
1.2) span a virtual Array over that pointer (using SafeArray-techniques)
1.3) important is, that from within the thread, you "unbind" the virtually spanned Array again at the end of processing

---

I guess I have misunderstood Olaf's explanation at some point. The line 1.2) span a virtual Array over that pointer (using SafeArray-techniques) doesn't simply mean:

Code:

---

    CopyMemory ByVal VarPtr(vDataHolder), ByVal pData, VARIANT_STRUCTURE_LENGTH

    For i = RangeStart To RangeEnd
        vDataHolder(i, 2) = InStr(1, vDataHolder(i, 1), Find, CompareMethod)
    Next

---

The threads might be trying to read the same area of memory. Not might be, they ARE reading the same area. So then the threads have to wait on each other resulting performance same or worse than a single thread execution?

You were already on the right path in your posting #35...
(where you reached about 800msec in each of your three async-started threads) -

And if you have 4 CPU-Cores you could cut that time to about 600msec
(in each of 4 workerthreads) - which would be faster than your current timings...

The only tasks remaing would be:
- to make the main-thread wait synchronously until each of the 4 threads is finished (New_c.Sleep + Doevents)
- and another boost could come from, when you get the Array-Spanning right

Your Variant-based "kind of Array-Spanning" does work as it is, but this way
you will access your 2D-Variant-Array through another layer of indirection, which will cost time...

I will post a short example for that tomorrow...

Olaf

Please look at the results here, Synchrounous call is 200msec faster actually.

Code:

---

'Data was splitted into 3 parts each processed by a unique thread
'And when they all finished, the stopwatch said 4780msec
Thread Calling Finished 119.73msec
Thread 0 Ended 3,659.41msec
Thread 1 Ended 4,491.96msec
Thread 2 Ended 4,780.21msec

'Data was not splitted and was processed all together by the main thread
'It was quicker than asynchronous methods
Synchrounous Start 0.00msec
Synchrounous End 4,602.77msec

---

This result is more bizzarre... suddenly the asynchrounous method cost 2000msec more. I guess my CPU hasn't truly got 4 cores even though GetCPUCoresCount says 4. When it hasn't got 4 cores, I assume 4 threads will just clog the processing... And the synchrounous call stays same performance.

Code:

---

Thread Calling Finished 0.14msec
Thread 0 Ended 3,048.75msec
Thread 1 Ended 6,056.63msec
Thread 2 Ended 6,058.44msec
Synchrounous Start 0.00msec
Synchrounous End 4,754.38msec

---

10~30% percent performance gain is not what I am really after .. I need much much speedier.

Before we dive into threading... a simple question first:

Are you aware, that XL-Ranges which are transferred into Variant-Arrays
will work best - when those Variant-Arrays are correctly typed as such?

What I mean is:
Dim VArr() As Variant
VArr = WS.Range("A1:XX100000")

instead of your current (note the missing braces):
Dim VArr As Variant
VArr = WS.Range("A1:XX100000")

With such properly flagged Variant-Arrays, I can do:
1Mio Instr-Tests in about 100msec (directly in VBA and singlethreaded)

Here's my result-ScreenShot for 1 Mio String-Cells (the second timing is for reassigning the Instr-Result-Array back to XL)
http://vbRichClient.com/Downloads/XLInstrResult.png

Here's my test-code (put it into a WorkBook-CodeModule):

Code:

---

Option Explicit

Const TestCount As Long = 1000000 '1Mio entries in Column A
Private WS As Worksheet, T1 As Single, T2 As Single

Private Sub Workbook_Open()
  Set WS = Me.ActiveSheet
 
  Dim VArrIn(), VArrOut()
  If WS.Range("A1").Value = Empty Then CreateTestData VArrIn
 
  VArrIn = WS.Range("A1:A" & TestCount).Value 'read Inp-Arr from XL-Range
 
  T1 = Timer
    DoInstrSearchOn VArrIn, VArrOut, "longer Test", vbBinaryCompare
  T1 = Timer - T1
 
  T2 = Timer
    WS.Range("B1:B" & UBound(VArrOut)).Value = VArrOut
  T2 = Timer - T2
 
  MsgBox "InStr-Looping: " & Format$(T1 * 1000, "0msec") & vbLf & _
        "XL-Range-Put: " & Format$(T2 * 1000, "0msec")
End Sub

Private Sub CreateTestData(VArrIn())
  ReDim VArrIn(1 To TestCount, 1 To 1)
    Dim i As Long
    For i = 1 To UBound(VArrIn)
      VArrIn(i, 1) = "A somewhat longer Test-String " & i
    Next
  WS.Range("A1:A" & TestCount).Value = VArrIn
End Sub

Private Sub DoInstrSearchOn(VArrIn(), VArrOut(), sFind As String, ByVal Compare As VbCompareMethod)
  ReDim VArrOut(1 To UBound(VArrIn), 1 To 1)
  Dim i As Long
  For i = 1 To UBound(VArrIn)
    VArrOut(i, 1) = InStr(1, VArrIn(i, 1), sFind, Compare)
  Next
End Sub

---

Olaf

Attachment 140809

Testing on my side. Seems that putting the data back cost much more time than it did on your side.

About the correctly typed Variant, I wasn't aware. Well it made sense because it looked like I had added another layer of indirection ...

It is a great tip.:p

I made some modifications to your example that I removed the parentheses both in the variable declaration and param declaration of DoInstrSearchOn. And here is what I got:

Attachment 140811

The execution time is hugely improved.

However it's not entirely true with my previous program where I don't have to pass the Variant to a function:

Code:

---

   

    Dim v() As Variant
    'Or Dim v as Variant

    Set rg = Range("A1:B1000000")
    v = rg.Value

    New_c.Timing True
    Dim i As Long, k As Long
    Debug.Print "Synchrounous Start", New_c.Timing
    For i = LBound(v, 1) To UBound(v, 1)
        v(i, 2) = InStr(1, v(i, 1), "manuf", vbTextCompare)
    Next
    Debug.Print "Synchrounous End", New_c.Timing

---

Code:

---

'Without parentheses
Synchrounous Start          0.00msec
Synchrounous End            1,043.29msec

'With parentheses
Synchrounous Start          0.00msec
Synchrounous End            910.49msec

---

Guess it has to have something with the param passing here. Not exactly know how and why.

Well proved not the case .. it has something to do with vbTextCompare, or 1Million is not large enough ..

Code:

---


v(i, 2) = InStr(1, v(i, 1), "manuf", vbBinaryCompare)

'Without parentheses
Synchrounous Start          0.00msec
Synchrounous End            162.92msec

'With parentheses
Synchrounous Start          0.00msec
Synchrounous End            281.22msec

---

Anyway since the focus here is to use multithreading to boost speed of operation on a Variant Array, this correct typing negligence of mine can be conveniently neglected:p

If there is anything bigger than that in my code, I'd love to be told. Thanks for the tip. Again.

I am not so sure about multithreading now. If one wants to improve program performance, the first thing to look at is not multithreading, but rather, the algorithm, data structure, or overall desgin.

Multithreading is useful for something entirely seperated like UI and a background worker.

Olaf, I can't find such a method in vbRichClient:

Quote:

---

The only tasks remaing would be:
- to make the main-thread wait synchronously until each of the 4 threads is finished (New_c.Sleep + Doevents)

---

It would be nice if you could add it to the library ...

Quote:

---

Originally Posted by Resurrected

Olaf, I can't find such a method in vbRichClient:

Quote:

---

The only tasks remaing would be:
- to make the main-thread wait synchronously until each of the 4 threads is finished (New_c.Sleep + Doevents)

---

It would be nice if you could add it to the library ...

---

The correct method-name is: New_c.SleepEx

As for waiting till an amount of threads are finished
(assuming you have a dedicated ThreadPoolClass written):

Code:

---

' within your own cThreadPool-ParentClass, ...
' which starts e.g. 4 instances of cWorkerThreadWrapper...
' each cWorkerThreadWrapper delegating from its own ThreadFinished-Event...
' back into this cThreadPool-ParentClass

Public Sub StartWorkerThreadsAsyncWith(JobParams)
  mFinishedCount = 0
  For i = 1 to mCPUCoreCount 'start as many workers, as there are CPU-Cores
    '... start WorkerThreads asynchronously
  Next
 
  Dim T#: T = New_c.HPTimer
  Do Until mFinishedCount = mCPUCoreCount Or New_c.HPTimer - T > 10 '<- seconds TimeOut
    New_c.SleepEx 10
    DoEvents
  Loop
 
  If mFinishedCount = mCPUCoreCount Then 'all Threads succeeded/are finished
    'return processed results and update the GUI or XL-Sheet with them
  Else 'TimeOut was reached
    'show TimeOut-Err-Message
  End If
End Sub

'Parent-callback-stub, which is called from within the Thread-Finished-Events of the Workers
Public WorkerThreadIsFinished(Sender As cWorkerThread)
  mFinishedCount = mFinishedCount + 1
End Sub

---

But what I still don't see is, how any threading would make much sense in your scenario.
Considering that there are two parts:
1) Performing the Instr-Results on huge (splitted across threads) Variant-Arrays
2) Transferring the huge Variant-Arrays back to an Excel-Sheet

Part 1 needs about 200msec, Part 2 needs about 2seconds (about factor 10 more time than part1).

What you could gain from "ideal threading" (e.g. across 4 CPU-Cores) is only:
An reduced time for part 1 --> now being 50msec instead of 200msec.

In addition you would not gain much since the total time is:
2.20 seconds without any threading
2.05 seconds with threading

Olaf

Hi for all.
I read the example of Olaf (Hello World) with the cThread class.
I ask a question, certainly trivial but I did not understand.:confused:
The synchronous call of a function of a thread is like calling a VB6 function. So why use a thread for this?
What I thought was that a thread was useful only for asynchronous calls, but looking at the examples it does not seem that way. What are the advantages: speed, efficiency, what else?
Thanks

Can I use for database queries?

Quote:

---

Originally Posted by VBDevelopper

Hi for all.
I read the example of Olaf (Hello World) with the cThread class.
I ask a question, certainly trivial but I did not understand.:confused:
The synchronous call of a function of a thread is like calling a VB6 function. So why use a thread for this?

---

A proper VB6-thread "lives as a Public AX-Dll-Class on an STA".

So, since this kind of threading requires an entire Class anyways (and not only a single "thread-function", as in "free threading"),
why not use this Thread-Class to also provide it with "initial state" (from the Main-Thread once, stored in the Class' Private Vars).

This eases the amount on "Param-Arguments to pass and transfer with Async-Function-Calls".

So, to transfer initial state to an upfired Thread-Class in the Init-Phase (shortly after instantiating the Class on its new thread),
one might want to transfer such state to it directly in the Init-Function to those "internal State-Private-Vars".
And the sync-calls will ease your efforts in that regard because you can ensure (in the clientside Init-Function-call itself)
that the Init-Params (as e.g. a Connection-String to your DB) were properly received by the ThreadClass...
(without having to wait for an Event, to be sure the Init-state was received by the ThreadClass).

@ChenLin
Yes, you can use it for DB-Queries.

Olaf

Hi Olaf.
Thank you for replay.
I'll ask you another trivial question.
What does STA mean? Single Thread Apartment?

Also
I made a change to your project by adding a new function in the class cThread.

Code:

---

Public Function DoubleF(S As Integer) As Integer
  DoubleF = S * 2
End Function

---

and I tried to call it that way:

Code:

---

    Dim StrResult As String, ThreadID As Long
    Cls
    Print Now; " (ThreadID of the Main-Thread: " & App.ThreadID & ")"; vbLf
    Print "Let's perform a few calls against the ThreadClass which now runs on its own STA "; vbLf
    'first we do synchronous Calls against the Thread-Instance, which was created regfree in Form_Load
    StrResult = TH.CallSynchronous("StringReflection", "ABC")
    Print "Direct (synchronous) StringReflection-Call with result: "; StrResult
    ThreadID = TH.CallSynchronous("GetThreadID")
    Print "Direct (synchronous) GetThreadID-Call with result: "; ThreadID; vbLf
    'now the calls, which are more common in threading-scenarios - the asynchronous ones, which don't
    'make the caller wait for the result (instead the results will be received in the Event-Handler below)
    TH.CallAsync "StringReflection", "ABC"
    TH.CallAsync "GetThreadID"
    Dim intResult As Integer
    intResult = TH.CallSynchronous("DoubleF", 10)
    Print "intResult"; intResult
    Print "The two async calls were send (now exiting the Form_Click-routine)..."; vbLf

---

and I get an error.
Why?:confused:

Hi Olaf,

I've created a thread dll that executes another program (multiple times) via CreateProcess/WaitForSingleObject/TerminateProcess.

This works fine until I try to abort it from my wrapper class via TH.CancelExecution; this crashes the app almost always in the IDE and fairly often when compiled.

I can post code to replicate this, if needed, but I suspect you may already know why; is it likely to be related to the thread handles associated with the Process I created (tried with InheritHandles set to both 1& and 0&)

Cheers,

Colin

EDIT: Forgot to add; the code to run the external program works perfectly fine outside of the dll. It's been in use for a long time without ever causing any crashes.

EDIT2: Threw something together that illustrates the problem with a simple BAT file as the external program

Attachment 169663

UPDATE:

The CreateProcess aspects to my sample project are a bit of a red herrring, it turns out, as I've since observed that any thread that is exited whilst inside a loop is susceptible to this crashing. I even tried to replace my For/Next loop with a recursive call (to match your DirScan demo, which does the same), and it remained unstable, particularly when cancelled straight away. If the job is allowed to run to completion at least once, it appears to be less prone to crashing if subsequent runs are cancelled, though I'm not sure what that tell us, precisely...

Quote:

---

Originally Posted by ColinE66

...it turns out, as I've since observed that any thread that is exited whilst inside a loop is susceptible to this crashing.

---

Was not able to reproduce that on either Win8.1 nor Win10 - but got "successful" on WinXP...

Studying the code in your ThreadDll (JobRunner.dll) - I was able to prevent the crashes, by adding
an additional CancelCheck-line into your Main-Loop:

Code:

---

Public Sub Test(pCommand As String)
Dim i As Long

  mCancelled = False
  For i = 1 To 20
      If Cancelled Then Exit Sub
      RaiseEvent Iteration(i)
      ExecCmd pCommand
  Next i

  RaiseEvent JobComplete

End Sub

---

The idea behind it being simply, to *prevent* the ThreadHandler-mechanism, to send "any more events after an external cancelling"
(via the Named-Pipe I use underneath for communication)...

Since a clientside CancelExecution will (in addition to setting a "Cancel-Flag" in shared memory) also close the "communication-channel" (the "old pipehandle") -
followed by re-opening a new pipe-handle immediately after that (for the next call of a "Public Main-Routine" in your Server-Dll).

I assume, that an attempt to use the (already closed, or "marked for close") "old pipe-handle" (by trying to send Event-Data over it from the server-side),
is causing the crashes (at least on XP - probably also on Vista and Win7).

Will try to look into it, when I find time (to make it more bullet-proof, ignoring Event-Send-Requests when the Thread-Handler-Classes are in "CancelExecution-state") -
though the best way to prevent these crashes seems to me, to really make sure to leave the "Main-Public-Function" as early as possible, when an outside Cancelling was detected
(no matter how deep you were in some private Sub-Routines - the Cancel-Exits should be honored "further up the stack" as early as possible as well...).

Addition:
Looking further at the code in your threaded JobRunner.dll, I've seen that you're waiting for
5000msec (5seconds) for the shelled process in question to be finished (via WaitForSingleObject).
During that time, the thread will not be able to detect outside cancelling -
and that "clashes" with: TH.TimeoutSecondsToHardTerminate (which is by default at 3seconds).

Hard thread-termination (via TerminateThread-API, which is called under the covers when TH goes out of scope) needs to be avoided -
better would be, to allow the thread to close "gracefully" - by ensuring a TH.TimeoutSecondsToHardTerminate
which is greater than the "maximum-time the thread-dll-class cannot react to outside cancel-signalling".

And another idea would be (since you already use other processes to do the actual work, which are by definition "asynchronous"),
to not use any threading-helpers at all - instead a simple "Process-Pool-Class" could be enough, which checks via an internal timer,
whether the "shelled processes" are finished with their Job(s) - or not).

Here a simple "wireframe-class" you could expand on, making some experiments:
(the workhorse here is the Helper-Object, which is returned by Wsh.Exec(CmdLine)...

Code:

---

Option Explicit
 
Private Wsh As Object, Processes As New Collection
Private WithEvents tmrCheckProcesses As cTimer

Private Sub Class_Initialize()
  Set Wsh = CreateObject("WScript.Shell")
  Set tmrCheckProcesses = New_c.Timer(100, True)
End Sub

Public Sub AddAndExec(ByVal CmdLine As String)
  Processes.Add Wsh.Exec(CmdLine)
End Sub

Private Sub tmrCheckProcesses_Timer()
  Const WshRunning = 0, WshFinished = 1, WshFailed = 2
  Dim i As Long, P As Object
 
  On Error Resume Next
 
    For i = Processes.Count To 1 Step -1 'loop backwards, to be able to delete from the Collection
      Set P = Processes(i)
      Select Case P.Status
        Case WshRunning
          'set a flag to the outside, or something, signalling this state
        Case WshFinished 'successful finishing
          Processes.Remove i 'a normal remove from the collection should be enough
        Case WshFailed
          Processes.Remove i 'remove this from the Col as well,
          P.Terminate 'but just in case the process is still linering, try to terminate it as well
         
          'If P.ExitCode = SomeValue Then
            'just to hint at another property, the Wsh-Process-Object offers
          'End If
      End Select
    Next
   
  If Err Then Err.Clear
End Function

---

HTH

Olaf

Quote:

---

Originally Posted by Schmidt

Was not able to reproduce that on either Win8.1 nor Win10 - but got "successful" on WinXP...

---

Win 10 here...

Quote:

---

Originally Posted by Schmidt

Since a clientside CancelExecution will (in addition to setting a "Cancel-Flag" in shared memory)

---

Funnily enough, that's how I managed to get around the crashes whilst waiting for you to reply. I added an mAbort flag inside my wrapper class and pass VarPtr(mAbort) to the dll. From there, of course, I can see when that value is changed on the outside and act accordingly; in my case just skipping over the 'aborted' jobs (a matter of milliseconds) and allowing things to shut down as gracefully as would have occurred in a normal 'job complete' scenario.

It actually works well enough for me to not need brute-force cancellations, though it would be welcome if you can 'toughen things up' a bit in this regard.

Oh, and thanks for WScript.Shell suggestion; may explore that approach on some other occasion...

Quote:

---

Originally Posted by ColinE66

... thanks for WScript.Shell suggestion; may explore that approach on some other occasion...

---

The Process-encapsulating Object, which is returned by Wsh.Exec is quite capable -
since it supports even StdIn, StdOut and StdErr of the Process it is attached to (which might come in handy, with that VideoDecoding-stuff I guess)...

Here is a Page, where the thing is documented:
https://docs.microsoft.com/en-us/pre...28v%3dvs.84%29
(Property-Listing at the bottom).

Regards,

Olaf

Hmmm, that does look interesting as I've recently replaced a lot of my code with equivalent FFmpeg functionality. I should be able to read image byte streams from StdError (where FFmpeg writes to, for some unknown reason) via a pipe with this WScript shell thingy, if I've understood that right?

Quote:

---

Originally Posted by ColinE66

Hmmm, that does look interesting as I've recently replaced a lot of my code with equivalent FFmpeg functionality. I should be able to read image byte streams from StdError (where FFmpeg writes to, for some unknown reason) via a pipe with this WScript shell thingy, if I've understood that right?

---

To be precise, it's not the WshShell-Object I'm talking about,
but the (Process-representing) Object, which is returned by the .Exec-Method of the WshShell-Object.

In the example further above, I've added these Process-Objects into a normal VB-Collection:
Processes.Add Wsh.Exec(CmdLine)

But you can of course experiment with it in an isolated fashion as well:
Dim P As Object
Set P = Wsh.Exec(CmdLine)
...
VBByteArray = P.StdOut.ReadAll
or
VBByteArray = P.StdErr.ReadAll

should work IMO ... never used these Pipe-reading capabilites in a production-app,
so cannot tell where the quirks are... only tested StdOut at some time with a simple Ping-Command.

There's some examples, when you google around - e.g. here:
https://stackoverflow.com/questions/...ut-from-stdout

The StdIn/Out/Err-Props and methods seem to be compatible to the TextStream-object:
https://docs.microsoft.com/en-us/pre...28v%3dvs.84%29

Regards,

Olaf