threadfunction.bas

来自「16 relay output channels and 16 isolated」· BAS 代码 · 共 187 行

Attribute VB_Name = "ThreadFunction"
Option Explicit
Public lDriverHandle As Long ''Driver's handle
Public mDeviceNum As Long
Public mDeviceName As String * 80
Public gbStopThread As Boolean

Private Const GWL_WNDPROC = -4
Public Const GWL_USERDATA = (-21)
Public Const WM_USER = &H400
Public HandleofMain As Long

''Data
Public DICount As Long
''Message Map
Public Const WM_ADVMSGERR = WM_USER + 1
Public Const WM_ADVMSGTHREADEND = WM_USER + 2
Public Const WM_ADVMSGDEVREMOVE = WM_USER + 3
Public Const WM_ADVMSGUPDATEDATA = WM_USER + 4

Private Const MAXLONG = &H7FFFFFFF
Private Const THREAD_BASE_PRIORITY_IDLE = -15
Private Const THREAD_BASE_PRIORITY_LOWRT = 15
Private Const THREAD_BASE_PRIORITY_MAX = 2
Private Const THREAD_BASE_PRIORITY_MIN = -2
Private Const THREAD_PRIORITY_HIGHEST = THREAD_BASE_PRIORITY_MAX
Private Const THREAD_PRIORITY_LOWEST = THREAD_BASE_PRIORITY_MIN
Private Const THREAD_PRIORITY_ABOVE_NORMAL = (THREAD_PRIORITY_HIGHEST - 1)
Private Const THREAD_PRIORITY_BELOW_NORMAL = (THREAD_PRIORITY_LOWEST + 1)
Private Const THREAD_PRIORITY_ERROR_RETURN = (MAXLONG)
Private Const THREAD_PRIORITY_IDLE = THREAD_BASE_PRIORITY_IDLE
Private Const THREAD_PRIORITY_NORMAL = 0
Private Const THREAD_PRIORITY_TIME_CRITICAL = THREAD_BASE_PRIORITY_LOWRT

'Thread creation flags
Private Const CREATE_ALWAYS = 2
Private Const CREATE_NEW = 1
Private Const CREATE_NEW_CONSOLE = &H10
Private Const CREATE_NEW_PROCESS_GROUP = &H200
Private Const CREATE_NO_WINDOW = &H8000000
Private Const CREATE_PROCESS_DEBUG_EVENT = 3
Private Const CREATE_SUSPENDED = &H4
Private Const CREATE_THREAD_DEBUG_EVENT = 2
'Thread/process processing API
Public Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)
Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)
Public Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
Public Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long

' To use multithread function ,we can't call form's function in another thread
' for that the component only can run in the thread who creates it.so we use message
' and we create a windowproc to receive our message which sent by us in this thread

Public Function StartThread(ByVal paraFormHwnd As Long)
    
    Dim threadid As Long
    Dim hnd&, res&
    HandleofMain = paraFormHwnd
    hnd = CreateThread(0, 0, AddressOf EventThread, vbNullString, CREATE_SUSPENDED, threadid)
    SetThreadPriority hnd, THREAD_PRIORITY_TIME_CRITICAL
    ResumeThread hnd
    If hnd = 0 Then
        ' Return with zero (error)
        Exit Function
    End If
    ' We don't need the thread handle
    CloseHandle hnd
    
End Function
Public Function Hook(ByVal hwnd As Long) As Long
    Dim pOld As Long
      pOld = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
      SetWindowLong hwnd, GWL_USERDATA, pOld
      Hook = pOld
End Function

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, _
      ByVal wParam As Long, ByVal lParam As Long) As Long
      
      If uMsg = WM_ADVMSGERR Then ''Msgbox for error
        ChkErr wParam
      ElseIf uMsg = WM_ADVMSGTHREADEND Then  ''' Thread end
        frmMain.cmdStart.Enabled = True
        frmMain.cmdStop.Enabled = False
        frmMain.cmdExit.Enabled = True
      ElseIf uMsg = WM_ADVMSGDEVREMOVE Then  '''Device is removed
        DRV_DeviceClose lDriverHandle
        frmMain.cmdCloseDevice.Enabled = False
        frmMain.cmdOpenDevice.Enabled = True
        frmMain.cmdStart.Enabled = True
        frmMain.cmdStop.Enabled = False
        frmMain.cmdExit.Enabled = True
      
        MsgBox "The device is removed, please reopen the device!"
      ElseIf uMsg = WM_ADVMSGUPDATEDATA Then ''' update data
         If wParam >= 0 And wParam < 8 Then
                frmMain.txtDiInterrupt(wParam) = frmMain.txtDiInterrupt(wParam) + 1
         End If
      End If
      
      Dim lpPrevWndProc As Long
      
      lpPrevWndProc = GetWindowLong(hw, GWL_USERDATA)
      WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function
Public Function ChkErr(ByVal lErrCde As Long)
Dim sErrMsg As String * 128
Dim Response As Integer

  If (lErrCde <> 0) Then
      DRV_GetErrorMessage lErrCde, sErrMsg
      Response = MsgBox(sErrMsg, vbOKOnly, "Error!!")
      
      DRV_DeviceClose lDriverHandle
      frmMain.cmdCloseDevice.Enabled = False
      frmMain.cmdOpenDevice.Enabled = True
  End If
End Function

Public Function EventThread()
  
  Dim i As Integer
  Dim lErrCde As Long
  Dim ptCheckEvent As PT_CheckEvent
  Dim usEventType As Long
  ptCheckEvent.EventType = VarPtr(usEventType)
  ptCheckEvent.Milliseconds = 5000
  
  gbStopThread = False
  
  'Cyclic check Fast DO events
  While (gbStopThread = False)
     
    lErrCde = DRV_CheckEvent(lDriverHandle, ptCheckEvent)
    If (lErrCde <> 0) Then
        SendMessage HandleofMain, WM_ADVMSGERR, lErrCde, 0
        gbStopThread = True
    End If
    
    Select Case usEventType
        
    Case ADS_EVT_NO_EVENT
      'Exit For

    Case ADS_EVT_DI_INTERRUPT0  'Enable DI 0 interrupt event
      SendMessage HandleofMain, WM_ADVMSGUPDATEDATA, 0, 0

    Case ADS_EVT_DI_INTERRUPT1  'Enable DI 1 interrupt event
      SendMessage HandleofMain, WM_ADVMSGUPDATEDATA, 1, 0

    Case ADS_EVT_DI_INTERRUPT2  'Enable DI 2 interrupt event
      SendMessage HandleofMain, WM_ADVMSGUPDATEDATA, 2, 0
      
    Case ADS_EVT_DI_INTERRUPT3  'Enable DI 3 interrupt event
      SendMessage HandleofMain, WM_ADVMSGUPDATEDATA, 3, 0

    Case ADS_EVT_DI_INTERRUPT4  'Enable DI 4 interrupt event
      SendMessage HandleofMain, WM_ADVMSGUPDATEDATA, 4, 0

    Case ADS_EVT_DI_INTERRUPT5  'Enable DI 5 interrupt event
      SendMessage HandleofMain, WM_ADVMSGUPDATEDATA, 5, 0

    Case ADS_EVT_DI_INTERRUPT6  'Enable DI 6 interrupt event
      SendMessage HandleofMain, WM_ADVMSGUPDATEDATA, 6, 0

    Case ADS_EVT_DI_INTERRUPT7  'Enable DI 7 interrupt event
      SendMessage HandleofMain, WM_ADVMSGUPDATEDATA, 7, 0
      
    Case ADS_EVT_DEVREMOVED
       gbStopThread = True
       SendMessage HandleofMain, WM_ADVMSGDEVREMOVE, 0, 0
       
    End Select
   Wend
      
   SendMessage HandleofMain, WM_ADVMSGTHREADEND, 0, 0
End Function