frmmain.frm

HD 6P RFID发卡器、考勤卡钟 串口通讯接口程序 VB 源码

   End If
    
End Sub

Private Sub cmdreadew6k_Click()
    If m_CardID.CardID <> 0 Then
     m_CardID.CARDTYPE = CByte(1) '钱包索引,如果是
     
     MSComm.InBufferCount = 0
     MSComm.OutBufferCount = 0
     stbResult.Panels(2).Text = ""
    
     If MSComm.PortOpen Then
        m_nBufferLength = 1000
        '读钱包命令
        m_bResult = SendCommandA(MT_READEW_CARDOFHD6K, m_CardID, Len(m_CardID), m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        Else: MsgBox "命令发送失败"
        End If
     End If
   Else
     MsgBox "请先寻卡"
  End If
    
End Sub

Private Sub cmdsetwk_Click()
     'BLOCKSTRUCT OldKey, NewKey;
   Dim OldKey As BLOCKSTRUCT
   Dim NewKey As BLOCKSTRUCT
   Dim kk As Integer

   For kk = 0 To 15 Step 1
       OldKey.Data(kk) = &HFF
       NewKey.Data(kk) = &HFF
   Next kk
   Call SetCardRootKey(OldKey.Data(0), NewKey.Data(0))
    
End Sub

Private Sub cmdwritecard6k_Click()
  Dim CardInfo As CARDINFO_HD6K
  Dim str As String
  Dim kk As Integer
  Dim Name() As Byte
  Call MemSet_HD(CardInfo, &H0, Len(CardInfo))
  If m_CardID.CardID <> 0 Then
    
    CardInfo.CardID = m_CardID     '写卡时要带上寻卡时读出的资料，否则命令失败
    CardInfo.CardNo = 12345        '卡号
    MsgBox Prop.ReaderID
    
    If Prop.ReaderID <> 0 Then
      CardInfo.EWallet.ReaderSN = Prop.ReaderID              ' Reader序列号
    Else
      MsgBox "请先读读卡器"
      Exit Sub
    End If
    str = "1234567"
    Call CopyMemory(CardInfo.PersonNo, str, Len(str))
    
    str = "张山"
    'Name = str
    CardInfo.MyName = str
   'MsgBox CStr(Name)
   ' Call CopyMemory(CardInfo.MyName(1), Name(0), Len(str) * 2)
    'Call CopyMemory(CardInfo, StrConv(str, vbUnicode), LenB(StrConv(str, vbUnicode)))
    CardInfo.GradeNo = 0      ' 级别
    CardInfo.GroupNo = 0      ' 分组
    
    str = "000000"
    CardInfo.Password = str
    'If Len(str) = 6 Then
    'For kk = 1 To 6 Step 1
        'CardInfo.Password(kk) = CByte(Mid(str, kk, kk))
       ' CardInfo.Password(kk) = 0
    'Next kk
    'Else
       'MsgBox "密码要6位数字"
       'Exit Sub
    'End If
    CardInfo.DeptNo = 25 '部门编号
    CardInfo.CARDTYPE = 0                                      ' 卡类型
    '卡类型可以直接选择，可以任意组合
    CardInfo.CARDTYPE = CardInfo.CARDTYPE + CardType_POS        '收费
    'CardInfo.CARDTYPE = CardInfo.CARDTYPE + CARDTYPE_ATT        '考勤
    'CardInfo.CARDTYPE = CardInfo.CARDTYPE + CARDTYPE_ACC        '门禁
    'CardInfo.CARDTYPE = CardInfo.CARDTYPE + CARDTYPE_OPR        '操作员
    'CardInfo.OPRCARDTYPE = OPRCARDTYPE_ENDOPR                  '操作员类行
    'CardInfo.OprCardType = Integer(OPRCARDTYPE_ENDCONFIG)
    
    CardInfo.StartDate.Year = 2009  ' 启用日期
    CardInfo.StartDate.Month = 5
    CardInfo.StartDate.Day = 5
    CardInfo.DeadDate.Year = 2010   ' 截止日期
    CardInfo.DeadDate.Month = 10
    CardInfo.DeadDate.Day = 10

    CardInfo.QuotaPerDay = 100       ' 日限额-元
    CardInfo.QuotaPerTimes = 50   ' 次限额-元
    CardInfo.CardDeposit = 30       ' 卡押金-元
    CardInfo.CERTTYPE = 1   '证件类型
    str = "1234567890"
   
    CardInfo.LockFlag = True   '1锁，0不锁               ' 锁卡标志
    CardInfo.IsWriteEW = True   '1 写，0不写                  ' 是否写钱包
    CardInfo.EWallet.CardID = m_CardID
    CardInfo.EWallet.IndexOfEW = 1    ' 钱包索引号
    CardInfo.EWallet.Deposit = 50      ' 本次充值额
    CardInfo.EWallet.Balance = 50      ' 钱包余额
    
    CardInfo.EWallet.SumOfDeposit = 0     ' 累计充值额
    CardInfo.EWallet.TraceOfEW = 0        ' 钱包流水号
    CardInfo.EWallet.IntradaySumOfAmount = 0 ' 当日累计消费额
    
    CardInfo.EWallet.LastDealDate_D.Year = 2006    ' 充值日期时间
    CardInfo.EWallet.LastDealDate_D.Month = 5
    CardInfo.EWallet.LastDealDate_D.Day = 10
    CardInfo.EWallet.LastTime_D.Hour = 12
    CardInfo.EWallet.LastTime_D.Minute = 30
    CardInfo.EWallet.LastTime_D.Second = 30
    
    'Call SendCommand(MT_WRITEDATA_CARDOFHD6K, CardInfo, Len(CardInfo))  ' 写卡
    MSComm.InBufferCount = 0
    MSComm.OutBufferCount = 0
    stbResult.Panels(2).Text = ""
    
    If MSComm.PortOpen Then
        m_nBufferLength = 1000
        m_bResult = SendCommandA(MT_WRITEDATA_CARDOFHD6K, CardInfo, Len(CardInfo), m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        Else: MsgBox "命令发送失败"
        End If
    End If
  Else
    MsgBox "请先寻卡"
  End If
    
End Sub

Private Sub cmdwriteew6k_Click()
  Dim m_EWInfo As EW_HD6K
  If m_CardID.CardID <> 0 Then
     m_EWInfo.CardID = m_CardID '写卡时 要带上此卡的序列号
     m_EWInfo.IndexOfEW = 1 ' 钱包索引号
     m_EWInfo.Deposit = 100 ' 本次充值额
     m_EWInfo.Balance = 100 ' 钱包余额
     m_EWInfo.SumOfDeposit = 100 '累计充值额
     
     m_EWInfo.TraceOfEW = 0 ' 钱包流水号
     m_EWInfo.IntradaySumOfAmount = 0 ' 当日累计消费额
     m_EWInfo.ReaderSN = Prop.ReaderID ' Reader序列号

     m_EWInfo.LastDealDate_D.Year = 6 ' 充值日期时间
     m_EWInfo.LastDealDate_D.Month = 5
     m_EWInfo.LastDealDate_D.Day = 10
     
     MSComm.InBufferCount = 0
     MSComm.OutBufferCount = 0
     stbResult.Panels(2).Text = ""
    
     If MSComm.PortOpen Then
        m_nBufferLength = 1000
        '写钱包
        m_bResult = SendCommandA(MT_WRITEEW_CARDOFHD6K, m_EWInfo, Len(m_EWInfo), m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        Else: MsgBox "命令发送失败"
        End If
     End If
     
  Else: MsgBox "请先寻卡"
  End If
    
End Sub





Private Sub Command1_Click()

End Sub

Private Sub cmdWriteHD4k_Click()
    Dim ATTCardinfo As ATTGUARDCARD_HD4K
    Dim POSCardInfo As POSCARD_HD4K
    Dim OPRCardInfo As OPRCARD_HD4K
    Dim str As String
    Dim kk As Integer
    '考勤门禁卡
   ATTCardinfo.SectorNo = 2 ' 扇区号
   ATTCardinfo.FileSort = FILEOFHD4K_ATT
   ATTCardinfo.CardNo = 12456 '
   str = "gxj76"          '  人员编号
    ATTCardinfo.PersonNo = str
   ATTCardinfo.Grade = 1
   ATTCardinfo.Group = 2
    '卡密码
   ATTCardinfo.Password = "0000"
   str = "张三"
   '持卡人姓名
   ATTCardinfo.Name = str
   ATTCardinfo.Date.Year = 2006
   ATTCardinfo.Date.Month = 5
   ATTCardinfo.Date.Day = 16
   ' 写HD4k考勤卡
   MSComm.InBufferCount = 0
    MSComm.OutBufferCount = 0
    stbResult.Panels(2).Text = ""
    If MSComm.PortOpen Then
        m_nBufferLength = 1000
        m_bResult = SendCommandA(MT_WRITE_CARDOFHD4K, ATTCardinfo, Len(ATTCardinfo), m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        End If
    End If
   'Call SendCommand(MT_WRITE_CARDOFHD4K, ATTCardinfo, Len(ATTCardinfo))

    '消费卡文件
   'POSCardInfo.SectorNo = 3 ' 扇区号
   'POSCardInfo.FileSort = FILEOFHD4K_POS
   'POSCardInfo.CardNo = 123456
   'str = "你好"
   'POSCardInfo.Name = str
   'POSCardInfo.Password = "0000"
   
   'POSCardInfo.Group = 20
   'POSCardInfo.Date.Year = 6 '
   'POSCardInfo.Date.Month = 5 '
   'POSCardInfo.Date.Day = 16 '
   'POSCardInfo.Balance = 0 '
   
   'MSComm.InBufferCount = 0
   'MSComm.OutBufferCount = 0
   'stbResult.Panels(2).Text = ""
   'If MSComm.PortOpen Then
   '   m_nBufferLength = 1000
   '   m_bResult = SendCommandA(MT_WRITE_CARDOFHD4K, POSCardInfo, Len(POSCardInfo), m_bBuffer(0), m_nBufferLength)
   '   If m_bResult Then
   '      ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
   '      Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
   '      MSComm.Output = m_bSendData
   '   End If
   'End If
   'Call SendCommand(MT_WRITE_CARDOFHD4K, POSCardInfo, Len(POSCardInfo)) ' 写消费卡

    '操作员卡
   'OPRCardInfo.SectorNo = 2 ' 扇区号
   'OPRCardInfo.FileSort = FILEOFHD4K_OPR
   'OPRCardInfo.CardNo = 15421
   'str = "你好"
   'OPRCardInfo.Name = str
   'OPRCardInfo.Password = "0000"
   'OPRCardInfo.Date.Year = 2006 '
   'OPRCardInfo.Date.Month = 5
   'OPRCardInfo.Date.Day = 4
   'OPRCardInfo.POSID = 14
   'OPRCardInfo.OprID = 2
   'MSComm.InBufferCount = 0
   'MSComm.OutBufferCount = 0
   'stbResult.Panels(2).Text = ""
   'If MSComm.PortOpen Then
   '   m_nBufferLength = 1000
   '   m_bResult = SendCommandA(MT_WRITE_CARDOFHD4K, OPRCardInfo, Len(OPRCardInfo), m_bBuffer(0), m_nBufferLength)
   '   If m_bResult Then
   '      ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
   '      Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
   '      MSComm.Output = m_bSendData
   '   End If
   'End If
   'Call SendCommand(MT_WRITE_CARDOFHD4K, OPRCardInfo, Len(OPRCardInfo)) '写操作员卡
     
End Sub

Private Sub Form_Load()
    m_bResult = CreateObject(hwnd, GB_GB, True) '创建对象
    Call MemSet_HD(m_CardID, 0, Len(m_CardID))
'    Call SetCardRootKey
    If m_bResult Then
        stbResult.Panels(2).Text = "创建对象成功"
    Else
        stbResult.Panels(2).Text = "创建对象失败"
    End If
    m_nLEDCount = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call DestroyObject '释放对象
End Sub

Private Sub cmdConnect_Click()
    If MSComm.PortOpen Then
        MSComm.PortOpen = False
    Else
        MSComm.CommPort = txtCommPort.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 cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdReaderProp_Click()
    MSComm.InBufferCount = 0
    MSComm.OutBufferCount = 0
    stbResult.Panels(2).Text = ""
    
    If MSComm.PortOpen Then
        m_nBufferLength = 1000
        m_bResult = SendCommandA(MT_RECV_READERPROP, nil, 0, m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        End If
    End If
End Sub

Private Sub cmdBeep_Click()
    MSComm.InBufferCount = 0
    MSComm.OutBufferCount = 0
    stbResult.Panels(2).Text = ""
    
    If MSComm.PortOpen Then
        m_nBufferLength = 1000
        Dim Beep As BEEPSTRUCT
        Beep.Count = 2
        Beep.Times = 100
    
        m_bResult = SendCommandA(MT_BEEP, Beep, Len(Beep), m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        End If
    End If
End Sub

Private Sub cmdSetWaitTime_Click()
    MSComm.InBufferCount = 0
    MSComm.OutBufferCount = 0
    stbResult.Panels(2).Text = ""
    
    If MSComm.PortOpen Then
        m_nBufferLength = 1000
        Dim nWaitTime As Long
        nWaitTime = 2000
    
        m_bResult = SendCommandA(MT_SET_WAITTIME, nWaitTime, Len(nWaitTime), m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        End If
    End If
End Sub

Private Sub cmdLED_Click()
    MSComm.InBufferCount = 0
    MSComm.OutBufferCount = 0
    stbResult.Panels(2).Text = ""
    
    If MSComm.PortOpen Then