Attribute VB_Name = "modMifare1"
Option Explicit
Public gblnMifareTimer As Boolean
Public klx As String '卡類型
Public khj As String '卡呼叫
Public blockno As String
Public Mode As String
Public currLedBuzzerState As Integer
Public currComPort As MSComm
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Sub ClearComPortBuffer()
currComPort.InBufferCount = 0
currComPort.OutBufferCount = 0
currComPort.InputLen = 1
End Sub
Private Function RFMifare_SendCommand(tmpCommandCode As String, tmpCommandLength As String, Optional tmpParameter As String = Empty) As Boolean
Dim Dummy As Variant
Dim StartTime As Long
Dim tmpSendout(0) As Byte
Dim tmpReceiveIn(0) As Byte
Dim tmpResult As Boolean
tmpResult = False
ClearComPortBuffer
tmpSendout(0) = tmpCommandCode
currComPort.Output = tmpSendout
tmpSendout(0) = tmpCommandLength
currComPort.Output = tmpSendout
If Len(tmpParameter) > 0 Then
tmpSendout(0) = tmpParameter
currComPort.Output = tmpSendout
tmpSendout(0) = RFMifare_Checksum(RFMifare_Checksum(tmpCommandCode, tmpCommandLength), tmpParameter)
currComPort.Output = tmpSendout
Else
tmpSendout(0) = RFMifare_Checksum(tmpCommandCode, tmpCommandLength)
currComPort.Output = tmpSendout
End If
gblnMifareTimer = False
StartTime = GetTickCount
Do
Dummy = DoEvents()
If GetTickCount - StartTime > 100 Then gblnMifareTimer = True
Loop Until (currComPort.InBufferCount <> 0) Or (gblnMifareTimer = True)
If gblnMifareTimer <> True Then
tmpReceiveIn(0) = currComPort.Input(0)
End If
If Trim(Val(Hex(tmpReceiveIn(0)))) = 67 Then
tmpResult = True
Else
tmpResult = False
End If
RFMifare_SendCommand = tmpResult
End Function
' 加載密碼
Public Function RFMifare_Transkey(tmpSector As String, pw1 As String, pw2 As String, pw3 As String, pw4 As String, pw5 As String, pw6 As String) As Integer
Dim Dummy As Variant
Dim StartTime As Long
Dim tmpSendout(0) As Byte
Dim tmpReceiveIn(0) As Byte
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpParameter As String
Dim tmpCheckSum As Long
Dim tmpCheckSumStr As String
Dim tmpReturnData As String
Dim intX As Integer
If Chk23H_HandShake = True Then
ClearComPortBuffer
tmpCommandCode = &HA4
tmpCommandLength = &H7
tmpCheckSum = RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum( _
RFMifare_Checksum(RFMifare_Checksum(tmpCommandCode, tmpCommandLength), tmpSector), pw1), pw2), pw3), pw4), pw5), pw6)
tmpCheckSumStr = "&" & "H" & Hex(tmpCheckSum)
tmpSendout(0) = tmpCommandCode
currComPort.Output = tmpSendout
tmpSendout(0) = tmpCommandLength
currComPort.Output = tmpSendout
tmpSendout(0) = tmpSector
currComPort.Output = tmpSendout
tmpSendout(0) = pw1
currComPort.Output = tmpSendout
tmpSendout(0) = pw2
currComPort.Output = tmpSendout
tmpSendout(0) = pw3
currComPort.Output = tmpSendout
tmpSendout(0) = pw4
currComPort.Output = tmpSendout
tmpSendout(0) = pw5
currComPort.Output = tmpSendout
tmpSendout(0) = pw6
currComPort.Output = tmpSendout
tmpSendout(0) = tmpCheckSumStr
currComPort.Output = tmpSendout
gblnMifareTimer = False
StartTime = GetTickCount
Do
Dummy = DoEvents()
If GetTickCount - StartTime > 100 Then gblnMifareTimer = True
Loop Until (currComPort.InBufferCount <> 0) Or (gblnMifareTimer = True)
If gblnMifareTimer <> True Then
tmpReceiveIn(0) = currComPort.Input(0)
End If
If Trim(Val(Hex(tmpReceiveIn(0)))) = 67 Then
tmpReturnData = RFMifare_Send89H(2, 1, 0)
'tmpCardNum = tmpReturnData
If tmpReturnData = "000" Then
RFMifare_Transkey = 0
Else
RFMifare_Transkey = 1
End If
Else
RFMifare_Transkey = 1
End If
Else
RFMifare_Transkey = 1
End If
End Function
Private Function RFMifare_Checksum(tmpCommandCode As String, tmpCommandLength As String) As Long
Dim tmpResult As Long
tmpResult = ((Not (tmpCommandCode)) And tmpCommandLength) Or _
((Not (tmpCommandLength)) And tmpCommandCode)
RFMifare_Checksum = tmpResult
End Function
Public Function RFMifare_Send23H() As Integer
Dim Dummy As Variant
Dim StartTime As Long
Dim tmpRecieveIn(0) As Byte
Dim tmpSendout(0) As Byte
Dim tmpResult As Integer
tmpResult = 1
If Not currComPort Is Nothing Then
If currComPort.PortOpen = False Then currComPort.PortOpen = True
ClearComPortBuffer
tmpSendout(0) = &H23
currComPort.Output = tmpSendout
gblnMifareTimer = False
StartTime = GetTickCount
Do
Dummy = DoEvents()
If GetTickCount - StartTime > 100 Then gblnMifareTimer = True
Loop Until (currComPort.InBufferCount <> 0) Or (gblnMifareTimer = True)
If gblnMifareTimer <> True Then
tmpRecieveIn(0) = currComPort.Input(0)
End If
If Trim(Val(Hex(tmpRecieveIn(0)))) = 45 Then tmpResult = 0
End If
RFMifare_Send23H = tmpResult
End Function
Private Function Chk23H_HandShake() As Boolean
Dim tmpResult As Boolean
If RFMifare_Send23H() = 0 Then
tmpResult = True
Else
tmpResult = False
End If
Chk23H_HandShake = tmpResult
End Function
Public Function RFMifare_Initialization() As Boolean
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpReturnData As String
Dim tmpResult As Boolean
tmpCommandCode = &H0
tmpCommandLength = &H0
tmpResult = False
If RFMifare_SendCommand(tmpCommandCode, tmpCommandLength) = True Then
tmpReturnData = RFMifare_Send89H(2)
If tmpReturnData = "000000" Then
tmpResult = True
Else
tmpResult = False
End If
End If
RFMifare_Initialization = tmpResult
End Function
'set buzzer on
Public Sub RFMifare_SetBuzzerOn()
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpParameter As String
Dim tmpReturnData As String
If Chk23H_HandShake = True Then
tmpCommandCode = &H7A
tmpCommandLength = &H1
currLedBuzzerState = currLedBuzzerState Or &H4 'buzzer on
tmpParameter = currLedBuzzerState
If RFMifare_SendCommand(tmpCommandCode, tmpCommandLength, tmpParameter) = True Then
tmpReturnData = RFMifare_Send89H(6, 1, 1)
If tmpReturnData = "" Then
'currLedBuzzerState = 1
Else
'currLedBuzzerState = 0
End If
End If
End If
End Sub
'set buzzer off
Public Sub RFMifare_SetBuzzerOff()
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpParameter As String
Dim tmpReturnData As String
Dim tmpResult As Boolean
If Chk23H_HandShake = True Then
tmpCommandCode = &H7A
tmpCommandLength = &H1
currLedBuzzerState = currLedBuzzerState And (Not &H4) 'buzzer on
tmpParameter = currLedBuzzerState
If RFMifare_SendCommand(tmpCommandCode, tmpCommandLength, tmpParameter) = True Then
tmpReturnData = RFMifare_Send89H(6, 1, 1)
If tmpReturnData = "" Then
'currLedBuzzerState = 1
Else
'currLedBuzzerState = 0
End If
End If
End If
End Sub
Private Function RFMifare_Send89H(tmpDataLength As Integer, Optional tmpDatatype As Integer = 0, Optional tmpMethod As Integer = 0, _
Optional tmpTimerInterval As Long = 100, Optional ByRef tmpResult As Integer) As String
Dim Dummy As Variant
Dim StartTime As Long
Dim tmpSendout(0) As Byte
Dim tmpReceiveByte(100) As Byte
Dim tmpReceiveVariant(20) As Variant
Dim tmpReturnData As String
Dim tmpString As String
Dim intX As Integer
Dim i As Integer, k As Integer, MAXBLOCKNUM As Integer
i = 0: k = 0: MAXBLOCKNUM = 0
ClearComPortBuffer
tmpSendout(0) = &H89
currComPort.Output = tmpSendout
MAXBLOCKNUM = 0
Do
StartTime = GetTickCount
gblnMifareTimer = False
Do
Dummy = DoEvents()
If GetTickCount - StartTime > tmpTimerInterval Then gblnMifareTimer = True
Loop Until (currComPort.InBufferCount <> 0) Or (gblnMifareTimer = True)
If gblnMifareTimer = True Then Exit Do
If tmpDatatype = 0 Then
tmpReceiveByte(i) = currComPort.Input(0)
Else
tmpReceiveVariant(i) = Hex(currComPort.Input(0))
End If
i = i + 1
MAXBLOCKNUM = MAXBLOCKNUM + 1
Loop Until (gblnMifareTimer = True) Or (i > tmpDataLength)
k = 0
Select Case tmpMethod
Case 0
If tmpDatatype = 0 Then
For i = 1 To MAXBLOCKNUM
tmpString = Trim(Val(Hex(tmpReceiveByte(k))))
If Len(tmpString) = 1 Then tmpString = 0 & tmpString
tmpReturnData = tmpReturnData & tmpString
k = k + 1
Next
Else
For i = 0 To MAXBLOCKNUM
tmpString = tmpReceiveVariant(i)
tmpReturnData = tmpReturnData & tmpString
k = k + 1
Next
End If
Case 1
If tmpDatatype = 1 Then
For i = MAXBLOCKNUM - 2 To 2 Step -1
tmpString = tmpReceiveVariant(i)
If Len(tmpString) = 1 Then tmpString = "0" & tmpString
tmpReturnData = tmpReturnData & tmpString
k = k + 1
Next
Else
End If
Case 2
If tmpDatatype = 1 Then
For i = 0 To MAXBLOCKNUM
tmpString = tmpReceiveVariant(i)
If Len(tmpString) = 1 Then tmpString = "0" & tmpString
tmpReturnData = tmpReturnData & tmpString
k = k + 1
Next
Else
End If
End Select
If tmpDatatype = 1 Then
If tmpResult = -1 Then tmpResult = tmpReceiveVariant(0)
End If
RFMifare_Send89H = tmpReturnData
End Function
' 建立連接
Public Function AutoLinkCom(tmpComPort As MSComm) As Integer
Set currComPort = tmpComPort
currLedBuzzerState = 0
If Chk23H_HandShake = True Then
If RFMifare_Initialization = True Then
AutoLinkCom = 0
Else
AutoLinkCom = 1
End If
End If
End Function
'set green led on
Public Sub RFMifare_SetGreenLEDOn()
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpParameter As String
Dim tmpReturnData As String
If Chk23H_HandShake = True Then
tmpCommandCode = &H7A
tmpCommandLength = &H1
currLedBuzzerState = currLedBuzzerState Or &H1
tmpParameter = currLedBuzzerState
If RFMifare_SendCommand(tmpCommandCode, tmpCommandLength, tmpParameter) = True Then
tmpReturnData = RFMifare_Send89H(6, 1, 1)
If tmpReturnData = "" Then
'currLedBuzzerState = 1
Else
'currLedBuzzerState = 0
End If
End If
End If
End Sub
'set green led off
Public Sub RFMifare_SetGreenLEDOff()
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpParameter As String
Dim tmpReturnData As String
If Chk23H_HandShake = True Then
tmpCommandCode = &H7A
tmpCommandLength = &H1
currLedBuzzerState = currLedBuzzerState And (Not &H1)
tmpParameter = currLedBuzzerState
If RFMifare_SendCommand(tmpCommandCode, tmpCommandLength, tmpParameter) = True Then
tmpReturnData = RFMifare_Send89H(6, 1, 1)
If tmpReturnData = "" Then
'currLedBuzzerState = 1
Else
'currLedBuzzerState = 0
End If
End If
End If
End Sub
'set red led on
Public Sub RFMifare_SetRedLEDOn()
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpParameter As String
Dim tmpReturnData As String
If Chk23H_HandShake = True Then
tmpCommandCode = &H7A
tmpCommandLength = &H1
currLedBuzzerState = currLedBuzzerState Or &H2
tmpParameter = currLedBuzzerState
If RFMifare_SendCommand(tmpCommandCode, tmpCommandLength, tmpParameter) = True Then
tmpReturnData = RFMifare_Send89H(6, 1, 1)
If tmpReturnData = "" Then
'currLedBuzzerState = 1
Else
'currLedBuzzerState = 0
End If
End If
End If
End Sub
'set red led off
Public Sub RFMifare_SetRedLEDOff()
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpParameter As String
Dim tmpReturnData As String
If Chk23H_HandShake = True Then
tmpCommandCode = &H7A
tmpCommandLength = &H1
currLedBuzzerState = currLedBuzzerState And (Not &H2) 'buzzer on
tmpParameter = currLedBuzzerState
If RFMifare_SendCommand(tmpCommandCode, tmpCommandLength, tmpParameter) = True Then
tmpReturnData = RFMifare_Send89H(6, 1, 1)
If tmpReturnData = "" Then
'currLedBuzzerState = 1
Else
'currLedBuzzerState = 0
End If
End If
End If
End Sub
'RFMifare_Gettype 讀卡類型
Public Function RFMifare_Gettype(ByRef tmpCardType As String) As Integer
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpReturnData As String
If Chk23H_HandShake = True Then
tmpCommandCode = &HAA
tmpCommandLength = &H0
If RFMifare_SendCommand(tmpCommandCode, tmpCommandLength) = True Then
tmpReturnData = RFMifare_Send89H(4, 0, 0)
If Left(tmpReturnData, 4) <> "0002" Then
RFMifare_Gettype = 1
Else
RFMifare_Gettype = 0
End If
If Mid(tmpReturnData, 5, 4) = "0400" Then
tmpCardType = "M1"
Else
If Mid(tmpReturnData, 5, 4) = "1000" Then
tmpCardType = "ML10"
End If
End If
Else
RFMifare_Gettype = 1
End If
Else
RFMifare_Gettype = 1
End If
End Function
'RFMifare_Getsnr 讀卡序列號
Public Function RFMifare_Getsnr(ByRef tmpCardNum As String) As Integer
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpReturnData As String
If Chk23H_HandShake = True Then
tmpCommandCode = &HAB
tmpCommandLength = &H0
If RFMifare_SendCommand(tmpCommandCode, tmpCommandLength) = True Then
tmpReturnData = RFMifare_Send89H(6, 1, 1)
tmpCardNum = tmpReturnData
If tmpReturnData = "" Then
RFMifare_Getsnr = 1
Else
RFMifare_Getsnr = 0
End If
Else
RFMifare_Getsnr = 1
End If
Else
RFMifare_Getsnr = 1
End If
End Function
' 卡認證
Public Function RFMifare_Authentication(tmpMode As String, tmpSector As String, key_adr As String) As Integer
Dim Dummy As Variant
Dim StartTime As Long
Dim tmpSendout(0) As Byte
Dim tmpReceiveIn(0) As Byte
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpParameter As String
Dim tmpCheckSum As Long
Dim tmpReturnData As String
If Chk23H_HandShake = True Then
ClearComPortBuffer
tmpCommandCode = &HB8
tmpCommandLength = &H3
tmpParameter = RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(tmpCommandCode, tmpCommandLength), _
tmpMode), tmpSector), key_adr)
tmpSendout(0) = tmpCommandCode
currComPort.Output = tmpSendout
tmpSendout(0) = tmpCommandLength
currComPort.Output = tmpSendout
tmpSendout(0) = tmpMode
currComPort.Output = tmpSendout
tmpSendout(0) = tmpSector
currComPort.Output = tmpSendout
tmpSendout(0) = key_adr
currComPort.Output = tmpSendout
tmpSendout(0) = tmpParameter
currComPort.Output = tmpSendout
gblnMifareTimer = False
StartTime = GetTickCount
Do
Dummy = DoEvents()
If GetTickCount - StartTime > 100 Then gblnMifareTimer = True
Loop Until (currComPort.InBufferCount <> 0) Or (gblnMifareTimer = True)
If gblnMifareTimer <> True Then
tmpReceiveIn(0) = currComPort.Input(0)
End If
If Trim(Val(Hex(tmpReceiveIn(0)))) = 67 Then
tmpReturnData = RFMifare_Send89H(2, 1, 0, 1000)
If tmpReturnData = "000" Then
RFMifare_Authentication = 0
Else
RFMifare_Authentication = 1
End If
Else
RFMifare_Authentication = 1
End If
Else
RFMifare_Authentication = 1
End If
End Function
' 修改密碼
Public Function RFMifare_Writekey(tmpSector As String, ca1 As String, ca2 As String, ca3 As String, ca4 As String, pw1 As String, pw2 As String, pw3 As String, _
pw4 As String, pw5 As String, pw6 As String, pw7 As String, pw8 As String, pw9 As String, pw10 As String, pw11 As String, pw12 As String, _
pw13 As String, pw14 As String, pw15 As String, pw16 As String, tmpMode As String) As Integer
Dim Dummy As Variant
Dim StartTime As Long
Dim tmpSendout(0) As Byte
Dim tmpReceiveIn(0) As Byte
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpParameter As String
Dim tmpCheckSum As Long
Dim tmpReturnData As String
Dim tmpResult As Integer
tmpResult = 1
If Chk23H_HandShake = True Then
ClearComPortBuffer
tmpCommandCode = &HAE
tmpCommandLength = &H16
tmpCheckSum = RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum( _
RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum( _
RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum( _
RFMifare_Checksum(RFMifare_Checksum(tmpCommandCode, tmpCommandLength), tmpSector), ca1), ca2), ca3), ca4), pw1), pw2), pw3), pw4), pw5), _
pw6), pw7), pw8), pw9), pw10), pw11), pw12), pw13), pw14), pw15), pw16), tmpMode)
tmpSendout(0) = tmpCommandCode
currComPort.Output = tmpSendout
tmpSendout(0) = tmpCommandLength
currComPort.Output = tmpSendout
tmpSendout(0) = tmpSector
currComPort.Output = tmpSendout
tmpSendout(0) = ca1
currComPort.Output = tmpSendout
tmpSendout(0) = ca2
currComPort.Output = tmpSendout
tmpSendout(0) = ca3
currComPort.Output = tmpSendout
tmpSendout(0) = ca4
currComPort.Output = tmpSendout
tmpSendout(0) = pw1
currComPort.Output = tmpSendout
tmpSendout(0) = pw2
currComPort.Output = tmpSendout
tmpSendout(0) = pw3
currComPort.Output = tmpSendout
tmpSendout(0) = pw4
currComPort.Output = tmpSendout
tmpSendout(0) = pw5
currComPort.Output = tmpSendout
tmpSendout(0) = pw6
currComPort.Output = tmpSendout
tmpSendout(0) = pw7
currComPort.Output = tmpSendout
tmpSendout(0) = pw8
currComPort.Output = tmpSendout
tmpSendout(0) = pw9
currComPort.Output = tmpSendout
tmpSendout(0) = pw10
currComPort.Output = tmpSendout
tmpSendout(0) = pw11
currComPort.Output = tmpSendout
tmpSendout(0) = pw12
currComPort.Output = tmpSendout
tmpSendout(0) = pw13
currComPort.Output = tmpSendout
tmpSendout(0) = pw14
currComPort.Output = tmpSendout
tmpSendout(0) = pw15
currComPort.Output = tmpSendout
tmpSendout(0) = pw16
currComPort.Output = tmpSendout
tmpSendout(0) = tmpMode
currComPort.Output = tmpSendout
tmpSendout(0) = tmpCheckSum
currComPort.Output = tmpSendout
gblnMifareTimer = False
StartTime = GetTickCount
Do
Dummy = DoEvents()
If GetTickCount - StartTime > 100 Then gblnMifareTimer = True
Loop Until (currComPort.InBufferCount <> 0) Or (gblnMifareTimer = True)
If gblnMifareTimer <> True Then
tmpReceiveIn(0) = currComPort.Input(0)
End If
If Trim(Val(Hex(tmpReceiveIn(0)))) = 67 Then
tmpReturnData = RFMifare_Send89H(2, 1, 2, 100)
If tmpReturnData = "000000" Then
tmpResult = 0
End If
End If
End If
RFMifare_Writekey = tmpResult
End Function
' 卡呼叫
Public Function RFMifare_Request(tmpMode As String, ByRef tmpCardType As String) As Integer
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpParameter As String
Dim tmpReturnData As String
Dim tmpResult As Integer
If tmpMode = "ALL" Then tmpMode = &H1
If tmpMode = "IDLE" Then tmpMode = &H0
tmpCommandCode = &HB5
tmpCommandLength = &H1
tmpParameter = tmpMode
tmpResult = 1
If Chk23H_HandShake = True Then
If RFMifare_SendCommand(tmpCommandCode, tmpCommandLength, tmpParameter) = True Then
tmpReturnData = RFMifare_Send89H(4, 1, 2)
If Left(tmpReturnData, 4) = "0002" Then
tmpResult = 0
Else
tmpResult = 1
End If
If Mid(tmpReturnData, 5, 4) = "0400" Then tmpCardType = "Mifare 1"
If Mid(tmpReturnData, 5, 4) = "1000" Then tmpCardType = "Mifare Light L10"
End If
End If
RFMifare_Request = tmpResult
End Function
' 卡激活
Public Function RFMifare_Select(ca1 As String, ca2 As String, ca3 As String, ca4 As String) As Integer
Dim Dummy As Variant
Dim StartTime As Long
Dim tmpSendout(0) As Byte
Dim tmpReceiveIn(0) As Byte
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpParameter As String
Dim tmpCheckSum As Long
Dim tmpReturnData As String
Dim tmpResult As Integer
tmpResult = 1
If Chk23H_HandShake = True Then
ClearComPortBuffer
tmpCommandCode = &HB7
tmpCommandLength = &H4
tmpCheckSum = RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum( _
tmpCommandCode, tmpCommandLength), ca1), ca2), ca3), ca4)
tmpSendout(0) = tmpCommandCode
currComPort.Output = tmpSendout
tmpSendout(0) = tmpCommandLength
currComPort.Output = tmpSendout
tmpSendout(0) = ca1
currComPort.Output = tmpSendout
tmpSendout(0) = ca2
currComPort.Output = tmpSendout
tmpSendout(0) = ca3
currComPort.Output = tmpSendout
tmpSendout(0) = ca4
currComPort.Output = tmpSendout
tmpSendout(0) = tmpCheckSum
currComPort.Output = tmpSendout
gblnMifareTimer = False
StartTime = GetTickCount
Do
Dummy = DoEvents()
If GetTickCount - StartTime > 100 Then gblnMifareTimer = True
Loop Until (currComPort.InBufferCount <> 0) Or (gblnMifareTimer = True)
If gblnMifareTimer <> True Then
tmpReceiveIn(0) = currComPort.Input(0)
End If
If Trim(Val(Hex(tmpReceiveIn(0)))) = 67 Then
tmpReturnData = RFMifare_Send89H(2, 1, 0, 500)
'tmpReadbuff = Mid(tmpReturnData, 5, 32)
If tmpReturnData = "000" Then
tmpResult = 0
End If
End If
End If
RFMifare_Select = tmpResult
End Function
' 卡休眠
Public Function RFMifare_Halt() As Integer
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpReturnData As String
Dim tmpResult As Integer
tmpCommandCode = &HBD
tmpCommandLength = &H0
tmpResult = 1
If Chk23H_HandShake = True Then
If RFMifare_SendCommand(tmpCommandCode, tmpCommandLength) = True Then
tmpReturnData = RFMifare_Send89H(2, 0, 0, 500)
If tmpReturnData = "000000" Then
tmpResult = 0
End If
End If
End If
RFMifare_Halt = tmpResult
End Function
' 讀數據塊
Public Function RFMifare_Readblock(tmpBlockno As String, ca1 As String, ca2 As String, ca3 As String, ca4 As String, tmpMode As String, tmpReadbuff As String) As Integer
Dim Dummy As Variant
Dim StartTime As Long
Dim tmpSendout(0) As Byte
Dim tmpReceiveIn(0) As Byte
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpParameter As String
Dim tmpCheckSum As Long
Dim tmpReturnData As String
If Chk23H_HandShake = True Then
ClearComPortBuffer
tmpCommandCode = &HAC
tmpCommandLength = &H6
tmpCheckSum = RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum( _
RFMifare_Checksum(tmpCommandCode, tmpCommandLength), tmpBlockno), ca1), ca2), ca3), ca4), tmpMode)
tmpSendout(0) = tmpCommandCode
currComPort.Output = tmpSendout
tmpSendout(0) = tmpCommandLength
currComPort.Output = tmpSendout
tmpSendout(0) = tmpBlockno
currComPort.Output = tmpSendout
tmpSendout(0) = ca1
currComPort.Output = tmpSendout
tmpSendout(0) = ca2
currComPort.Output = tmpSendout
tmpSendout(0) = ca3
currComPort.Output = tmpSendout
tmpSendout(0) = ca4
currComPort.Output = tmpSendout
tmpSendout(0) = tmpMode
currComPort.Output = tmpSendout
tmpSendout(0) = tmpCheckSum
currComPort.Output = tmpSendout
gblnMifareTimer = False
StartTime = GetTickCount
Do
Dummy = DoEvents()
If GetTickCount - StartTime > 100 Then gblnMifareTimer = True
Loop Until (currComPort.InBufferCount <> 0) Or (gblnMifareTimer = True)
If gblnMifareTimer <> True Then
tmpReceiveIn(0) = currComPort.Input(0)
End If
If Trim(Val(Hex(tmpReceiveIn(0)))) = 67 Then
tmpReturnData = RFMifare_Send89H(18, 1, 2, 1000)
tmpReadbuff = Mid(tmpReturnData, 5, 32)
If Left(tmpReturnData, 4) = "0010" Or Left(tmpReturnData, 4) = "0008" Then
RFMifare_Readblock = 0
Else
RFMifare_Readblock = 1
End If
Else
RFMifare_Readblock = 1
End If
Else
RFMifare_Readblock = 1
End If
End Function
' 寫數據塊
Public Function RFMifare_Writeblock(tmpBlockno As String, ca1 As String, ca2 As String, ca3 As String, ca4 As String, wb1 As String, wb2 As String, wb3 As String, _
wb4 As String, wb5 As String, wb6 As String, wb7 As String, wb8 As String, wb9 As String, wb10 As String, wb11 As String, _
wb12 As String, wb13 As String, wb14 As String, wb15 As String, wb16 As String, tmpMode As String) As Integer
Dim Dummy As Variant
Dim StartTime As Long
Dim tmpSendout(0) As Byte
Dim tmpReceiveIn(0) As Byte
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpParameter As String
Dim tmpCheckSum As Long
Dim tmpReturnData As String
If Chk23H_HandShake = True Then
ClearComPortBuffer
tmpCommandCode = &HAD
tmpCommandLength = &H16
tmpCheckSum = RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum( _
RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum( _
RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum( _
RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(tmpCommandCode, tmpCommandLength), _
tmpBlockno), ca1), ca2), ca3), ca4), wb1), wb2), wb3), wb4), wb5), wb6), wb7), wb8), wb9), wb10), wb11), wb12), wb13), wb14), wb15), wb16), tmpMode)
tmpSendout(0) = tmpCommandCode
currComPort.Output = tmpSendout
tmpSendout(0) = tmpCommandLength
currComPort.Output = tmpSendout
tmpSendout(0) = tmpBlockno
currComPort.Output = tmpSendout
tmpSendout(0) = ca1
currComPort.Output = tmpSendout
tmpSendout(0) = ca2
currComPort.Output = tmpSendout
tmpSendout(0) = ca3
currComPort.Output = tmpSendout
tmpSendout(0) = ca4
currComPort.Output = tmpSendout
tmpSendout(0) = wb1
currComPort.Output = tmpSendout
tmpSendout(0) = wb2
currComPort.Output = tmpSendout
tmpSendout(0) = wb3
currComPort.Output = tmpSendout
tmpSendout(0) = wb4
currComPort.Output = tmpSendout
tmpSendout(0) = wb5
currComPort.Output = tmpSendout
tmpSendout(0) = wb6
currComPort.Output = tmpSendout
tmpSendout(0) = wb7
currComPort.Output = tmpSendout
tmpSendout(0) = wb8
currComPort.Output = tmpSendout
tmpSendout(0) = wb9
currComPort.Output = tmpSendout
tmpSendout(0) = wb10
currComPort.Output = tmpSendout
tmpSendout(0) = wb11
currComPort.Output = tmpSendout
tmpSendout(0) = wb12
currComPort.Output = tmpSendout
tmpSendout(0) = wb13
currComPort.Output = tmpSendout
tmpSendout(0) = wb14
currComPort.Output = tmpSendout
tmpSendout(0) = wb15
currComPort.Output = tmpSendout
tmpSendout(0) = wb16
currComPort.Output = tmpSendout
tmpSendout(0) = tmpMode
currComPort.Output = tmpSendout
tmpSendout(0) = tmpCheckSum
currComPort.Output = tmpSendout
gblnMifareTimer = False
StartTime = GetTickCount
Do
Dummy = DoEvents()
If GetTickCount - StartTime > 500 Then gblnMifareTimer = True
Loop Until (currComPort.InBufferCount <> 0) Or (gblnMifareTimer = True)
If gblnMifareTimer <> True Then
tmpReceiveIn(0) = currComPort.Input(0)
End If
If Trim(Val(Hex(tmpReceiveIn(0)))) = 67 Then
tmpReturnData = RFMifare_Send89H(18, 1, 2, 500)
If Left(tmpReturnData, 4) = "0010" Then
RFMifare_Writeblock = 0
Else
RFMifare_Writeblock = 1
End If
Else
RFMifare_Writeblock = 1
End If
Else
RFMifare_Writeblock = 1
End If
End Function
' 寫入電子錢包
Public Function RFMifare_Writevalue(tmpBlockno As String, ca1 As String, ca2 As String, ca3 As String, ca4 As String, _
rv1 As String, rv2 As String, rv3 As String, rv4 As String, ByRef tmpReadbuff As String) As Integer
Dim Dummy As Variant
Dim StartTime As Long
Dim tmpSendout(0) As Byte
Dim tmpReceiveIn(0) As Byte
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpParameter As String
Dim tmpCheckSum As Long
Dim tmpReturnData As String
Dim tmpResult As Integer
Dim tmpRet As Integer
tmpResult = 1
If Chk23H_HandShake = True Then
ClearComPortBuffer
tmpCommandCode = &HB0
tmpCommandLength = &H9
tmpCheckSum = RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum( _
RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(tmpCommandCode, tmpCommandLength), _
tmpBlockno), ca1), ca2), ca3), ca4), rv1), rv2), rv3), rv4)
tmpSendout(0) = tmpCommandCode
currComPort.Output = tmpSendout
tmpSendout(0) = tmpCommandLength
currComPort.Output = tmpSendout
tmpSendout(0) = tmpBlockno
currComPort.Output = tmpSendout
tmpSendout(0) = ca1
currComPort.Output = tmpSendout
tmpSendout(0) = ca2
currComPort.Output = tmpSendout
tmpSendout(0) = ca3
currComPort.Output = tmpSendout
tmpSendout(0) = ca4
currComPort.Output = tmpSendout
tmpSendout(0) = rv1
currComPort.Output = tmpSendout
tmpSendout(0) = rv2
currComPort.Output = tmpSendout
tmpSendout(0) = rv3
currComPort.Output = tmpSendout
tmpSendout(0) = rv4
currComPort.Output = tmpSendout
tmpSendout(0) = tmpCheckSum
currComPort.Output = tmpSendout
gblnMifareTimer = False
StartTime = GetTickCount
Do
Dummy = DoEvents()
If GetTickCount - StartTime > 500 Then gblnMifareTimer = True
Loop Until (currComPort.InBufferCount <> 0) Or (gblnMifareTimer = True)
If gblnMifareTimer <> True Then
tmpReceiveIn(0) = currComPort.Input(0)
End If
If Trim(Val(Hex(tmpReceiveIn(0)))) = 67 Then
tmpRet = -1
tmpReturnData = RFMifare_Send89H(6, 1, 2, 1000, tmpRet)
tmpReadbuff = tmpReturnData
If tmpRet = 0 Then tmpResult = 0
End If
End If
RFMifare_Writevalue = tmpResult
End Function
' 讀取電子錢包
Public Function RFMifare_Readvalue(tmpBlockno As String, ca1 As String, ca2 As String, ca3 As String, ca4 As String, tmpReadbuff As String) As Integer
Dim Dummy As Variant
Dim StartTime As Long
Dim tmpSendout(0) As Byte
Dim tmpReceiveIn(0) As Byte
Dim tmpCommandCode As String
Dim tmpCommandLength As String
Dim tmpParameter As String
Dim tmpCheckSum As Long
Dim tmpReturnData As String
Dim tmpResult As Integer
Dim tmpRet As Integer
tmpResult = 1
If Chk23H_HandShake = True Then
ClearComPortBuffer
tmpCommandCode = &HAF
tmpCommandLength = &H5
tmpCheckSum = RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum(RFMifare_Checksum( _
tmpCommandCode, tmpCommandLength), tmpBlockno), ca1), ca2), ca3), ca4)
tmpSendout(0) = tmpCommandCode
currComPort.Output = tmpSendout
tmpSendout(0) = tmpCommandLength
currComPort.Output = tmpSendout
tmpSendout(0) = tmpBlockno
currComPort.Output = tmpSendout
tmpSendout(0) = ca1
currComPort.Output = tmpSendout
tmpSendout(0) = ca2
currComPort.Output = tmpSendout
tmpSendout(0) = ca3
currComPort.Output = tmpSendout
tmpSendout(0) = ca4
currComPort.Output = tmpSendout
tmpSendout(0) = tmpCheckSum
currComPort.Output = tmpSendout
gblnMifareTimer = False
StartTime = GetTickCount
Do
Dummy = DoEvents()
If GetTickCount - StartTime > 100 Then gblnMifareTimer = True
Loop Until (currComPort.InBufferCount <> 0) Or (gblnMifareTimer = True)
If gblnMifareTimer <> True Then
tmpReceiveIn(0) = currComPort.Input(0)
End If
If Trim(Val(Hex(tmpReceiveIn(0)))) = 67 Then
tmpRet = -1
tmpReturnData = RFMifare_Send89H(6, 1, 2, 1000, tmpRet)
If tmpReturnData = "830083" Then
tmpReadbuff = 0
Else
tmpReadbuff = Mid(tmpReturnData, 5,
End If
If tmpRet = 0 Then tmpResult = 0
End If
End If
RFMifare_Readvalue = tmpResult
End Function
