thread.bas

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

Attribute VB_Name = "Thread"
Option Explicit

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

' Windows (Constant, Data structure, API) declaration
Public Const CREATE_SUSPENDED = &H4
Public Const THREAD_PRIORITY_NORMAL = &H0
Public Const THREAD_PRIORITY_TIME_CRITICAL = &H15

'WindowProc message
Public Const WM_ADVMSGERR = WM_USER + 1
Public Const WM_ADVMSGUPDATE = WM_USER + 2



Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Boolean
End Type

Global ThreadHandle As Long

Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long
Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As Long, ByVal nPriority As Long) As Long
Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lpExitCode As Long) As Long
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
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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) 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 Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)

Sub EventThread()
    Dim usEventType As Long
    
    ptCheckEvent.EventType = DRV_GetAddress(usEventType)
    ptCheckEvent.Milliseconds = 1000

    While (m_bContinue)
        m_ErrCde = DRV_CheckEvent(m_DriverHandle, ptCheckEvent)
        If (m_ErrCde <> SUCCESS) Then
            SendMessage HandleofForm1, WM_ADVMSGERR, m_ErrCde, 0
        Else
            SendMessage HandleofForm1, WM_ADVMSGUPDATE, usEventType, 0
        End If
    Wend
    
End Sub

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
      
    Dim pDIData(0) As Byte
    Dim pCntrData(3) As Long
    Dim i As Integer
    Dim usTmp As Integer
    Dim szBuf As String
    Dim ulSize As Long
    Dim lstItem As ListItem
    Dim ulTmp As Long

    If (m_bContinue = True) Then
      If uMsg = WM_ADVMSGERR Then ''Msgbox for error
        ChkErr wParam
      ElseIf uMsg = WM_ADVMSGUPDATE Then ''' update data
            If ((wParam >= ADS_EVT_DI_INTERRUPT0) And (wParam <= ADS_EVT_DI_INTERRUPT3)) Then
               ulSize = Len(pDIData(0))
               AdxDioGetLatestEventDiPortsState m_DriverHandle, wParam, pDIData(0), ulSize
               
               For i = 0 To m_PortCount - 1
                   usTmp = i + m_StartPort
                   Form1.lstDI.ListItems(i + 1).Text = usTmp
                   
                   szBuf = Format(pDIData(usTmp), "0")
                   Form1.lstDI.ListItems(i + 1).SubItems(1) = szBuf
                   
               Next
            End If
            If ((wParam <> ADS_EVT_NO_EVENT) And (wParam <> 65535)) Then
                ulSize = Len(pCntrData(0)) * 4
                AdxCntrGetLatestEventCounterValue m_DriverHandle, wParam, pCntrData(0), ulSize
                For i = 0 To m_CntrCount - 1
                    usTmp = i + m_StartCntr
                    Form1.lstCntr.ListItems(i + 1).Text = usTmp
                    
                    If (pCntrData(usTmp) < 0) Then
                        ulTmp = 4294967296# + pCntrData(usTmp)
                    Else
                        ulTmp = pCntrData(usTmp)
                    End If
                    szBuf = Format(ulTmp, "0")
                    Form1.lstCntr.ListItems(i + 1).SubItems(1) = szBuf
                Next
            End If
        End If
      End If
        
      m_bThreadStop = True
      
      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!!")

  End If
End Function