frmdemo.frm

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

    m_HD8583.TraceOfPOS = 0
    m_HD8583.TerminalID = GetTerminalID()
    m_HD8583.TERMINALTYPE = 1
    '工作模式定义如下
    '如果机具类型为IC卡读写器： H01 表示充值
    '如果机具为IC卡消费机 H00 计值  H01 定值 H02  记次 H03 扣次 H04  编号 H05 记时 H06 补贴
    '如果机具为IC卡考勤机 H00 普通考勤 H01 巡更机 H02 定餐机
    m_HD8583.WorkMode = WordMode
    m_HD8583.MerchantID = 12

    Dim bTemp(0 To 13) As Byte
    bTemp(0) = 1              ' 钱包索引号
    bTemp(1) = 15   ' 响应超时时限，单位为100ms
    bTemp(2) = 3             ' 最大超时次数
    bTemp(3) = 1            ' 允许消费超限额否
    bTemp(4) = 52           ' 卡最大闲置期，以月为单位
    bTemp(5) = 3         ' 单卡间隔，单位为s
    bTemp(6) = 1       ' 在线通知间隔，单位为分钟
    bTemp(7) = 1         ' 冲正方式
    bTemp(8) = 0           ' 启用操作员签到否
    bTemp(9) = 1             ' 记录满处理方式
    bTemp(10) = 1          ' 黑名单卡刷卡保存记录否
    If CKBlistMode.Value = 1 Then
       bTemp(11) = 1            ' 黑名单方式否
    Else
       bTemp(11) = 0            '白名单模式
    End If
    bTemp(12) = 0          ' 上下班状态
     If chkOfflineMode.Value = 1 Then
       bTemp(13) = 1         ' 脱机模式否
    Else
       bTemp(13) = 0
    End If
    m_HD8583.LenOfAdditionalData1 = Len(bTemp(0)) * 14
    Call CopyMemory(m_HD8583.AdditionalData1(0), bTemp(0), m_HD8583.LenOfAdditionalData1)

    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 strFileName As String '文件名
    Dim lngHandle As Long '句柄
    Dim strWrite As String '要写入的文本内容
    strFileName = "C:\Documents and Settings\Administrator\桌面\工作文件夹\hd6k_sdk\VB\AttRecord.txt"
    lngHandle = FreeFile() '取得句柄
    '准备要写入的内容
    strWrite = "落日楼头，断鸿声里，江南游子。把吴钩看了，栏干拍遍，无人会、登临意。"
    Open strFileName For Output As lngHandle    '打开文件
    Print #lngHandle, strWrite    '写入文本
    Close lngHandle    '关闭文件
    
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 Form_Load()
    m_bResult = CreateObject(0, COMMTYPE_RS232, 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 = 0
    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()
    
    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, False) ' 转换报文
    If m_bResult Then
        ReDim m_bSendData(0 To m_BufferLength - 1) As Byte
        Call CopyMemory(m_bSendData(0), m_Buffer, m_BufferLength)