📄 packets.bas
字号:
Attribute VB_Name = "Packets"
Option Explicit
'***************************************
'***功能:计算输入数据的CRC值
'***输入:16进制格式的字符串
'***返回:包含CRC计算结果的数组
'***************************************
Public Function CreatePacket(Data_Resource() As Byte) As Variant
Dim Result As Integer, i As Integer, CRC_Table As Variant, CRLo As Byte, CRHi As Byte, CR As Variant
CRC_Table = Array( _
&H0, &H1189, &H2312, &H329B, &H4624, &H57AD, &H6536, &H74BF, &H8C48, &H9DC1, &HAF5A, &HBED3, &HCA6C, &HDBE5, &HE97E, &HF8F7, &H1081, &H108, &H3393, &H221A, &H56A5, &H472C, &H75B7, &H643E, &H9CC9, &H8D40, &HBFDB, &HAE52, &HDAED, &HCB64, &HF9FF, &HE876, _
&H2102, &H308B, &H210, &H1399, &H6726, &H76AF, &H4434, &H55BD, &HAD4A, &HBCC3, &H8E58, &H9FD1, &HEB6E, &HFAE7, &HC87C, &HD9F5, &H3183, &H200A, &H1291, &H318, &H77A7, &H662E, &H54B5, &H453C, &HBDCB, &HAC42, &H9ED9, &H8F50, &HFBEF, &HEA66, &HD8FD, &HC974, _
&H4204, &H538D, &H6116, &H709F, &H420, &H15A9, &H2732, &H36BB, &HCE4C, &HDFC5, &HED5E, &HFCD7, &H8868, &H99E1, &HAB7A, &HBAF3, &H5285, &H430C, &H7197, &H601E, &H14A1, &H528, &H37B3, &H263A, &HDECD, &HCF44, &HFDDF, &HEC56, &H98E9, &H8960, &HBBFB, &HAA72, _
&H6306, &H728F, &H4014, &H519D, &H2522, &H34AB, &H630, &H17B9, &HEF4E, &HFEC7, &HCC5C, &HDDD5, &HA96A, &HB8E3, &H8A78, &H9BF1, &H7387, &H620E, &H5095, &H411C, &H35A3, &H242A, &H16B1, &H738, &HFFCF, &HEE46, &HDCDD, &HCD54, &HB9EB, &HA862, &H9AF9, &H8B70, _
&H8408, &H9581, &HA71A, &HB693, &HC22C, &HD3A5, &HE13E, &HF0B7, &H840, &H19C9, &H2B52, &H3ADB, &H4E64, &H5FED, &H6D76, &H7CFF, &H9489, &H8500, &HB79B, &HA612, &HD2AD, &HC324, &HF1BF, &HE036, &H18C1, &H948, &H3BD3, &H2A5A, &H5EE5, &H4F6C, &H7DF7, &H6C7E, _
&HA50A, &HB483, &H8618, &H9791, &HE32E, &HF2A7, &HC03C, &HD1B5, &H2942, &H38CB, &HA50, &H1BD9, &H6F66, &H7EEF, &H4C74, &H5DFD, &HB58B, &HA402, &H9699, &H8710, &HF3AF, &HE226, &HD0BD, &HC134, &H39C3, &H284A, &H1AD1, &HB58, &H7FE7, &H6E6E, &H5CF5, &H4D7C, _
&HC60C, &HD785, &HE51E, &HF497, &H8028, &H91A1, &HA33A, &HB2B3, &H4A44, &H5BCD, &H6956, &H78DF, &HC60, &H1DE9, &H2F72, &H3EFB, &HD68D, &HC704, &HF59F, &HE416, &H90A9, &H8120, &HB3BB, &HA232, &H5AC5, &H4B4C, &H79D7, &H685E, &H1CE1, &HD68, &H3FF3, &H2E7A, _
&HE70E, &HF687, &HC41C, &HD595, &HA12A, &HB0A3, &H8238, &H93B1, &H6B46, &H7ACF, &H4854, &H59DD, &H2D62, &H3CEB, &HE70, &H1FF9, &HF78F, &HE606, &HD49D, &HC514, &HB1AB, &HA022, &H92B9, &H8330, &H7BC7, &H6A4E, &H58D5, &H495C, &H3DE3, &H2C6A, &H1EF1, &HF78)
Result = &HFFFF
For i = 0 To UBound(Data_Resource)
Result = (Int(Result / 256) And &HFF) Xor CRC_Table((Result Xor Data_Resource(i)) And &HFF)
Next
CRHi = (Result Xor &HFF) And &HFF
CRLo = (Int(Result / 256) Xor &HFF) And &HFF
CR = Data_Resource
ReDim Preserve CR(UBound(Data_Resource) + 3)
CR(UBound(CR) - 2) = CRHi
CR(UBound(CR) - 1) = CRLo
CR(UBound(CR)) = &H7E
CreatePacket = CR
End Function
'***************************************
'***功能:检查输入的字符串是否16进制数字
'***输入:字符串
'***返回:是\否
'***************************************
Public Function HexCheck(Source As String) As Boolean
Dim i As Integer, HexChr As String
For i = 1 To Len(Source)
HexChr = Mid(Source, i, 1)
If InStr("0123456789ABCDEFabcdef", HexChr) = 0 Then
MsgBox "无效的数值,请重新输入", , "错误信息"
HexCheck = False
Exit Function
Else
End If
Next i
HexCheck = True
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -