Многопоточность: VB <-> PB

[BION]

Необходимо некоторые функции в VB программе вывести в отдельные потоки. Средствами VB это делать мягко говоря не приемлимо. А т.к. потоки есть в PB хочу написать dll и предавать туда адреса соответствующих функций. Понятно, что передать через AddressOf, НО! как в PB

Код: Выделить всё

THREAD CREATE ProcName (param) [SUSPEND] TO hThread


адрес функции из VB преобразовать в ProcName (The name of the thread function to execute as a thread.)

[jangle]

А если использовать API функцию CreateThread?

[BION]

А если использовать API функцию CreateThread?

Ха, чёт я сразу не сообразил... Тоесть вызвать в PB dll'е, надо поробывать.

[BION]

А если использовать API функцию CreateThread?

Ха, чёт я сразу не сообразил... Тоесть вызвать в PB dll'е, надо поробывать.

Вобщем, падает
Хз, мож чего неправильно делаю
pbdll:

Код: Выделить всё

#COMPILE DLL "PBTH.dll"
#Dim All
#Include "win32api.inc"


FUNCTION CreateTh (BYVAL proc AS LONG) EXPORT AS LONG
   Local hT, lpThreadId As Dword
      
   hT = CreateThread _ ' Create thread from sub
   ( _
      ByVal 0, _                     /* Pointer To Thread security attributes*/
      ByVal 0, _                     // initial Thread stack Size, In bytes
      proc, _                    // Pointer To Thread Function
      ByVal 0, _                 // argument For New Thread
      ByVal 0, _                     // creation flags
      ByVal VarPtr(lpThreadId) _     // Pointer To returned Thread identifier
   )
   
    ' Если убрать две следующие строки,
    ' функция до падения приложения успешно вернёт lpThreadId
    WaitForSingleObject(hT,%INFINITE)
    CloseHandle(hT)
   
    FUNCTION = lpThreadId

END FUNCTION

VB module

Код: Выделить всё

Declare Function CreateTh& Lib "PBTH.DLL" Alias "CREATETH" (proc&)

[volo]

А если использовать API функцию CreateThread?

Ха, чёт я сразу не сообразил... Тоесть вызвать в PB dll'е, надо поробывать.

Вобщем, падает
Хз, мож чего неправильно делаю
pbdll:

Код: Выделить всё

#COMPILE DLL "PBTH.dll"
#Dim All
#Include "win32api.inc"


FUNCTION CreateTh (BYVAL proc AS LONG) EXPORT AS LONG
   Local hT, lpThreadId As Dword
      
   hT = CreateThread _ ' Create thread from sub
   ( _
      ByVal 0, _                     /* Pointer To Thread security attributes*/
      ByVal 0, _                     // initial Thread stack Size, In bytes
      proc, _                    // Pointer To Thread Function
      ByVal 0, _                 // argument For New Thread
      ByVal 0, _                     // creation flags
      ByVal VarPtr(lpThreadId) _     // Pointer To returned Thread identifier
   )
   
    ' Если убрать две следующие строки,
    ' функция до падения приложения успешно вернёт lpThreadId
    WaitForSingleObject(hT,%INFINITE)
    CloseHandle(hT)
   
    FUNCTION = lpThreadId

END FUNCTION

VB module

Код: Выделить всё

Declare Function CreateTh& Lib "PBTH.DLL" Alias "CREATETH" (proc&)

Попробуй добавить параметр подобно как:

Код: Выделить всё

    hbmp = CreateThread(BYVAL %NULL,32768,CODEPTR(power_knob),0,0,hbmp)
    CLoseHandle hbmp


я имею ввиду initial Thread stack Size, In bytes - сделай 32768 байт размер

[BION]

Попробуй добавить параметр подобно как:

Код: Выделить всё

    hbmp = CreateThread(BYVAL %NULL,32768,CODEPTR(power_knob),0,0,hbmp)
    CLoseHandle hbmp


я имею ввиду initial Thread stack Size, In bytes - сделай 32768 байт размер

Нет, та же история...
Говорила мама - пиши на Си...

[volo]

Попробуй добавить параметр подобно как:

Код: Выделить всё

    hbmp = CreateThread(BYVAL %NULL,32768,CODEPTR(power_knob),0,0,hbmp)
    CLoseHandle hbmp


я имею ввиду initial Thread stack Size, In bytes - сделай 32768 байт размер

Нет, та же история...
Говорила мама - пиши на Си...

Глянь кусок кода может найдешь нужное решение типа:


THREAD CREATE WorkerThreadFunction (CBHNDL) SUSPEND TO hThread
SetThreadPriority hThread, %THREAD_PRIORITY_BELOW_NORMAL
THREAD RESUME hThread TO iRet ' hard to believe the "TO var" is REQUIRED huh?
' wait for the thread function to copy its run parameters:
WaitForSingleObject hEventReady, %INFINITE
' clean up
CloseHandle hEventReady

--------------------------------

Код: Выделить всё

#COMPILE  EXE
#DEBUG    ERROR ON
#REGISTER NONE
#DIM      ALL
#TOOLS    OFF

'  %NOGDI = 1     ' no GDI (Graphics Device Interface) functions
'  %NOMMIDS = 1   ' no Multimedia ID definitions

%NOMMIDS = 1
#INCLUDE "WIN32API.INC"
#INCLUDE "COMDLG32.INC"    ' for OpenFileDialog
' Get message from GetLastError as string
FUNCTION SystemErrorMessageText (BYVAL ECode AS LONG) AS STRING
  LOCAL Buffer AS ASCIIZ * 255
  FormatMessage %FORMAT_MESSAGE_FROM_SYSTEM, BYVAL %NULL, ECode, %NULL, buffer, SIZEOF(buffer), BYVAL %NULL
  FUNCTION = FORMAT$(ECode, "##### ") & Buffer
END FUNCTION

'==[End Windows API Header Files]============================

' --------------------------
'  CONTROLS ON MAIN SCREEN
' --------------------------

%ID_TIMER            = 101      ' will be continuously updated whilst running
%ID_DATETIME         = 102

%ID_FILENAME         = 105     ' pick the file to be 'processed'
%ID_FILENAME_BROWSE  = 106

%ID_START            = 111
%ID_ABORT            = 112

%ID_Progress         =  115     ' text control telling us what worker thread is doing.


%DLG_STYLE           = %WS_VISIBLE OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX

' DIALOG SET USER slots
%DSU_HWND         = 1      ' handle to main dialog
%DSU_HTHREAD      = 2      ' if true, it's an open handle to an executing worker thread
%DSU_HEVENTREADY  = 3      '
%DSU_FILENAME_PTR = 4


$EVENT_ABORT      = "Abort_Worker_Thread_Event"
%NUMBER_CYCLES    =  10    ' number of times the target file will be 'processed' before thread
                           ' function ends if worker thread not aborted.
%PROGRESS_MODULO  =  50    ' update screen every this many records


MACRO   m_CreateThreadReadyEvent  =   CreateEvent (BYVAL %NULL, BYVAL %TRUE, BYVAL %FALSE, BYVAL %NULL)
' private window message:
%PWM_THREAD_FUNCTION_COMPLETED = %WM_USER + 1    ' posted to main window on completion. lPAram= Aborted (True/False)

' -----------------------------------------------------
'                 PROGRAM ENTRY POINT
' -----------------------------------------------------
FUNCTION WINMAIN (BYVAL hInstance     AS LONG, _
                  BYVAL hPrevInstance AS LONG, _
                  BYVAL lpCmdLine     AS ASCIIZ PTR, _
                  BYVAL iCmdShow      AS LONG) AS LONG

  LOCAL hDlg AS LONG

  DIALOG NEW  %NULL, "Worker Thread With Abort Demo", 10,10, 300,200, %DLG_STYLE TO hDlg

  CONTROL ADD LABEL,  hDlg, %ID_DATETIME, "", 200, 10, 90, 12

  CONTROL ADD TEXTBOX, hDlg, %ID_FILENAME, "",  10, 24, 220,12
  CONTROL ADD BUTTON,  hDlg, %ID_FILENAME_BROWSE, "&Browse", 241, 24, 40, 14

  CONTROL ADD BUTTON, hDLg, %ID_START, "&Start", 10, 40, 40, 14
  CONTROL ADD BUTTON, hDlg, %ID_ABORT, "&Abort", 10, 56, 40, 14

  CONTROL ADD LABEL,  hDlg, %ID_PROGRESS, "Nothing Happening", 10, 80, 280, 48


  DIALOG SHOW MODAL hDlg, CALL DlgProc



END FUNCTION  ' WinMain

' ----------------------------------------------------------------
' Helper Function to abort the designated worker Thread function.
' Should never be called unless a worker thread is running
' ----------------------------------------------------------------
FUNCTION AbortWorkerThread (BYVAL hWnd AS LONG, BYVAL hThread AS LONG ) AS LONG

   LOCAL hEvent AS LONG, szEvent AS ASCIIZ * 128
   LOCAL bInherit AS LONG
   LOCAL iWait    AS LONG

   ' get handle to abort event so we can signal it
   szEvent = $EVENT_ABORT
   bInherit = %FALSE     ' we will not be passing this handle to any other process

   hEvent = OpenEVent (%EVENT_ALL_ACCESS, bINherit, szEvent)

   ' OpenEvent will fail if the event does not exist; but that means the worker thread is not running;
   ' meaning either this function was called when it shouldn't have been; OR.... the thread function
   ' ended 'normally' between the time the abort command is issued and "now."
   ' However, waiting on the thread handle is safe, since that handle cannot be closed yet.

   IF ISTRUE hEvent THEN
       SetEvent hEvent
   END IF

  ' wait for the thread function to end (which it may have even before we got here):
   iWait   = WaitForSingleObject (hThread, %INFINITE)

   ' close our handle to abort event (clean up)
   ' The thread handle is closed in DlgProc when this function returns
   CloseHandle hEvent

END FUNCTION


'----------------------------------
'    MAIN WINDOW PROCESSOR
'----------------------------------

CALLBACK FUNCTION DlgPRoc () AS LONG
LOCAL sText AS STRING
LOCAL hThread AS LONG, hEventReady AS LONG
LOCAL iRet AS LONG


SELECT CASE AS LONG CBMSG


     CASE %WM_INITDIALOG
         ' disable Abort button, Start button waiting for file to be selected
         CONTROL DISABLE  CBHNDL, %ID_START
         CONTROL DISABLE  CBHNDL, %ID_ABORT

         ' set up a timer so we can see that the screen is always updating
         ' one second (1000 millisecond) update period. We don't need the return value
         SetTimer CBHNDL, %ID_TIMER, 1& * 1000&, BYVAL %NULL

     CASE %WM_TIMER
         ' update the timer label with the current time
         sText =  DATE$ & " " & TIME$
         CONTROL  SET TEXT CBHNDL, %ID_DATETIME, sText

     CASE %WM_SYSCOMMAND

         IF  (CBWPARAM AND &hFFF0) = %SC_CLOSE THEN
             DIALOG GET USER CBHNDL, %DSU_HTHREAD TO hThread
             IF ISTRUE hThread THEN
                 MSGBOX    "Must abort worker thread function " & $CRLF _
                        & "(or wait for it to complete) to exit", _
                          %MB_APPLMODAL OR %MB_ICONHAND, "Can't Exit Now"
                 ' Return True To prevent default action (close).
                 FUNCTION = %TRUE
                 EXIT FUNCTION
             END IF
         END IF


     CASE %WM_DESTROY
         ' we should never get here unless it's OK to exit
         ' kill the timer
         KillTimer  CBHNDL, %ID_TIMER

     CASE %WM_COMMAND
       SELECT CASE AS LONG CBCTL

          CASE %ID_START
              ' should not be enabled unless the file in the filename control is available
              ' create a ready event and save in the designated dialog user value slot

              ' start a worker thread, passing handle to the dialog
              ' create a ready event:
              hEventReady     =  m_CreateThreadReadyEvent
              ' store it where our thread function can read it:
              DIALOG SET USER  CBHNDL, %DSU_HEVENTREADY, hEVentReady
              ' get filename and set the pointer; cannot use CONTROL GET TEXT from thread function
              ' since this thread is in a Wait State

              CONTROL GET TEXT CBHNDL, %ID_FILENAME TO sText
              DIALOG  SET USER CBHNDL, %DSU_FILENAME_PTR, VARPTR(sText)

              ' create suspended, set priority, and resume:
              THREAD CREATE      WorkerThreadFunction (CBHNDL) SUSPEND TO hThread
              SetThreadPriority  hThread, %THREAD_PRIORITY_BELOW_NORMAL
              THREAD RESUME hThread  TO iRet  ' hard to believe the "TO var" is REQUIRED huh?
              ' wait for the thread function to copy its run parameters:
              WaitForSingleObject  hEventReady, %INFINITE
              ' clean up
              CloseHandle          hEventReady

              ' Save the (open) thread handle
              DIALOG SET USER CBHNDL, %DSU_HTHREAD, hThread
              ' now that thread function has started, disable the start and enable the abort buttons
              CONTROL DISABLE    CBHNDL, %ID_START
              CONTROL ENABLE     CBHNDL, %ID_ABORT
              ' -------------------------------------------------------------------
              ' HERE IS THE POINT WHERE YOU WOULD DISABLE/ENABLE *ALL* CONTROLS
              ' WHOSE ENABLE STATUS DEPENDS IF A WORKER THREAD IS RUNNING OR NOT.
              ' -------------------------------------------------------------------




          CASE %ID_ABORT
              ' should not be enabled unless a worker thread is running.
              DIALOG GET USER CBHNDL, %DSU_HTHREAD TO hTHREAD
              CALL   AbortWorkerThread (CBHNDL, hThread)
              ' this will (eventually) post a completion message to this window,
              ' at which time we close the thread handle

          CASE %ID_FILENAME_BROWSE

'FUNCTION OpenFileDialog (BYVAL hWnd AS DWORD, _            ' parent window
'                         BYVAL sCaption AS STRING, _       ' caption
'                         sFileSpec AS STRING, _            ' filename
'                         BYVAL sInitialDir AS STRING, _    ' start directory
'                         BYVAL sFilter AS STRING, _        ' filename filter
'                         BYVAL sDefExtension AS STRING, _  ' default extension
'                         dFlags AS DWORD _                 ' flags
'                        ) AS LONG
              sText = ""
              IF OpenFileDialog(CBHNDL, "Select File to Process", sText, "", "*.*","", %OFN_FILEMUSTEXIST) THEN
                   CONTROL SET TEXT CBHNDL, %ID_FILENAME, sText
                   ' this will trigger an EN_CHANGE which will enable the ID_START if it should be enabled
              END IF



          CASE %ID_FILENAME
              ' check if the file is avaiable and no worker thread is running already,
              ' if so enable the start button
              IF CBCTLMSG = %EN_CHANGE THEN
                 DIALOG GET USER CBHNDL, %DSU_HTHREAD TO hThread
                 IF ISFALSE hThread THEN    ' no worker thread is running, so we can enable
                                            ' the 'go' button if this file is valid
                      CONTROL GET TEXT CBHNDL, %ID_FILENAME TO sText
                      IF DIR$ (sText) > "" THEN
                           CONTROL ENABLE CBHNDL, %ID_START
                      ELSE
                           CONTROL DISABLE CBHNDL, %ID_START
                      END IF
                 END IF
              END IF

      END SELECT

   CASE %PWM_THREAD_FUNCTION_COMPLETED

       SText       = "Worker Thread Function Completed via "  & IIF$(CBLPARAM, "Manual Abort", "Natural Causes")
       CONTROL    SET TEXT CBHNDL, %ID_PROGRESS, Stext

      ' diasable abort
       CONTROL DISABLE CBHNDL, %ID_ABORT
       ' close the open Thread handle
       DIALOG GET USER CBHNDL,  %DSU_HTHREAD TO hThread
       THREAD CLOSE hThread  TO hThread
       DIALOG SET USER CBHNDL, %DSU_HTHREAD, %NULL   ' set to %NULL so we know no worker thread
                                                     ' function is currently exectuting.

      ' enable the start button if we have a valid file in the control
      CONTROL GET TEXT CBHNDL, %ID_FILENAME TO sText
      IF DIR$ (sText) > "" THEN
          CONTROL ENABLE  CBHNDL, %ID_START
      END IF
     ' -------------------------------------------------------------------
     ' HERE IS THE POINT WHERE YOU WOULD DISABLE/ENABLE *ALL* CONTROLS
     ' WHOSE ENABLE STATUS DEPENDS IF A WORKER THREAD IS RUNNING OR NOT.
     ' (HERE THREAD FUNCTION IS *NOT* RUNNING).
     ' -------------------------------------------------------------------


END SELECT


END FUNCTION

' ----------------------------------------------------------
' Worker thread function. Processes the current file by reading it
' %NUMBER_CYCLES times or until manually aborted, then exits after
' posting a private message to the calling Window/Dialog (passed parameter).
' ----------------------------------------------------------
FUNCTION WorkerThreadFunction (BYVAL hDlg AS LONG) AS LONG

LOCAL sFile AS STRING, hFile AS LONG, nRecord AS LONG, Z AS LONG, W AS STRING, S AS STRING
LOCAL sTExt AS STRING, iRecord AS LONG
LOCAL pFilename AS STRING PTR
' ------Wait Variables ------
LOCAL heventReady   AS LONG
LOCAL bWaitAll      AS LONG
LOCAL iWait         AS LONG
'----- event variables ------
LOCAL szEventAbort  AS ASCIIZ * 64, hEvent() AS LONG
LOCAL lpSecurity    AS SECURITY_ATTRIBUTES PTR
LOCAL bManualReset  AS LONG, bInitialState AS LONG
LOCAL bAbort        AS LONG
LOCAL SE            AS LONG

' ---------------------------------------------------------------
' Get our thread parameters into LOCAL variables before allowing
' the calling thread to continue.
' ----------------------------------------------------------------

DIALOG GET USER  hDlg, %DSU_HEVENTREADY TO hEventReady
DIALOG GET USER  hDlg, %DSU_FILENAME_PTR TO pFileName
' -----------------------------------------------------------------------------------------------------
' I had to use a string ptr here instead of CONTROL GET TEXT because the calling thread was in a wait
' state (WaitForSingleObject) and apparently (undocumented but not reasonably) CONTROL GET TEXT does
' "something" which must execute in the context of the same thread (suspended) as the dialog.
' Apparently (that means also not documented), DIALOG GET USER does not need to execute anything in the
' context of the thread in which the dialog was created.
' -----------------------------------------------------------------------------------------------------

sFile          = @pFileName
' signal the calling thread we have copied our parameters and it may continue
SetEvent         hEventReady


' ------------Set up processing events -------------------------------------------------
' We will be looking for two events: an 'abort' event and a 'continue' event.
' WaitForMultipleObjects will suspend this thread until EITHER event is signalled.
' The 'continue' event is created in a signalled state and remains in that state;
' the abort event is created unsignalled, and is signalled by calling SetEvent() at the
' appropriate times.


' We want the abort event to be first (in the array assed to WaitForMultipleObjects), since
' WFMO returns the LOWEST (first) event which is signalled when more than one
' event is signalled.

   REDIM hEvent(1)   ' we need to monitor two events in total

' Create our abort event as first event in the array
' We use a named event so other parts of the program have access to it.
   szEventAbort       = $EVENT_ABORT
   bManualReset       = %TRUE   ' The only choice for control freaks. Actually it's immaterial in this program.
   lpSecurity         = %NULL   ' null pointer ==> Default security
   bInitialSTate      = %FALSe  ' create unsignalled.
   hEvent(0)          = CreateEvent (BYVAL lpSecurity, bManualreset, bInitialState, szEventAbort)

  ' Create an unnamed event in signalled state as event #2, so worker thread processes forever -
  ' or at least processes until it completes the task or is manually aborted.
   bManualReset     = %TRUE    ' Do not allow system to reset this to unsignalled
                               ' which it will do if not manual reset type!
   bInitialState    = %TRUE    ' Create this event signalled so wait will be satisfied.
  ' This event does not need a name: no other functions need access to it!
   hEvent(1)        = CreateEvent ( BYVAL lpSecurity, bManualReset, bInitialState, BYVAL %NULL)

    ' set parameter for the wait:
   bWaitAll         = %FALSE      ' we want WFMO to return when EITHER event is signalled (or both).

   ' --------------------------------------------
   ' PROCESS THE FILE %NUMBER_CYCLE TIMES
   ' --------------------------------------------

   FOR Z = 1 TO %NUMBER_CYCLES

      hFile   = FREEFILE
      OPEN      sFile FOR INPUT AS hFile
      FILESCAN  hFile, RECORDS TO nRecord
      w        = USING$ ("Scanned #, Records for cycle # of # ", nRecord, Z, %NUMBER_CYCLES)
      CONTROL    SET TEXT hDlg, %ID_PROGRESS, W
      iRecord  = 0&      ' record counter for each cycle

      ' now process each record of the file
       DO
          ' Wait until either the abort event (object 1) or the continue event (object 2) is signalled.
          ' Since 'continue' is ALWAYS signalled, this function will always return immediately
          ' and it's just a matter of deciding if Abort was signalled or not.
          ' iWait will be the LOWEST of the the signalled events when more than one event is signalled.
          iWait = WaitForMultipleObjects (BYVAL 2&, BYVAL VARPTR(hEvent(0)), bWaitAll, %INFINITE)
          SE    = GetLastError

          SELECT CASE AS LONG iWait
              CASE %WAIT_OBJECT_0     ' first event, the abort, satisfied the waut
                bAbort = %TRUE
                EXIT DO

              CASE %WAIT_OBJECT_0 + 1  ' second event, the "please continue" , satisfied the wait.

                 IF NOT EOF(hFile) THEN
                      LINE INPUT #hFile, S
                      INCR iRecord
                      IF iRecord MOD %PROGRESS_MODULO = 0 THEN
                         sText = USING$ ("Processed #, of #, Records in Cycle # of #", iRecord, nrecord, Z, %NUMBER_CYCLES)
                         CONTROL SET TEXT hDlg, %ID_PROGRESS, sText
                      END IF
                      ' way too fast to demo unless I code a delay in here (with small file)
                       SLEEP  5
                 ELSE          ' end of file
                     ' set cool message
                     sText = USING$ ("All #, records processed in Cycle #", nRecord, Z)
                     CONTROL SET TEXT hDlg, %ID_PROGRESS, sText
                     EXIT DO
                 END IF

             CASE ELSE
                 ' needless to say, you should not get here. Ever.
                 MSGBOX "Oops!" & SystemErrorMessageText (SE)
                 EXIT DO
          END SELECT

       LOOP

       CLOSE hFile  ' done with this cycle
       ' Go again? or all done?
       IF bAbort THEN
           EXIT FOR
       END IF


  NEXT Z   ' repeat file processing

  ' Close our handles to both events since we are done with them
  ' Since we acquired the handles in this procedure, we should close them here. No, that's not
  ' any kind of "rule" but it is IMNSHO a "Best Programming Practice"
  CloseHandle  hEvent(0)
  CloseHandle  hEvent(1)

  ' post message to calling window with results; set lparam = the abort status
  DIALOG POST hDlg, %PWM_THREAD_FUNCTION_COMPLETED, %NULL, bAbort

END FUNCTION



[BION]

Вот нашел, статья с сайта PB с примером: Multi-Threading for Basic Programmers - как раз описывается нужная мне схема. Скачал, запустил(пришлось кое-чего подправить) - падает собака. Видимо это уже храническое... И потом, пример 99 года, XP ещё не было...

p.s. Ой как не хочу проект на vb.net переводить...