一个字节数组双向链表类，主要针对串口通讯而开发的
本帖最后由 tclgb 于 2013-11-26 08:44 编辑发一个双向链表类，每一个节点，主要存储字节数组信息，主要针对串口通讯而开发的，分享给有需要的朋友。
显示为部分代码，完整代码请通过网盘下载。
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 '接收数据字节数
'一个双向链表类 (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
学习了！！赞 好，谢谢楼主，赞。
页:
[1]