frmdemo.frm

HD 6P RFID 终端机、考勤卡钟 CAN 通讯接口程序 VB 源码

    m_HD8583.LenOfAdditionalData2 = 20
    Dim nTemp As Long
    nTemp = 500      ' 日消费限额
    Call CopyMemory(m_HD8583.AdditionalData2(0), nTemp, Len(nTemp))
    nTemp = 50           ' 次消费限额
    Call CopyMemory(m_HD8583.AdditionalData2(4), nTemp, Len(nTemp))
    nTemp = 10             ' 日消费限次
    Call CopyMemory(m_HD8583.AdditionalData2(8), nTemp, Len(nTemp))
    nTemp = 5           ' 定值消费机的定值额
    Call CopyMemory(m_HD8583.AdditionalData2(12), nTemp, Len(nTemp))
    nTemp = 100        ' 透支额
    Call CopyMemory(m_HD8583.AdditionalData2(16), nTemp, Len(nTemp))
    Dim str As String * 16
    str = "你好啊"
    m_HD8583.LenOfAdditionalData3 = Len(str)
    m_HD8583.AdditionalData3 = str
    str = "8888888"                    ' 管理中心电话号码
    m_HD8583.LenOfAdditionalData4 = Len(str)
    m_HD8583.AdditionalData4 = str
    If TimerOn(CmdConfigPara, 300) Then
        Call DoSendDatagram(m_HD8583)
    End If
End Sub

Private Sub Command1_Click()
   Dim n As Integer
   Dim Buffer() As Byte
   Dim strA As String

 'Buffer = Space$(256)
  ' n = GetSystemDirectory(Buffer(0), 256)
   'strA = StrConv(Buffer, vbUnicode)
   'strA = Left$(strA, n)
  ' Print strA
  strA = "悄悄"
  Buffer = strA
    
End Sub

Private Sub CmdWriteText_Click()
    Dim strFileName As String '文件名
    Dim lngHandle As Long '句柄
    Dim strWrite As String '要写入的文本内容
    strFileName = "c:\w.txt"
    lngHandle = FreeFile() '取得句柄
    '准备要写入的内容
    strWrite = "落日楼头，断鸿声里，江南游子。把吴钩看了，栏干拍遍，无人会、登临意。"
    Open strFileName For Output As lngHandle    '打开文件
    Print #lngHandle, strWrite    '写入文本
    Close lngHandle    '关闭文件
    'App.Path   获取当前路径
    
    
    
      
End Sub

Private Sub Command2_Click()
      m_RspHd8583.TerminalSN = m_ReqHd8583.TerminalSN
                 m_RspHd8583.Address = m_ReqHd8583.Address
                '写金额
                 m_RspHd8583.AdditionalAmount = 2350
                 Dim byte1() As Byte
                 Dim MyName  As String
                 MyName = "张三风"
                 byte1 = MyName
'                 Call CopyMemory(m_HD8583.AdditionalData4(0), byte1(0), Len(MyName) * 2)
'                 m_HD8583.LenOfAdditionalData4 = Len(MyName) * 2
End Sub

Private Sub Form_Load()
    m_bResult = CreateObject(hwnd, COMMTYPE_CAN1_1, 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
    Call cmbSysID_Click
    cmbSysID.ListIndex = 2    '收费
    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 cmbSysID_Click()
    If cmbSysID.ListIndex = 0 Then
        m_nSystemID = HDA_SYSTEMIDOFATT1_1
        m_nBroadcastAddress = HDA_BROADCASTADDRESSOFONE + HDA_SYSTEMIDOFATT1_1
    ElseIf cmbSysID.ListIndex = 1 Then
        m_nSystemID = HDA_SYSTEMIDOFACC1_1
        m_nBroadcastAddress = HDA_BROADCASTADDRESSOFONE + HDA_SYSTEMIDOFACC1_1
    ElseIf cmbSysID.ListIndex = 2 Then
        m_nSystemID = HDA_SYSTEMIDOFPOS1_1
        m_nBroadcastAddress = HDA_BROADCASTADDRESSOFONE + HDA_SYSTEMIDOFPOS1_1
    Else
        m_nBroadcastAddress = HDA_BROADCASTADDRESSOFALL
    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

Private Sub cmdReecho_Click()
    ' 请求报文清零
    Call MemSet_HD(m_HD8583, &H0, Len(m_HD8583))
    m_HD8583.Message_Type = MT_REECHO2
    m_HD8583.TerminalSN = GetTerminalSN()
    m_HD8583.Address = GetAddress()
    Dim MyName  As String
    If TimerOn(cmdReecho, 300) Then
        Call DoSendDatagram(m_HD8583)
    End If
End Sub

Private Sub cmdNotice_Click()
    Dim DateTime As MYDATETIMESTRUCT

    ' 请求报文清零
    Call MemSet_HD(m_HD8583, &H0, Len(m_HD8583))
    m_HD8583.Message_Type = MT_ONLINENOTICE2
    m_HD8583.TerminalSN = GetTerminalSN()
    m_HD8583.Address = GetAddress()
    m_HD8583.DateTime = GetDateTime()
    m_HD8583.VerOfList = 1

    If TimerOn(cmdNotice, 3000) Then
        Call DoSendDatagram(m_HD8583)
    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 = m_nSystemID + CLng(txtAddress.Text)
      
    Else '广播通讯
        GetAddress = m_nBroadcastAddress
    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

Private Sub List1_Click()

End Sub

Private Sub IDsetIDWL_Click()

End Sub

Private Sub IDSETBL_Click()
     Dim Count As Long
     Call MemSet_HD(m_HD8583, &H0, Len(m_HD8583))
     m_HD8583.Message_Type = MT_UPDATEIDLIST2
     m_HD8583.Address = GetAddress()
     m_HD8583.TerminalID = GetTerminalID()
     m_HD8583.VerOfList = CurrentVersion + 10
     m_HD8583.LenOfAdditionalData3 = 1 ' 结束标志
     
     Dim SerialNum As Long
     SerialNum = 1
     m_HD8583.LenOfAdditionalData1 = Len(SerialNum)
     Call CopyMemory(m_HD8583.AdditionalData1(0), SerialNum, Len(SerialNum))
     Dim CardNO As Long
     For Count = 1 To CurrentVersion + 10 Step 1
         CardNO = Count + CurrentVersion
         Call CopyMemory(m_HD8583.AdditionalData2(Count * 4 - 4), CardNO, 4)
     Next Count
     m_HD8583.LenOfAdditionalData2 = 4 * Count - 4
     If (TimerOn(IDSETBL, 5000)) Then
         Call DoSendDatagram(m_HD8583)
     End If
     
End Sub

'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