- UID
- 5181
- 精华
- 积分
- 453
- 威望
- 点
- 宅币
- 个
- 贡献
- 次
- 宅之契约
- 份
- 最后登录
- 1970-1-1
- 在线时间
- 小时
|
本帖最后由 天马座 于 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)
- '删除 [lo..hi]对应宽字节
- Call removeRange0(lo * 2, (hi - lo + 1) * 2)
- End Sub
- Public Sub removeRangeB(ByVal lo As Long, ByVal hi As Long)
- '删除 [lo..hi]对应字节
- 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)
- '替换[lo..hi]对应宽字节
- 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)
- '替换[lo..hi]对应字节
- 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
复制代码
|
|