VB6四字节卡号相互转换源码

读卡器介绍：ID IC ICode 2 HID ICLASS 二代证RFID读卡器USB模拟键盘输出卡号-淘宝网 (taobao.com)

Private Sub Command1_Click()
Dim H2b As Double
Dim L2b As Double
Dim i As Integer
Dim HexStr, wg34 As String

Dim lsh
Dim mypiccdata(4) As Byte


lsh = Val(Text1)
If lsh > 4294967295# Then
    MsgBox "数据大于4字节会溢出！请重新输入", vbCritical + vbOKOnly, "提示"
    Text1.SetFocus
    Exit Sub
End If

H2b = Int(lsh / (65536))
L2b = lsh - H2b * 65536

HexStr = Right("0000" + Hex(H2b), 4) + Right("0000" + Hex(L2b), 4)
Text4 = HexStr

For i = 0 To 3
   mypiccdata(i) = "&H" + Mid(HexStr, i * 2 + 1, 2)
   Text2(i) = mypiccdata(i)
   Text3(i) = Right("00" + Hex(mypiccdata(i)), 2)
Next

doublecardhao = mypiccdata(1)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(2)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(3)
Text5 = Format(doublecardhao, "00000000")

doublecardhao = mypiccdata(2)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(3)
Text6 = Format(mypiccdata(1), "000") + Format(doublecardhao, "00000")

doublecardhao = mypiccdata(0)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(1)
wg34 = Format(doublecardhao, "00000")
doublecardhao = mypiccdata(2)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(3)
Text7 = wg34 + Format(doublecardhao, "00000")

End Sub

Private Sub Command2_Click()
Dim i As Integer
Dim HexStr As String
Dim mypiccdata(4) As Byte
Dim doublecardhao As Double

HexStr = Right("00000000" + Trim(Text4), 8)
Text4 = HexStr

For i = 0 To 3
    Text3(i) = Mid(HexStr, i * 2 + 1, 2)
    mypiccdata(i) = "&H" + Mid(HexStr, i * 2 + 1, 2)
    Text2(i) = mypiccdata(i)
Next

doublecardhao = mypiccdata(0)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(1)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(2)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(3)
Text1 = Format(doublecardhao, "0000000000")

doublecardhao = mypiccdata(1)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(2)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(3)
Text5 = Format(doublecardhao, "00000000")

doublecardhao = mypiccdata(2)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(3)
Text6 = Format(mypiccdata(1), "000") + Format(doublecardhao, "00000")

doublecardhao = mypiccdata(0)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(1)
wg34 = Format(doublecardhao, "00000")
doublecardhao = mypiccdata(2)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(3)
Text7 = wg34 + Format(doublecardhao, "00000")

End Sub

Private Sub Command3_Click()
Dim i As Integer
Dim HexStr As String
Dim mypiccdata(4) As Byte
Dim doublecardhao As Double

For i = 0 To 3
   If Text2(i) = "" Then
    MsgBox "请输入正确的十进制数据！", vbCritical + vbOKOnly, "提示"
    Text2(i).SetFocus
    Exit Sub
   End If
Next

HexStr = ""
For i = 0 To 3
    mypiccdata(i) = Val(Text2(i))
    Text3(i) = Right("00" + Hex(Val(Text2(i))), 2)
    HexStr = HexStr + Right("00" + Hex(Val(Text2(i))), 2)
Next
Text4 = HexStr

doublecardhao = mypiccdata(0)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(1)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(2)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(3)
Text1 = Format(doublecardhao, "0000000000")

doublecardhao = mypiccdata(1)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(2)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(3)
Text5 = Format(doublecardhao, "00000000")

doublecardhao = mypiccdata(2)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(3)
Text6 = Format(mypiccdata(1), "000") + Format(doublecardhao, "00000")

doublecardhao = mypiccdata(0)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(1)
wg34 = Format(doublecardhao, "00000")
doublecardhao = mypiccdata(2)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(3)
Text7 = wg34 + Format(doublecardhao, "00000")
End Sub

Private Sub Command4_Click()
Dim i As Integer
Dim HexStr As String
Dim mypiccdata(4) As Byte
Dim doublecardhao As Double

For i = 0 To 3
   If Text3(i) = "" Then
    MsgBox "请输入正确的十六进制数据！", vbCritical + vbOKOnly, "提示"
    Text3(i).SetFocus
    Exit Sub
   End If
Next


HexStr = ""
For i = 0 To 3
    mypiccdata(i) = "&H" + Trim(Text3(i))
    Text2(i) = mypiccdata(i)
    HexStr = HexStr + Right("00" + Trim(Text3(i)), 2)
Next
Text4 = HexStr

doublecardhao = mypiccdata(0)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(1)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(2)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(3)
Text1 = Format(doublecardhao, "0000000000")

doublecardhao = mypiccdata(1)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(2)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(3)
Text5 = Format(doublecardhao, "00000000")

doublecardhao = mypiccdata(2)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(3)
Text6 = Format(mypiccdata(1), "000") + Format(doublecardhao, "00000")

doublecardhao = mypiccdata(0)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(1)
wg34 = Format(doublecardhao, "00000")
doublecardhao = mypiccdata(2)
doublecardhao = doublecardhao * 256
doublecardhao = doublecardhao + mypiccdata(3)
Text7 = wg34 + Format(doublecardhao, "00000")
End Sub


Private Sub Text1_KeyPress(KeyAscii As Integer)
  Select Case KeyAscii
                  Case 13
                       Command1_Click
                  Case vbKey0 To vbKey9, vbKeyBack
                  Case Else
                          KeyAscii = 0
          End Select
End Sub
Private Sub Text2_KeyPress(Index As Integer, KeyAscii As Integer)
 Select Case KeyAscii
                  Case vbKey0 To vbKey9, vbKeyBack
                  Case Else
                          KeyAscii = 0
          End Select
End Sub

Private Sub Text2_LostFocus(Index As Integer)
If Text2(Index) > 255 Then
    MsgBox "请输入0-255之间的数!", vbCritical + vbOKOnly, "提示"
    Text2(Index) = 0
    Text2(Index).SetFocus
End If
End Sub

Private Sub Text3_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case KeyAscii
                  Case vbKey0 To vbKey9, vbKeyBack
                  Case 97 To 102
                  Case 65 To 70
                  Case Else
                          KeyAscii = 0
          End Select
End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
                  Case 13
                       Command3_Click
                  Case vbKey0 To vbKey9, vbKeyBack
                  Case 97 To 102
                  Case 65 To 70
                  Case Else
                          KeyAscii = 0
          End Select
End Sub