frmdemo.frm

来自「HD 6P RFID 终端机、考勤卡钟 Zigbee 通讯接口程序 VB 源码」· FRM 代码 · 共 599 行 · 第 1/2 页

    m_HD8583.AdditionalData2(0) = 0 'PID
    m_HD8583.AdditionalData2(1) = 0 'PID
    m_HD8583.AdditionalData2(2) = 0 'Channel
    
    If TimerOn(cmdSetZigbee, 2000) Then
        Call DoSendDatagram(m_HD8583)
    End If
End Sub

Private Sub Form_Load()
    m_bResult = CreateObject(0, COMMTYPE_ZIGBEE, True, GB_GB) '创建对象
    If m_bResult Then
        sbStatus.Panels(2).Text = "创建对象成功"
    Else
        sbStatus.Panels(2).Text = "创建对象失败"
    End If
    
    m_nStart = 0
    m_strEnumPort = ""
    Call ListPorts
    sbStatus.Panels(3).Text = Now
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If MSComm.PortOpen Then
        MSComm.PortOpen = False
    End If
    Call DestroyObject '销毁对象
End Sub

'改变串口
Private Sub cmbPort_Click()
    If cmbPort.Text <> m_strPort Then
        If MSComm.PortOpen Then
            Call cmdConnect_Click
        End If
        m_strPort = cmbPort.Text
    End If
End Sub

'连接串口
Private Sub cmdConnect_Click()
    If MSComm.PortOpen Then
        MSComm.PortOpen = False
    Else
        MSComm.CommPort = cmbPort.Text
        MSComm.Settings = txtPortSet.Text
        MSComm.PortOpen = True
    End If
    
    If MSComm.PortOpen Then
        cmdConnect.Caption = "关闭串口"
    Else
        cmdConnect.Caption = "连接串口"
    End If
End Sub

'枚举本机串口号并在cmbPort中列出
Private Sub ListPorts()
    Dim bNum As Boolean
    Dim nPos, nStart, nEnd As Long
    Dim strPorts As String
    
    nPos = 1
    strPorts = EnumCommPorts() '枚举本机串口号
    '分别把串口号插入cmbPort中
    If strPorts <> m_strEnumPort Then
        m_strEnumPort = strPorts
        If MSComm.PortOpen Then
            Call cmdConnect_Click
        End If
        cmbPort.Clear
        Do
            nPos = InStr(nPos, strPorts, "com", vbTextCompare)
            If nPos = 0 Then
                Exit Do
            ElseIf nPos > 2 Then
                If Mid(strPorts, nPos - 1, 1) <> "," Then '","为串口分隔符
                    Exit Do
                End If
            End If
            
            nEnd = nPos + 2
            Do
                nEnd = nEnd + 1
                bNum = IsNumeric(Mid(strPorts, nEnd, 1))
            Loop Until bNum = False
            cmbPort.AddItem (Mid(strPorts, nPos + 3, nEnd - nPos - 3))
            nPos = nEnd + 1
        Loop Until nPos = 0
        
        If cmbPort.ListCount > 0 Then
            cmbPort.ListIndex = 0
        End If
        m_strPort = cmbPort.Text
    End If
End Sub

'获取终端序列号
Private Function GetTerminalSN() As Long
    If chkBroadcast.Value = 0 Then
        GetTerminalSN = CLng(txtTerSN.Text)
    Else '广播通讯
        GetTerminalSN = HDA_BROADCASTSN
    End If
End Function

'获取终端地址
Private Function GetAddress() As Long
    If chkBroadcast.Value = 0 Then
        GetAddress = CLng(cmbAddress.Text)
    Else '广播通讯
        GetAddress = HDA_BROADCASTADDRESSOFALL
    End If
End Function

'获取系统当前日期和时间
Private Function GetDateTime() As MYDATETIMESTRUCT
    Dim DateTime As MYDATETIMESTRUCT
    Dim LocalTime As SYSTEMTIME
    
    Call GetLocalTime(LocalTime)
    DateTime.Year = LocalTime.wYear - 2000
    DateTime.Month = LocalTime.wMonth
    DateTime.Day = LocalTime.wDay
    DateTime.Hour = LocalTime.wHour
    DateTime.Minute = LocalTime.wMinute
    DateTime.Second = LocalTime.wSecond
    DateTime.DayOfWeek = LocalTime.wDayOfWeek
    
    GetDateTime = DateTime
End Function

'启动等待响应定时器
Private Function TimerOn(cmd As CommandButton, Time As Long) As Boolean
    If frmMain.Timer2.Enabled Then
        MsgBox "前面操作未完成, 请稍候!"
        TimerOn = False
        Exit Function
    End If
    
    If MSComm.PortOpen Then
        frmMain.sbStatus.Panels(2).Text = "等待......"
        If Time > 0 Then '等待响应定时器启动
            frmMain.Timer2.Interval = Time
            frmMain.Timer2.Enabled = True
            m_nStart = GetTickCount()
            
            Set m_Button = cmd
            m_Button.Enabled = False
        End If
    Else
        frmMain.sbStatus.Panels(2).Text = "请先连接串口!"
        TimerOn = False
        Exit Function
    End If
    
    TimerOn = True
End Function

'停止等待响应定时器
Private Function TimerOff() As Long
    frmMain.Timer2.Enabled = False
    If TypeOf m_Button Is CommandButton Then
        m_Button.Enabled = True
    End If
    TimerOff = GetTickCount() - m_nStart '时延
End Function

'1秒钟定时器
Private Sub Timer1_Timer()
    Call ListPorts '定时更新串口列表
    sbStatus.Panels(3).Text = Now
End Sub

'等待响应超时
Private Sub Timer2_Timer()
    Timer2.Enabled = False '停止计时
    If TypeOf m_Button Is CommandButton Then
        m_Button.Enabled = True
    End If
    
    sbStatus.Panels(2).Text = "响应超时, 等待: " + CStr(Timer2.Interval) + "毫秒"
End Sub

'发送报文处理
Private Function DoSendDatagram(ByRef HD8583 As HD8583STRUCT) As Boolean
    m_BufferLength = Len(m_Buffer)
    m_bResult = SendHD8583(HD8583, m_Buffer, m_BufferLength, True) ' 转换报文
    If m_bResult Then
        ReDim m_bSendData(0 To m_BufferLength - 1) As Byte
        Call CopyMemory(m_bSendData(0), m_Buffer, m_BufferLength)
        MSComm.InBufferCount = 0
        MSComm.OutBufferCount = 0
        MSComm.Output = m_bSendData
        frmMain.sbStatus.Panels(2).Text = "发送报文成功"
        DoSendDatagram = True
    Else
        frmMain.sbStatus.Panels(2).Text = "发送报文失败"
        DoSendDatagram = False
    End If
End Function

'添加终端号
Private Sub AddTerminal(ByVal Address As Integer)
    Dim bFound As Boolean
    bFound = False
    For i = 0 To cmbAddress.ListCount - 1   ' Loop through list.
        If cmbAddress.List(i) = m_ReqHd8583.Address Then
            bFound = True
            Exit For
        End If
    Next i
    If bFound = False Then
        cmbAddress.AddItem (m_ReqHd8583.Address)
    End If
End Sub

Private Sub MSComm_OnComm()
    Dim bRecvData() As Byte
    Dim nLength As Long
    Dim nCommand As Long
    
    Select Case MSComm.CommEvent
        Case comEvReceive
'           Sleep (10) '等待接收完数据
            nLength = MSComm.InBufferCount
            bRecvData = MSComm.Input '接收数据
            Call CopyMemory(m_Buffer, bRecvData(0), nLength)
            m_Message = 0
            Do While m_Message <> -1
                m_BufferLength = Len(m_Buffer)
                m_Message = UnPackHD8583A(m_Buffer, m_BufferLength, nLength)
                If m_Message <> -1 Then
                    Call DoRecvDatagram(nLength)
                    nLength = 0
                End If
            Loop
    End Select
End Sub

'接收报文处理
Private Sub DoRecvDatagram(ByVal Length As Long)
    Dim DateTime As MYDATETIMESTRUCT

    '响应报文清零
    Call MemSet_HD(m_RspHd8583, &H0, Len(m_RspHd8583))
    '获取请求报文
    Call GetHD8583(m_Buffer, Length, m_ReqHd8583)
    
    '校验MAC值
    If IsMACValid(m_bWK(1)) Then
       frmMain.sbStatus.Panels(2).Text = "MAC值正确"
    Else
        frmMain.sbStatus.Panels(2).Text = "MAC值错误"
        Exit Sub
    End If
    
    '是终端响应报文则显示响应码
    If (m_ReqHd8583.Message_Type Mod 2) = HDA_REQMESSAGEOFBACKGROUND Then
        frmMain.sbStatus.Panels(2).Text = "响应码: " + CStr(m_ReqHd8583.Response_Code) + _
                                          ", 等待: " + CStr(TimerOff()) + "毫秒"
        '响应码不等于RC_SUCCESS则直接退出
        If m_ReqHd8583.Response_Code <> RC_SUCCESS Then
            Exit Sub
        End If
    End If
    
    m_RspHd8583.Message_Type = m_ReqHd8583.Message_Type
    DateTime = GetDateTime

    '根据信息码对报文做不同的处理
    Select Case m_ReqHd8583.Message_Type
        Case MT_REECHO1 '回响测试
            m_RspHd8583.TerminalSN = m_ReqHd8583.TerminalSN
            m_RspHd8583.Address = m_ReqHd8583.Address
            m_RspHd8583.Response_Code = RC_SUCCESS
        Case MT_REECHO2
        Case MT_ONLINENOTICE1
            m_RspHd8583.TerminalSN = m_ReqHd8583.TerminalSN
            m_RspHd8583.Address = m_ReqHd8583.Address
            m_RspHd8583.DateTime = DateTime
            m_RspHd8583.Response_Code = RC_SUCCESS
            m_RspHd8583.VerOfList = m_ReqHd8583.VerOfList
        Case MT_SEARCHNETWORKOFZIGBEEMODULE1
            Call AddTerminal(m_ReqHd8583.Address)
            Exit Sub
        Case MT_SEARCHNETWORKOFZIGBEEMODULE2
            Call AddTerminal(m_ReqHd8583.Address)
            Call cmdGetMAC_Click
    End Select

    '是终端请求报文则发送响应报文
    If (m_ReqHd8583.Message_Type Mod 2) = HDA_REQMESSAGEOFTERMINAL Then
        Call DoSendDatagram(m_RspHd8583)
    End If
End Sub