SnippetWare.com » Strings

Fast String Manipulation

Zaur — Sun, 11 Oct 2009 13:10:49 +0000

Option Explicit

Private lPosition As Long
Private strBigString As String

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Public Sub AddToString(strAdd As String)
    ' If the current position + length of string to add is greater
    ' than the length of the BigString, then increase the size of
    ' the BigString
    If lPosition + LenB(strAdd) > LenB(strBigString) Then strBigString = strBigString & Space$(10000)

    ' Add strAdd to the BigString
    CopyMemory ByVal StrPtr(strBigString) + lPosition, ByVal StrPtr(strAdd), LenB(strAdd)

    ' Move the pointer to show where the end of the string is
    lPosition = lPosition + LenB(strAdd)
End Sub

Public Property Get ReturnString() As String
    ' Trim off the blank characters and return the string
    strBigString = left$(strBigString, lPosition \ 2)      'trim back to size
    ReturnString = strBigString
End Property

Private Sub Class_Initialize()
    'Set the starting position of the BigString to 0
    lPosition = 0
End Sub

Public Sub Initialise()
    ' Re-Initialise String
    lPosition = 0
    strBigString = vbNullString
End Sub

Public Sub ReplaceEx(sFind As String, sReplace As String, bCompare As VbCompareMethod)
    strBigString = Replace$(strBigString, sFind, sReplace, , , bCompare)
End Sub

Public Sub AddNewString(strAdd As String)
    ' Re-Initialise String
    lPosition = 0
    strBigString = vbNullString

    AddToString strAdd
End Sub

Public Sub AddToStringEx( _
        Optional ByVal strAdd1 As String, _
        Optional ByVal strAdd2 As String, _
        Optional ByVal strAdd3 As String, _
        Optional ByVal strAdd4 As String, _
        Optional ByVal strAdd5 As String _
    )

    If Len(strAdd1) <> 0 Then AddToString strAdd1
    If Len(strAdd2) <> 0 Then AddToString strAdd2 Else Exit Sub
    If Len(strAdd3) <> 0 Then AddToString strAdd3 Else Exit Sub
    If Len(strAdd4) <> 0 Then AddToString strAdd4 Else Exit Sub
    If Len(strAdd5) <> 0 Then AddToString strAdd5 Else Exit Sub
End Sub

Returns a string without any zero terminator. Typically, this was a string returned by a Windows API call

Zaur — Sun, 11 Oct 2009 13:10:21 +0000

'-----------------------------------------------------------
' FUNCTION: StripTerminator
'
' Returns a string without any zero terminator.  Typically,
' this was a string returned by a Windows API call.
'
' IN: [strString] - String to remove terminator from
'
' Returns: The value of the string passed in minus any
'          terminating zero.
'-----------------------------------------------------------
'
Function StripTerminator(ByVal strString As String) As String
    Dim intZeroPos As Integer

    intZeroPos = InStr(strString, Chr$(0))
    If intZeroPos > 0 Then
        StripTerminator = Left$(strString, intZeroPos - 1)
    Else
        StripTerminator = strString
    End If
End Function

Enhanced Split and Join functions

Zaur — Sun, 11 Oct 2009 13:09:46 +0000

'-------------------------------------------------------------------------------------------------------------
'
'   Module          : modStrings
'   Description     : String Utility Functions
'   Author          : Quick VB
'   Last Updated    : 15th April, 2000.
'   Notes           : Functions may be slower esp., SplitString compared to Split function
'                     But, you do need to sacrifice performance for added functionality.
'                     Compile these functions into a Global Multiuse Class module in your ActiveX DLL.
'
'                     Requires IE 4.0 or later to be installed in order to work. (StrBPrk function)
'
'   Copyright Info  :
'
'   This module is provided AS-IS. This module can be used as a part of a compiled
'   executable whether freeware or not. This module may not be posted to any web site
'   or BBS or any redistributable media like CD-ROM without the consent of the author.
'
'   web site : http://www.quickvb.com/
'
'   e-mail   : esanthosh@quickvb.com
'
'   Revision History :
'
'
'-------------------------------------------------------------------------------------------------------------

Option Explicit

'
' API Declarations
'
Private Declare Function StrCSpnI Lib "shlwapi" Alias "StrCSpnIA" _
                                  (ByVal StringSearched As String, ByVal Characters As String) As Long

'
' Enums
'
Public Enum PadType
    padLeft
    padCenter
    padRight
End Enum

Public Function SplitString(ByVal toSplit As String, _
                            Optional ByVal SplitChars As String = " ", _
                            Optional ByVal EscapeChar As String = "\", _
                            Optional ByVal TrimStrings As Boolean = True) _
                            As String()

    '--------------------------------------------------------------------------------------------------
    ' Arguments :
    '
    ' toSplit               - String to be Splitted
    ' SplitChars            - Delimiters that are used for Splitting the String (Default : Space)
    ' EscapeChar            - The Escape Character (if precedes a Split Character, the Split
    '                         Character is recognized as a literal) (Default : Back Slash)
    ' TrimStrings           - If True, trims the returned Strings in the Array, else the spaces are
    '                         returned as-is.
    '
    ' Returns   : The Splitted String Array
    '
    '
    ' Notes     :  This function is slower than the Split() counterpart. It's slows down as the length of the
    '              string increases. But, it provides you two things that Split() does not provide.
    '              1. It allows multiple delimiters (called SplitChars here)
    '              2. What if you want to represent the delimiter itself ? For e.g., if you have
    '                 - as the delimiter and you want to pass A-B as an argument ?. For this, this function
    '                allows you to have one Escape Character. Instead of passing A-B, you pass the argument as
    '               A\-B in this case.
    '
    '--------------------------------------------------------------------------------------------------

    Dim retArray() As String        ' The returned array of results
    Dim tempString As String        ' The Temporary Buffer
    Dim arrLength As Long           ' No. Of Splitted Parts
    Dim isEscapeChar As Boolean     ' Was a Escape Character found ?
    Dim FoundPos As Long            ' The position at which the Split Character was found

    ReDim retArray(0 To 0)          ' Hmm.. Looks like bad example of Initializing an array
    arrLength = -1                  ' No of split parts - 1

    If EscapeChar <> "" Then
        EscapeChar = Left$(EscapeChar, 1)   ' Only one character can be allowed as the EscapeCharacter
    End If

    If Len(toSplit) = 0 Then       ' No String, nothing to do ...
        SplitString = retArray
        Exit Function
    End If

    If Len(SplitChars) = 0 Then     ' No Splitting to be done
        SplitString = retArray
        Exit Function
    End If

    '
    ' To avoid Redimensioning Array many times within the loop, we dimension the array to the
    ' maximum possible extent and waste some memory
    '
    ReDim retArray(0 To 10)

    toSplit = toSplit & Chr$(0)
    SplitChars = SplitChars & Chr$(0)

    Do
        ' Use the SHLWAPI function to search for String matches
        FoundPos = StrCSpnI(toSplit, SplitChars)

        '
        ' The String before the Split Character (if any) should be "splitted"
        ' unless there is a Escape Character preceding the Split Character
        '
        FoundPos = FoundPos + 1     ' Remember ? C Strings start with a Zero Index

        Select Case FoundPos
            Case Len(toSplit), 0
                arrLength = arrLength + 1

                If arrLength > UBound(retArray) Then
                    ReDim Preserve retArray(arrLength + 5)  ' Pre-Allocate more memory
                End If

                If isEscapeChar Then
                    retArray(arrLength) = tempString & toSplit    ' Whatever is remaining
                Else
                    retArray(arrLength) = toSplit
                End If

                If TrimStrings Then retArray(arrLength) = Trim$(retArray(arrLength))
                Exit Do

            Case Is > 1
                ' Check for Escape Character
                If Mid$(toSplit, FoundPos - 1, 1) = EscapeChar Then
                    ' The Split Character is intepreted as an ordinary literal.
                    isEscapeChar = True

                    ' Remove everything before the Escape Character for temporary storage
                    If Len(toSplit) > 2 Then
                        tempString = Left$(toSplit, FoundPos - 2) & Mid$(toSplit, FoundPos, 1)
                    Else        ' The Escape Character is the First Character
                        tempString = Mid$(toSplit, FoundPos)
                    End If

                    ' To avoid "finding" the Escaped Split Character again, we rip that part
                    If Len(toSplit) > FoundPos + 1 Then
                        toSplit = Mid$(toSplit, FoundPos + 1)
                    Else
                        ' The String has ended with the Escaped Split Character. Now
                        ' this is the last part of the string that must be stored in the
                        ' Split Array. Just do that !
                        arrLength = arrLength + 1

                        If arrLength > UBound(retArray) Then
                            ReDim Preserve retArray(arrLength + 5)  ' Pre-Allocate more memory
                        End If

                        retArray(arrLength) = tempString
                        If TrimStrings Then retArray(arrLength) = Trim$(retArray(arrLength))
                        Exit Do
                    End If

                Else        ' No Escape Character
                    arrLength = arrLength + 1

                    If arrLength > UBound(retArray) Then
                        ReDim Preserve retArray(arrLength + 5)  ' Pre-Allocate more memory
                    End If

                    ' We might have left-overs of an Escaped Split Character
                    If isEscapeChar Then
                        retArray(arrLength) = tempString & Left$(toSplit, FoundPos - 1)
                        isEscapeChar = False
                    Else
                        retArray(arrLength) = Left$(toSplit, FoundPos - 1)
                    End If

                    If TrimStrings Then retArray(arrLength) = Trim$(retArray(arrLength))

                    ' Remove that Part
                    If Len(toSplit) > FoundPos + 1 Then
                        toSplit = Mid$(toSplit, FoundPos + 1)
                    Else
                        ' No more string to be splitted. Re-dimenstion the array.
                        Exit Do
                    End If
                End If

            Case 1
                ' The Split Character is at the First Position
                If Len(toSplit) > 1 Then
                    toSplit = Mid$(toSplit, 2)
                Else
                    Exit Do
                End If
        End Select
    Loop

    ReDim Preserve retArray(arrLength)
    toSplit = ""

    SplitString = retArray

End Function

Public Function Pad(ByVal argString As String, ByVal TotalLength As Long, _
                    Optional ByVal Direction As PadType = padCenter, _
                    Optional ByVal PadCharacter As String = " ") As String
    '
    ' Pads a String using another string to the specified length (Memories of XBase ?)
    '

    If argString = "" Then Exit Function

    If TotalLength <= Len(argString) Then
        Pad = Left$(argString, TotalLength)
        Exit Function
    End If

    PadCharacter = Left$(PadCharacter, 1)

    If Direction = padCenter Then
        PadCharacter = String$((TotalLength - Len(argString)) \ 2, PadCharacter)
    Else
        PadCharacter = String$(TotalLength - Len(argString), PadCharacter)
    End If

    Select Case Direction
        Case padLeft
            Pad = PadCharacter & argString

        Case padRight
            Pad = argString & PadCharacter

        Case Else
            Pad = PadCharacter & argString & PadCharacter
            If Len(Pad) < TotalLength Then
                Pad = Space$(TotalLength - Len(Pad)) & Pad
            End If
    End Select
End Function

Public Function JoinString(StringIn() As String, _
                           ByVal JoinCharacter As String, Optional ByVal EscapeChar As String = "\") As String

    '-----------------------------------------------------------------------------------------
    ' Arguments :  StringIn      - Array of Strings to be joined
    '              JoinCharacter - Character used for joining strings in the array
    '              EscapeChar    - If the Escape Character or Join Character is found in a string
    '                              it is preceded by the EscapeChar. The resulting string can be
    '                              used with the SplitStrting Function.
    '
    ' Returns    : The joined String
    '
    ' Comments   : Ever tried to Join the Strings "a","b","c,d" using Comma as the delimiter ?
    '              You don't have to figure out which is the delimiter and which comma is the
    '              literal. With JoinString(), you always know what you are getting.
    '
    '-----------------------------------------------------------------------------------------

    Dim I As Long, LastPos As Long

    ' Argument validation
    If EscapeChar = "" Then EscapeChar = "\"
    If JoinCharacter = "" Then JoinCharacter = " "
    If Len(JoinCharacter) > 1 Then JoinCharacter = Left$(JoinCharacter, 1)

    For I = LBound(StringIn) To UBound(StringIn)
        If InStr(1, StringIn(I), JoinCharacter, vbTextCompare) > 0 Then
            StringIn(I) = Replace(StringIn(I), JoinCharacter, EscapeChar & JoinCharacter, 1, -1, vbTextCompare)
        End If

        ' Join 'em
        JoinString = JoinString & StringIn(I) & JoinCharacter
    Next

    ' Remove the last Join Character
    JoinString = Left$(JoinString, Len(JoinString) - 1)

End Function

Generate GUID using the CoCreateGuid API

Zaur — Sun, 11 Oct 2009 13:08:21 +0000

' ----------------------------
' Constants & API Declarations
' ----------------------------

Public Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Public Declare Function CoCreateGuid Lib "OLE32.DLL" (pGuid As GUID) As Long
Public Const S_OK = 0 ' return value from CoCreateGuid

' ---------
' Function
' ---------

Function GetGUID() As String
    Dim lResult As Long
    Dim lguid As GUID
    Dim MyguidString As String
    Dim MyGuidString1 As String
    Dim MyGuidString2 As String
    Dim MyGuidString3 As String
    Dim DataLen As Integer
    Dim StringLen As Integer
    Dim i%

    On Error GoTo error_olemsg

    lResult = CoCreateGuid(lguid)

    If lResult = S_OK Then
        MyGuidString1 = Hex$(lguid.Data1)
        StringLen = Len(MyGuidString1)
        DataLen = Len(lguid.Data1)
        MyGuidString1 = LeadingZeros(2 * DataLen, StringLen) & MyGuidString1        'First 4 bytes (8 hex digits)

        MyGuidString2 = Hex$(lguid.Data2)
        StringLen = Len(MyGuidString2)
        DataLen = Len(lguid.Data2)
        MyGuidString2 = LeadingZeros(2 * DataLen, StringLen) & Trim$(MyGuidString2)        'Next 2 bytes (4 hex digits)

        MyGuidString3 = Hex$(lguid.Data3)
        StringLen = Len(MyGuidString3)
        DataLen = Len(lguid.Data3)
        MyGuidString3 = LeadingZeros(2 * DataLen, StringLen) & Trim$(MyGuidString3)        'Next 2 bytes (4 hex digits)

        GetGUID = MyGuidString1 & MyGuidString2 & MyGuidString3

        For i% = 0 To 7
           MyguidString = MyguidString & Format$(Hex$(lguid.Data4(i%)), "00")
        Next i%

        'MyGuidString contains last 8 bytes of Guid (16 hex digits)
        GetGUID = GetGUID & MyguidString
    Else
        GetGUID = "00000000" ' return zeros if function unsuccessful
    End If

    Exit Function

error_olemsg:
         MsgBox "Error " & Str(Err) & ": " & Error$(Err)
         GetGUID = "00000000"
         Exit Function

End Function

' =============================================================== '

Function LeadingZeros(ExpectedLen As Integer, ActualLen As Integer) As String
    LeadingZeros = String$(ExpectedLen - ActualLen, "0")
End Function