Author Topic: WinAPI Threading (64 Bit)  (Read 3043 times)

0 Members and 1 Guest are viewing this topic.

Offline SpriggsySpriggs

  • Forum Resident
  • Posts: 1145
  • Larger than life
    • View Profile
    • GitHub
WinAPI Threading (64 Bit)
« on: May 08, 2021, 09:31:48 pm »
justsomeguy had started a post in the Discussion section of the forum concerning threading in QB64 and I had replied with some code for Windows 64 bit threading using Win32 API code. I thought it deserved its own post since this is quite a feat when using Win32 API functions. The below code is based on the MSDN page on threading here. The code uses plenty of Win32 API functions so I hope it can be helpful to others who are venturing into external libraries and the WinAPI. It includes memory allocation functions, thread safe functions, function addresses, and even provides an example of using a QB64 function as a callback and as an exported function. The code I have provided is currently set up to run 20 threads. One can adjust the MAX_THREADS constant to see a different output.

The C++ header that you will need. Save it as threadwin.h
Code: C++: [Select]
  1. #include<strsafe.h>
  2. int32 FUNC_MYTHREADFUNCTION(ptrszint*_FUNC_MYTHREADFUNCTION_OFFSET_LPPARAM);
  3. extern "C"{
  4.         __declspec(dllexport) int32 MyThreadFunction(ptrszint*lpParam){
  5.                 return FUNC_MYTHREADFUNCTION((lpParam));
  6.         }
  7. }
  8.  
  9. int32 sizeoftchar(){
  10.         return sizeof(TCHAR);
  11. }

And the QB64 code:
Code: QB64: [Select]
  1.  
  2. Type MyData
  3.     As Long val1, val2
  4.  
  5. Const BUF_SIZE = 255
  6. Const MAX_THREADS = 20
  7. Const HEAP_ZERO_MEMORY = &H00000008
  8. Const INFINITE = 4294967295
  9. Const STD_OUTPUT_HANDLE = -11
  10. Const INVALID_HANDLE_VALUE = -1
  11.  
  12. Const MB_OK = 0
  13.  
  14. Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H00000100
  15. Const FORMAT_MESSAGE_FROM_SYSTEM = &H00001000
  16. Const FORMAT_MESSAGE_IGNORE_INSERTS = &H00000200
  17. Const LANG_NEUTRAL = &H00
  18. Const SUBLANG_DEFAULT = &H01
  19.  
  20. Const LMEM_ZEROINIT = &H0040
  21.  
  22.     Function LoadLibrary%& (lpLibFileName As String)
  23.     Function GetProcAddress%& (ByVal hModule As _Offset, lpProcName As String)
  24.     Sub FreeLibrary (ByVal hLibModule As _Offset)
  25.     Function GetLastError& ()
  26.     Function HeapAlloc%& (ByVal hHeap As _Offset, Byval dwFlags As Long, Byval dwBytes As _Offset)
  27.     Function GetProcessHeap%& ()
  28.     Sub ExitProcess (ByVal uExitCode As _Unsigned Long)
  29.     Function CreateThread%& (ByVal lpThreadAttributes As _Offset, Byval dwStackSize As _Offset, Byval lpStartAddress As _Offset, Byval lpParameter As _Offset, Byval dwCreationFlags As Long, Byval lpThreadId As _Offset)
  30.     Function WaitForMultipleObjects& (ByVal nCount As Long, Byval lpHandles As _Offset, Byval bWaitAll As _Byte, Byval dwMilliseconds As Long)
  31.     Sub WaitForMultipleObjects (ByVal nCount As Long, Byval lpHandles As _Offset, Byval bWaitAll As _Byte, Byval dwMilliseconds As Long)
  32.     Sub CloseHandle (ByVal hObject As _Offset)
  33.     Sub HeapFree (ByVal hHeap As _Offset, Byval dwFlags As Long, Byval lpMem As _Offset)
  34.     Sub StringCchPrintf Alias "StringCchPrintfA" (ByVal pszDest As _Offset, Byval cchDest As _Offset, pszFormat As String, Byval arg1 As Long, Byval arg2 As Long)
  35.     Sub StringCchPrintf2 Alias "StringCchPrintfA" (ByVal pszDest As _Offset, Byval cchDest As _Offset, pszFormat As String, lpszFunction As String, Byval error As Long, Byval lpMsgBuf As _Offset)
  36.     Sub StringCchLength Alias "StringCchLengthA" (ByVal psz As _Offset, Byval cchMax As _Offset, Byval pcchLength As _Offset)
  37.     Function GetStdHandle%& (ByVal nStdHandle As Long)
  38.     Function CreateMutex%& Alias "CreateMutexA" (ByVal lpMutexAttributes As _Offset, Byval bInitialOwner As Long, Byval lpName As _Offset)
  39.     Sub WriteConsole (ByVal hConsoleOutput As _Offset, Byval lpBuffer As _Offset, Byval nNumberOfCharsToWrite As Long, Byval lpNumberOfCharsWritten As _Offset, Byval lpReserved As _Offset)
  40.     Sub FormatMessage Alias FormatMessageA (ByVal dwFlags As Long, Byval lpSource As Long, Byval dwMessageId As Long, Byval dwLanguageId As Long, Byval lpBuffer As _Offset, Byval nSize As Long, Byval Arguments As _Offset)
  41.     Sub MessageBox Alias "MessageBoxA" (ByVal hWnd As _Offset, Byval lpText As _Offset, lpCaption As String, Byval uType As _Unsigned Long)
  42.     Sub LocalFree (ByVal hMem As _Offset)
  43.     Function LocalAlloc%& (ByVal uFlags As _Unsigned Long, Byval uBytes As _Unsigned _Offset)
  44.     Function lstrlen& Alias "lstrlenA" (ByVal lpString As _Offset)
  45.     Function LocalSize%& (ByVal hMem As _Offset)
  46.  
  47. Declare Library "threadwin"
  48.     Function sizeoftchar& ()
  49.  
  50.     Function MAKELANGID& (ByVal p As Long, Byval s As Long)
  51.  
  52. Dim As _Offset libload: libload = LoadLibrary(Command$(0))
  53. Dim As _Offset MyThreadFunc: MyThreadFunc = GetProcAddress(libload, "MyThreadFunction")
  54.  
  55. Dim As MyData pDataArray(1 To MAX_THREADS)
  56. Dim As Long dwThreadIdArray(1 To MAX_THREADS)
  57. Dim As _Offset hThreadArray(1 To MAX_THREADS), heap(1 To MAX_THREADS)
  58.  
  59. Dim As _Offset ghMutex: ghMutex = CreateMutex(0, 0, 0)
  60. If ghMutex = 0 Then
  61.     ErrorHandler "CreateMutex"
  62. For i = 1 To MAX_THREADS
  63.     heap(i) = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, Len(pDataArray(i)))
  64.     Dim As _MEM pdata: pdata = _MemNew(8)
  65.     _MemPut pdata, pdata.OFFSET, heap(i)
  66.     _MemGet pdata, pdata.OFFSET, pDataArray(i)
  67.     If heap(i) = 0 Then
  68.         ExitProcess 2
  69.     End If
  70.     pDataArray(i).val1 = i
  71.     pDataArray(i).val2 = i + 100
  72.     hThreadArray(i) = CreateThread(0, 0, MyThreadFunc, _Offset(pDataArray(i)), 0, _Offset(dwThreadIdArray(i)))
  73.     If hThreadArray(i) = 0 Then
  74.         ErrorHandler "CreateThread"
  75.         ExitProcess 3
  76.     End If
  77. WaitForMultipleObjects MAX_THREADS, _Offset(hThreadArray()), 1, INFINITE
  78. For i = 1 To MAX_THREADS
  79.     CloseHandle hThreadArray(i)
  80.     If heap(i) <> 0 Then
  81.         HeapFree GetProcessHeap, 0, heap(i)
  82.     End If
  83. CloseHandle ghMutex
  84. _MemFree pdata
  85. FreeLibrary libload
  86.  
  87. Function MyThreadFunction& (lpParam As _Offset)
  88.     Dim As String * BUF_SIZE msgBuf
  89.     Dim As _Offset hStdout
  90.     Dim As Long cchStringSize, dwChars
  91.     Dim As MyData MyData
  92.     hStdout = GetStdHandle(STD_OUTPUT_HANDLE)
  93.     If hStdout = INVALID_HANDLE_VALUE Then
  94.         MyThreadFunction = 1
  95.     End If
  96.     Dim As _MEM PMYDATA: PMYDATA = _MemNew(8)
  97.     _MemPut PMYDATA, PMYDATA.OFFSET, lpParam
  98.     _MemGet PMYDATA, PMYDATA.OFFSET, MyData
  99.     StringCchPrintf _Offset(msgBuf), BUF_SIZE, "Parameters = %d, %d" + Chr$(10) + Chr$(0), MyData.val1, MyData.val2
  100.     StringCchLength _Offset(msgBuf), BUF_SIZE, _Offset(cchStringSize)
  101.     WriteConsole hStdout, _Offset(msgBuf), cchStringSize, _Offset(dwChars), 0
  102.     _MemFree PMYDATA
  103.     MyThreadFunction = 0
  104.  
  105. Sub ErrorHandler (lpszFunction As String)
  106.     Dim As _Offset lpMsgBuf, lpDisplayBuf
  107.     Dim As Long dw: dw = GetLastError
  108.     FormatMessage FORMAT_MESSAGE_ALLOCATE_BUFFER Or FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0, dw, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), _Offset(lpMsgBuf), 0, 0
  109.     lpDisplayBuf = LocalAlloc(LMEM_ZEROINIT, (lstrlen(lpMsgBuf) + lstrlen(_Offset(lpszFunction)) + 40) * sizeoftchar)
  110.     StringCchPrintf2 lpDisplayBuf, LocalSize(lpDisplayBuf) / sizeoftchar, "%s failed with error %d:" + Chr$(10) + " %s" + Chr$(0), lpszFunction + Chr$(0), dw, lpMsgBuf
  111.     MessageBox 0, lpDisplayBuf, "Error" + Chr$(0), MB_OK
  112.     LocalFree lpMsgBuf
  113.     LocalFree lpDisplayBuf

And a screenshot of the program:
 
Screenshot 2021-05-08 210936.png
« Last Edit: May 09, 2021, 09:24:57 am by SpriggsySpriggs »
Shuwatch!

Offline justsomeguy

  • Newbie
  • Posts: 47
    • View Profile
Re: WinAPI Threading
« Reply #1 on: May 08, 2021, 09:38:05 pm »
Great Job! One day I hope to see when QB64 supports threads natively, and perhaps this could be the basis for it.