📄 frm_test.frm
字号:
TabIndex = 8
Top = 3570
Width = 2100
End
Begin VB.CommandButton Command8
Caption = "读MF1卡序列号"
Height = 495
Left = 2760
TabIndex = 7
Top = 4260
Width = 2100
End
Begin VB.CommandButton Command6
Caption = "修改MF1卡扇区密码"
Height = 495
Left = 360
TabIndex = 6
Top = 4260
Width = 2100
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "数据内容"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 240
Index = 0
Left = 360
TabIndex = 17
Top = 240
Width = 1020
End
Begin VB.Label Label13
Caption = "验证密码"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 255
Index = 24
Left = 960
TabIndex = 15
Top = 1020
Width = 1095
End
Begin VB.Label Label13
Caption = "新的验证密码"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 255
Index = 25
Left = 480
TabIndex = 14
Top = 1500
Width = 1695
End
Begin VB.Label Label13
Caption = "将要操作的扇区"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 255
Index = 26
Left = 2145
TabIndex = 13
Top = 2070
Width = 1815
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "将要操作的数据块"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 240
Index = 27
Left = 1920
TabIndex = 12
Top = 2430
Width = 2040
End
End
Begin VB.Frame Frame1
Caption = "T5557 OR EMID Card"
Height = 2175
Left = 5160
TabIndex = 0
Top = 360
Width = 5775
Begin VB.TextBox Text3
Height = 375
Left = 120
MaxLength = 30
TabIndex = 44
Text = "Text1"
Top = 600
Width = 5535
End
Begin VB.CheckBox OP_SoundT5557
Caption = "发卡机读写声音提示"
Height = 255
Left = 120
TabIndex = 36
Top = 1080
Value = 1 'Checked
Width = 1935
End
Begin VB.CommandButton Command2
Caption = "写卡片内容"
Height = 495
Left = 1440
TabIndex = 4
Top = 1440
Width = 1215
End
Begin VB.CommandButton Command3
Caption = "读卡片内容"
Height = 495
Left = 120
TabIndex = 3
Top = 1440
Width = 1215
End
Begin VB.CommandButton Command4
Caption = "读EMID卡序列号"
Height = 495
Left = 2760
TabIndex = 2
Top = 1440
Width = 1455
End
Begin VB.CommandButton Command5
Caption = "读57卡序列号"
Height = 495
Left = 4320
TabIndex = 1
Top = 1440
Width = 1335
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "数据内容"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 240
Index = 7
Left = 120
TabIndex = 45
Top = 360
Width = 1020
End
End
End
Attribute VB_Name = "Frm_Test"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim RW_TypeMF1 As Byte
Dim RW_Type4442 As Byte
Dim RW_TypeT5557 As Byte
Dim sData As String
Dim sLen, i As Integer
Const SS = "没有放卡或卡片密码验证错误!"
Private Sub Command1_Click()
Dim Ic_BuffA(39) As Byte
Dim Model, Name, Ver As String
If SaryUsbReader1.SearchReader(Ic_BuffA) Then
For i = 1 To 30
If Ic_BuffA(i) <> 0 Then Name = Name + Chr(Ic_BuffA(i))
Next
Model = Chr(Ic_BuffA(0))
For i = 31 To 39
If Ic_BuffA(i) <> 0 Then Ver = Ver + Chr(Ic_BuffA(i))
Next
End If
Text1 = Name
Label2 = "发卡机类型:" & Model & " 发卡机软件版本:" & Ver
End Sub
Private Sub Command11_Click()
Dim Ic_BuffA(39) As Byte
If Com_Block.Text = "03" Then
MsgBox "试图将未知格式数据写入密码区,将破坏卡片,按确定退出!"
Exit Sub
End If
If SaryUsbReader1.WriteCard_MF1(RW_TypeMF1, Com_Sector.Text + Com_Block.Text, Txt_KeyA.Text, Text2.Text, Ic_BuffA) Then
MsgBox "写卡成功"
Else
If Ic_BuffA(39) = &H55 Then MsgBox SS
End If
End Sub
Private Sub Command12_Click()
Dim Ic_BuffA(39) As Byte
If SaryUsbReader1.ReadCard_MF1(RW_TypeMF1, Com_Sector.Text + Com_Block.Text, Txt_KeyA.Text, Ic_BuffA) Then
sData = ""
For i = 0 To 15 '+ 4'后面4个字节是ID号
sData = sData & Right$("00" & Hex(Ic_BuffA(i)), 2)
Next
Text2.Text = sData
Else
If Ic_BuffA(39) = &H55 Then MsgBox SS
End If
End Sub
Private Sub Command13_Click()
Dim ErrNum As Byte
If Val(Txt_TotalByte.Text) > 40 Then Txt_TotalByte.Text = 40 '最多40个字节
If Val(Txt_BeginAddr.Text) > 255 Then Txt_BeginAddr.Text = 255
If SaryUsbReader1.WriteCard_SLE4442(Asc("C"), Right(100 & Hex(Txt_BeginAddr), 2) & Right(100 & Hex(Txt_TotalByte), 2), Txt_KeyA_4442, Txt_KeyB_4442, ErrNum) Then
MsgBox "卡片密码修改成功!"
Txt_Num = ErrNum
Else
MsgBox SS
End If
End Sub
Private Sub Command14_Click()
Dim ErrNum As Byte
If Val(Txt_TotalByte.Text) > 40 Then Txt_TotalByte.Text = 40 '最多40个字节
If Val(Txt_BeginAddr.Text) > 255 Then Txt_BeginAddr.Text = 255
If Val(Txt_BeginAddr) + Val(Txt_TotalByte) > 256 Then Exit Sub
If SaryUsbReader1.WriteCard_SLE4442(RW_Type4442, Right(100 & Hex(Txt_BeginAddr), 2) & Right(100 & Hex(Txt_TotalByte), 2), Txt_KeyA_4442, Text5, ErrNum) Then
Txt_Num = ErrNum
MsgBox "写卡成功"
Else
Txt_Num = ErrNum
MsgBox SS
End If
End Sub
Private Sub Command15_Click()
Dim Ic_BuffA(40) As Byte
If Val(Txt_TotalByte.Text) > 40 Then Txt_TotalByte.Text = 40 '最多40个字节
If Val(Txt_BeginAddr.Text) > 255 Then Txt_BeginAddr.Text = 255
If Val(Txt_BeginAddr) + Val(Txt_TotalByte) > 256 Then Exit Sub
If SaryUsbReader1.ReadCard_SLE4442(RW_Type4442, Right(100 & Hex(Txt_BeginAddr), 2) & Right(100 & Hex(Txt_TotalByte), 2), Ic_BuffA) Then
sData = ""
For i = 0 To Val(Txt_TotalByte) - 1
sData = sData & Right$("00" & Hex(Ic_BuffA(i)), 2)
Next
Text5.Text = sData
Txt_Num = Ic_BuffA(40)
Else
Txt_Num = Ic_BuffA(40)
MsgBox SS
End If
End Sub
Private Sub Command2_Click()
Dim Ic_BuffA(39) As Byte
sData = Left(Text3 & String(56, "0"), 56)
sLen = Len(Text3)
For i = 1 To 27
Ic_BuffA(i - 1) = Val("&H" & Mid(sData, i * 2 - 1, 2))
Next
If SaryUsbReader1.WriteCard(Ic_BuffA) Then
MsgBox "写卡成功"
Else
If Ic_BuffA(39) = &H55 Then MsgBox SS
End If
End Sub
Private Sub Command3_Click()
Dim Ic_BuffA(39) As Byte
If SaryUsbReader1.ReadCard(Ic_BuffA) Then
sData = ""
For i = 0 To 27
sData = sData & Right$("00" & Hex(Ic_BuffA(i)), 2)
Next
Text3 = sData
Else
If Ic_BuffA(39) = &H55 Then MsgBox SS
End If
End Sub
Private Sub Command4_Click()
Dim Ic_BuffA(39) As Byte
If SaryUsbReader1.ReadCard_EID(Ic_BuffA) Then
sData = "原始数据:"
For i = 0 To 4
sData = sData & Right("00" & Hex(Ic_BuffA(i)), 2)
Next
sData = sData & " 普通码:"
For i = 5 To 14
sData = sData & Chr(Ic_BuffA(i))
Next
sData = sData & " 三五码:"
For i = 15 To 22
sData = sData & Chr(Ic_BuffA(i))
If i = 17 Then sData = sData & ","
Next
MsgBox sData
Else
If Ic_BuffA(39) = &H55 Then MsgBox SS
End If
End Sub
Private Sub Command5_Click()
Dim Ic_BuffA(39) As Byte
If SaryUsbReader1.ReadCard_TID(Ic_BuffA) Then
sData = "原始数据:"
For i = 0 To 4
sData = sData & Right("00" & Hex(Ic_BuffA(i)), 2)
Next
sData = sData & " 普通码:"
For i = 5 To 14
sData = sData & Chr(Ic_BuffA(i))
Next
sData = sData & " 三五码:"
For i = 15 To 22
sData = sData & Chr(Ic_BuffA(i))
If i = 17 Then sData = sData & ","
Next
MsgBox sData
Else
If Ic_BuffA(39) = &H55 Then MsgBox SS
End If
End Sub
Private Sub Command6_Click()
Dim Ic_BuffA(39) As Byte
If SaryUsbReader1.WriteCard_MF1(Asc("C"), Com_Sector.Text + "03", Txt_KeyA.Text, Txt_KeyB.Text, Ic_BuffA) Then
MsgBox "密码修改成功!"
Else
If Ic_BuffA(39) = &H55 Then MsgBox SS
End If
End Sub
Private Sub Command7_Click()
Dim Ic_BuffA(39) As Byte
sData = Text1
sLen = Len(Text1)
For i = 1 To sLen
Ic_BuffA(i - 1) = Asc(Mid(sData, i, 1))
Next
If SaryUsbReader1.SetReaderName(Ic_BuffA) Then
MsgBox "设置成功"
Else
If Ic_BuffA(39) = &H55 Then MsgBox SS
End If
End Sub
Private Sub Command8_Click()
Dim Ic_BuffA(39) As Byte
If SaryUsbReader1.ReadCard_MF1_ID(RW_TypeMF1, Ic_BuffA) Then
sData = "原始数据:"
For i = 0 To 4
sData = sData & Right("00" & Hex(Ic_BuffA(i)), 2)
Next
sData = sData & " 普通码:"
For i = 5 To 14
sData = sData & Chr(Ic_BuffA(i))
Next
sData = sData & " 三五码:"
For i = 15 To 22
sData = sData & Chr(Ic_BuffA(i))
If i = 17 Then sData = sData & ","
Next
MsgBox sData
Else
If Ic_BuffA(39) = &H55 Then MsgBox SS
End If
End Sub
Private Sub Form_Load()
RW_TypeMF1 = Asc("P")
RW_Type4442 = Asc("P")
RW_TypeT5557 = Asc("P")
SaryUsbReader1.EntryMonitor
End Sub
Private Sub Form_Unload(Cancel As Integer)
SaryUsbReader1.ExitMonitor
End Sub
Private Sub SaryUsbReader1_iNotifyRoutineA(iEventStatus As Long)
If iEventStatus = 0 Then Shape1.BackColor = vbRed
If iEventStatus = 3 Then Shape1.BackColor = vbGreen
End Sub
Private Sub OP_Sound4442_Click()
If OP_Sound4442 = vbChecked Then RW_Type4442 = Asc("P")
If OP_Sound4442 = vbUnchecked Then RW_Type4442 = Asc("L")
End Sub
Private Sub Op_SoundMF1_Click()
If Op_SoundMF1 = vbChecked Then RW_TypeMF1 = Asc("P")
If Op_SoundMF1 = vbUnchecked Then RW_TypeMF1 = Asc("L")
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -