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

[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 '头节点

Private curNode As clsUartNode '当前节点

Private endNode As clsUartNode '尾巴节点

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

……