一个字节数组双向链表类，主要针对串口通讯而开发的

tclgb

发一个双向链表类，每一个节点，主要存储字节数组信息，主要针对串口通讯而开发的，分享给有需要的朋友。
显示为部分代码，完整代码请通过网盘下载。

[Visual Basic] 纯文本查看 复制代码

Option Explicit

Public preNode As clsUartNode    '指向前一个节点的指针
Public nextNode As clsUartNode    '指向下一个节点的指针
Public ptrSendData As Long     '发送数据的指针
Public intSendDataCount As Integer    '发送数据字节数
Public lngModbusAddr As Long    '发送数据的ModbusAddr
Public intCtlIndex As Long    '发送数据的控件索引
Public ParaType As ParaTypeTag '发送参数的类型
Public ptrRecvData As Long   '接收数据的指针
Public intRecvDataCount As Integer    '接收数据字节数

[Visual Basic] 纯文本查看 复制代码

'一个双向链表类 (StrList)
Option Explicit

'分配,清除内存
Private Declare Function GlobalAlloc Lib "KERNEL32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "KERNEL32" (ByVal hMem As Long) As Long
Private Const GMEM_FIXED = &H0
Private Const GMEM_ZEROINIT = &H40
'复制内存
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)




Private headNode As clsUartNode   '头节点              <--Head->
Private curNode As clsUartNode    '当前节点            <--curNode-->
Private endNode As clsUartNode     '尾巴节点           <--endNode-->
Private mvarSize As Integer         '节点总数
Private bolFlagGetCmd As Boolean   '是否有指令被取出，true为是



'申请内存
Private Function MemAlloc(ByVal dwBytes As Long)
    MemAlloc = GlobalAlloc(GMEM_FIXED Or GMEM_ZEROINIT, dwBytes)
End Function

'**************************************************************************************************************
'Public Sub Add(bytArrSendData() As Byte)
'功能       :       增加节点，bytArrSendData(Byte) 将值加入到链表中
'参数       :       bytArrSendData() 发送指令的数组，以0为最小下标;
'                   intSendDataCount 发送数据字节数;
'                   lngModbusAddr 发送数据的modbus地址 ;
'返回       :       无
'修改历史   :
'**************************************************************************************************************

Public Sub Add(bytArrSendData() As Byte, lngModbusAddr As Long, Optional enmParaType As ParaTypeTag = PT_General, Optional intCtlIndex As Integer = -1)
    Dim node As New clsUartNode    '新增一个节点
    Dim tPtr As Long
    Dim intSendArrCount As Integer
    
    intSendArrCount = UBound(bytArrSendData) + 1
    tPtr = MemAlloc(intSendArrCount)
    If tPtr = 0 Then Err.Raise 0, , "内存不足"

    CopyMemory ByVal tPtr, bytArrSendData(0), intSendArrCount '节点赋值
    node.ptrSendData = tPtr
    node.lngModbusAddr = lngModbusAddr
    node.intCtlIndex = intCtlIndex
    node.ParaType = enmParaType
    node.intSendDataCount = intSendArrCount
  
    Set node.preNode = endNode  '新节点加入到链表尾巴                 Node-->endNode-->
    
    If headNode Is Nothing Then '加入的节点是第一个节点的处理
        Set headNode = node     '头节点就是这一个
        Set curNode = node      '当前节点是第一个节点
    Else
        Set endNode.nextNode = node '新加的话，终节点指向本节点
    End If
    
    Set endNode = node
     mvarSize = mvarSize + 1
End Sub

'**************************************************************************************************************
'Public Sub Clear()
'功能       :       清除所有节点
'参数       :
'返回       :       无
'修改历史   :
'**************************************************************************************************************

Public Sub Clear()
    Dim tPtr As Long
    Dim i As Integer
    
    If mvarSize > 0 Then
        For i = 1 To mvarSize
            'MsgBox i
            Set curNode = headNode.nextNode '头节点下移
            tPtr = headNode.ptrSendData
            Call GlobalFree(tPtr)
            tPtr = headNode.ptrRecvData
            Call GlobalFree(tPtr)
            Set headNode = curNode
            If i <> mvarSize Then
                Set headNode.preNode = Nothing  '头节点清除
            End If
        Next
    End If
    
    Set headNode = Nothing
    Set endNode = Nothing
    Set curNode = Nothing
    mvarSize = 0
    bolFlagGetCmd = False
End Sub

……

完整类的下载地址
http://pan.baidu.com/s/148Qft
密码: xgkx  

kklinan

学习了！！赞

zb619176

好，谢谢楼主，赞。