Please post comments on this posting at http://www.powerbasic.com/support/pb...ad.php?t=41676
Try ending the VB6 program before closing any message boxes (running in other threads) to see total threads still running.
Clicking Yes to run multiple times will start a new thread for any open slots in the ghandle() array.
In PB the program can be terminated by ending the main thread so THREAD CLOSE's may be executed.
IN VB the program will not end if other threads are active so THREAD CLOSE cleanup is not needed.
THREAD CLOSE is only executed when a thread is finishing so other PB thread functions can be added and tested.
It is suggested that the PowerBASIC source code be saved as PBTHREAD.BAS so
the DLL is created as PBTHREAD.DLL to match the declare statements in VB6.
The Form_QueryUnload in VB6 should not allow ending the program if other threads are running.
-------------------------------------------------------------------------------------------
Here is the PB code to create the DLL or run as a stand-alone program to test the DLL code.
Try ending the VB6 program before closing any message boxes (running in other threads) to see total threads still running.
Clicking Yes to run multiple times will start a new thread for any open slots in the ghandle() array.
In PB the program can be terminated by ending the main thread so THREAD CLOSE's may be executed.
IN VB the program will not end if other threads are active so THREAD CLOSE cleanup is not needed.
THREAD CLOSE is only executed when a thread is finishing so other PB thread functions can be added and tested.
It is suggested that the PowerBASIC source code be saved as PBTHREAD.BAS so
the DLL is created as PBTHREAD.DLL to match the declare statements in VB6.
The Form_QueryUnload in VB6 should not allow ending the program if other threads are running.
Code:
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'THIS CODE IS ABSOLUTELY REQUIRED
Dim OtherThreads As Long
OtherThreads = PBTHREADCOUNT - 1
If OtherThreads Then
Me.Caption = Str$(OtherThreads) + " other thread(s) still busy."
Cancel = 1
End If
End Sub
Here is the PB code to create the DLL or run as a stand-alone program to test the DLL code.
Code:
'MULTI-THREADING DLL FOR VB6 PBThread.BAS, PBThread.EXE, PBTHREAD.DLL
'
'This program allows safe threading using VB6 in or out of the environment
'Critical section code is automatically loaded and released when ended
'Thread handles are kept in the array g(%ExtraThreadsAllowed)
'Closing a message box makes its slot available in g() for another thread with same number
'
'To test using PB set %EXE = 1
'To test using VB set %EXE = 0 to create PbThread.DLL
'
'Mike Doty 10/9/2009
'
'Save as PBTHREAD.BAS
%EXE = 1 'create PBTHREAD.EXE
'%EXE = 0 'create PBTHREAD.DLL for use with VB6
%ExtraThreadsAllowed = 2 'change to how many threads are allowed (creates message boxes)
#IF %EXE
#COMPILE EXE
#ELSE
#COMPILE DLL
#ENDIF
#INCLUDE "win32api.inc"
GLOBAL gCS AS CRITICAL_SECTION 'automatically init/destroyed
'usage: EnterCritical:g=99:gs="something":LEAVE CRITICAL
GLOBAL ghandle() AS LONG 'handles to any threads
'=============================================================================
#IF %EXE = 1
FUNCTION PBMAIN () AS LONG
LOCAL x AS LONG
InitializeCriticalSection gCS 'critical section automatically allocated
LOCAL result AS LONG
LOCAL lResult AS LONG
REDIM gHandle(%ExtraThreadsAllowed) AS LONG 'only 1 extra thread in this simple demo
DO
lResult = MSGBOX("Click YES to run or click NO to exit all threads",%MB_YESNO OR %MB_SYSTEMMODAL,"PB Threading with VB6")
IF lResult <> %IDYES THEN EXIT DO
FOR x = 1 TO %ExtraThreadsAllowed
result = PBThreadCreate
NEXT
LOOP
DeleteCriticalSection gCS 'critical section automatically allocated
'In VB6 code this should not be necessary because the program can not end until THREADCOUNT is 1.
FOR x = 1 TO %ExtraThreadsAllowed 'cleanup if handles were not closed
IF gHandle(x) THEN PbThreadClose gHandle(x)
NEXT
END FUNCTION
#ENDIF
'=============================================================================
#IF %EXE = 0
FUNCTION LIBMAIN(BYVAL hInstance AS DWORD, _
BYVAL lReason AS LONG, _
BYVAL lReserved AS LONG) AS LONG
SELECT CASE AS LONG lReason
CASE %DLL_PROCESS_ATTACH
InitializeCriticalSection gCS 'critical section automatically allocated
REDIM gHandle(%ExtraThreadsAllowed) AS LONG 'normally dwords, but using long with VB6
LIBMAIN = 1
EXIT FUNCTION
CASE %DLL_PROCESS_DETACH
DeleteCriticalSection gCS 'critical section automatically allocated
EXIT FUNCTION
CASE %DLL_THREAD_ATTACH
EXIT FUNCTION
CASE %DLL_THREAD_DETACH
EXIT FUNCTION
END SELECT
LIBMAIN = 0: ? "failure to initialize the DLL!
END FUNCTION
#ENDIF
'=============================================================================
FUNCTION PBTHREADCLOSE(ElementNumber AS LONG) EXPORT AS LONG
LOCAL result AS LONG
THREAD CLOSE gHandle(ElementNumber) TO result '0 = failure
FUNCTION = result
END FUNCTION
'=============================================================================
FUNCTION PBTHREADCOUNT EXPORT AS LONG
FUNCTION = THREADCOUNT
END FUNCTION
'=============================================================================
SUB PBSLEEP(milliseconds AS LONG) EXPORT
SLEEP milliseconds
END SUB
'=============================================================================
SUB EnterCritical 'CALL EnterCritical:Set globals: CALL LeaveCritical
EnterCriticalSection gCS
END SUB
'=============================================================================
SUB LeaveCritical
LeaveCriticalSection gCS
END SUB
'=============================================================================
FUNCTION PBThreadCreate EXPORT AS LONG
LOCAL x AS LONG
LOCAL result AS LONG
EnterCritical
x = EmptySlot
IF x THEN
THREAD CREATE ExtraThread(x) TO gHandle(x) 'if invalid gHandle(x) remains 0
SLEEP 50
IF gHandle(x) THEN
FUNCTION = gHandle(x) '0 is invalid
'Thread CLose gHandle(x) to result 'don't need the file handle
ELSE
? "Unable to create ExtraThread" + STR$(x)
END IF
'ELSE
' ? "No more slots available"
END IF
LeaveCritical
END FUNCTION
'=============================================================================
FUNCTION EmptySlot AS LONG
LOCAL x AS LONG
FOR x = 1 TO %ExtraThreadsAllowed
IF ghandle(x) = 0 THEN
FUNCTION = x
EXIT FOR
END IF
NEXT
END FUNCTION
'=============================================================================
THREAD FUNCTION ExtraThread(BYVAL x AS LONG) AS LONG
LOCAL Result AS LONG
? "ExtraThread" + STR$(x) + " Total running" + STR$(PbthreadCount)
EnterCritical 'using a global array so using critical section
Result = PBTHREADCLOSE(x)
IF result THEN
gHandle(x) = 0
LeaveCritical
ELSE
LeaveCritical
? "THREAD CLOSE ERROR OF THREAD" + STR$(x)
END IF
END FUNCTION
Code:
REM VB6 Test program
Option Explicit
Private Declare Function PBTHREADCREATE Lib "PBThread.dll" () As Long
Private Declare Function PBTHREADCLOSE Lib "PBThread.dll" () As Long
Private Declare Function PBTHREADCOUNT Lib "PBThread.dll" () As Long
Private Declare Sub PBSLEEP Lib "PBThread.dll" (milliseconds As Long)
Const ExtraThreadsAllowed = 5
Dim gsTitle As String
Dim ghandle() As Long
Private Sub Command1_Click()
Dim result As Long
Dim x As Long
For x = 1 To ExtraThreadsAllowed
result = PBTHREADCREATE
Next
End Sub
Private Sub Form_Load() 'Copy paste command button for control array of 3 buttons
ReDim ghandle(ExtraThreadsAllowed)
ChDir App.Path 'So DLL is found in current directory
gsTitle = "Safe Threads for VB6 using PowerBASIC"
Me.Caption = gsTitle
Command1.Caption = "CREATE"
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'THIS CODE IS ABSOLUTELY REQUIRED
Dim OtherThreads As Long
OtherThreads = PBTHREADCOUNT - 1
If OtherThreads Then
Me.Caption = Str$(OtherThreads) + " other thread(s) still busy."
Cancel = 1
End If
End Sub
Comment