VB用指针操作快速处理字符串

声明：

Private Declare Sub RtlMoveMemory Lib "kernel32" (dst As Any, src As Any, ByVal nBytes&)
Private Declare Function SysAllocStringByteLen& Lib "oleaut32" (ByVal olestr&, ByVal BLen&)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

代码

Private Function AllocString04(ByVal lSize As Long) As String

  ' http://www.xbeat.net/vbspeed/
  ' by Jory, jory@joryanick.com, 20011023

    RtlMoveMemory ByVal VarPtr(AllocString04), SysAllocStringByteLen(0&, lSize + lSize), 4&

End Function



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Sub Append(Text As String)

  Dim lngText          As Long
  Dim strTemp          As String
  Dim lngVPointr       As Long

    lngText = Len(Text)

    If lngText > 0 Then
        If (plngStringLen + lngText) > plngBufferLen Then
            plngBufferLen = (plngStringLen + lngText) * 2&
            strTemp = AllocString04(plngBufferLen)

            '***  copymemory might be faster than this
            Mid$(strTemp, 1&) = pstrBuffer

            '***  Alternate pstrBuffer = strTemp
            '***  switch pointers instead of slow =
            lngVPointr = StrPtr(pstrBuffer)
            RtlMoveMemory ByVal VarPtr(pstrBuffer), ByVal VarPtr(strTemp), 4&
            RtlMoveMemory ByVal VarPtr(strTemp), lngVPointr, 4&

            '  Debug.Print "plngBufferLen: " & plngBufferLen
        End If

        Mid$(pstrBuffer, plngStringLen + 1&) = Text
        plngStringLen = plngStringLen + lngText
    End If

End Sub

Private Sub Clear()

  '***  do not clear the buffer to save allocation time
  '***  if you use the function multiple times

    plngStringLen = 0&

    plngBufferLen = 0& 'clear the buffer
    pstrBuffer = vbNullString 'clear the buffer

End Sub
Private Function Value() As String

    Value = Mid$(pstrBuffer, 1, plngStringLen)

End Function