I was looking the tutorial on this link --> http://www.powerbasic.com/support/te...threading3.asp
Consist on 2 dlls compiled with PowerBasic and that allow the multi-threads use from the Visual Basic 6. When i tried to compile the dlls with the PowrBasic 8.03 i got some errors on the sources, but at finally i found the changes required to compile.
The pbthread.dll source i compiled is the follow code:
This code can be perfectly compiled with PowerBasic 8.03. How you can see i modified the part where the original source get a parameter to spawn X number of threads. Because i only need to create one.
Well, the problem..
the created thread start to work perfectly but the anomaly is that the principal thread of our vb6 program stop to work. This mean only the function assigned to the thread is working.
How can i fix that extrange problem ?
thx
Consist on 2 dlls compiled with PowerBasic and that allow the multi-threads use from the Visual Basic 6. When i tried to compile the dlls with the PowrBasic 8.03 i got some errors on the sources, but at finally i found the changes required to compile.
The pbthread.dll source i compiled is the follow code:
$DEBUG ERROR ON
$COMPILE DLL "PBThread.DLL"
$INCLUDE "WIN32API.INC"
' CONSTANTS
%MAX_SLEEP_TIME = 10000&
%MIN_SLEEP_TIME = 1&
%MT_NOTIFY = %WM_USER + 800
' TYPES
Type ThreadPostInfo
WindowHandle As Long
CallbackAddress As DWORD
End Type
' GLOBAL VARIABLES
Global glngGeneralMutex As Long
Global glngHInstance As Long
' FUNCTION/SUB DECLARATIONS
Declare Function CreateCallbackWindow Lib "PBThrdWd.Dll" (lThreadID As Long) As Long
DECLARE FUNCTION SleepForAWhile(BYVAL lpParam AS LONG) AS LONG
DECLARE FUNCTION SpawnThreads (BYVAL CallbackFunctionAddress AS DWORD) AS LONG
' FUNCTION: LibMain
FUNCTION LIBMAIN(BYVAL hInstance AS LONG, BYVAL fwdReason AS LONG, BYVAL lpvReserved AS LONG) EXPORT AS LONG
On Error Resume Next
Dim lngC As Long
Dim lngRet As Long
' Store the instance handle for future reference.
glngHInstance = hInstance
Select Case fwdReason
CASE %DLL_PROCESS_ATTACH
' Create the mutex.
glngGeneralMutex = CreateMutex(BYVAL %NULL, %FALSE, BYVAL %NULL)
LIBMAIN = 1
Exit Function
CASE %DLL_PROCESS_DETACH
' Close the mutex.
CloseHandle glngGeneralMutex
LIBMAIN = 1
Exit Function
CASE %DLL_THREAD_ATTACH
LIBMAIN = 1
Exit Function
CASE %DLL_THREAD_DETACH
' If a window was created for this thread, destroy it.
DIM ascWindowName AS ASCIIZ * 80
Dim lngHWnd As Long
ascWindowName = "MTExample" & Str$(GetCurrentThreadID())
lngHWnd = FindWindow(BYVAL %NULL, ascWindowName)
IF lngHWnd <> %NULL THEN
SendMessage lngHWnd, %WM_DESTROY, %FALSE, %FALSE
End If
LIBMAIN = 1
Exit Function
End Select
' Any message which is not handled in the above SELECT CASE reaches
' this point and is unknown.
End Function
' FUNCTION: SpawnThreads
FUNCTION SpawnThreads ALIAS "SpawnThreads" (BYVAL CallbackFunctionAddress AS DWORD) EXPORT AS LONG
' This function creates a bunch of threads
' and each thread notifies the calling application
' when the work's done.
'
' Returns TRUE on success, and FALSE on failure.
On Error GoTo Error_SpawnThreads
DIM ascWindowName AS ASCIIZ * 80
Dim lngHeap As Long
Dim lngHeapPtr As Long
Dim lngHThreadResult As Long
Dim lngHWnd As Long
Dim lngIndex As Long
Dim lngLength As Long
Dim lngRet As Long
Dim lngThreadID As Long
Dim udtThreadInfo As ThreadPostInfo
CALL WaitForSingleObject(glngGeneralMutex, %INFINITE)
' Assume a %FALSE for now.
FUNCTION = %FALSE
' Create a window if necessary.
lngThreadID = GetCurrentThreadID()
ascWindowName = "MTExample" & Str$(lngThreadID)
lngHWnd = FindWindow(BYVAL %NULL, ascWindowName)
IF lngHWnd = %NULL THEN
' We need to create a window for this thread.
lngHWnd = CreateCallbackWindow(lngThreadID)
End If
If lngHWnd <> 0 Then
' Allocate memory in the heap.
lngLength = SIZEOF(udtThreadInfo)
lngHeap = GetProcessHeap
IF lngHeap <> %NULL THEN
' Create as many threads as needed.
lngHeapPtr = HeapAlloc(lngHeap, 0, lngLength)
If lngHeapPtr <> 0 Then
udtThreadInfo.WindowHandle = lngHWnd
udtThreadInfo.CallbackAddress = CallbackFunctionAddress
' We have success, copy the UDT into the heap.
MoveMemory ByVal lngHeapPtr, ByVal VarPtr(udtThreadInfo), lngLength
THREAD CREATE SleepForAWhile(lngHeapPtr) TO lngHThreadResult
THREAD CLOSE lngHThreadResult TO lngRet
End If
'FUNCTION = %TRUE
FUNCTION = lngHWnd
End If
End If
Call ReleaseMutex(glngGeneralMutex)
Exit Function
Error_SpawnThreads:
Call ReleaseMutex(glngGeneralMutex)
End Function
' FUNCTION: SleepForAWhile
Function SleepForAWhile(ByVal HeapPtr As Long) As Long
' This function will sleep somewhere between
' %MIN_SLEEP_TIME and %MAX_SLEEP_TIME seconds.
' Once it awakes, it'll post a completed message to a hidden window
' and terminate.
On Error GoTo Error_SleepForAWhile
Dim lngLength As Long
Dim lngProcessHeap As Long
Dim lngRet As Long
Dim lngSleepTime As Long
Dim udtThreadInfo As ThreadPostInfo
lngLength = SIZEOF(udtThreadInfo)
' We have a pointer to a udt.
' Use CopyMemory and release the memory.
MoveMemory ByVal VarPtr(udtThreadInfo), ByVal HeapPtr, lngLength
' Now release the memory!
lngProcessHeap = GetProcessHeap
lngRet = HeapFree(lngProcessHeap, 0, HeapPtr)
lngSleepTime = RND(%MIN_SLEEP_TIME, %MAX_SLEEP_TIME)
Call apiSLEEP(lngSleepTime)
' Now post a message to the correct window.
' The 3rd parameter is the function address.
' and the 4th signifies success.
CALL SendMessage(udtThreadInfo.WindowHandle, %MT_NOTIFY, udtThreadInfo.CallbackAddress, %TRUE)
Exit Function
Error_SleepForAWhile:
CALL SendMessage(udtThreadInfo.WindowHandle, %MT_NOTIFY, udtThreadInfo.CallbackAddress, %FALSE)
End Function
$COMPILE DLL "PBThread.DLL"
$INCLUDE "WIN32API.INC"
' CONSTANTS
%MAX_SLEEP_TIME = 10000&
%MIN_SLEEP_TIME = 1&
%MT_NOTIFY = %WM_USER + 800
' TYPES
Type ThreadPostInfo
WindowHandle As Long
CallbackAddress As DWORD
End Type
' GLOBAL VARIABLES
Global glngGeneralMutex As Long
Global glngHInstance As Long
' FUNCTION/SUB DECLARATIONS
Declare Function CreateCallbackWindow Lib "PBThrdWd.Dll" (lThreadID As Long) As Long
DECLARE FUNCTION SleepForAWhile(BYVAL lpParam AS LONG) AS LONG
DECLARE FUNCTION SpawnThreads (BYVAL CallbackFunctionAddress AS DWORD) AS LONG
' FUNCTION: LibMain
FUNCTION LIBMAIN(BYVAL hInstance AS LONG, BYVAL fwdReason AS LONG, BYVAL lpvReserved AS LONG) EXPORT AS LONG
On Error Resume Next
Dim lngC As Long
Dim lngRet As Long
' Store the instance handle for future reference.
glngHInstance = hInstance
Select Case fwdReason
CASE %DLL_PROCESS_ATTACH
' Create the mutex.
glngGeneralMutex = CreateMutex(BYVAL %NULL, %FALSE, BYVAL %NULL)
LIBMAIN = 1
Exit Function
CASE %DLL_PROCESS_DETACH
' Close the mutex.
CloseHandle glngGeneralMutex
LIBMAIN = 1
Exit Function
CASE %DLL_THREAD_ATTACH
LIBMAIN = 1
Exit Function
CASE %DLL_THREAD_DETACH
' If a window was created for this thread, destroy it.
DIM ascWindowName AS ASCIIZ * 80
Dim lngHWnd As Long
ascWindowName = "MTExample" & Str$(GetCurrentThreadID())
lngHWnd = FindWindow(BYVAL %NULL, ascWindowName)
IF lngHWnd <> %NULL THEN
SendMessage lngHWnd, %WM_DESTROY, %FALSE, %FALSE
End If
LIBMAIN = 1
Exit Function
End Select
' Any message which is not handled in the above SELECT CASE reaches
' this point and is unknown.
End Function
' FUNCTION: SpawnThreads
FUNCTION SpawnThreads ALIAS "SpawnThreads" (BYVAL CallbackFunctionAddress AS DWORD) EXPORT AS LONG
' This function creates a bunch of threads
' and each thread notifies the calling application
' when the work's done.
'
' Returns TRUE on success, and FALSE on failure.
On Error GoTo Error_SpawnThreads
DIM ascWindowName AS ASCIIZ * 80
Dim lngHeap As Long
Dim lngHeapPtr As Long
Dim lngHThreadResult As Long
Dim lngHWnd As Long
Dim lngIndex As Long
Dim lngLength As Long
Dim lngRet As Long
Dim lngThreadID As Long
Dim udtThreadInfo As ThreadPostInfo
CALL WaitForSingleObject(glngGeneralMutex, %INFINITE)
' Assume a %FALSE for now.
FUNCTION = %FALSE
' Create a window if necessary.
lngThreadID = GetCurrentThreadID()
ascWindowName = "MTExample" & Str$(lngThreadID)
lngHWnd = FindWindow(BYVAL %NULL, ascWindowName)
IF lngHWnd = %NULL THEN
' We need to create a window for this thread.
lngHWnd = CreateCallbackWindow(lngThreadID)
End If
If lngHWnd <> 0 Then
' Allocate memory in the heap.
lngLength = SIZEOF(udtThreadInfo)
lngHeap = GetProcessHeap
IF lngHeap <> %NULL THEN
' Create as many threads as needed.
lngHeapPtr = HeapAlloc(lngHeap, 0, lngLength)
If lngHeapPtr <> 0 Then
udtThreadInfo.WindowHandle = lngHWnd
udtThreadInfo.CallbackAddress = CallbackFunctionAddress
' We have success, copy the UDT into the heap.
MoveMemory ByVal lngHeapPtr, ByVal VarPtr(udtThreadInfo), lngLength
THREAD CREATE SleepForAWhile(lngHeapPtr) TO lngHThreadResult
THREAD CLOSE lngHThreadResult TO lngRet
End If
'FUNCTION = %TRUE
FUNCTION = lngHWnd
End If
End If
Call ReleaseMutex(glngGeneralMutex)
Exit Function
Error_SpawnThreads:
Call ReleaseMutex(glngGeneralMutex)
End Function
' FUNCTION: SleepForAWhile
Function SleepForAWhile(ByVal HeapPtr As Long) As Long
' This function will sleep somewhere between
' %MIN_SLEEP_TIME and %MAX_SLEEP_TIME seconds.
' Once it awakes, it'll post a completed message to a hidden window
' and terminate.
On Error GoTo Error_SleepForAWhile
Dim lngLength As Long
Dim lngProcessHeap As Long
Dim lngRet As Long
Dim lngSleepTime As Long
Dim udtThreadInfo As ThreadPostInfo
lngLength = SIZEOF(udtThreadInfo)
' We have a pointer to a udt.
' Use CopyMemory and release the memory.
MoveMemory ByVal VarPtr(udtThreadInfo), ByVal HeapPtr, lngLength
' Now release the memory!
lngProcessHeap = GetProcessHeap
lngRet = HeapFree(lngProcessHeap, 0, HeapPtr)
lngSleepTime = RND(%MIN_SLEEP_TIME, %MAX_SLEEP_TIME)
Call apiSLEEP(lngSleepTime)
' Now post a message to the correct window.
' The 3rd parameter is the function address.
' and the 4th signifies success.
CALL SendMessage(udtThreadInfo.WindowHandle, %MT_NOTIFY, udtThreadInfo.CallbackAddress, %TRUE)
Exit Function
Error_SleepForAWhile:
CALL SendMessage(udtThreadInfo.WindowHandle, %MT_NOTIFY, udtThreadInfo.CallbackAddress, %FALSE)
End Function
Well, the problem..
the created thread start to work perfectly but the anomaly is that the principal thread of our vb6 program stop to work. This mean only the function assigned to the thread is working.
How can i fix that extrange problem ?
thx
Comment