📄 frmrwcard.frm
字号:
VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Begin VB.Form frmRWCard
BorderStyle = 1 'Fixed Single
Caption = "IC卡数据采集"
ClientHeight = 4140
ClientLeft = 45
ClientTop = 330
ClientWidth = 7230
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 4140
ScaleWidth = 7230
Begin VB.Data datCard
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 3360
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "temCardData"
Top = 3120
Width = 3855
End
Begin VB.CommandButton cmdReturn
Caption = "返回"
Height = 375
Left = 5520
TabIndex = 4
Top = 3600
Width = 1455
End
Begin VB.CommandButton cmdRead
Caption = "读取数据卡"
Height = 375
Left = 2400
TabIndex = 3
Top = 3600
Width = 1455
End
Begin VB.CommandButton cmdSave
Caption = "保存至数据库"
Enabled = 0 'False
Height = 375
Left = 3960
TabIndex = 2
Top = 3600
Width = 1455
End
Begin VB.CommandButton cmdClear
Caption = "清空数据卡"
Height = 375
Left = 840
TabIndex = 1
Top = 3600
Width = 1455
End
Begin VB.ComboBox cmbTermID
Height = 300
Left = 1200
Style = 2 'Dropdown List
TabIndex = 0
Top = 3120
Width = 2175
End
Begin MSDBGrid.DBGrid grdCard
Bindings = "frmRWCard.frx":0000
Height = 3015
Left = 0
OleObjectBlob = "frmRWCard.frx":0016
TabIndex = 5
Top = 0
Width = 7215
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "采集板序号:"
Height = 255
Left = 120
TabIndex = 6
Top = 3240
Width = 1095
End
End
Attribute VB_Name = "frmRWCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/07/09
'描 述：CBB三表户外计量系统 Ver 5.2
'网 站：http://www.Mndsoft.com/ (VB6源码博客)
'网 站：http://www.VbDnet.com/ (VB.NET源码博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Dim curUserID As Integer
Dim curDevID As Integer
Function chkDataCard() As Boolean
Dim flag1 As String * 4
Dim flag2 As String * 4
Dim errCode As Integer
Dim i As Integer
chkDataCard = False
errCode = IC_Read_Hex(ByVal icdev, IC_BaseAddr + 1, 1, flag1)
If errCode < 0 Then
MsgBox "读卡错误,错误码:" + Format(Abs(errCode)), , "读卡"
Exit Function
End If
flag1 = "&H" + Trim(flag1)
errCode = IC_Read(ByVal icdev, IC_BaseAddr + 2, 1, flag2)
If errCode < 0 Then
MsgBox "读卡错误,错误码:" + Format(Abs(errCode)), , "读卡"
Exit Function
End If
flag2 = "&H" + Trim(flag2)
If Val(flag1) = &HFC And Val(flag2) = &H0 Then
chkDataCard = True
End If
End Function
Sub ClearCard()
Dim WriteChar As String * 2
Dim WriteBack As Integer
'status
AppendStatusInfo "清空当前数据卡", icoBLUE
SaveLog "清空当前数据卡", 0
WriteChar = "ff"
For i = 1 To 256
WriteBack = IC_Write_Hex(icdev, IC_BaseAddr + i - 1, 1, WriteChar)
If WriteBack < 0 Then
'status
AppendStatusInfo "IC卡数据写错误 " + "错误码:" + Format(WriteBack), icoRED
SaveLog "IC卡数据写错误 " + "错误码:" + Format(WriteBack), 1
MsgBox "IC卡数据写错误" + Chr(10) + "错误码:" + Format(WriteBack)
Exit Sub
End If
Next i
WriteChar = "fc"
WriteBack = IC_Write_Hex(icdev, IC_BaseAddr + 1, 1, WriteChar)
If WriteBack < 0 Then
'status
AppendStatusInfo "IC卡数据写错误 " + "错误码:" + Format(WriteBack), icoRED
SaveLog "IC卡数据写错误 " + "错误码:" + Format(WriteBack), 1
MsgBox "IC卡数据写错误" + Chr(10) + "错误码:" + Format(WriteBack)
Exit Sub
End If
WriteChar = "00"
WriteBack = IC_Write_Hex(icdev, IC_BaseAddr + 2, 1, WriteChar)
If WriteBack < 0 Then
'status
AppendStatusInfo "IC卡数据写错误 " + "错误码:" + Format(WriteBack), icoRED
SaveLog "IC卡数据写错误 " + "错误码:" + Format(WriteBack), 1
MsgBox "IC卡数据写错误" + Chr(10) + "错误码:" + Format(WriteBack)
Exit Sub
End If
WriteChar = "04"
WriteBack = IC_Write_Hex(icdev, IC_BaseAddr + 3, 1, WriteChar)
If WriteBack < 0 Then
'status
AppendStatusInfo "IC卡数据写错误 " + "错误码:" + Format(WriteBack), icoRED
SaveLog "IC卡数据写错误 " + "错误码:" + Format(WriteBack), 1
MsgBox "IC卡数据写错误" + Chr(10) + "错误码:" + Format(WriteBack)
Exit Sub
End If
MsgBox "数据卡清空完毕!", 64, "清空数据卡"
End Sub
Function GetCardData(curTermNum As Integer, curCardUserID As Integer) As Long
Dim ReadChar As String * 4
Dim ReadBack As Integer
Dim ReadInt As Long
Dim i As Integer
ReadInt = 0
For i = 1 To 3 '每表占2.5个字节,读三个字节
If (curCardUserID Mod 2) = 0 Then '卡内用户号为偶数
ReadBack = IC_Read_Hex(icdev, IC_BaseAddr + 4 + (curTermNum - 1) * 42 + 2 + Int((curCardUserID - 1) / 2) * 5 + 2 + i - 1, 1, ReadChar)
If ReadBack < 0 Then
MsgBox "IC卡数据读取错误" + Chr(10) + "错误码:" + Format(ReadBack)
GetCardData = -1
Exit Function
End If
If i = 1 Then
' ReadChar = Trim(Right(Left(ReadChar, 2), 1))
ReadChar = "&H" + Trim(ReadChar)
ReadInt = ReadInt * 10 + (Val(ReadChar) And &HF)
Else
ReadChar = "&H" + Trim(ReadChar)
ReadInt = ReadInt * 10 + (Val(ReadChar) And &HF0) \ 16
ReadInt = ReadInt * 10 + (Val(ReadChar) And &HF)
End If
Else '奇数
ReadBack = IC_Read_Hex(icdev, IC_BaseAddr + 4 + (curTermNum - 1) * 42 + 2 + Int((curCardUserID - 1) / 2) * 5 + i - 1, 1, ReadChar)
If ReadBack < 0 Then
MsgBox "IC卡数据读取错误" + Chr(10) + "错误码:" + Format(ReadBack)
GetCardData = -1
Exit Function
End If
If i = 3 Then
' ReadChar = Trim(Left(ReadChar, 1))
ReadChar = "&H" + Trim(ReadChar)
ReadInt = ReadInt * 10 + (Val(ReadChar) And &HF0) \ 16
Else
ReadChar = "&H" + Trim(ReadChar)
ReadInt = ReadInt * 10 + (Val(ReadChar) And &HF0) \ 16
ReadInt = ReadInt * 10 + (Val(ReadChar) And &HF)
End If
End If
Next i
GetCardData = ReadInt
End Function
Function GetTerm(curNum As Integer) As Integer
Dim ReadChar As String * 2
Dim ReadBack As Integer
Dim ReadInt As Integer
Dim i As Integer
ReadInt = 0
For i = 1 To 2
ReadBack = IC_Read_Hex(icdev, IC_BaseAddr + 4 + (curNum - 1) * 42 + i - 1, 1, ReadChar)
If ReadBack < 0 Then
MsgBox "IC卡数据读取错误" + Chr(10) + "错误码:" + Format(ReadBack)
GetTerm = -1
Exit Function
End If
ReadChar = Trim(ReadChar)
ReadInt = ReadInt * 10 + Val(ReadChar)
Next i
GetTerm = ReadInt
End Function
Function GetTermSum() As Integer
Dim ReadBack As Integer
Dim ReadChar As String * 4
Dim NextTermAddr As Integer
ReadBack = IC_Read_Hex(icdev, IC_BaseAddr + 3, 1, ReadChar)
If ReadBack < 0 Then
MsgBox "IC卡数据读取错误" + Chr(10) + "错误码:" + Format(ReadBack)
GetTermSum = 0
Exit Function
End If
ReadChar = "&H" + Trim(ReadChar)
NextTermAddr = Val(ReadChar)
GetTermSum = (NextTermAddr - 4) / 42 '每终端占&H2A(42)byte,16个表,每表20BIT,终端号占2字节
End Function
Function ReadCard() As Boolean
Dim TermSum As Integer
Dim curTerm As Integer
Dim curCardUserID As Integer
Dim curDevName As String
Dim CardValue As Long
Dim i As Integer
Dim SQL As String
Dim rcTemUser As Recordset
Dim rcDevsMap As Recordset
Dim curType As Integer
cmbTermID.Clear
Set rcDevsMap = dbCbb.OpenRecordset("DevsMap", dbOpenSnapshot)
TermSum = GetTermSum()
If TermSum <= 0 Then
'status
AppendStatusInfo "当前数据卡中没有有效的终端数据", icoBLUE
SaveLog "当前数据卡中没有有效的终端数据", 0
MsgBox "当前数据卡中没有有效的终端数据", 64, "读取数据卡"
ReadCard = False
Exit Function
End If
cmbTermID.AddItem "全部"
For i = 1 To TermSum
curTerm = GetTerm(i)
cmbTermID.AddItem curTerm
If curTerm <= 0 Then
GoTo Next_Term
End If
SQL = "select UserMap.BuildID,UserMap.Unit,UserMap.Door,UserDev.CardUserID,UserDev.devType "
SQL = SQL + "from UserMap,UserDev "
SQL = SQL + "where UserMap.UserID=UserDev.UserID "
SQL = SQL + "and UserDev.CardTermID=" + Format(curTerm) + " "
' SQL = SQL + "and UserDev.devType=" + Format(curType) + " "
SQL = SQL + "order by UserDev.CardUserID "
Set rcTemUser = dbCbb.OpenRecordset(SQL)
If rcTemUser.EOF Or rcTemUser.RecordCount <= 0 Then
GoTo Next_Term
End If
'status
AppendStatusInfo "读终端" & curTerm & "卡数据", icoBLUE
SaveLog "读终端" & curTerm & "卡数据", 0
rcTemUser.MoveLast
rcTemUser.MoveFirst
For curCardUserID = 1 To rcTemUser.RecordCount
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -