Hello all.  I know you're not suppose to really do multithreading in VB6,
but I really need to.  I've tried ActiveX EXE threads, where you make a
separate EXE for your threads, but they take a lot of CPU time for some
reason.  Overhead maybe?  I've tried some multithreading examples on Planet
Source Code (great place!), but I've only been able to start threads, not
get data back from them.  I need to be able to do things like network Pings,
etc.

Is there a good solution to this problem?  I found something called Thread
Factory (http://www.halfx.com), but is it any good?  They boast all this
stuff about marshalling, an OCX interface, written in C++/ASM, etc.
Desaware also has something called SpyWorks that's suppose to do
multithreading, but there's not much about it.  It's really expensive too,
compared to the Thread Factory anyway.  I found a few others, but they were
ActiveX EXE's.

I want something easy and efficient.  Can anyone recommend something?

Thanks!

Hi,

Keep in mind that multithreading (or multiprogramming or multitasking, where
you are talking about) takes always a lot of extra overhead.

Therefore as that is something you want to avoid, then think before you
begin.

Multitasking is only effect full in areas where you can by instance download
something form Internet and print that in the same time. Things which are
themselves slow.

Cor


Show quoteHide quote

You could use FreeBasic to make a standard DLL, and call it from VB with
"Declare". FreeBasic supports multi-threading. Doing the same in VB would
cause unpredictable behavior or crashes. See here:

http://www.desaware.com/tech/threading.aspx

http://www.freebasic.net/index.php/about?section=features

http://www.freebasic.net/wiki/wikka.php?wakka=CatPgThreading

You may have to refresh twice if you don't see anything in the two links
above.

Usually, multithreaded applications have one GUI thread, and one or more
worker or background threads. However, you have to be careful when accessing
shared resources, or global variables. That's because one high level
language line can be compiled into multiple machine code lines. For
instance, if you have:

If A > B Then
    A = A - B
    MsgBox "A is greater than B"
End If

The machine language code may look like this:

    Mov EAX, A ' Set EAX register(in the CPU, 32 bits) = A
    Cmp EAX, B ' Compare EAX with B, and saves the result to CPU's flags
    JNG End_IF    ' Goto(Jump) to End_IF if not greater than.
    Sub A, B    ' Subtract, A = A - B
    Call AddressOf MsgBox
End_IF:

If A = 5 and B = 3, and another thread switched in the middle of the IF
statement(after the first or second machine line code above) and changed A
to 2, then A<B and the message box is still shown, and A becomes
unexpectedly negative. Similar things happen when you use more than 32 bit
variables or values on a 32 bit CPU/OS, a simple addition/subtraction or
even assignment takes at least 2 instructions.

The solution is to design multithreading applications carefully.  You need
to read about "Thread synchronization" before accessing shared resources,
such as global variables. FreeBasic has some functions to handle this, but
see MSDN for background.

One other option without threads and delays is to use Raw sockets, but the
user who run your program must be a member of the Administrators group.
Search MSKB for "raw socket ping", or the web.

PRB: RAW Socket Access Denied to Non-Admin Windows NT 4.0 and Windows 2000
Users
http://support.microsoft.com/kb/195445

Another alternative is using IcmpSendEcho2(Windows 2000+). When using this
function, you have to use WaitForSingleObject() and similar functions, but
you don't have to wait forever. You can specify 0 for the time out interval,
so the function just checks if IcmpSendEcho2 finished and return
immediately. You can use WaitForSingleObject() in a Timer for instance.

IcmpSendEcho2 Function:
http://msdn.microsoft.com/en-us/library/aa366051(VS.85).aspx

asynchronous Fast multi ping
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=72116&lngWId=1

Submitted on: 5/29/2009

I guess you are lucky!

Thanks, I do have other needs for multithreading though.  There are other
network APIs that block that don't have asynchronous versions.  Such as
listing computers on a domain or a workgroup.  Depending on the type of
environment, that can take a LONG time, all the while my app. is locked.  :(

This project looked intereting:

http://planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=26900&lngWId=
1

(The 1 on the second line is part of the url)

I had never tried this before, but I was wondering if you had seen it, or
tried, and found that it failed.

Thanks, I just tried that and had trouble with it.  It seemed convoluted to
me.

BUT, good news.  I did some work with Thread Factory (halfx.com) and I got a
pretty good number of threads going for a simple ping with low CPU usage
even.  The only thing I need to look into more are what they're calling
"message pumps", so I can get data sent back during a thread's execution
rather than only after completion.

Weird thing though.  It says "March 2009 Spring Sale", but it's now June.  I
guess I'll email them and find out.

Just in case you want to give my free thread-helper-stuff a try...

I've just finished a small example, how to use it in conjunction
with your ping-scenario (but limited to 32 threads in the
threadpool). This threading-helper-lib is able, to queue Jobs
at the clientside - so, in the example below, I just do my loop
over the 1-255 subnet-entries and stuff 8 jobs into each
thread (queued).

The largest part regarding the codevolume is a small Ping-
class, that is used within the serverside (I refer to the
thread as the "server" or "the serverside") - the serverside
is just a plain AX-Dll, compiled with VB6.

If you want to bring the following code "to life", then you
will have to ensure a proper naming (read the comments)
for all classes and also the naming of the Dll is important.
Then make also sure, that everything is placed within
the same path (both VB-projects, the AX-thread-Dll,
called PingLib.dll - and also your VB-Std-Exe and *.vbp)
Before you run the clientside project, make sure, that
you compiled your thread-binary "PingLib.dll" beforehand.

The threading-support (and not only that) is contained
in my 3-dll-toolset, which you can read about and download
here: www.thecommon.net/3.html

Ok, here comes the code - it is able, to scan a 255er subnet
within 11seconds (ping-timeout at 1000msec in that case):


'*** A Public class "cThrd" (MultiUse(5)) in an AX-Dll: "PingLib.dll"
'*** also make sure, that this new Dll contains the private class
'*** "cPing" too - then compile that AX-Dll into your App.Path,
'*** into the same Folder, where your client-project+Exe resides

Option Explicit

Private oPing As cPing

Private Sub Class_Initialize()
  Set oPing = New cPing
End Sub

Public Function Ping(IPAddr As String, ByVal TimeOut_msec As Long)
Dim FriendlyResult As String, RoundTripTime As Long

  oPing.Ping IPAddr, FriendlyResult, RoundTripTime, TimeOut_msec

  'return our IPAddress, the RoundtripTime, and a potential err-info
  Ping = Array(IPAddr, RoundTripTime, FriendlyResult)
End Function

'that's it already - the server-class is "done"


'*** Now the client-handler-class, which "knows" your remote-Thread,
'*** and handles its state and actions from the clientside. Name
'*** this class "cPingJob" and include it into a normal Exe-project
Option Explicit

Private WithEvents TH As cThreadHandler 'this is actually our connection
Private CentralEventSink As cPingMessages 'here we just delegate results

Public Sub InitThread(TKey As String, PingMessages As cPingMessages)
  Set CentralEventSink = PingMessages 'set the internal delegator-object

  With New cRegFree 'and create our remote-thread
    Set TH = .ThreadObjectCreate(TKey, App.Path & "\PingLib.dll", "cThrd")
  End With
End Sub

Public Sub CancelExecution()
  TH.CancelExecution
End Sub

Public Sub QueuePingJob(IPAddress As String, ByVal TimeOut_msec As Long)
  TH.CallAsync "Ping", IPAddress, TimeOut_msec 'the call supports queueing
End Sub

Private Sub TH_MethodFinished(MethodName As String, Result As Variant, _
        ErrString As String, ErrSource As String, ByVal ErrNumber As Long)

  'as said, just the delegation
  CentralEventSink.RaiseCentralEvent TH.ThreadKey, Result(0), Result(1), _
                                     Result(2)
End Sub


'*** this additional class should also be included in your client-
'*** exe-project - it is only a central Event-Sink + delegator
'*** name it "cPingMessages"
Option Explicit

Event PingResults(ThreadKey As String, ByVal IPAddress As String, _
       ByVal RoundTripTime As Long, ByVal ResultString As String)

Public Sub RaiseCentralEvent(ThreadKey As String, _
           ByVal IPAddress As String, ByVal RoundTripTime As Long, _
           ByVal ResultString As String)

  'just the redirection into the hosting Form per centralized Event
  RaiseEvent PingResults(ThreadKey, IPAddress, RoundTripTime, _
                         ResultString)
End Sub


'*** and finally the last clientside code-module - our Form
'*** the naming of this form is not important
Option Explicit

'define 32 clientside Thread-Handler-Objects
Private ThreadHandlers(0 To 31) As cPingJob

'a central EventSink, which redirects Events from the ThreadPool above
Private WithEvents CentralEventSink As cPingMessages

Private T!, RetCount As Long '<-just to prove, that we don't miss a job

Private Sub Form_Load()
Dim i&, LeftIPPart As String
  KeyPreview = True
  Caption = "Subnet-Pings are in progress..."

  With Controls.Add("VB.ListBox", "LB")
    .Visible = True
    .Move 0, 0, ScaleWidth, ScaleHeight
  End With

  Set CentralEventSink = New cPingMessages

  For i = 0 To UBound(ThreadHandlers) 'initialize our pool
    Set ThreadHandlers(i) = New cPingJob
    ThreadHandlers(i).InitThread "Thread_" & i, CentralEventSink
  Next i

  LeftIPPart = "192.168.0."
  T = Timer: RetCount = 0 'this should result with 255 returned jobs in
total
  For i = 1 To 255 'and queue the ping-jobs for our whole subnet
    ThreadHandlers(i Mod 32).QueuePingJob LeftIPPart & i, 1000
  Next i
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim i&
  If Not KeyCode = vbKeyEscape Then Exit Sub

  For i = 0 To UBound(ThreadHandlers) 'press Esc, to cancel all jobs
    ThreadHandlers(i).CancelExecution
  Next i
End Sub

Private Sub CentralEventSink_PingResults(ThreadKey As String, _
      ByVal IPAddress As String, ByVal RoundTripTime As Long, _
      ByVal ResultString As String)
  RetCount = RetCount + 1
  Controls("LB").AddItem RetCount & " " & ThreadKey & " " & _
                         IPAddress & " " & RoundTripTime & _
                         " " & ResultString
  If RetCount = 255 Then Caption = "whole scan ready after: " & Timer - T
End Sub





'*** Ok, here comes the Ping-Class now, which finally does its
'*** work at the serverside too - I've just placed it at the end of the
'*** post, to not "break the flow". It has only one method, called Ping -
'*** just ensure, that this class is named "cPing" and included
'*** as a private class within your AX-PingLib.dll-project too.

'this class is a bit large, but it was just a copy'n-paste from the
'original MSDN-VB6-example, and some param-rearranging ...
'Within the PingLib.dll this class is defined private ...
'but it will also work outside the thread-library of course
Option Explicit

Private Const ICMP_SUCCESS As Long = 0
Private Const ICMP_STATUS_BUFFER_TO_SMALL = 11001
Private Const ICMP_STATUS_DESTINATION_NET_UNREACH = 11002
Private Const ICMP_STATUS_DESTINATION_HOST_UNREACH = 11003
Private Const ICMP_STATUS_DESTINATION_PROTOCOL_UNREACH = 11004
Private Const ICMP_STATUS_DESTINATION_PORT_UNREACH = 11005
Private Const ICMP_STATUS_NO_RESOURCE = 11006
Private Const ICMP_STATUS_BAD_OPTION = 11007
Private Const ICMP_STATUS_HARDWARE_ERROR = 11008
Private Const ICMP_STATUS_LARGE_PACKET = 11009
Private Const ICMP_STATUS_REQUEST_TIMED_OUT = 11010
Private Const ICMP_STATUS_BAD_REQUEST = 11011
Private Const ICMP_STATUS_BAD_ROUTE = 11012
Private Const ICMP_STATUS_TTL_EXPIRED_TRANSIT = 11013
Private Const ICMP_STATUS_TTL_EXPIRED_REASSEMBLY = 11014
Private Const ICMP_STATUS_PARAMETER = 11015
Private Const ICMP_STATUS_SOURCE_QUENCH = 11016
Private Const ICMP_STATUS_OPTION_TOO_BIG = 11017
Private Const ICMP_STATUS_BAD_DESTINATION = 11018
Private Const ICMP_STATUS_NEGOTIATING_IPSEC = 11032
Private Const ICMP_STATUS_GENERAL_FAILURE = 11050

Private Const INADDR_NONE As Long = &HFFFFFFFF
Private Const WSA_SUCCESS = 0
Private Const WS_VERSION_REQD As Long = &H101

Private Declare Function WSAStartup Lib "wsock32.dll" _
  (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long

Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Private Declare Function IcmpCloseHandle Lib "icmp.dll" _
  (ByVal IcmpHandle As Long) As Long

Private Declare Function inet_addr Lib "wsock32.dll" _
  (ByVal cp As String) As Long


Private Type WSADATA
   wVersion As Integer
   wHighVersion As Integer
   szDescription(0 To 256) As Byte
   szSystemStatus(0 To 128) As Byte
   iMaxSockets As Long
   iMaxUDPDG As Long
   lpVendorInfo As Long
End Type


Private Declare Function IcmpSendEcho Lib "icmp.dll" _
(ByVal IcmpHandle As Long, ByVal DestinationAddress As Long, _
  ByVal RequestData As String, ByVal RequestSize As Long, _
  ByVal RequestOptions As Long, ReplyBuffer As ICMP_ECHO_REPLY, _
  ByVal ReplySize As Long, ByVal Timeout As Long) As Long

Private Type IP_OPTION_INFORMATION
   Ttl             As Byte
   Tos             As Byte
   Flags           As Byte
   OptionsSize     As Byte
   OptionsData     As Long
End Type

Private Type ICMP_ECHO_REPLY
   address         As Long
   Status          As Long
   RoundTripTime   As Long
   DataSize        As Long
   Reserved        As Integer
   ptrData         As Long
   Options         As IP_OPTION_INFORMATION
   Data            As String * 250
End Type


Private Sub Class_Initialize()
Dim WSAD As WSADATA
   WSAStartup WS_VERSION_REQD, WSAD
End Sub

Private Sub Class_Terminate()
  WSACleanup
End Sub

Public Function Ping(sAddress As String, _
                Optional FriendlyResult As String, _
                Optional RoundTripTime As Long, _
                Optional ByVal TimeOut_msec As Long = 1000) As Long
Dim hIcmp As Long, lAddress As Long, Reply As ICMP_ECHO_REPLY
Const sPing$ = "hello"

  lAddress = inet_addr(sAddress)
  If (lAddress = -1) Or (lAddress = 0) Then Exit Function

  hIcmp = IcmpCreateFile()
  If hIcmp = 0 Then Exit Function

  IcmpSendEcho hIcmp, lAddress, sPing, Len(sPing), 0, _
               Reply, Len(Reply), TimeOut_msec

  If Reply.Status = ICMP_SUCCESS Then
    Ping = True
    RoundTripTime = Reply.RoundTripTime
  Else
    RoundTripTime = -TimeOut_msec
  End If

  FriendlyResult = EvaluatePingResponse(Reply.Status)

  IcmpCloseHandle hIcmp
End Function


Private Function EvaluatePingResponse(PingResponse As Long) As String
  Select Case PingResponse

    Case ICMP_SUCCESS: EvaluatePingResponse = "Success!"

    'Some error occurred
    Case ICMP_STATUS_BUFFER_TO_SMALL
      EvaluatePingResponse = "Buffer Too Small"
    Case ICMP_STATUS_DESTINATION_NET_UNREACH
      EvaluatePingResponse = "Destination Net Unreachable"
    Case ICMP_STATUS_DESTINATION_HOST_UNREACH
      EvaluatePingResponse = "Destination Host Unreachable"
    Case ICMP_STATUS_DESTINATION_PROTOCOL_UNREACH
      EvaluatePingResponse = "Destination Protocol Unreachable"
    Case ICMP_STATUS_DESTINATION_PORT_UNREACH
      EvaluatePingResponse = "Destination Port Unreachable"
    Case ICMP_STATUS_NO_RESOURCE
      EvaluatePingResponse = "No Resources"
    Case ICMP_STATUS_BAD_OPTION
      EvaluatePingResponse = "Bad Option"
    Case ICMP_STATUS_HARDWARE_ERROR
      EvaluatePingResponse = "Hardware Error"
    Case ICMP_STATUS_LARGE_PACKET
      EvaluatePingResponse = "Packet Too Big"
    Case ICMP_STATUS_REQUEST_TIMED_OUT
      EvaluatePingResponse = "Request Timed Out"
    Case ICMP_STATUS_BAD_REQUEST
      EvaluatePingResponse = "Bad Request"
    Case ICMP_STATUS_BAD_ROUTE
      EvaluatePingResponse = "Bad Route"
    Case ICMP_STATUS_TTL_EXPIRED_TRANSIT
      EvaluatePingResponse = "TimeToLive Expired Transit"
    Case ICMP_STATUS_TTL_EXPIRED_REASSEMBLY
      EvaluatePingResponse = "TimeToLive Expired Reassembly"
    Case ICMP_STATUS_PARAMETER
      EvaluatePingResponse = "Parameter Problem"
    Case ICMP_STATUS_SOURCE_QUENCH
      EvaluatePingResponse = "Source Quench"
    Case ICMP_STATUS_OPTION_TOO_BIG
      EvaluatePingResponse = "Option Too Big"
    Case ICMP_STATUS_BAD_DESTINATION
      EvaluatePingResponse = "Bad Destination"
    Case ICMP_STATUS_NEGOTIATING_IPSEC
      EvaluatePingResponse = "Negotiating IPSEC"
    Case ICMP_STATUS_GENERAL_FAILURE
      EvaluatePingResponse = "General Failure"

    Case Else: EvaluatePingResponse = "Unknown Response"

  End Select
End Function



HTH

Olaf

Thanks Schmidt!  I will look into that as well.  I'm still learning about
thread pools, but is there a reason it's limited to 32?

By the way, I really enjoyed your comebacks.  Very sharp.

Someone mentioned that this is a VB group and so VB.NET can be discussed
here.  But then what is microsoft.public.dotnet.languages.vb?  I guess you
can talk about VB.NET in vb.general.discussion, but we can't talk about VB6
in the dotnet group?  :)


Show quoteHide quote

As already mentioned - VB-threads are a bit heavy-weight,
because of setting up the thread-local-storage (TLS) and the
single-threded-apartment (STA) stuff beforehand on the just
started thread, followed by the instantiation of a COM-
class which is hosted within that "enhanced environment" on
that thread.

Therefore the (reduced) threadpool, which is created once -
a single thread-object-instantiation takes about 10-15msec -
suming up to a small delay of around 0.5sec on App-Startup
(32 threads are started, before the Form in my example
becomes visible).
Talking to the threads (once they are created) is fast - and
also the performance *within* such a thread (working on
a job) is the same as with other thread-implementations.

Therefore it makes sense, to let these threads live as long
as the app lives - a thread acts more like a server then
(and it is hosting in fact such a server - the instantiated
COM-Server-Class - from your small thread AX-Dll).

You can provide such a "remotely running" server-class from
the clientside with new Job-Parameters - and from within
your server-class' Method (which thereby was triggered),
you can raise back normal VB-Events if you need that -
and also (finally) the results of asynchronous Method-Calls.
But also synchronous Method-Calls against the Server-
class are possible from the clientside.
And since my thread-helper-implementation is acting
more client/server-like due to the nature of VBs STA-
threads, I thought - why not make the best out of it,
and also add multi-client-capabilities, meaning more than
one client can connect to - and queue Jobs against such a
already running server-thread(or class) - and these clients
can be hosted either in different client-classes within the
same App(process) - or within different Apps(processes)!
That means, that my helper-approach is also usable
for Interprocess-communication, not only for inter-
thread-communication within a normal VB-Exe.

The only thing, a client-class (internally using the
clientside helperobject TH As cThreadHandler) needs
to know, to be able to connect to a running server-thread -
no matter in what process the thread is running -
is the ThreadKey - a normal String-param, which you
can define yourself during creation of a (server-)thread.

And regarding ThreadPools...
The term "ThreadPool" in other helper-tools usually
involves a bit more "comfort" - and is often represented
as a separate (helper-) class.

Not so in my toolset - there is no ThreadPool-Object,
just the plain threads (represented over a clientside
TH=cThreadhandler, as already mentioned above).
Instead I implemented the "threadpool" in that ping-
demo with a plain (Object-)Array:
Private ThreadHandlers(0 To 31) As cPingJob

   cPingJob then contains the real clientside threading-
   helper-class TH As cThreadHandler).

Back to the threadpool-array, which represents only
32 clientside handler objects - each one starting its
own (single) remote-thread over the Init-Function.

That array is defined at Form-Level - and what you
usually want in such a "hosting code-module" is a central
Event-interface for all your threads (in case they are
all doing the same thing as in our ping-case here).

VB does not support Events from an Object-Array
directly, but indirectly over a small EventDelegator-
class (named cPingMessages in the example).

This central Event-Object + the ThreadHandler-array
form together, what you can look at as an equivalent
to a threadpool (you could for example wrap that
stuff in an additional class cThreadpool, but in my
small example I've just used the form directly as the
hosting container for the array and the central Eventsink).

And regarding the 32 threads - you can easily adjust
that array-ubound yourself, if you want to play around
with more - but in practise I would not go above 64
threads on a dualcore-machine - and maybe 128 threads
on a quadcore-machine, since the thread-scheduling-
overhead is also at play here - just look at the reply
from Tom Shelton, who apparently measured a
runtime-performance of around one minute, firing up
all the 255 threads for his subnet-scan - not sure though,
if these values were caused due to an inappropriate
ping-timeout-parameter, but if I see it right, he also used
a ping-timeout of 1000msec.

As said, just play around with the array-ubound, to find
your own best compromise - what I currently do is,
to feed each of the 32 threads an equal amount of ping-
jobs (out of the 1-255) over the (i Mod 32) expression.
In case you play around with the Ubound, you will
need to change that expression to:
(i Mod (Ubound(ThreadHandlers)+1))
Or just introduce a ThreadCount-Variable or -Const,
which you can use to redim the Array and also in the
Modulo-expression.

Each thread has to perform about 8 jobs then - and
since my ping-timeout was set to 1000msec, the theoretical
best performance would have been 8seconds - in practise
I've measured 11seconds for all threads to finish their
queued jobs. Maybe the ping-api does not return exactly
after the timeout it was given, or the scheduling-overhead
does already show its influence even on that smaller number
of just 32 threads.

Oh - please don't add more fuel here...;-)

Let's concentrate on the threading-topic - if you have questions
about my helper-binaries- or problems setting up the example,
please just ask.

Olaf

The dotnet group is the other side of the tracks and we don't go
there! I can almost hear the mournful sound of an Amtrak train whistle
in the distance and watch the bundles of tumbleweed blowing across the
arid landscape...

MM

SupaFly wrote:
Home of whatever dirty-dog evangelist came here to spread that lie.  HTH!

This isn't exactly what you're asking for, but
it might be of interest:

  I wrote a userControl to resolve IP -> hostname
that uses WSAAsyncGetHostByAddr, allowing you
to set the max. wait time. (The default timeout
for the non-async method seems to be 20-30 seconds,
while in my own tests I've found that 5 seconds
seems to be plenty of time to wait for any server
to respond.)

   I use the UC in an ActiveX EXE to do translation
on my own server logs. The entire process is still not
especially fast, even with async -- there's no
multi-threading -- but the EXE can just run in the
background without any trouble. I just call it from
a VBScript. If you *have to* do it all fast for
some reason then this method may not help much,
although I don't see any reason that you couldn't
run multiple instances and split up the work load.

www.jsware.net/jsware/vbcode.php5#htp


Show quoteHide quote

Woops. After rereading your posts I realized
that my earlier post is probably not of much
value to you. I've found no problems using
ActiveX EXEs but I haven't tried doing quite
the same thing that you're doing.

Vista SP2 Being "offered"
dhRichClient3 Thread Classes Issues
VB6 on Vista Home Premium problem
Excel Execution from VB Fails on 2nd Attempt
Use an Addin to automatically add date/time stamp to each edited line of VB6 code?
Sub .... or Private Sub....
Moving .exe somtimes works
In High Density Mode - Looking for previous control counting post
How to create the project referencing library, which user may not have on his computer?
How can An MDI child form stay on top ?