vb StringBuilder类
本帖最后由 天马座 于 2022-6-23 11:30 编辑此类主要解决vb字符串频繁连接速度慢的问题，支持UTF-8 UTF-16互转，其他功能陆续添加
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
Private s As String
Private size As Long, capacity As Long
Private Sub Class_Initialize()
size = 0
capacity = 8
s = String(capacity \ 2, ChrW(0))
End Sub
Public Function length() As Long
'返回字符串长度 宽字节
length = size \ 2
End Function
Public Function lengthB() As Long
'返回字符串长度 字节
lengthB = size
End Function
Public Sub clear()
'清除缓冲区
size = 0
capacity = 8
s = String(capacity \ 2, ChrW(0))
End Sub
Public Sub append(ByRef value As String)
'添加
Call copyB(value, size)
End Sub
Public Sub copy(ByRef value As String, ByVal index As Long)
'写入 index对应宽字节 put命名被占用 改为copy
Call copyB(value, index * 2)
End Sub
Public Sub copyB(ByRef value As String, ByVal index As Long)
'写入 index对应字节
If index < 0 Or index > size Or LenB(value) = 0 Then
Exit Sub
End If
Dim n As Long
n = LenB(value)
Call ensureCapacity(index + n)
Call CopyMemory(ByVal unsignedAdd(StrPtr(s), index), ByVal StrPtr(value), n)
If size < index + n Then
size = index + n
End If
End Sub
Public Sub insert(ByRef value As String, ByVal index As Long)
'插入 index对应宽字节
Call insertB(value, index * 2)
End Sub
Public Sub insertB(ByRef value As String, ByVal index As Long)
'插入 index对应字节
If index < 0 Or index > size Or LenB(value) = 0 Then
Exit Sub
End If
Dim n As Long
n = LenB(value)
Call ensureCapacity(size + n)
If index <> size Then
Call CopyMemory(ByVal unsignedAdd(StrPtr(s), index + n), ByVal unsignedAdd(StrPtr(s), index), size - index)
End If
Call CopyMemory(ByVal unsignedAdd(StrPtr(s), index), ByVal StrPtr(value), n)
size = size + n
End Sub
Public Sub remove(ByVal index As Long)
'删除 index对应宽字节
Call removeRange0(index * 2, 2)
End Sub
Public Sub removeB(ByVal index As Long)
'删除 index对应字节
Call removeRange0(index, 1)
End Sub
Public Sub removeRange(ByVal lo As Long, ByVal hi As Long)
'删除 对应宽字节
Call removeRange0(lo * 2, (hi - lo + 1) * 2)
End Sub
Public Sub removeRangeB(ByVal lo As Long, ByVal hi As Long)
'删除 对应字节
Call removeRange0(lo, hi - lo + 1)
End Sub
Private Sub removeRange0(ByVal lo As Long, ByVal n As Long)
If n <= 0 Or lo < 0 Or lo + n > size Then
Exit Sub
End If
If size - (lo + n) > 0 Then
Call CopyMemory(ByVal unsignedAdd(StrPtr(s), lo), ByVal unsignedAdd(StrPtr(s), lo + n), size - (lo + n))
End If
size = size - n
End Sub
Public Sub replaceRange(ByVal lo As Long, ByVal hi As Long, ByRef oldValue As String, ByRef nweValue As String)
'替换对应宽字节
Call replaceRangeB(lo * 2, hi * 2, oldValue, nweValue)
End Sub
Public Sub replaceRangeB(ByVal lo As Long, ByVal hi As Long, ByRef oldValue As String, ByRef nweValue As String)
'替换对应字节
If lo < 0 Or hi >= size Or LenB(oldValue) = 0 Then
Exit Sub
End If
Dim start As Long, i As Long, oldLength As Long
Dim update As Boolean
Dim src As String
Dim sb As New StringBuilder
src = toString()
update = False
oldLength = LenB(oldValue)
i = lo + 1
start = lo + 1
Do While i <= hi + 1
i = InStrB(i, src, oldValue)
If i < 1 Then
If update Then
sb.append MidB(src, start, hi + 2 - start)
End If
Exit Do
End If
sb.append MidB(src, start, i - start)
sb.append nweValue
i = i + oldLength
start = i
update = True
Loop
If update Then
Call removeRangeB(lo, hi)
Call insertB(sb.toString, lo)
End If
Set sb = Nothing
End Sub
Public Function toString() As String
'返回缓冲区中的字符串
toString = MidB(s, 1, size)
End Function
Private Function unsignedAdd(a As Long, b As Long) As Long
If (a Xor b) And &H80000000 Then
unsignedAdd = a + b
Else
unsignedAdd = (a Xor &H80000000) + b Xor &H80000000
End If
End Function
Private Sub ensureCapacity(ByVal minCapacity As Long)
If capacity >= minCapacity Then
Exit Sub
End If
Dim newCapacity As Long
newCapacity = capacity
Do While newCapacity < minCapacity
newCapacity = newCapacity + newCapacity
Loop
s = s & String((newCapacity - capacity) \ 2, ChrW(0))
capacity = newCapacity
End Sub
没有示例的代码,差评。 Ink_Hin_fifteen 发表于 2019-7-25 20:29
没有示例的代码,差评。
后续会添加
页:
[1]