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?
Printable View
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.
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: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
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?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
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.
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:'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
10~30% percent performance gain is not what I am really after .. I need much much speedier.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
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):
OlafCode: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
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
Guess it has to have something with the param passing here. Not exactly know how and why.Code:'Without parentheses
Synchrounous Start 0.00msec
Synchrounous End 1,043.29msec
'With parentheses
Synchrounous Start 0.00msec
Synchrounous End 910.49msec
Well proved not the case .. it has something to do with vbTextCompare, or 1Million is not large enough ..
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:pCode:
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
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:
It would be nice if you could add it to the library ...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)
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):
But what I still don't see is, how any threading would make much sense in your scenario.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
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?
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.
and I tried to call it that way:Code:Public Function DoubleF(S As Integer) As Integer
DoubleF = S * 2
End Function
and I get an error.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
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...
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:
The idea behind it being simply, to *prevent* the ThreadHandler-mechanism, to send "any more events after an external cancelling"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
(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
Win 10 here...Quote:
Originally Posted by Schmidt
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.Quote:
Originally Posted by Schmidt
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...
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?
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
Just had a little play. WSH.Exec would be perfect if it weren't for the fact that it spawns a command window. The only ways I've seen of suppressing that would prevent the cCollection from being populated with the processes, it seems.
Unless you have any ideas in that regard, it looks like a non-starter...
Shame.