|
[原理解析]
本人右手小拇指骨折……暂停更新原理部分……
<font color=red>[核心代码]
'------------------------------------------------------------------'
' 函数说明: 从HEX纪录的字符串中获取数据 '
' 输入: 字符串,数据缓冲区 '
' 输出: 读取操作是否成功 '
' 调用函数: 无 '
'------------------------------------------------------------------'
Public Function Get_Date_From_Hex_Item _
( _
strHEXItem As String, _
ByRef chDataBuffer() As Byte, _
ByRef ItemType As Integer, _
ByRef wAddress As Long _
) As Boolean
On Error GoTo Err_Handle:
ReDim chData(0 To 0) As Byte
Dim Size As Integer
Get_Date_From_Hex_Item = False
Dim TempString As String
Dim CheckSum As Integer
Dim CheckSumData As Byte
'数据初始化和有效性检测
strHEXItem = Trim(strHEXItem)
If strHEXItem = "" Then
Exit Function
End If
If Left(strHEXItem, 1) <> ":" Then
Exit Function
End If
CheckSum = 0
'读取HEX纪录中包含的数据大小
TempString = Mid(strHEXItem, 2, 2)
If (Get_Byte_From_ASCII_HEX(TempString, chData(0)) = False) Then
Exit Function
End If
Size = chData(0)
CheckSum = CheckSum + chData(0)
If (Size <> 0) Then
'重新定义数据缓冲区的大小
ReDim chDataBuffer(0 To (Size - 1))
End If
'读取地址
TempString = Mid(strHEXItem, 4, 2)
ReDim chData(0 To 1) As Byte
If (Get_Byte_From_ASCII_HEX(TempString, chData(1)) = False) Then
Exit Function
End If
CheckSum = CheckSum + chData(1)
TempString = Mid(strHEXItem, 6, 2)
If (Get_Byte_From_ASCII_HEX(TempString, chData(0)) = False) Then
Exit Function
End If
CheckSum = CheckSum + chData(0)
Byte_To_Int32 chData(0), wAddress
'读取类型
TempString = Mid(strHEXItem, 8, 2)
If (Get_Byte_From_ASCII_HEX(TempString, chData(0)) = False) Then
Exit Function
End If
CheckSum = CheckSum + chData(0)
ItemType = chData(0)
'读取数据可选
If ItemType = 0 Then
'数据记录
Dim n As Integer
For n = 0 To Size - 1
'读取数据
TempString = Mid(strHEXItem, 10 + n * 2, 2)
If (Get_Byte_From_ASCII_HEX(TempString, chDataBuffer(n)) = False) Then
Exit Function
End If
CheckSum = CheckSum + chDataBuffer(n)
Next n
End If
'读取CheckSum
TempString = Mid(strHEXItem, (5 + Size) * 2, 2)
If (Get_Byte_From_ASCII_HEX(TempString, CheckSumData) = False) Then
Exit Function
End If
Int16_To_Byte CheckSum, chData(0)
'取反
chData(0) = BYTENot(chData(0))
If chData(0) = &HFF Then
If CheckSumData <> 0 Then
Exit Function
End If
Else
chData(0) = chData(0) + 1
If (chData(0) <> CheckSumData) Then
Exit Function
End If
End If
Get_Date_From_Hex_Item = True
Exit Function
'------------------------------------------------------------------'
Err_Handle:
Err.Clear
End Function
'------------------------------------------------------------------'
' 函数说明: 将HEX字符串转换为单个字节 '
' 输入: 字符串,数据缓冲区 '
' 输出: 读取操作是否成功 '
' 调用函数: 无 '
'------------------------------------------------------------------'
Public Function Get_Byte_From_ASCII_HEX(strHEX As String, ByRef chByte As Byte) As Boolean
On Error GoTo Err_Handle:
Dim strTemp As String
strHEX = Trim(strHEX)
strHEX = Left(strHEX, 2)
strTemp = UCase(Left(strHEX, 1))
chByte = 0
Select Case strTemp
Case "0" To "9"
chByte = chByte + Val(strTemp)
Case "A"
chByte = chByte + 10
Case "B"
chByte = chByte + 11
Case "C"
chByte = chByte + 12
Case "D"
chByte = chByte + 13
Case "E"
chByte = chByte + 14
Case "F"
chByte = chByte + 15
Case Else
'无效的字符出现
Get_Byte_From_ASCII_HEX = False
Exit Function
End Select
chByte = chByte * 16
strTemp = UCase(Right(strHEX, 1))
Select Case strTemp
Case "0" To "9"
chByte = chByte + Val(strTemp)
Case "A"
chByte = chByte + 10
Case "B"
chByte = chByte + 11
Case "C"
chByte = chByte + 12
Case "D"
chByte = chByte + 13
Case "E"
chByte = chByte + 14
Case "F"
chByte = chByte + 15
Case Else
'无效的字符出现
Get_Byte_From_ASCII_HEX = False
Exit Function
End Select
Get_Byte_From_ASCII_HEX = True
Exit Function
'------------------------------------------------------------------'
Err_Handle:
Err.Clear
Get_Byte_From_ASCII_HEX = False
End Function
<font color=#699BCD>
本贴被 Gorgon Meducer 编辑过,最后修改时间:2008-10-27,15:37:58. |
阿莫论坛20周年了!感谢大家的支持与爱护!!
曾经有一段真挚的爱情摆在我的面前,我没有珍惜,现在想起来,还好我没有珍惜……
|