Option Explicit
'***************************************************
'*字符串缓冲类，用于字符串的连接可提高效率
'*作者 CSDN_viena
'*修改时间 2005-10-9
'*属性 length - 字符个数
'* capacity - 缓冲区的当前容量,可用于插入新的字符的存储空间
'* Increment - 扩容增量，默认为1024字节
'*方法 append - 添加字符串
'* toString - 转为字符串
'***************************************************
'使用示例
' Dim sb As CStringBuffer
' Set sb = New CStringBuffer
' 'sb.Increment = 4096 '可按字符串大小修改增量，一般不用设置，用默认的1024
' sb.append "你好，"
' sb.append "这个是字符串缓冲类的演示，用于大量字符串的连接效率会高一些"
' MsgBox sb.toString, vbInformation, "呵呵"
' Set sb = Nothing
Private mlngIncrement As Long '扩容增量，默认为1024字节
Private mlngCapacity As Long '缓冲区的当前容量,可用于插入新的字符的存储空间
Private mlngLength As Long '字符个数
Private mlngEOA As Long '数组第一个空元素的索引
Private mabyt() As Byte
Private mlngUb As Long '数组上界
Private Sub Class_Initialize()
mlngIncrement = 1024
mlngCapacity = 512
mlngUb = 1023
ReDim mabyt(mlngUb)
mlngLength = 0
mlngEOA = 0
End Sub
Private Sub Class_Terminate()
Erase mabyt
End Sub
Private Sub expand()
'扩容
mlngUb = mlngUb + mlngIncrement
ReDim Preserve mabyt(mlngUb) '缓冲区扩容
mlngCapacity = mlngCapacity + mlngIncrement / 2
End Sub
Public Sub append(ByVal STR As String)
If STR = "" Then Exit Sub
Dim abyt() As Byte '添加的字符串转为Byte数组
Dim lngUb As Long '添加的字符串转为Byte数组的上界
Dim lngLength As Long '添加的字符串的长度
Dim i As Long
abyt = STR
lngUb = UBound(abyt)
lngLength = (lngUb + 1) \ 2
Do While lngLength > mlngCapacity '插入新的字符超出缓冲区容量
Call expand
Loop
For i = 0 To lngUb
mabyt(mlngEOA + i) = abyt(i)
Next
mlngEOA = mlngEOA + lngUb + 1
mlngCapacity = mlngCapacity - lngLength
mlngLength = mlngLength + lngLength
Erase abyt
End Sub
Public Property Get length() As Long
length = mlngLength
End Property
Public Property Get capacity() As Long
capacity = mlngCapacity
End Property
Public Function toString() As String
ReDim Preserve mabyt(mlngEOA - 1)
toString = mabyt
ReDim Preserve mabyt(mlngUb)
End Function
Public Property Get Increment() As Variant
Increment = mlngIncrement
End Property
'Public Sub setIncrement(ByVal lngIncrement As Long)
' mlngIncrement = lngIncrement
'End Sub
Public Property Let Increment(ByVal Increment As Variant)
If Not CInt(Increment) Mod 2 = 0 Then
MsgBox "增量必须是偶数", , "提示"
Exit Property
End If
mlngIncrement = Increment
'如果缓冲区尚为空，重新设置容量为增量
If mlngLength = 0 Then
mlngCapacity = Increment / 2
mlngUb = Increment - 1
ReDim mabyt(mlngUb)
End If
End Property
