Attribute VB_Name = "basCallBackEventProc"
'///////////////////////////////////////////////////////////////////////////////
'// Device       ：Card Reader/Writer Device Communication Control Liblary
'//
'// File Name    ：basCallBackEventProc.bas
'//
'// Purpose      ：Visual Basic 6 Standard Module
'//
'// Update       ：2013.03.26    Panasonic System Networks Co.,Ltd.
'//
'///////////////////////////////////////////////////////////////////////////////

' メモリコピー
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, _
                                                             ByVal Source As Long, _
                                                             ByVal Length As Long _
                                                             )

Public SendFlag As Integer

'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
'//
'//     レスポンス受信イベントハンドラ登録（コールバック関数登録）
'//
'//     説明：ポーリングレスポンス受信イベント用のコールバック関数を登録いたします。
'//           （ポートクローズ時には強制解除されます。）
'//
'//     Integer = crwSetResponseEventProc(
'//                             iPortNo  (As Integer), _        '受信するポート[1〜256]
'//                             iRecMode (As Integer), _        'BusyStatus時polling[1:する/0:しない]
'//                             lTimeOut (As Long), _           'データ受信待ちタイマー(ms)[0:無限待ち]
'//                             AddressOf pResponseEventProc, _ 'CallBack関数名(0:登録解除)
'//                             pParam   (As Long), _           'Applicationによって定義された値(0で良い)
'//                             lEvent   (As Long) _            'CallBack関数で受け取る論理和
'//                             )
'//
'//     例 ：[COM7],[Busy Polling On],[10秒待ち],["ResponseEvent"],["A"受信＋DSR OFF信号]
'//               lEvent = EVT_RSP_CRW_RESPONSE + EVT_RSP_CRW_ERR_DSR（イベント指定）
'//         登録：Rtn = crwSetResponseEventProc(7,1,10000,AddressOf ResponseEvent,0,lEvent)
'//
'//         解除：Rtn = crwSetResponseEventProc(7,1,10000,0,0,lEvent)
'//
'//         コールバック関数に渡されるパラメータ:
'//         Public Sub ResponseEvent(ByVal iPortNo As Integer, _    'イベントが発生したポート
'//                                  ByVal lEvent As Long, _        'イベントが発生した論理和
'//                                  ByVal lpData As String, _      '受信データ
'//                                  ByVal iDataLen As Integer, _   '受信したデータの長さ
'//                                  ByVal pParam As Long _         'Applicationによって定義された値
'//                                  )
'//
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub ResponseEvent(ByVal iPortNo As Integer, _
                         ByVal lEvent As Long, _
                         ByVal lpData As String, _
                         ByVal iDataLen As Integer, _
                         ByVal pParam As Long _
                         )

    On Error Resume Next
    Debug.Print "Port No." & iPortNo & " " & lEvent;
    Select Case lEvent
        Case EVT_RSP_CRW_RESPONSE
            Debug.Print " "; lpData
            MsgBox "[EVT_RSP_CRW_RESPONSE(&H1) (" & Chr(&H22) & "A" & Chr(&H22) & ")受信]" & vbCrLf & _
                   "Port No." & iPortNo & vbCrLf & _
                   "[Answer Data]  = " & lpData & vbCrLf & _
                   "Receive Length = " & CStr(iDataLen) _
                   , vbInformation, "[ReceiveResponseEvent]"
        Case EVT_RSP_CRW_READY
            Debug.Print " "; lpData
            MsgBox "[EVT_RSP_CRW_READY(&H2) (" & Chr(&H22) & "R" & Chr(&H22) & ")受信]" & vbCrLf & _
                   "Port No." & iPortNo & vbCrLf & _
                   "[Ready Status] = " & lpData & vbCrLf & _
                   "Receive Length = " & CStr(iDataLen) _
                   , vbInformation, "[ReceiveResponseEvent]"
        Case EVT_RSP_CRW_BUSY
            Debug.Print " "; lpData
            MsgBox "[EVT_RSP_CRW_BUSY(&H4) (" & Chr(&H22) & "B" & Chr(&H22) & ")受信]" & vbCrLf & _
                   "Port No." & iPortNo & vbCrLf & _
                   "[Busy Status]  = " & lpData & vbCrLf & _
                   "Receive Length = " & CStr(iDataLen) _
                   , vbInformation, "[ReceiveResponseEvent]"
        Case EVT_RSP_CRW_CANCELED
            MsgBox "[EVT_RSP_CRW_CANCELED(&H8)]" & vbCrLf & _
                   "Port No." & iPortNo & vbCrLf & "受信待ち中止！", vbInformation, "[ReceiveResponseEvent]"
            
        Case EVT_RSP_CRW_ERR_RES_TIMEOUT
            MsgBox "[EVT_RSP_CRW_ERR_RES_TIMEOUT(&H100)]" & vbCrLf & _
                   "Port No." & iPortNo & vbCrLf & "受信待ちタイムアウト!", vbCritical, "[ReceiveResponseEvent]"
        Case EVT_RSP_CRW_ERR_CTS_TIMEOUT
            MsgBox "[EVT_RSP_CRW_ERR_CTS_TIMEOUT(&H200)]" & vbCrLf & _
                   "Port No." & iPortNo & vbCrLf & "CTS ON 待ちタイムアウト！", vbCritical, "[ReceiveResponseEvent]"
        Case EVT_RSP_CRW_ERR_DSR
            MsgBox "[EVT_RSP_CRW_ERR_DSR(&H400)]" & vbCrLf & _
                   "Port No." & iPortNo & vbCrLf & "端末がOFFです！", vbCritical, "[ReceiveResponseEvent]"
        Case EVT_RSP_CRW_ERR_BCC_RETRY
            MsgBox "[EVT_RSP_CRW_ERR_BCC_RETRY(&H800)]" & vbCrLf & _
                   "Port No." & iPortNo & vbCrLf & "BCCエラーリトライOVER！", vbCritical, "[ReceiveResponseEvent]"
        Case EVT_RSP_CRW_ERR_COMM_WRITE
            MsgBox "[EVT_RSP_CRW_ERR_COMM_WRITE(&H1000)]" & vbCrLf & _
                   "Port No." & iPortNo & vbCrLf & "COM Write Error!", vbCritical, "[ReceiveResponseEvent]"
        Case EVT_RSP_CRW_ERR_COMM_READ
            MsgBox "[EVT_RSP_CRW_ERR_COMM_READ(&H2000)]" & vbCrLf & _
                   "Port No." & iPortNo & vbCrLf & "COM Read Error!", vbCritical, "[ReceiveResponseEvent]"
        Case Else
            MsgBox "[etc(&H???)]" & vbCrLf & _
                   "Events : " & lEvent & " ?????", vbCritical, "[ReceiveResponseEvent]"
    End Select
End Sub

'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
'//
'//     バイナリデータ受信イベントハンドラ登録（コールバック関数登録）
'//
'//     説明：ＰＣＣ ＵＨＦ帯バイナリ受信イベント用のコールバック関数を登録いたします。
'//           （ポートクローズ時には強制解除されます。）
'//
'//     受信電文形式：[SYN][STX][lpData][SYN][ETX][LRC]
'//
'//     Integer = crwSetReceiveBinaryEventProc(
'//                         iPortNo  (As Integer), _                '受信するポート[1〜256]
'//                         lTimeOut (As Long), _                   'データ受信待ちタイマー(ms)[0:無限待ち]
'//                         AddressOf pReceiveBinaryEventProc, _    'CallBack関数名(0:登録解除)
'//                         pParam   (As Long), _                   'Applicationによって定義された値(0で良い)
'//                         lEvent   (As Long) _                    'CallBack関数で受け取る論理和
'//                             )
'//
'//     例 ：[COM11],[5秒待ち],["BinaryEvent"],[データ受信＋DSR OFF信号]
'//               lEvent = EVT_BIN_CRW_RESPONSE + EVT_BIN_CRW_ERR_DSR（イベント指定）
'//         登録：Rtn = crwSetResponseEventProc(11,5000,AddressOf BinaryEvent,0,lEvent)
'//
'//         解除：Rtn = crwSetResponseEventProc(11,5000,0,0,lEvent)
'//
'//         コールバック関数に渡されるパラメータ:
'//         Public Sub BinaryEvent(ByVal iPortNo As Integer, _      'イベントが発生したポート
'//                                  ByVal lEvent As Long, _        'イベントが発生した論理和
'//                                  ByVal lpData As String, _      '受信データ
'//                                  ByVal iDataLen As Integer, _   '受信したデータの長さ
'//                                  ByVal pParam As Long _         'Applicationによって定義された値
'//                                  )
'//
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub BinaryEvent(ByVal iPortNo As Integer, _
                            ByVal lEvent As Long, _
                            ByVal lpData As Long, _
                            ByVal iDataLen As Integer, _
                            ByVal pParam As Long _
                            )

    ' バイナリデータ受信イベント
    Dim rData()     As Byte
    Dim strData     As String
    Dim i           As Integer
    Dim ptr         As Long
    
    On Error Resume Next
    Debug.Print "Port No." & iPortNo & " " & lEvent;
    Select Case lEvent
        Case EVT_BIN_CRW_RESPONSE
            If iDataLen > 0 Then
                ReDim rData(iDataLen)
                ptr = VarPtr(rData(0))
                Call MoveMemory(ptr, lpData, iDataLen)
                strData = ""
                For i = 0 To iDataLen - 1
                    strData = strData & Right$("0" & Hex(rData(i)), 2)
                Next
                Debug.Print " "; strData
                MsgBox "[EVT_BIN_CRW_RESPONSE(&H1)]" & vbCrLf & _
                       "Port No." & iPortNo & vbCrLf & _
                       "Receive Data = " & strData & vbCrLf & _
                       "RData Length = " & CStr(iDataLen) _
                       , vbInformation, "[ReceiveBinaryEvent]"
            Else
                Debug.Print " 0byte 受信?"
                MsgBox "[EVT_BIN_CRW_RESPONSE(&H1)]" & vbCrLf & _
                       "Port No." & iPortNo & " 0byte 受信?"
            End If
        Case EVT_BIN_CRW_CANCELED
            MsgBox "[EVT_BIN_CRW_CANCELED(&H8)]" & vbCrLf & _
                   "Port No." & iPortNo & vbCrLf & "受信待ち中止！", vbInformation, "[ReceiveBinaryEvent]"
        Case EVT_BIN_CRW_ERR_RES_TIMEOUT
            MsgBox "[EVT_BIN_CRW_ERR_RES_TIMEOUT(&H100)]" & vbCrLf & _
                   "Port No." & iPortNo & vbCrLf & "受信待ちタイムアウト！", vbCritical, "[ReceiveBinaryEvent]"
        Case EVT_BIN_CRW_ERR_CTS_TIMEOUT
            MsgBox "[EVT_BIN_CRW_ERR_CTS_TIMEOUT(&H200)]" & vbCrLf & _
                   "Port No." & iPortNo & vbCrLf & "CTS OFF!", vbCritical, "[ReceiveBinaryEvent]"
        Case EVT_BIN_CRW_ERR_DSR
            MsgBox "[EVT_BIN_CRW_ERR_DSR(&H400)]" & vbCrLf & _
                    "Port No." & iPortNo & vbCrLf & "DSR OFF!", vbCritical, "[ReceiveBinaryEvent]"
        Case EVT_BIN_CRW_ERR_BCC_RETRY
            MsgBox "[EVT_BIN_CRW_ERR_BCC_RETRY(&H800)]" & vbCrLf & _
                    "Port No." & iPortNo & vbCrLf & "BCCエラーリトライOVER!", vbCritical, "[ReceiveBinaryEvent]"
        Case EVT_BIN_CRW_ERR_COMM_WRITE
            MsgBox "[EVT_BIN_CRW_ERR_COMM_WRITE(&H1000)]" & vbCrLf & _
                    "Port No." & iPortNo & vbCrLf & "COM Write Error!", vbCritical, "[ReceiveBinaryEvent]"
        Case EVT_BIN_CRW_ERR_COMM_READ
            MsgBox "[EVT_BIN_CRW_ERR_COMM_READ(&H2000)]" & vbCrLf & _
                    "Port No." & iPortNo & vbCrLf & "COM Read Error!", vbCritical, "[ReceiveBinaryEvent]"
        Case Else
            MsgBox "[etc(&H???)]" & vbCrLf & _
                   "Events : " & lEvent & " ?????", vbCritical, "[ReceiveBinaryEvent]"
    End Select
End Sub

'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
'//
'//     電文データ受信イベントハンドラ登録（コールバック関数登録）
'//
'//     説明：電文形式 [STX]+”lpData”+[ETX]+[BCC] 受信イベント用のコールバック関数を登録します。
'//           （ポートクローズ時には強制解除されます。）
'//
'//     受信電文形式：[SYN][STX][lpData][SYN][ETX][LRC]
'//
'//     Integer = crwSetReceiveDataBCCEventProc(
'//                         iPortNo         (As Integer), _             '受信するポート[1〜256]
'//                         iACKResponse    (As Integer), _             'ACK/NAKを返却するかどうかのフラグ（0 : しない / 0以外 : する）
'//                         lTimeOut        (As Long), _                'データ受信待ちタイマー(ms)[0:無限待ち]
'//                         AddressOf pReceiveBCCEventProc, _           'CallBack関数名(0:登録解除)
'//                         pParam          (As Long), _                'Applicationによって定義された値(0で良い)
'//                         lEvent          (As Long) _                 'CallBack関数で受け取る論理和
'//                             )
'//
'//     例 ：[COM11],[ACK返却],[5秒待ち],["BinaryEvent"],[データ受信＋DSR OFF信号]
'//               lEvent = EVT_BCC_CRW_RESPONSE + EVT_BCC_CRW_ERR_DSR（イベント指定）
'//         登録：Rtn = crwSetReceiveDataBCCEventProc(11,1,5000,AddressOf BCCEvent,0,lEvent)
'//
'//         解除：Rtn = crwSetReceiveDataBCCEventProc(11,5000,0,0,lEvent)
'//
'//         コールバック関数に渡されるパラメータ:
'//         Public Sub BCCEvent(ByVal iPortNo As Integer, _         'イベントが発生したポート
'//                                  ByVal lEvent As Long, _        'イベントが発生した論理和
'//                                  ByVal bstrData As String, _    '受信データ
'//                                  ByVal iDataLen As Integer, _   '受信したデータの長さ
'//                                  ByVal pParam As Long _         'Applicationによって定義された値
'//                                  )
'//
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub BCCEvent(ByVal iPortNo As Integer, _
                    ByVal lEvent As Long, _
                    ByVal bstrData As String, _
                    ByVal iDataLen As Integer, _
                    ByVal pParam As Long _
                    )

    Select Case lEvent
        Case EVT_BCC_CRW_RESPONSE
                'レスポンスデータ受信
                If iDataLen > 0 Then
                    MsgBox "Port No." & iPortNo & vbCrLf & _
                           "Receive Data = " & bstrData & vbCrLf & _
                           "RData Length = " & CStr(iDataLen) _
                           , vbInformation, "[ReceiveDataBCCEvent]"
                End If
        Case EVT_BCC_CRW_CANCELED
                '登録解除による受信待ちキャンセル
            MsgBox "[EVT_BCC_CRW_CANCELED(&H100)]" & vbCrLf & _
                   "Port No." & iPortNo & vbCrLf & "登録解除による受信待ちキャンセル！", vbCritical, "[ReceiveDataBCCEvent]"
        Case EVT_BCC_CRW_ERR_RES_TIMEOUT
                'デバイスからの応答待ちタイムアウト
            MsgBox "[EVT_BCC_CRW_ERR_RES_TIMEOUT(&H100)]" & vbCrLf & _
                   "Port No." & iPortNo & vbCrLf & "受信待ちタイムアウト！", vbCritical, "[ReceiveDataBCCEvent]"
        Case EVT_BCC_CRW_ERR_CTS_TIMEOUT
                'CTSオン待ちタイムアウト
            MsgBox "[EVT_BCC_CRW_ERR_CTS_TIMEOUT(&H400)]" & vbCrLf & _
                    "Port No." & iPortNo & vbCrLf & "DSR OFF!", vbCritical, "[ReceiveDataBCCEvent]"
        Case EVT_BCC_CRW_ERR_DSR
                'DSRオフエラー（端末未接続／電源オフ）
            MsgBox "[EVT_BCC_CRW_ERR_DSR(&H400)]" & vbCrLf & _
                    "Port No." & iPortNo & vbCrLf & "DSR OFF!", vbCritical, "[ReceiveDataBCCEvent]"
        Case EVT_BCC_CRW_ERR_BCC_RETRY
                'LRCエラーリトライオーバー
            MsgBox "[EVT_BCC_CRW_ERR_BCC_RETRY(&H800)]" & vbCrLf & _
                    "Port No." & iPortNo & vbCrLf & "BCCエラーリトライOVER!", vbCritical, "[ReceiveDataBCCEvent]"
        Case EVT_BCC_CRW_ERR_COMM_WRITE
                '送信時のWIN32APIエラー発生
            MsgBox "[EVT_BCC_CRW_ERR_COMM_WRITE(&H1000)]" & vbCrLf & _
                    "Port No." & iPortNo & vbCrLf & "COM Write Error!", vbCritical, "[ReceiveDataBCCEvent]"
        Case EVT_BCC_CRW_ERR_COMM_READ
                '受信時のWIN32APIエラー発生
            MsgBox "[EVT_BCC_CRW_ERR_COMM_READ(&H2000)]" & vbCrLf & _
                    "Port No." & iPortNo & vbCrLf & "COM Read Error!", vbCritical, "[ReceiveDataBCCEvent]"
    End Select
End Sub

'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
'//
'//     通信イベントハンドラ登録（コールバック関数登録）
'//
'//     説明：シリアルポート通信イベント用のコールバック関数を登録いたします。
'//           （ポートクローズ時には強制解除されます。）
'//
'//     Integer = crwSetCommEventProc(
'//                         iPortNo  (As Integer), _       '受信するポート[1〜256]
'//                         AddressOf pCommEventProc, _    'CallBack関数名(0:登録解除)
'//                         pParam   (As Long), _          'Applicationによって定義された値(0で良い)
'//                         lEvent   (As Long) _           'CallBack関数で受け取る論理和
'//                             )
'//
'//     例 ：[COM6],,["CommEvent"],[データ受信検出 + BREAK信号＋DSR OFF信号]
'//               lEvent = EVT_CRW_RXCHAR + EVT_CRW_BREAK + EVT_CRW_DSR（イベント指定）
'//         登録：Rtn = crwSetCommEventProc(11,AddressOf CommEvent,0,lEvent)
'//
'//         解除：Rtn = crwSetCommEventProc(11,0,0,lEvent)
'//
'//         コールバック関数に渡されるパラメータ:
'//         Public Sub CommEvent(ByVal iPortNo As Integer, _      'イベントが発生したポート
'//                              ByVal lBufferLength As String, _ 'EVT_CRW_RXCHARが発生した時の入力バッファサイズ
'//                              ByVal lEvent As Long, _          'イベントが発生した論理和
'//                              ByVal pParam As Long _           'Applicationによって定義された値
'//                              )
'//
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub CommEvent(ByVal iPortNo As Integer, _
                     ByVal lBufferLen As Long, _
                     ByVal lEvent As Long, _
                     ByVal pParam As Long _
                     )
    Dim ret     As Integer
    Dim rData() As Byte
    Dim rDataLen As Integer
    Dim strData As String
    Dim i       As Integer
    
    On Error Resume Next
    Debug.Print "Port No." & iPortNo & " " & lEvent;
    Select Case lEvent
        Case EVT_CRW_RXCHAR
            With Form1
                RetVal.Text = ""
                'EVT_CRW_RXCHAR受信時のCall関数がtrue And Call関数がNonの時
                If .OpEVT_RXCHAR_Return(0).Value = False Then
                    If .OpEVT_RXCHAR_Return(1).Value = True Then       'crwReceiveData
                        .SSTab1.Tab = 1
                        .ReceiveData_Click
                    ElseIf .OpEVT_RXCHAR_Return(2).Value = True Then   'crwReceiveBinaryReprot
                        .SSTab1.Tab = 2
                        .ReceiveBinaryReport_Click
                    ElseIf .OpEVT_RXCHAR_Return(3).Value = True Then   'crwReceiveBinaryData
                        .SSTab1.Tab = 3
                        .ReceiveBinaryData_Click
                    ElseIf .OpEVT_RXCHAR_Return(4).Value = True Then   'crwReceiveDataBCC
                        .SSTab1.Tab = 5
                        .ReceiveDataBCC_Click
                    ElseIf .OpEVT_RXCHAR_Return(5).Value = True Then   'crwReceiveDataBCCHF
                        .SSTab1.Tab = 5
                        .ReceiveDataBCCHF_Click
                    End If
                Else
                    MsgBox "[ EVT_CRW_RXCHAR(&H1) ]" & vbCrLf & _
                    "入力バッファにデータを受信しました。", vbCritical, "[COMEvent]"
                End If
            End With

        Case EVT_CRW_TXEMPTY
            Debug.Print " 送信完了!"
            If SendFlag = 1 Then
                Form1.RetVal.Text = ""
                ret = crwSetResponseEventProc( _
                    iPortNo, _
                    0, _
                    5000, _
                    AddressOf ResponseEvent, _
                    0, _
                    EVT_RSP_CRW_ALL _
                    )
                Form1.DisplayResult (ret)
            Else
                MsgBox "[ EVT_CRW_TXEMPTY(&H4) ]" & vbCrLf & _
                        "Port No." & iPortNo & " 送信完了!"
            End If
                   
        Case EVT_CRW_ERR_FRAME
            MsgBox "[ EVT_CRW_ERR_FRAME(&H100) ]" & vbCrLf & _
                   "フレミングエラー！", vbCritical, "[COMEvent]"
        Case EVT_CRW_ERR_OVERRUN
            MsgBox "[ EVT_CRW_ERR_OVERRUN(&H200) ]" & vbCrLf & _
                    "オーバーランエラー！", vbCritical, "[COMEvent]"
        Case EVT_CRW_ERR_PARITY
            MsgBox "[ EVT_CRW_ERR_PARITY(&H400) ]" & vbCrLf & _
                   "パリティエラー！", vbCritical, "[COMEvent]"
        Case EVT_CRW_CTS
            MsgBox "[ EVT_CRW_CTS(&H1000) ]" & vbCrLf & _
                   "CTS Line Change!", vbCritical, "[COMEvent]"
        Case EVT_CRW_DSR
            If MsgBox("[ EVT_CRW_DSR(&H2000) ]" & vbCrLf & _
                "DSR が OFF になりました！" & vbCrLf & vbCrLf & "ポートをクローズしますか？" _
                , vbQuestion + vbYesNo, "[COMEvent]") = vbYes Then
                ret = crwClosePort(iPortNo)
                If ret = RET_CRW_SUCCESS Then
                    MsgBox "ポートをクローズしました！", vbInformation + vbOKOnly, "[COMEvent]"
                End If
            End If
        Case EVT_CRW_RLSD
            MsgBox "[ EVT_CRW_RLSD(&H4000) ]" & vbCrLf & _
                    "RLSD Change!", vbCritical, "[COMEvent]"
        Case EVT_CRW_BREAK
            ret = crwClosePort(iPortNo)
            MsgBox "[ EVT_CRW_BREAK(&H8000) ]" & vbCrLf & _
                   "Port No." & iPortNo & vbCrLf & "Break信号検出!" & vbCrLf & "Port:" & iPortNo & " Close!!", vbCritical, "[COMEvent]"
        Case EVT_CRW_RING
            MsgBox "[ EVT_CRW_RING(&H1000) ]" & vbCrLf & _
                   "RING!", vbCritical, "[COMEvent]"
        Case Else
            MsgBox "[ etc (&H????) ]" & vbCrLf & _
                   "Events : " & lEvent & " ?????", vbCritical, "[COMEvent]"
    End Select
End Sub
