form1.frm

一款基于标准IC卡考勤数据读写操作示例的开发源程序。主要给需要开发IC卡和考勤系统的网友学习参考用

End Sub

Private Sub Command14_Click()
  RefreshClock
  If OpenPort(Port, BaudRate, clock_id) Then
    'AddLog "[" + CStr(port) + "  号端口 " + CStr(clock_id) + "  号机 成功打开！"
    FrmList.Caption = "删除黑名单"
    FrmList.Show vbModal, Me
    If FrmList.OkFlag Then
      If DeleteBlackCard(hPort, FrmList.txCard) Then
        Text5.Text = "删除黑名单成功"
      Else
        Text5.Text = "删除黑名单失败"
      End If
    End If
    ClosePort
  Else
    Text5.Text = "不能联接设备"
  End If
End Sub

Private Sub Command15_Click()
  RefreshClock
  If OpenPort(Port, BaudRate, clock_id) Then
    'AddLog "[" + CStr(port) + "  号端口 " + CStr(clock_id) + "  号机 成功打开！"
    If DeleteAllAllowedCard(hPort) Then
       Text5.Text = "清除所有白名单成功"
    Else
       Text5.Text = "清除所有白名单失败"
    End If
    ClosePort
  Else
    Text5.Text = "不能联接设备"
  End If
End Sub

Private Sub Command16_Click()
  RefreshClock
  If OpenPort(Port, BaudRate, clock_id) Then
    'AddLog "[" + CStr(port) + "  号端口 " + CStr(clock_id) + "  号机 成功打开！"
    If DeleteAllBlackCard(hPort) Then
       Text5.Text = "清除所有黑名单成功"
    Else
       Text5.Text = "清除所有黑名单失败"
    End If
    ClosePort
  Else
    Text5.Text = "不能联接设备"
  End If
End Sub

Private Sub Command17_Click()
   Dim CardNo As String
   RefreshClock
   If OpenPort(Port, BaudRate, clock_id) Then
     Do While (1)
        DoEvents
        If IFlag = True Then Exit Do
        If ReadLastCard(hPort, CardNo) Then
          List1.AddItem CardNo
        End If
     Loop
     ClosePort
   Else
    Text5.Text = "不能联接设备"
  End If
End Sub

Private Sub Command18_Click()
    Dim PwStr As String
    Dim Block As Integer
    Dim buf As String * 40
    RefreshClock
    Block = AcbCardSector.ListIndex * 4 + 3
    PwStr = Trim(edNewCardPW.Text) & "FF078069FFFFFFFFFFFF"
    If Len(PwStr) <> 32 Then
     MsgBox ("密码长度必须为12位长度")
      GoTo Ext
    End If
    If OpenPort(Port, BaudRate, clock_id) Then
        If SetSecurityCode(hPort, Trim(edOldCardPW.Text), Trim(edOldCardPW.Text)) Then
          If WriteICCardPassWord(hPort, PwStr, Block) Then '修改扇区6的密码
             MsgBox ("写卡密码失败")
          Else
             MsgBox ("写卡密码成功")
          End If
        End If
      ClosePort
   Else
      MsgBox ("不能联接设备")
   End If
Ext:
End Sub

Private Sub Command19_Click()
   Dim card_money As Long
   RefreshClock
   ' card_money = txValue.Text * 10
   ' If (Len(txCard.Text) = 0) Then
   ' MsgBox ("卡号长度不能为零")
   ' GoTo Ext
   ' End If
   ' If OpenPort(Port, BaudRate, clock_id) Then
   '   If (GetClockSupports(hPort, fiAllowCharge)) And (SetAllowCharge(hPort, AcbCardStyle.ListIndex, Trim(txCard.Text), card_money)) Then
   '     MsgBox ("下传补贴成功")
   '   Else
   '     MsgBox ("下传补贴失败")
   '   End If
   '   ClosePort
   'Else
   '   MsgBox ("不能联接设备")
   'End If
'Ext:
End Sub

Private Sub Command2_Click()
  '说明：889D的机型该功能不支持
  Dim CardNo As String
  Dim TimeStr As String
  Dim c As Long
  Dim F As Boolean
  Dim sfilename As String
  List1.Clear
  RCount = 0
  RefreshClock
  If OpenPort(Port, BaudRate, clock_id) Then
     AddLog "[" + CStr(Port) + "]号端口[" + CStr(clock_id) + "]号机 成功打开！"
     sfilename = App.Path & "\" & Format(Now, "yyyymmdd") + "-" & CStr(clock_id) & ".txt"
     c = ReadAllRecordAsFile(hPort, clock_id, sfilename, 0, True, 0)
     If c = 0 Then
           AddLog "[" + CStr(clock_id) + "]机内没有记录"
     ElseIf c > 0 Then
           AddLog "[" + CStr(clock_id) + "]机总共读取 " & CStr(c) & " 条记录"
           If Check1.Value = 1 Then
              F = ClearAllReadCard(hPort)
              If F Then
                  AddLog "[" + CStr(clock_id) + "]机所有记录已被删除！"
              Else
                  AddLog "[" + CStr(clock_id) + "]机删除记录失败。"
              End If
           End If
     ElseIf (c = -1) Or (c = -2) Then
           AddLog "[" + CStr(clock_id) + "]机串行通行错误"
     ElseIf c = -3 Then
           AddLog "[" + CStr(clock_id) + "]机命令字异或校验错误"
     ElseIf c = -4 Then
           AddLog "[" + CStr(clock_id) + "]机用户中止或接收未完成"
     Else
           AddLog "[" + CStr(clock_id) + "]机资源分配错误"
     End If
     Close #1
    ClosePort
    'MsgBox CStr(GetRecentErrCode)
    Else
      AddLog CStr(clock_id) + "号机联机失败"
  End If
End Sub


Sub CreateAfile(fName As String)
  'Set fs = CreateObject("Scripting.FileSystemObject")
  'Set F = fs.CreateTextFile(fName, True)
  'F.WriteLine ("Add Data blow")
  'F.Close
End Sub

Private Sub Command20_Click()
  Dim FileName As String
  Dim strTemp As String
  
  
  
  CommonDialog1.ShowOpen
  FileName = CommonDialog1.FileName
  
  Open FileName For Input As #1

   Do While (Not EOF(1))
  
    Line Input #1, strTemp
    List1.AddItem strTemp
  Loop
  
 ' RichTextBox1.LoadFile FileName
  End Sub

Private Sub Command21_Click()
  Dim card_buf As String * 50
  Dim name_buf As String * 50
  Dim card_pwd As String * 10
  
  Dim card_money As Long
  Dim card_times As Long
  Dim card_style As Long
  Dim day_consumed As Long
  Dim day_times As Long
  Dim c_month As Long
  Dim c_day As Long
  Dim c_flag As Long
  Dim GroupStation As Long
  Dim GroupId As Long
  
  RefreshClock
    If OpenPort(Port, BaudRate, clock_id) Then
      If ReadICCardEx(hPort, card_buf, name_buf, card_pwd, card_money, card_times, day_consumed, day_times, c_month, c_day, c_flag, GroupStation, GroupId, card_style) Then
         'WriteICCardPassWord hPort, edCardPW.Text
        If GetSystemLangID() = 950 Then
          GBTBIG5 name_buf, name_buf
        End If
        edCardId.Text = card_buf
        edCardName.Text = name_buf
        edCardMoney.Text = card_money / 10
        edCardTimes.Text = card_times
        MsgBox ("读卡成功")
      Else
        MsgBox ("读卡错误")
      End If
      ClosePort
   Else
      MsgBox ("不能联接设备")
   End If
End Sub

Private Sub Command22_Click()
  Dim card_buf As String * 50
  Dim name_buf As String * 50
  Dim card_name As String * 50
  Dim card_pwd As String
  
  Dim card_money As Long
  Dim card_times As Long
  Dim card_style As Long
  Dim day_consumed As Long
  Dim day_times As Long
  Dim c_month As Long
  Dim c_day As Long
  Dim c_flag As Long
  Dim GroupStation As Long
  Dim GroupId As Long
  Dim MatchCard As Boolean
  RefreshClock
    If OpenPort(Port, BaudRate, clock_id) Then
      Select Case cbCardStyle.ListIndex
        Case 0
          card_style = CARDSTYLE_OLDCARD
        Case 1
          card_style = CARDSTYLE_NEWCARD
        Case 2
          card_style = CARDSTYLE_690CARD
      End Select
      card_buf = edCardId.Text
      card_name = edCardName.Text
      card_money = edCardMoney.Text * 10
      card_times = edCardTimes.Text
      card_pwd = "123456"
      day_consumed = 0
      day_times = 0
      c_month = 0
      c_day = 0
      c_flag = 0
      GroupStation = -1
      GroupId = 0
      MatchCard = False
      card_style = 690
      name_buf = card_name
      If GetSystemLangID() = 950 Then
         BIG5TGB card_name, name_buf
      End If
      If WriteICCardEx(hPort, card_buf, name_buf, card_pwd, card_money, card_times, day_consumed, day_times, c_month, c_day, c_flag, GroupStation, GroupId, card_style, MatchCard) Then
         'WriteICCardPassWord hPort, edCardPW.Text
        MsgBox ("写卡成功")
      Else
        MsgBox ("写卡错误")
      End If
      ClosePort
   Else
      MsgBox ("不能联接设备")
   End If
End Sub

Private Sub Command23_Click()
   '实时消费,下面两个函数取自EastRiverD.dll，其它函数使用EastRiver.Dll
   Dim CardNo As String
   Dim temp As Boolean
   Dim Record As String * 60

   IFlag = False
   'PCardInfo.Size = Len(PCardInfo)
   RefreshClock
   If SetTimeParam(1000, 100, 50, 10) Then
   End If
   If OpenPort(Port, BaudRate, clock_id) Then
     Do While (1)
        DoEvents
        If IFlag = True Then Exit Do
        
        If RealReadStringRecord(hPort, clock_id, Record) Then
           If Len(Trim(Record)) > 0 Then
              If Left(Record, 1) = "1" Then '有卡
                'If PCardInfo.NoCard Then
                '做后续处理
                'End If
                 List1.AddItem Record
                 temp = RealFeedback(hPort, clock_id, 500, -1, 0) '如果是ID消费机690D,反馈信息回去，其它机型不要调用
                 Beep
              End If
           End If
        End If
     Loop
     ClosePort
   Else
     MsgBox "不能联接读卡设备！", vbInformation, "错误"
   End If
End Sub

Private Sub Command24_Click()
  IFlag = True
End Sub

Private Sub Command25_Click()
Dim retcode As Boolean

 If OpenPort(Port, BaudRate, clock_id) Then
  retcode = SetNotification(hPort, Text7.Text, CInt(Text6.Text), True)
 
End If
  
  ClosePort
  
End Sub

Private Sub Command26_Click()
Dim strDateTime As String * 30
Dim ok As Boolean


 RefreshClock
SelectCommStyle (1)
hPort = OpenClientSocket(ipAddr, ipPort)
SetCmdVerify True
ok = CallClock(hPort, clock_id)
    If ReadClockTimeString(hPort, strDateTime) Then
       Text5.Text = "20" + strDateTime
    Else
       Text5.Text = "不能读出设备的时间"
    End If
CloseClientSocket hPort
End Sub

Private Sub Command27_Click()
 Dim flag As Boolean
 Dim nLine, Action, Rst, Bytes As Long
 Dim DataBuff As String
 Dim strLine As String
 Dim Count As Long
 DataBuff = Space(1000)
  
  Count = 0
  flag = True
  Action = 0
  Bytes = 16
  RefreshClock
  If OpenPort(Port, BaudRate, clock_id) Then
     'Text5.Text = "[" + CStr(port) + "  号端口" + CStr(clock_id) + "  号机 成功打开！"
     Do While flag = True
        Rst = BatchReadRecordEx(hPort, Action, Bytes, Count, DataBuff)
        If Rst = 0 Then
          If Count > 0 Then
             Open (FileName) For Append As #1
             List1.AddItem DataBuff
             'For K = 0 To nLine - 1 '原66，现修改后为114 格式：机号+卡号+时间+标志
             ' strLine = CStr(clock_id) + vbTab + Format(Mid(DataBuff, K * 114 + 1, 10), "0000000000") + vbTab + Mid(DataBuff, K * 114 + 21, 14) + vbTab + Str(Asc(Mid(DataBuff, K * 114 + 55, 1)) And 63)+ vbTab + Str(Asc(Mid(DataBuff, K * 114 + 55, 1)) shr 6)
             '这里要注意根据记录多少来截取相应的记录
             Print #1, DataBuff
             ' Count = Count + 1
             'Next K
             Close #1
             Action = 1  '如果接收的数据认为有错误数据，这里可以设置成0，继续读上一批，如果连续几次不成功可以退出来
          Else
             flag = False
          End If
        Else
          flag = False
        End If
     Loop
    If Count > 0 Then
        Text5.Text = "下载记录总数" & Count
     Else
        Text5.Text = CStr(clock_id) & " 号机内没有数据"
     End If
    ClosePort
   Else
     Text5.Text = CStr(clock_id) + "号机联机失败"
   End If
End Sub

Private Sub Command28_Click()
Dim Data As String
Data = Space(20)
  RefreshClock
  If OpenPort(Port, BaudRate, clock_id) Then
    'AddLog "[" + CStr(port) + "  号端口 " + CStr(clock_id) + "  号机 成功打开！"
    If CheckCardExists(hPort, 1, Text5.Text, Data) Then
       MsgBox ("白名单已存在")
    Else
       MsgBox ("白名单不存在")
    End If
    ClosePort
  Else
    Text5.Text = "不能联接设备"
  End If
End Sub

Private Sub Command3_Click()
  List1.Clear
End Sub


Private Sub Command4_Click()
  Dim I As Integer
  Dim Count As Integer
  Dim ECount As Integer
  Dim Downed As Integer
  Dim fIdx As Integer
  Dim CardNo As String
  Dim CardName As String
  Dim S As String
  ECount = 0
  RefreshClock
  If OpenPort(Port, BaudRate, clock_id) Then
    'AddLog "[" + CStr(port) + "  号端口 " + CStr(clock_id) + "  号机 成功打开！"
    'FrmList.Caption = "下载白名单"
    'FrmList.Show vbModal, Me
    'If FrmList.OkFlag Then
     Count = List1.ListCount
     Downed = 0
     For I = 0 To Count - 1
        DoEvents
        S = List1.List(I)
        fIdx = InStr(S, Chr(9))
        CardNo = Mid(S, 1, fIdx - 1)
        CardName = "