VB6 MSComm串口转485通讯示例源码_vb6 485通讯


VB6 MSComm串口转485通讯示例源码_vb6 232串口_02

Dim GetData, iscommopen As Boolean
Dim COMBUF(0 To 10000) As Byte, databuf(0 To 10000) As Byte, comand(0 To 10) As Byte
Dim commpoi, istimecount, netstay As Integer
Private Declare Function CRC_16 Lib "crcbyhoho.dll" (ByVal buf As Long, ByVal nLen As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim dispcardno As String
Function checkcom(com As Integer) As Boolean ' 检测串口
On Error GoTo err:
MSComm1.CommPort = com
MSComm1.PortOpen = True
MSComm1.PortOpen = False
checkcom = True
Exit Function
err:
checkcom = False
End Function
Private Sub Check1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Command1.Caption = "打开端口" Then
answ = MsgBox("请先打开与设备相连的端口,再执行此功能!", vbCritical, "注意:")
Exit Sub
End If

If Val(Text1) = 0 Then
answ = MsgBox("请先输入要轮询的站点号!", vbCritical, "注意:")
Text1.SetFocus
Exit Sub
End If
If Check1.Value = 0 Then
Timer2.Enabled = True
Else
Timer2.Enabled = False
Timer1.Enabled = False
End If
End Sub

Private Sub Command1_Click()
Dim a As Integer
Dim comstr As String
comstr = Trim(Combo2.Text) + ","
Select Case Combo3.ListIndex
Case 0
comstr = comstr + "N,8,1"
Case 1
comstr = comstr + "O,8,1"
Case 2
comstr = comstr + "E,8,1"
Case 3
comstr = comstr + "M,8,1"
Case 4
comstr = comstr + "S,8,1"
End Select



If Command1.Caption = "打开端口" Then
a = Val(Mid(Trim(Combo1.Text), 4, 1))
MSComm1.CommPort = a

MSComm1.OutBufferSize = 1024
MSComm1.InBufferSize = 1024
MSComm1.InputMode = 1
MSComm1.InputLen = 0
MSComm1.InBufferCount = 0
MSComm1.SThreshold = 1
MSComm1.RThreshold = 1
MSComm1.Settings = comstr
MSComm1.PortOpen = True

Command1.Caption = "关闭端口"
Else
Timer2.Enabled = False
Check1.Value = 0
MSComm1.PortOpen = False
Command1.Caption = "打开端口"
End If

End Sub

Private Sub Command10_Click()
Dim sendd(0 To 4) As Byte
Dim sendstr As String
Dim i, answ, crc As Long
If Command1.Caption = "打开端口" Then
answ = MsgBox("请先打开与设备相连的端口,再执行此功能!", vbCritical, "注意:")
Exit Sub
End If

sendd(0) = &HAA
sendd(1) = &HAA
sendd(2) = Val(Text1) Mod 256 '机号
sendd(3) = Int(Val(Text1) / 256) Mod 256
sendd(4) = &HD2

netstay = 3
MSComm1.Output = sendd()
sendstr = "发送:"
For i = 0 To 4
sendstr = sendstr + Right("00" + Hex(sendd(i)), 2) + " "
Next
List1.AddItem (sendstr)
List1.ListIndex = List1.ListCount - 1

End Sub

Private Sub Command11_Click()
Dim sendd(0 To 8) As Byte
Dim sendstr As String
Dim keystr As String

Dim i, answ, crc As Long
If Command1.Caption = "打开端口" Then
answ = MsgBox("请先打开与设备相连的端口,再执行此功能!", vbCritical, "注意:")
Exit Sub
End If
If Val(Text1) = 0 Then
answ = MsgBox("请先输入要设定的站点号!", vbCritical, "注意:")
Text1.SetFocus
Exit Sub
End If

keystr = Left(Trim(Text12) + "000000", 6)

sendd(0) = &HAA
sendd(1) = &HAA
sendd(2) = Val(Text1) Mod 256 '机号
sendd(3) = Int(Val(Text1) / 256) Mod 256
sendd(4) = &HF
sendd(5) = "&H" & Mid(keystr, 1, 2)
sendd(6) = "&H" & Mid(keystr, 3, 2)
sendd(7) = "&H" & Mid(keystr, 5, 2)
sendd(8) = sendd(5) Xor sendd(6) Xor sendd(7)

netstay = 8
MSComm1.Output = sendd()

sendstr = "发送:"
For i = 0 To 8
sendstr = sendstr + Right("00" + Hex(sendd(i)), 2) + " "
Next

List1.AddItem (sendstr)
List1.ListIndex = List1.ListCount - 1

Timer1.Enabled = True

End Sub

Private Sub Command12_Click()
Dim sendd(0 To 12) As Byte
Dim sendstr As String
Dim timestr As String
Dim i, answ, crc As Long
Dim wekday As Byte

If Command1.Caption = "打开端口" Then
answ = MsgBox("请先打开与设备相连的端口,再执行此功能!", vbCritical, "注意:")
Exit Sub
End If

timestr = Format(Now, "YYYY-MM-DD HH:MM:SS")
wekday = IIf(Weekday(Date) - 1 < 0, 0, Weekday(Date) - 1)

sendd(0) = &HAA
sendd(1) = &HAA
sendd(2) = Val(Text1) Mod 256 '机号
sendd(3) = Int(Val(Text1) / 256) Mod 256
sendd(4) = &H4B
sendd(5) = "&H" & Mid(timestr, 18, 2)
sendd(6) = "&H" & Mid(timestr, 15, 2)
sendd(7) = "&H" & Mid(timestr, 12, 2)
sendd(8) = "&H" & Mid(timestr, 9, 2)
sendd(9) = "&H" & Mid(timestr, 6, 2)
sendd(10) = "&H" & Format(wekday, "00")
sendd(11) = "&H" & Mid(timestr, 3, 2)
sendd(12) = sendd(5) Xor sendd(6) Xor sendd(7) Xor sendd(8) Xor sendd(9) Xor sendd(10) Xor sendd(11)

netstay = 9
MSComm1.Output = sendd()

sendstr = "发送:"
For i = 0 To 12
sendstr = sendstr + Right("00" + Hex(sendd(i)), 2) + " "
Next

List1.AddItem (sendstr)
List1.ListIndex = List1.ListCount - 1

Timer1.Enabled = True

End Sub

Private Sub Command13_Click()
Dim sendd(0 To 4) As Byte
Dim sendstr As String

Dim i, answ, crc As Long
If Command1.Caption = "打开端口" Then
answ = MsgBox("请先打开与设备相连的端口,再执行此功能!", vbCritical, "注意:")
Exit Sub
End If
If Val(Text1) = 0 Then
answ = MsgBox("请先输入要读取的站点号!", vbCritical, "注意:")
Text1.SetFocus
Exit Sub
End If

sendd(0) = &HAA
sendd(1) = &HAA
sendd(2) = Val(Text1) Mod 256 '机号
sendd(3) = Int(Val(Text1) / 256) Mod 256
sendd(4) = &H2D

netstay = 10
MSComm1.Output = sendd()

sendstr = "发送:"
For i = 0 To 4
sendstr = sendstr + Right("00" + Hex(sendd(i)), 2) + " "
Next

List1.AddItem (sendstr)
List1.ListIndex = List1.ListCount - 1

Timer1.Enabled = True

End Sub

Private Sub Command14_Click()
Dim sendd(0 To 4) As Byte
Dim sendstr As String
Dim i, answ, crc As Long
If Command1.Caption = "打开端口" Then
answ = MsgBox("请先打开与设备相连的端口,再执行此功能!", vbCritical, "注意:")
Exit Sub
End If

sendd(0) = &HAA
sendd(1) = &HAA
sendd(2) = Val(Text1) Mod 256 '机号
sendd(3) = Int(Val(Text1) / 256) Mod 256
sendd(4) = &H87

netstay = 11
MSComm1.Output = sendd()
sendstr = "发送:"
For i = 0 To 4
sendstr = sendstr + Right("00" + Hex(sendd(i)), 2) + " "
Next
List1.AddItem (sendstr)
List1.ListIndex = List1.ListCount - 1

End Sub

Private Sub Command15_Click()
Dim sendd(0 To 38) As Byte
Dim sendstr As String
Dim i, answ, j, crc As Long

If Command1.Caption = "打开端口" Then
answ = MsgBox("请先打开与设备相连的端口,再执行此功能!", vbCritical, "注意:")
Exit Sub
End If
If Val(Text1) = 0 Then
answ = MsgBox("请先输入要轮询的站点号!", vbCritical, "注意:")
Text1.SetFocus
Exit Sub
End If

sendd(0) = &HAA
sendd(1) = &HAA
sendd(2) = Val(Text1) Mod 256 '机号
sendd(3) = Int(Val(Text1) / 256) Mod 256
sendd(4) = &H78


strls = dispcardno + Text5 + " "

'从4~'
'注意中英文在VB中的提取ASC码的方法
i = 1
j = 1
While (i <= 30)
longi = Asc(Mid(strls, j, 1))
j = j + 1
If (longi < 0) Then
'汉字
longi = 65536 + longi
sendd(i + 4) = ((longi - (longi Mod 256)) / 256) Mod 256 '千万不要以为"这些语句太繁杂,mod多此一举"
i = i + 1
sendd(i + 4) = longi Mod 256

i = i + 1

Else
'英文或数字
sendd(i + 4) = longi Mod 256
longi = longi / 256
i = i + 1
End If

Wend

crc = 0
For i = 5 To 34
crc = crc Xor sendd(i)
Next

sendd(35) = crc

netstay = 12
MSComm1.Output = sendd()

sendstr = "发送:"
For i = 0 To 35
sendstr = sendstr + Right("00" + Hex(sendd(i)), 2) + " "
Next

List1.AddItem (sendstr)
List1.ListIndex = List1.ListCount - 1
End Sub

Private Sub Command16_Click()
Dim sendd(0 To 8) As Byte
Dim sendstr As String
Dim i, answ, crc As Long
If Command1.Caption = "打开端口" Then
answ = MsgBox("请先打开与设备相连的端口,再执行此功能!", vbCritical, "注意:")
Exit Sub
End If

sendd(0) = &HAA
sendd(1) = &HAA
sendd(2) = Val(Text1) Mod 256 '机号
sendd(3) = Int(Val(Text1) / 256) Mod 256
sendd(4) = &H1E
sendd(5) = &HF1
sendd(6) = Int(Val(Text16) / 256) Mod 256 '延时
sendd(7) = Val(Text16) Mod 256
sendd(8) = sendd(5) Xor sendd(6) Xor sendd(7)

netstay = 13
MSComm1.Output = sendd()

sendstr = "发送:"
For i = 0 To 8
sendstr = sendstr + Right("00" + Hex(sendd(i)), 2) + " "
Next

List1.AddItem (sendstr)
List1.ListIndex = List1.ListCount - 1
End Sub

Private Sub Command17_Click()
Dim sendd(0 To 8) As Byte
Dim sendstr As String
Dim i, answ, crc As Long
If Command1.Caption = "打开端口" Then
answ = MsgBox("请先打开与设备相连的端口,再执行此功能!", vbCritical, "注意:")
Exit Sub
End If

sendd(0) = &HAA
sendd(1) = &HAA
sendd(2) = Val(Text1) Mod 256 '机号
sendd(3) = Int(Val(Text1) / 256) Mod 256
sendd(4) = &H1E
sendd(5) = &HE1
sendd(6) = 0
sendd(7) = 0
sendd(8) = &HE1

netstay = 14
MSComm1.Output = sendd()

sendstr = "发送:"
For i = 0 To 8
sendstr = sendstr + Right("00" + Hex(sendd(i)), 2) + " "
Next

List1.AddItem (sendstr)
List1.ListIndex = List1.ListCount - 1
End Sub

Private Sub Command18_Click()
Form2.Show 1
End Sub

Private Sub Command2_Click()
Dim sendd(0 To 4) As Byte
Dim sendstr As String
Dim i, answ As Long
If Command1.Caption = "打开端口" Then
answ = MsgBox("请先打开与设备相连的端口,再执行此功能!", vbCritical, "注意:")
Exit Sub
End If

sendd(0) = &HAA
sendd(1) = &HAA
sendd(2) = &H0
sendd(3) = &H0
sendd(4) = &HA5
netstay = 0
MSComm1.Output = sendd()

sendstr = "发送:"
For i = 0 To 4
sendstr = sendstr + Right("00" + Hex(sendd(i)), 2) + " "
Next

List1.AddItem (sendstr)
List1.ListIndex = List1.ListCount - 1

Timer1.Enabled = True
End Sub

Private Sub Command3_Click()
Dim sendd(0 To 9) As Byte
Dim sendstr As String
Dim i, answ, crc As Long
If Command1.Caption = "打开端口" Then
answ = MsgBox("请先打开与设备相连的端口,再执行此功能!", vbCritical, "注意:")
Exit Sub
End If

sendd(0) = &HAA
sendd(1) = &HAA
sendd(2) = Val(Text1) Mod 256 '机号
sendd(3) = Int(Val(Text1) / 256) Mod 256
sendd(4) = &HF0
sendd(5) = Val(Text2) Mod 256 '机号
sendd(6) = Int(Val(Text2) / 256) Mod 256
sendd(7) = fangma(DecToBin(sendd(5)))
sendd(8) = fangma(DecToBin(sendd(6)))
sendd(9) = &H0

netstay = 1
MSComm1.Output = sendd()

sendstr = "发送:"
For i = 0 To 9
sendstr = sendstr + Right("00" + Hex(sendd(i)), 2) + " "
Next

List1.AddItem (sendstr)
List1.ListIndex = List1.ListCount - 1

Timer1.Enabled = True
End Sub

Private Sub Command4_Click()
Dim sendd(0 To 38) As Byte
Dim sendstr As String
Dim i, answ, j, crc As Long

If Command1.Caption = "打开端口" Then
answ = MsgBox("请先打开与设备相连的端口,再执行此功能!", vbCritical, "注意:")
Exit Sub
End If
If Val(Text1) = 0 Then
answ = MsgBox("请先输入要轮询的站点号!", vbCritical, "注意:")
Text1.SetFocus
Exit Sub
End If

sendd(0) = &HAA
sendd(1) = &HAA
sendd(2) = Val(Text1) Mod 256 '机号
sendd(3) = Int(Val(Text1) / 256) Mod 256
sendd(4) = &H5A


strls = dispcardno + Text5 + " "

'从4~'
'注意中英文在VB中的提取ASC码的方法
i = 1
j = 1
While (i <= 30)
longi = Asc(Mid(strls, j, 1))
j = j + 1
If (longi < 0) Then
'汉字
longi = 65536 + longi
sendd(i + 4) = ((longi - (longi Mod 256)) / 256) Mod 256 '千万不要以为"这些语句太繁杂,mod多此一举"
i = i + 1
sendd(i + 4) = longi Mod 256

i = i + 1

Else
'英文或数字
sendd(i + 4) = longi Mod 256
longi = longi / 256
i = i + 1
End If

Wend


sendd(35) = Int(Text15 / 20)
sendd(36) = Int(Text14 / 20)
sendd(37) = Text13

crc = 0
For i = 5 To 37
crc = crc Xor sendd(i)
Next

sendd(38) = crc

netstay = 5
MSComm1.Output = sendd()

sendstr = "发送:"
For i = 0 To 38
sendstr = sendstr + Right("00" + Hex(sendd(i)), 2) + " "
Next

List1.AddItem (sendstr)
List1.ListIndex = List1.ListCount - 1

'Timer1.Enabled = True
End Sub

Private Sub Command5_Click()
Dim sendd(0 To 4) As Byte
Dim sendstr As String
Dim i, answ, crc As Long
If Command1.Caption = "打开端口" Then
answ = MsgBox("请先打开与设备相连的端口,再执行此功能!", vbCritical, "注意:")
Exit Sub
End If

sendd(0) = &HAA
sendd(1) = &HAA
sendd(2) = Val(Text1) Mod 256 '机号
sendd(3) = Int(Val(Text1) / 256) Mod 256
sendd(4) = &H69

netstay = 4
MSComm1.Output = sendd()
sendstr = "发送:"
For i = 0 To 4
sendstr = sendstr + Right("00" + Hex(sendd(i)), 2) + " "
Next
List1.AddItem (sendstr)
List1.ListIndex = List1.ListCount - 1

End Sub

Private Sub Command6_Click()
Dim sendd(0 To 7) As Byte
Dim sendstr As String
Dim i, answ, crc As Long
If Command1.Caption = "打开端口" Then
answ = MsgBox("请先打开与设备相连的端口,再执行此功能!", vbCritical, "注意:")
Exit Sub
End If

sendd(0) = &HAA
sendd(1) = &HAA
sendd(2) = Val(Text1) Mod 256 '机号
sendd(3) = Int(Val(Text1) / 256) Mod 256
sendd(4) = &HC3
sendd(5) = Int(Val(Text3) / 256) Mod 256 '延时
sendd(6) = Val(Text3) Mod 256
sendd(7) = sendd(5) Xor sendd(6)

netstay = 2
MSComm1.Output = sendd()

sendstr = "发送:"
For i = 0 To 7
sendstr = sendstr + Right("00" + Hex(sendd(i)), 2) + " "
Next

List1.AddItem (sendstr)
List1.ListIndex = List1.ListCount - 1


End Sub

Private Sub Command7_Click()
Dim sendd(0 To 7) As Byte
Dim sendstr As String
Dim i, answ, crc As Long
If Command1.Caption = "打开端口" Then
answ = MsgBox("请先打开与设备相连的端口,再执行此功能!", vbCritical, "注意:")
Exit Sub
End If

sendd(0) = &HAA
sendd(1) = &HAA
sendd(2) = Val(Text1) Mod 256 '机号
sendd(3) = Int(Val(Text1) / 256) Mod 256
sendd(4) = &H96
sendd(5) = Int(Text8 / 20) '机号
sendd(6) = Int(Text10 / 20)
sendd(7) = Text11

netstay = 6
MSComm1.Output = sendd()

sendstr = "发送:"
For i = 0 To 7
sendstr = sendstr + Right("00" + Hex(sendd(i)), 2) + " "
Next

List1.AddItem (sendstr)
List1.ListIndex = List1.ListCount - 1

End Sub

Private Sub Command8_Click()
Dim sendd(0 To 4) As Byte
Dim sendstr As String
Dim i, answ, crc As Long
If Command1.Caption = "打开端口" Then
answ = MsgBox("请先打开与设备相连的端口,再执行此功能!", vbCritical, "注意:")
Exit Sub
End If

sendd(0) = &HAA
sendd(1) = &HAA
sendd(2) = Val(Text1) Mod 256 '机号
sendd(3) = Int(Val(Text1) / 256) Mod 256
sendd(4) = &HB4

netstay = 7
MSComm1.Output = sendd()

sendstr = "发送:"
For i = 0 To 4
sendstr = sendstr + Right("00" + Hex(sendd(i)), 2) + " "
Next

List1.AddItem (sendstr)
List1.ListIndex = List1.ListCount - 1
End Sub

Private Sub Command9_Click()
List1.Clear
End Sub

Private Sub Form_Load()
Dim i As Integer
For i = 1 To 9
If checkcom(i) Then
Combo1.AddItem ("COM" + Trim(Str(i)))
End If
Next i
Combo1.ListIndex = Combo1.ListCount - 1

Combo2.AddItem (" 4800")
Combo2.AddItem (" 9600")
Combo2.AddItem ("19200")
Combo2.AddItem ("38400")
Combo2.ListIndex = 2

Combo3.AddItem ("None 无")
Combo3.AddItem ("Odd 奇")
Combo3.AddItem ("Even 偶")
Combo3.AddItem ("Mask 常1 ")
Combo3.AddItem ("Space 常0 ")
Combo3.ListIndex = 0

dispcardno = "卡号:1234567890"

Label15.Caption = Format(Now, "YYYY-MM-DD HH:MM:SS")
End Sub

Private Sub MSComm1_OnComm()
Dim bytInput() As Byte
Dim sendd(0 To 100) As Byte
Dim databuf(0 To 100) As Byte
Dim intInputLen As Integer
Dim n, edc, i As Integer
Dim rstr, jhstr, khstr, sstr As String
Dim plist As ListItem

On Error Resume Next

Sleep (50) '当接收数据超过8字节时,此延时是必须的,否则有可能最后一个包数据接收不到 50
If List1.ListCount > 100 Then List1.Clear

commpoi = 0
edc = 0
rstr = "接收:"
Select Case MSComm1.CommEvent
Case comEvReceive
Timer1.Enabled = False
MSComm1.InputMode = 1 '0:文本方式,1:二进制方式
intInputLen = MSComm1.InBufferCount
bytInput = MSComm1.Input
For n = 0 To intInputLen - 1
COMBUF(commpoi) = bytInput(n)
rstr = rstr + Right("00" + Hex(bytInput(n)), 2) + " "
commpoi = commpoi + 1
Next n
List1.AddItem (rstr)
List1.ListIndex = List1.ListCount - 1

Select Case netstay
Case 0
If COMBUF(4) = COMBUF(2) Xor COMBUF(3) Then
Text1 = CLng(COMBUF(2)) + CLng(COMBUF(3)) * 256
MsgBox "读取在线站点号成功!", vbInformation, "485读头工控机测试程序"
End If
Case 1
Text1 = Text2
MsgBox "在线站点号设置成功!", vbInformation, "485读头工控机测试程序"
Case 2
Case 3
If COMBUF(0) = &H69 And COMBUF(1) = &HD2 And (COMBUF(2) Xor COMBUF(3) Xor COMBUF(4) Xor COMBUF(5) Xor COMBUF(6) = COMBUF(7)) Then
rstr = "物理卡号:"
rstr = rstr + Right("00" + Hex(COMBUF(3)), 2) + "-"
rstr = rstr + Right("00" + Hex(COMBUF(4)), 2) + "-"
rstr = rstr + Right("00" + Hex(COMBUF(5)), 2) + "-"
rstr = rstr + Right("00" + Hex(COMBUF(6)), 2) + " 换算成十位卡号:"


doublecardhao = COMBUF(3)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + COMBUF(4)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + COMBUF(5)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + COMBUF(6)

rstr = rstr + Right("0000000000" + CStr(doublecardhao), 10)

dispcardno = "卡号:" + Right("0000000000" + CStr(doublecardhao), 10)
Text4 = rstr

If Check2.Value = 1 Then '读卡成功,自动清寄存器让设备可以再次读卡
Command4_Click
End If
Else
If Check1.Value = 0 Then
Text4 = ""
End If
End If
Case 4
If COMBUF(0) = &H69 And COMBUF(1) = &H69 Then
If COMBUF(2) = &H1 And (COMBUF(3) Xor COMBUF(4) Xor COMBUF(5) Xor COMBUF(6) Xor COMBUF(7) = COMBUF(8)) Then '只有卡号
rstr = "物理卡号:"
rstr = rstr + Right("00" + Hex(COMBUF(4)), 2) + "-"
rstr = rstr + Right("00" + Hex(COMBUF(5)), 2) + "-"
rstr = rstr + Right("00" + Hex(COMBUF(6)), 2) + "-"
rstr = rstr + Right("00" + Hex(COMBUF(7)), 2) + " 换算成十位卡号:"


doublecardhao = COMBUF(4)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + COMBUF(5)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + COMBUF(6)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + COMBUF(7)

rstr = rstr + Right("0000000000" + CStr(doublecardhao), 10)

dispcardno = "卡号:" + Right("0000000000" + CStr(doublecardhao), 10)
Text7 = rstr

If Check2.Value = 1 Then '读卡成功,自动清寄存器让设备可以再次读卡
Command4_Click
End If
'ElseIf COMBUF(2) = &H2 And COMBUF(3) = &H2A And commpoi > 8 Then '有*+数字按键
ElseIf COMBUF(2) = &H2 And commpoi > 8 Then '有*+数字按键
keystr = ""
For i = 3 To 4 + commpoi - 9
keystr = keystr + Chr(COMBUF(i))
Next
dispcardno = "按键:" + Left(keystr + " ", 10)
Text7 = "设备按键:" + keystr

If Check2.Value = 1 Then '读卡成功,自动清寄存器让设备可以再次读卡
Command4_Click
End If
ElseIf COMBUF(2) = &H3 And (COMBUF(3) Xor COMBUF(4) Xor COMBUF(5) Xor COMBUF(6) Xor COMBUF(7) = COMBUF(8)) Then '卡号和按键
rstr = "物理卡号:"
rstr = rstr + Right("00" + Hex(COMBUF(4)), 2) + "-"
rstr = rstr + Right("00" + Hex(COMBUF(5)), 2) + "-"
rstr = rstr + Right("00" + Hex(COMBUF(6)), 2) + "-"
rstr = rstr + Right("00" + Hex(COMBUF(7)), 2) + " 换算成十位卡号:"

doublecardhao = COMBUF(4)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + COMBUF(5)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + COMBUF(6)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + COMBUF(7)

rstr = rstr + Right("0000000000" + CStr(doublecardhao), 10)
dispcardno = "卡号:" + Right("0000000000" + CStr(doublecardhao), 10)

keystr = ""
For i = 9 To 10 + commpoi - 14
keystr = keystr + Chr(COMBUF(i))
Next
dispcardno = dispcardno + "按键:" + Left(keystr + " ", 10)

Text7 = rstr + ",按键:" + keystr

If Check2.Value = 1 Then '读卡成功,自动清寄存器让设备可以再次读卡
Command4_Click
End If
ElseIf intInputLen = 8 And (COMBUF(5) Xor COMBUF(6) = COMBUF(7)) Then
keystr = Chr(COMBUF(3))
dispcardno = "单键:" + Left(keystr + " ", 10)
Text7 = "设备单键:" + keystr

If Check2.Value = 1 Then '读卡成功,自动清寄存器让设备可以再次读卡
Command4_Click
End If
End If
Else
If Check1.Value = 0 Then
Text7 = ""
End If
End If
Case 5 '
Case 6 '
Case 7 '
Case 8 '
Case 9 '
Case 10 '
Case 11 '

If COMBUF(0) = &H69 And commpoi > 2 Then
keystr = ""
For i = 1 To 2 + commpoi - 3
keystr = keystr + Chr(COMBUF(i))
Next
Text4 = "设备按键:" + keystr
ElseIf COMBUF(0) = &H69 And COMBUF(2) = &HD Then
keystr = Chr(COMBUF(1))
Text4 = "设备单键:" + keystr
End If
Case 12 '

End Select

End Select
End Sub

Private Sub Text11_Click()
Shell Environ("PROGRAMFILES") & "\Internet Explorer\iexplore.exe " & "www.icmcu.com"
End Sub

Private Sub Timer1_Timer()
Timer1.Enabled = False

End Sub

Private Sub Timer2_Timer()
Timer2.Enabled = False
Command5_Click
Timer2.Enabled = True
End Sub

Private Sub Timer3_Timer()
Label15.Caption = Format(Now, "YYYY-MM-DD HH:MM:SS")
End Sub

​VB6串口通讯读卡器控制.rar-VB文档类资源-CSDN下载vb6使用MScomm控件串口通讯示例,展示了32、64位操作系统如何注册外部OCX控件,vb6调用更多下载资源、学习资料请访问CSDN下载频道.javascript:void(0)​