7,762
社区成员
发帖
与我相关
我的任务
分享急求：16进制字符串补位问题
根据前64个字节生成校验码，然后比较生成的校验码与模块回传的校验码的一致性。校验码的生成方法是把前64个字符的ASCII码相异或，再把异或结果转化为16进制串。
我编写的程序是：
Private Sub Command1_Click()
Dim a As String
a = "00F300E8010A00F300ED00EB00F300EB00F000C500F300F000EC00F300EE00200B"
Dim charAsc As Integer
charAsc = 0
For z = 1 To 64 '校验
charAsc = charAsc Xor Asc(Mid(a, z, 1))
Next z
If Format(Hex(charAsc), "00") = Mid(a, 65, 2) Then
Text1.Text = "right"
Else
Text1.Text = "wrong"
End If
End Sub
生成的校验码是B，返回的是0B。请问当生成的不够两位时，如何补充为2位。
我编写的程序是：
Private Sub Command1_Click()
Dim a As String
a = "00F300E8010A00F300ED00EB00F300EB00F000C500F300F000EC00F300EE00200B"
Dim charAsc As Integer
charAsc = 0
For z = 1 To 64 '校验
charAsc = charAsc Xor Asc(Mid(a, z, 1))
Next z
If Format(Hex(charAsc), "00") = Mid(a, 65, 2) Then
Text1.Text = "right"
Else
Text1.Text = "wrong"
End If
End Sub
生成的校验码是B，返回的是0B。请问当生成的不够两位时，如何补充为2位。
...全文
请发表友善的回复…
发表回复
of123 2006-03-14
- 打赏
- 举报
>这个有点问题，有时Right( "00 "& Hex(charAsc), 2)求出的校验码不对
是你的代码抄错了，有空格了。我常用的方法是：
Right("0" & Hex(charAsc), 2)
是你的代码抄错了，有空格了。我常用的方法是：
Right("0" & Hex(charAsc), 2)
KiteGirl 2006-03-13
- 打赏
- 举报
先别结帖，我有好办法！老老实实等着我把东西拿出来！敢结帖我打断你的腿！！
northwolves 2006-03-13
- 打赏
- 举报
If Right("00"& Hex(charAsc), 2) = Mid(a, 65, 2) Then
KiteGirl 2006-03-13
- 打赏
- 举报
clsPack32类模块的属性和事件。
'CheckError事件 校验错误。设置StringCode属性引发
'CheckReady事件 校验就绪。设置StringCode属性引发
'DatasCheang事件 数据改变。
'Datas()属性 保存数据的有效数组。
'Check属性 只读。校验码。
'StringCode属性 设置或返回数据及校验码的16进制字符串。
'CheckError事件 校验错误。设置StringCode属性引发
'CheckReady事件 校验就绪。设置StringCode属性引发
'DatasCheang事件 数据改变。
'Datas()属性 保存数据的有效数组。
'Check属性 只读。校验码。
'StringCode属性 设置或返回数据及校验码的16进制字符串。
KiteGirl 2006-03-13
- 打赏
- 举报
测试代码：
Private WithEvents priPack32 As clsPack32
Private Sub Command3_Click()
'错误的数据(引发错误事件)
'Text2.Text = ""
priPack32.StringCode = "00F300E8010A00F300ED00EB00F300EB00F000C500F300F000EC00F300EE0020OC"
Text1.Text = priPack32.StringCode
End Sub
Private Sub Command4_Click()
'正确的数据(引发就绪事件)
'Text2.Text = ""
priPack32.StringCode = "00F300E8010A00F300ED00EB00F300EB00F000C500F300F000EC00F300EE0020OB"
Text1.Text = priPack32.StringCode
End Sub
Private Sub Form_Load()
Set priPack32 = New clsPack32
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set priPack32 = Nothing
End Sub
Private Sub priPack32_CheckError()
'校验错误事件
Text2.Text = "Check Wrong"
End Sub
Private Sub priPack32_CheckReady()
'校验就绪事件
Text2.Text = "Check Right"
End Sub
Private WithEvents priPack32 As clsPack32
Private Sub Command3_Click()
'错误的数据(引发错误事件)
'Text2.Text = ""
priPack32.StringCode = "00F300E8010A00F300ED00EB00F300EB00F000C500F300F000EC00F300EE0020OC"
Text1.Text = priPack32.StringCode
End Sub
Private Sub Command4_Click()
'正确的数据(引发就绪事件)
'Text2.Text = ""
priPack32.StringCode = "00F300E8010A00F300ED00EB00F300EB00F000C500F300F000EC00F300EE0020OB"
Text1.Text = priPack32.StringCode
End Sub
Private Sub Form_Load()
Set priPack32 = New clsPack32
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set priPack32 = Nothing
End Sub
Private Sub priPack32_CheckError()
'校验错误事件
Text2.Text = "Check Wrong"
End Sub
Private Sub priPack32_CheckReady()
'校验就绪事件
Text2.Text = "Check Right"
End Sub
KiteGirl 2006-03-13
- 打赏
- 举报
代码：
modPack32.bas内容
Type tpPack32
pkDatas() As Byte
pkCheck As Byte
End Type
Private priPack32_HexTable() As Byte
Private priPack32_HexUnTable() As Byte
Private priPack32_HexTable_Enabled As Boolean
Public Function Pack32_CheckGetByBytes(ByRef pBytes() As Byte) As Byte
'获得字节数组的校验码
Dim tOutByte As Byte
Dim tHexs() As Byte
tHexs() = Pack32_HexsGetByBytes(pBytes())
tOutByte = Pack32_CheckGetByHexs(tHexs())
Pack32_CheckGetByBytes = tOutByte
End Function
Public Function Pack32_CheckGetByHexs(ByRef pBytes() As Byte) As Byte
'获得HEX数组的校验码
Dim tOutByte As Byte
Dim tBytes() As Byte
Dim tBytes_Index As Long
Dim tBytes_Length As Long
tBytes() = pBytes()
tBytes_Length = UBound(tBytes())
For tBytes_Index = 1 To tBytes_Length
tBytes(0) = tBytes(0) Xor tBytes(tBytes_Index)
Next
tOutByte = tBytes(0)
Pack32_CheckGetByHexs = tOutByte
End Function
Public Function Pack32_HexsPutToBytes(ByRef pBytes() As Byte) As Byte()
'将HEX串字节转换为字节
Dim tOutBytes() As Byte
Dim tOutBytes_Length As Long
Dim tOutBytes_Index As Long
Dim tBytes_Length As Long
Dim tBytes_Index As Long
Pack32_HexTable_Create
tBytes_Length = UBound(pBytes())
tOutBytes_Length = (tBytes_Length + 1) \ 2 - 1
ReDim tOutBytes(tOutBytes_Length)
For tOutBytes_Index = 0 To tOutBytes_Length
tBytes_Index = tOutBytes_Index * 2
tOutBytes(tOutBytes_Index) = priPack32_HexUnTable(pBytes(tBytes_Index)) * 16 + priPack32_HexUnTable(pBytes(tBytes_Index + 1))
Next
Pack32_HexsPutToBytes = tOutBytes()
End Function
Public Function Pack32_HexsGetByBytes(ByRef pBytes() As Byte) As Byte()
'将字节转换为HEX串字节
Dim tOutBytes() As Byte
Dim tOutBytes_Length As Long
Dim tOutBytes_Index As Long
Dim tBytes_Length As Long
Dim tBytes_Index As Long
Pack32_HexTable_Create
tBytes_Length = UBound(pBytes())
tOutBytes_Length = (tBytes_Length + 1) * 2 - 1
ReDim tOutBytes(tOutBytes_Length)
For tBytes_Index = 0 To tBytes_Length
tOutBytes_Index = tBytes_Index * 2
tOutBytes(tOutBytes_Index) = priPack32_HexTable(pBytes(tBytes_Index) \ 16)
tOutBytes(tOutBytes_Index + 1) = priPack32_HexTable(pBytes(tBytes_Index) Mod 16)
Next
Pack32_HexsGetByBytes = tOutBytes()
End Function
Private Sub Pack32_HexTable_Create()
'初始化HEX表
If Not priPack32_HexTable_Enabled Then
Dim tTableString As String
tTableString = "0123456789ABCDEF"
priPack32_HexTable() = StrConv(tTableString, vbFromUnicode)
priPack32_HexTable_Enabled = True
Dim tTable_Index As Long
ReDim priPack32_HexUnTable(0 To 255)
For tTable_Index = 0 To 15
priPack32_HexUnTable(priPack32_HexTable(tTable_Index)) = tTable_Index
Next
End If
End Sub
clsPack32.cls内容
Private priPack As tpPack32
Public Event CheckError()
Public Event CheckReady()
Public Property Get Datas() As Byte()
Datas() = priPack.pkDatas()
End Property
Public Property Let Datas(ByRef pBytes() As Byte)
Dim tBytes_Length As Long
tBytes_Length = UBound(pBytes())
If tBytes_Length = 31 Then
With priPack
.pkDatas() = pBytes()
.pkCheck = Pack32_CheckGetByBytes(.pkDatas())
End With
End If
End Property
Public Property Get Check() As Byte
Check = priPack.pkCheck
End Property
Public Property Get StringCode() As String
Dim tBytes() As Byte
tBytes() = priPack.pkDatas()
ReDim Preserve tBytes(32)
tBytes(32) = priPack.pkCheck
Dim tOutBytes() As Byte
tOutBytes() = Pack32_HexsGetByBytes(tBytes())
StringCode = StrConv(tOutBytes(), vbUnicode)
End Property
Public Property Let StringCode(ByVal pString As String)
Dim tBytes() As Byte
tBytes() = StrConv(pString, vbFromUnicode)
ReDim Preserve tBytes(65)
Dim tInDatas() As Byte
Dim tInCheck As Byte
Dim tReCheck As Byte
tInDatas() = Pack32_HexsPutToBytes(tBytes())
tInCheck = tInDatas(32)
ReDim Preserve tInDatas(31)
tReCheck = Pack32_CheckGetByBytes(tInDatas())
Dim tCheck As Boolean
tCheck = tReCheck = tInCheck
If tCheck Then
With priPack
.pkDatas() = tInDatas()
.pkCheck = tReCheck
End With
RaiseEvent CheckReady
Else
RaiseEvent CheckError
End If
End Property
modPack32.bas内容
Type tpPack32
pkDatas() As Byte
pkCheck As Byte
End Type
Private priPack32_HexTable() As Byte
Private priPack32_HexUnTable() As Byte
Private priPack32_HexTable_Enabled As Boolean
Public Function Pack32_CheckGetByBytes(ByRef pBytes() As Byte) As Byte
'获得字节数组的校验码
Dim tOutByte As Byte
Dim tHexs() As Byte
tHexs() = Pack32_HexsGetByBytes(pBytes())
tOutByte = Pack32_CheckGetByHexs(tHexs())
Pack32_CheckGetByBytes = tOutByte
End Function
Public Function Pack32_CheckGetByHexs(ByRef pBytes() As Byte) As Byte
'获得HEX数组的校验码
Dim tOutByte As Byte
Dim tBytes() As Byte
Dim tBytes_Index As Long
Dim tBytes_Length As Long
tBytes() = pBytes()
tBytes_Length = UBound(tBytes())
For tBytes_Index = 1 To tBytes_Length
tBytes(0) = tBytes(0) Xor tBytes(tBytes_Index)
Next
tOutByte = tBytes(0)
Pack32_CheckGetByHexs = tOutByte
End Function
Public Function Pack32_HexsPutToBytes(ByRef pBytes() As Byte) As Byte()
'将HEX串字节转换为字节
Dim tOutBytes() As Byte
Dim tOutBytes_Length As Long
Dim tOutBytes_Index As Long
Dim tBytes_Length As Long
Dim tBytes_Index As Long
Pack32_HexTable_Create
tBytes_Length = UBound(pBytes())
tOutBytes_Length = (tBytes_Length + 1) \ 2 - 1
ReDim tOutBytes(tOutBytes_Length)
For tOutBytes_Index = 0 To tOutBytes_Length
tBytes_Index = tOutBytes_Index * 2
tOutBytes(tOutBytes_Index) = priPack32_HexUnTable(pBytes(tBytes_Index)) * 16 + priPack32_HexUnTable(pBytes(tBytes_Index + 1))
Next
Pack32_HexsPutToBytes = tOutBytes()
End Function
Public Function Pack32_HexsGetByBytes(ByRef pBytes() As Byte) As Byte()
'将字节转换为HEX串字节
Dim tOutBytes() As Byte
Dim tOutBytes_Length As Long
Dim tOutBytes_Index As Long
Dim tBytes_Length As Long
Dim tBytes_Index As Long
Pack32_HexTable_Create
tBytes_Length = UBound(pBytes())
tOutBytes_Length = (tBytes_Length + 1) * 2 - 1
ReDim tOutBytes(tOutBytes_Length)
For tBytes_Index = 0 To tBytes_Length
tOutBytes_Index = tBytes_Index * 2
tOutBytes(tOutBytes_Index) = priPack32_HexTable(pBytes(tBytes_Index) \ 16)
tOutBytes(tOutBytes_Index + 1) = priPack32_HexTable(pBytes(tBytes_Index) Mod 16)
Next
Pack32_HexsGetByBytes = tOutBytes()
End Function
Private Sub Pack32_HexTable_Create()
'初始化HEX表
If Not priPack32_HexTable_Enabled Then
Dim tTableString As String
tTableString = "0123456789ABCDEF"
priPack32_HexTable() = StrConv(tTableString, vbFromUnicode)
priPack32_HexTable_Enabled = True
Dim tTable_Index As Long
ReDim priPack32_HexUnTable(0 To 255)
For tTable_Index = 0 To 15
priPack32_HexUnTable(priPack32_HexTable(tTable_Index)) = tTable_Index
Next
End If
End Sub
clsPack32.cls内容
Private priPack As tpPack32
Public Event CheckError()
Public Event CheckReady()
Public Property Get Datas() As Byte()
Datas() = priPack.pkDatas()
End Property
Public Property Let Datas(ByRef pBytes() As Byte)
Dim tBytes_Length As Long
tBytes_Length = UBound(pBytes())
If tBytes_Length = 31 Then
With priPack
.pkDatas() = pBytes()
.pkCheck = Pack32_CheckGetByBytes(.pkDatas())
End With
End If
End Property
Public Property Get Check() As Byte
Check = priPack.pkCheck
End Property
Public Property Get StringCode() As String
Dim tBytes() As Byte
tBytes() = priPack.pkDatas()
ReDim Preserve tBytes(32)
tBytes(32) = priPack.pkCheck
Dim tOutBytes() As Byte
tOutBytes() = Pack32_HexsGetByBytes(tBytes())
StringCode = StrConv(tOutBytes(), vbUnicode)
End Property
Public Property Let StringCode(ByVal pString As String)
Dim tBytes() As Byte
tBytes() = StrConv(pString, vbFromUnicode)
ReDim Preserve tBytes(65)
Dim tInDatas() As Byte
Dim tInCheck As Byte
Dim tReCheck As Byte
tInDatas() = Pack32_HexsPutToBytes(tBytes())
tInCheck = tInDatas(32)
ReDim Preserve tInDatas(31)
tReCheck = Pack32_CheckGetByBytes(tInDatas())
Dim tCheck As Boolean
tCheck = tReCheck = tInCheck
If tCheck Then
With priPack
.pkDatas() = tInDatas()
.pkCheck = tReCheck
End With
RaiseEvent CheckReady
Else
RaiseEvent CheckError
End If
End Property
Silo 2006-03-13
- 打赏
- 举报
都别拦我，我特地是来拜KiteGirl(小仙妹）的。。。。
KiteGirl 2006-03-13
- 打赏
- 举报
实际上你这个程序体现的是一种数据结构：每32个字节为一个单位，外加一个字节储存校验码。
Type tpPack
pkDatas(0 To 31) As Byte
pkCheck As Byte
End Type
字符串仅仅是这33个字节的16进制串。从数学角度解决不仅快速，而且简单。整个编码解码程序我都能给你写出来，等一会听我的好消息。如果你乐意的话不妨说说这是做什么用的。
这个程序做成一个类模块比较好。
Type tpPack
pkDatas(0 To 31) As Byte
pkCheck As Byte
End Type
字符串仅仅是这33个字节的16进制串。从数学角度解决不仅快速，而且简单。整个编码解码程序我都能给你写出来，等一会听我的好消息。如果你乐意的话不妨说说这是做什么用的。
这个程序做成一个类模块比较好。
zhangxiaoli 2006-03-13
- 打赏
- 举报
KiteGirl(小仙妹) ( ) 信誉：110 2006-03-13 12:44:00 得分: 0
先别结帖，我有好办法！老老实实等着我把东西拿出来！敢结帖我打断你的腿！！
强！！！！
先别结帖，我有好办法！老老实实等着我把东西拿出来！敢结帖我打断你的腿！！
强！！！！
zhangxiaoli 2006-03-13
- 打赏
- 举报
回复人：northwolves(狼行天下) () 信
If Right( "00 "& Hex(charAsc), 2) = Mid(a, 65, 2) Then
这个有点问题，有时Right( "00 "& Hex(charAsc), 2)求出的校验码不对
If Right( "00 "& Hex(charAsc), 2) = Mid(a, 65, 2) Then
这个有点问题，有时Right( "00 "& Hex(charAsc), 2)求出的校验码不对
zhangxiaoli 2006-03-13
- 打赏
- 举报
回复人：northwolves(狼行天下) () 信
If Right( "00 "& Hex(charAsc), 2) = Mid(a, 65, 2) Then
这个有点问题，有时Right( "00 "& Hex(charAsc), 2)求出的校验码不对
If Right( "00 "& Hex(charAsc), 2) = Mid(a, 65, 2) Then
这个有点问题，有时Right( "00 "& Hex(charAsc), 2)求出的校验码不对
KiteGirl 2006-03-13
- 打赏
- 举报
实际上求0B格式也不是难事：
Text2.Text = GetBytesHEX(GetCheckByBytes(tA))
Public Function GetBytesHEX(ByVal pByte As Byte, Optional pOutTableString As String = "0123456789ABCDEF") As Byte()
'返回一个字节的16进制表示。
Dim tOutBytes() As Byte
ReDim tOutBytes(3)
Dim tOutTable() As Byte
tOutTable() = StrConv(pOutTableString, vbFromUnicode)
tOutBytes(2) = tOutTable(pByte Mod 16)
tOutBytes(0) = tOutTable(pByte \ 16)
GetBytesHEX = tOutBytes()
End Function
Text2.Text = GetBytesHEX(GetCheckByBytes(tA))
Public Function GetBytesHEX(ByVal pByte As Byte, Optional pOutTableString As String = "0123456789ABCDEF") As Byte()
'返回一个字节的16进制表示。
Dim tOutBytes() As Byte
ReDim tOutBytes(3)
Dim tOutTable() As Byte
tOutTable() = StrConv(pOutTableString, vbFromUnicode)
tOutBytes(2) = tOutTable(pByte Mod 16)
tOutBytes(0) = tOutTable(pByte \ 16)
GetBytesHEX = tOutBytes()
End Function
KiteGirl 2006-03-13
- 打赏
- 举报
实际上你的需求不是你根本的目的。你的目的是编写一个测试字符串是否符合校验码的函数：
Private Sub Command1_Click()
Dim tString As String
Dim tOutCaption() As String
Dim tOutCaption_Index As Long
Dim tCheck As Boolean
tOutCaption() = Split("wrong,right", ",")
tA = "00F300E8010A00F300ED00EB00F300EB00F000C500F300F000EC00F300EE00200C"
tCheck = CheckBytes(tA)
tOutCaption_Index = tCheck And 1
Text1.Text = tOutCaption(tOutCaption_Index)
End Sub
Public Function CheckBytes(ByVal pString As String) As Boolean
'测试pString是否校验一致
Dim tOutBool As Boolean
Dim tCheckCode_Sur As Byte
Dim tCheckCode_Des As Byte
tCheckCode_Sur = GetCheckByBytes(pString) '计算新校验码
tCheckCode_Des = CByte("&H" & Mid(pString, 65, 2)) '取原有校验码
tOutBool = (tCheckCode_Sur = tCheckCode_Des)
CheckBytes = tOutBool
End Function
Public Function GetCheckByBytes(ByVal pString As String) As Byte
'获得pString的校验码
Dim tOutByte As Byte
Dim tIn_Bytes() As Byte
Dim tIn_Bytes_Index As Long
tIn_Bytes() = StrConv(pString, vbFromUnicode)
For tIn_Bytes_Index = 1 To 63
tIn_Bytes(0) = tIn_Bytes(0) Xor tIn_Bytes(tIn_Bytes_Index)
Next
tOutByte = tIn_Bytes(0)
GetCheckByBytes = tOutByte
End Function
Private Sub Command1_Click()
Dim tString As String
Dim tOutCaption() As String
Dim tOutCaption_Index As Long
Dim tCheck As Boolean
tOutCaption() = Split("wrong,right", ",")
tA = "00F300E8010A00F300ED00EB00F300EB00F000C500F300F000EC00F300EE00200C"
tCheck = CheckBytes(tA)
tOutCaption_Index = tCheck And 1
Text1.Text = tOutCaption(tOutCaption_Index)
End Sub
Public Function CheckBytes(ByVal pString As String) As Boolean
'测试pString是否校验一致
Dim tOutBool As Boolean
Dim tCheckCode_Sur As Byte
Dim tCheckCode_Des As Byte
tCheckCode_Sur = GetCheckByBytes(pString) '计算新校验码
tCheckCode_Des = CByte("&H" & Mid(pString, 65, 2)) '取原有校验码
tOutBool = (tCheckCode_Sur = tCheckCode_Des)
CheckBytes = tOutBool
End Function
Public Function GetCheckByBytes(ByVal pString As String) As Byte
'获得pString的校验码
Dim tOutByte As Byte
Dim tIn_Bytes() As Byte
Dim tIn_Bytes_Index As Long
tIn_Bytes() = StrConv(pString, vbFromUnicode)
For tIn_Bytes_Index = 1 To 63
tIn_Bytes(0) = tIn_Bytes(0) Xor tIn_Bytes(tIn_Bytes_Index)
Next
tOutByte = tIn_Bytes(0)
GetCheckByBytes = tOutByte
End Function
