frmdemo.frm

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

         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Label Label10 
      Caption         =   "终端号"
      Height          =   255
      Left            =   7560
      TabIndex        =   39
      Top             =   2880
      Width           =   615
   End
   Begin VB.Label Label9 
      Caption         =   "时间"
      Height          =   255
      Left            =   7680
      TabIndex        =   38
      Top             =   2400
      Width           =   375
   End
   Begin VB.Label Label8 
      Caption         =   "卡号"
      Height          =   255
      Left            =   7680
      TabIndex        =   37
      Top             =   1920
      Width           =   375
   End
   Begin VB.Label Label7 
      Caption         =   "实时上串记录显示"
      Height          =   375
      Left            =   7440
      TabIndex        =   33
      Top             =   1320
      Width           =   1095
   End
   Begin VB.Line Line3 
      X1              =   7320
      X2              =   7320
      Y1              =   1080
      Y2              =   4560
   End
   Begin VB.Line Line2 
      X1              =   4080
      X2              =   4080
      Y1              =   1080
      Y2              =   4680
   End
   Begin VB.Label LbVersion 
      Caption         =   "黑名单版本"
      Height          =   255
      Left            =   4200
      TabIndex        =   28
      Top             =   2280
      Width           =   975
   End
   Begin VB.Label Label6 
      Caption         =   "终端ID"
      Height          =   255
      Left            =   4680
      TabIndex        =   26
      Top             =   2760
      Width           =   615
   End
   Begin VB.Label Label5 
      Caption         =   "配置:"
      Height          =   195
      Left            =   1980
      TabIndex        =   14
      Top             =   240
      Width           =   615
   End
   Begin VB.Line Line1 
      X1              =   0
      X2              =   10680
      Y1              =   1080
      Y2              =   1080
   End
   Begin VB.Label Label4 
      Caption         =   "序列号:"
      Height          =   255
      Left            =   1980
      TabIndex        =   12
      Top             =   660
      Width           =   615
   End
   Begin VB.Label Label3 
      Caption         =   "子系统:"
      Height          =   255
      Left            =   120
      TabIndex        =   11
      Top             =   600
      Width           =   735
   End
   Begin VB.Label Label2 
      Caption         =   "地  址:"
      Height          =   255
      Left            =   4560
      TabIndex        =   10
      Top             =   1680
      Width           =   645
   End
   Begin VB.Label Label1 
      Caption         =   "串口号:"
      Height          =   255
      Left            =   120
      TabIndex        =   8
      Top             =   240
      Width           =   735
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim m_nSystemID As Long
Dim m_nBroadcastAddress As Long
Dim m_strPort, m_strEnumPort As String
Dim m_bResult As Boolean
Dim m_nStart As Long
Dim m_bWK(0 To 7) As Byte
Dim m_Button
Dim m_bSendData() As Byte
Dim m_BufferLength As Long
Dim m_Message As Long
Dim m_HD8583 As HD8583STRUCT
Dim m_RspHd8583 As HD8583STRUCT                    '响应报文
Dim m_ReqHd8583 As HD8583STRUCT                    '请求报文
Dim m_Buffer As BUFFERSTRUCT                       '缓冲区定义
Dim R_Date As TRADERECORDSTRUCT
Public m_nTryTimes As Integer                      '定义报文重发次数
Public nCount As Integer                           '处理记录的条数
Dim m_HD8583_Bak As HD8583STRUCT                   '采集记录时备份的报文
Dim CurrentVersion As Long                         '当前终端的黑名单版本
Dim IDWCListVersion As Long                        'ID白名单版本
Dim WordMode As Byte                               '工作模式


Private Sub btnAllotAddr_Click()
    Dim wAddress As Integer
    Call MemSet_HD(m_HD8583, &H0, Len(m_HD8583))
    m_HD8583.Message_Type = MT_ALLOTADDRESS2
    m_HD8583.TerminalSN = GetTerminalSN()
    m_HD8583.Address = GetAddress()
    wAddress = 108
    m_HD8583.LenOfAdditionalData1 = Len(wAddress)
    Call CopyMemory(m_HD8583.AdditionalData1(0), wAddress, m_HD8583.LenOfAdditionalData1)
    If TimerOn(btnAllotAddr, 300) Then
        Call DoSendDatagram(m_HD8583)
    End If
  
     
End Sub

Private Sub btnClearUpBList_Click()
'没有调试过，2006-5-29
      Call MemSet_HD(m_HD8583, &H0, Len(m_HD8583))
      m_HD8583.Message_Type = MT_UPDATELIST2
      m_HD8583.Address = GetAddress()
      m_HD8583.TerminalID = GetTerminalID()
      m_HD8583.VerOfList = 0
      m_HD8583.LenOfAdditionalData3 = 1
   
      m_HD8583.WorkKey(1) = 255
      m_HD8583.WorkKey(2) = 255
      m_HD8583.WorkKey(3) = 255
      m_HD8583.WorkKey(4) = 255
      m_HD8583.WorkKey(5) = 255
      m_HD8583.WorkKey(6) = 255
      m_HD8583.WorkKey(7) = 255
      m_HD8583.WorkKey(0) = 255
      If (TimerOn(btnClearUpBList, 5000)) Then
         Call DoSendDatagram(m_HD8583) '发送报文
      End If
End Sub

Private Sub btnCollectRec_Click()
      m_nTryTimes = 4  '报文重复次数赋值
      Call MemSet_HD(m_HD8583, &H0, Len(m_HD8583))
      m_HD8583.Message_Type = MT_BATCHSENDRECORD2
      m_HD8583.Address = GetAddress()
      m_HD8583.TerminalID = CLng(TextTermilID.Text)
      m_HD8583.LenOfAdditionalData1 = 1
      m_HD8583.AdditionalData1(0) = 10
      m_HD8583.WorkKey(1) = &HFF
      m_HD8583.WorkKey(2) = &HFF
      m_HD8583.WorkKey(3) = &HFF
      m_HD8583.WorkKey(4) = &HFF
      m_HD8583.WorkKey(5) = &HFF
      m_HD8583.WorkKey(6) = &HFF
      m_HD8583.WorkKey(7) = &HFF
      m_HD8583.WorkKey(0) = &HFF
      Call CopyMemory(m_HD8583_Bak, m_HD8583, Len(m_HD8583))
      If (TimerOn(btnCollectRec, 5000)) Then
         Call DoSendDatagram(m_HD8583) '发送报文
      End If
     
End Sub

Private Sub btnGetPara_Click()
    Call MemSet_HD(m_HD8583, &H0, Len(m_HD8583))
    m_HD8583.Message_Type = MT_CONFIGPARA2
    m_HD8583.TerminalSN = GetTerminalSN()
    m_HD8583.Address = GetAddress()
    If (TimerOn(btnGetPara, 5000)) Then
       Call DoSendDatagram(m_HD8583) '发送报文
    End If
     
End Sub

Private Sub btnGetUserID_Click()
    Call MemSet_HD(m_HD8583, &H0, Len(m_HD8583))
    m_HD8583.Message_Type = MT_SETUSERDEFNUMBER2
    m_HD8583.TerminalSN = GetTerminalSN()
    m_HD8583.Address = GetAddress()
    If (TimerOn(btnGetUserID, 1000)) Then
        Call DoSendDatagram(m_HD8583)
    End If
     
End Sub

Private Sub btnInitPara_Click()
    Dim DateTime As MYDATETIMESTRUCT
    Dim bCommType As Byte
    Call MemSet_HD(m_HD8583, &H0, Len(m_HD8583))
    m_HD8583.Message_Type = MT_INITPARA2
    m_HD8583.TerminalSN = GetTerminalSN()
    m_HD8583.Address = GetAddress()
    DateTime = GetDateTime()
    Call CopyMemory(m_HD8583.DateTime, DateTime, Len(DateTime))
    '此处请注意，0表示CAN通讯方式，1表示RS485通讯方式，2表示MODEM通讯方式
    '3表示TCP/IP通讯方式，4表示GPRS通讯方式
    bCommType = 0
    m_HD8583.LenOfAdditionalData1 = Len(bCommType)
    Call CopyMemory(m_HD8583.AdditionalData1(0), bCommType, m_HD8583.LenOfAdditionalData1)
    m_HD8583.LenOfAdditionalData2 = 1
    m_HD8583.AdditionalData2(0) = 0
    If (TimerOn(btnInitPara, 3500)) Then
       Call DoSendDatagram(m_HD8583)
    End If
End Sub

Private Sub btnUpdateBCList_Click()
'没有调试过，2006-5-29
     Dim Count As Long
     Dim BlackRecord As BlackListSTRUCT
     Call MemSet_HD(m_HD8583, &H0, Len(m_HD8583))
     m_HD8583.Message_Type = MT_UPDATELIST2
     m_HD8583.Address = GetAddress()
     m_HD8583.TerminalID = GetTerminalID()
     m_HD8583.VerOfList = CurrentVersion + 10
     m_HD8583.LenOfAdditionalData3 = 1 ' 结束标志
     Dim CardNO As Long
     For Count = 0 To 9 Step 1
         CardNO = Count + CurrentVersion
         BlackRecord.SerialNO = Count + 1
         BlackRecord.CardNO = CardNO
         Call CopyMemory(m_HD8583.AdditionalData2(Count * 5), BlackRecord, 5)
     Next Count
     m_HD8583.LenOfAdditionalData2 = Len(BlackRecord) * 9
     If (TimerOn(btnUpdateBCList, 3500)) Then
       Call DoSendDatagram(m_HD8583)
     End If
End Sub

Private Sub btnUpdateIDWCList_Click()
     Call MemSet_HD(m_HD8583, &H0, Len(m_HD8583))
     m_HD8583.Message_Type = MT_UPDATEIDWCLIST2
     m_HD8583.TerminalID = GetTerminalID()
     m_HD8583.Address = GetAddress()
     m_HD8583.VerOfList = IDWCListVersion + 10
     
     m_HD8583.LenOfAdditionalData3 = 1
     m_HD8583.WorkKey(1) = 255
     m_HD8583.WorkKey(2) = 255
     m_HD8583.WorkKey(3) = 255
     m_HD8583.WorkKey(4) = 255
     m_HD8583.WorkKey(5) = 255
     m_HD8583.WorkKey(6) = 255
     m_HD8583.WorkKey(7) = 255
     m_HD8583.WorkKey(0) = 255
     m_HD8583.VerOfList = IDWCListVersion + 10
     
     Dim Count As Long
     Dim CardNO As Long
     Dim MyName  As String * 12
     For Count = 0 To 9 Step 1
         CardNO = IDWCListVersion + Count
         MyName = "张三"
         Call CopyMemory(m_HD8583.AdditionalData2(Count * 4), CardNO, 4)
         m_HD8583.AdditionalData4 = m_HD8583.AdditionalData4 + MyName
     Next Count
     m_HD8583.LenOfAdditionalData2 = 4 * Count
     m_HD8583.LenOfAdditionalData4 = 12 * Count
     m_HD8583.LenOfAdditionalData1 = 1
     m_HD8583.AdditionalData1(0) = 1
     If (TimerOn(btnUpdateIDWCList, 3500)) Then
         Call DoSendDatagram(m_HD8583)
     End If
    
End Sub

Private Sub CmdConfigPara_Click()
    Call MemSet_HD(m_HD8583, &H0, Len(m_HD8583))
    m_HD8583.Message_Type = MT_CONFIGPARA2
    m_HD8583.TerminalSN = GetTerminalSN()
    m_HD8583.Address = GetAddress()
    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)