VB and VBA Users Source Code: StringBuilder class for VB/VBA
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
StringBuilder class for VB/VBA
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Monday, June 13, 2005
Hits:
4129
Category:
Files/Directories/IO
Article:
Below is the source code for a VB6/VBA string builder class. The purpose of the of this class is to optimise the concatenation of long strings by using an internal buffer. INSERT THE FOLLOWING CODE INTO A NEW CLASS CALLED "StringBuilder" 'Visual Basic/VBA string builder class 'Author: 'Andrew Baker (copyright www.vbusers.com) 'Summary: 'The StringBuilder class is designed to incrementally build up strings 'using an internal buffer to prevent unneccassary string copying. Option Explicit Private zlLength As Long, zlStart As Long, zlSize As Long Private zlResizeIncrement As Long Private zsBuffer As String 'Purpose : Overwrites any text in the buffer and sets the text to the specified text. 'Inputs : sText The text set the buffer text to. 'Outputs : N/A 'Date : 25/03/2001 'Notes : Equivalent to calling Clear and then Append. Public Sub SetText(sText As String) Clear Append sText End Sub 'Purpose : Appends text to the string. 'Inputs : sText The text to append. 'Outputs : N/A 'Date : 25/03/2001 'Notes : Public Sub Append(sText As String) Dim lLenAppend As Long 'Check that the buffer has been created If Len(zsBuffer) = 0 Then 'Create the buffer zsBuffer = Space$(zlSize) End If lLenAppend = Len(sText) If lLenAppend > 0 Then 'Check if the buffer is big enough to hold the data If zlLength + lLenAppend + 1 > zlSize Then 'Resize the buffer If zlResizeIncrement > lLenAppend Then zsBuffer = zsBuffer & Space$(zlResizeIncrement) Else 'Resize the buffer by twice the length of the appended string zsBuffer = zsBuffer & Space$(lLenAppend * 2) End If zlSize = Len(zsBuffer) 'Debug.Print Now & " Buffer resized to " & zlSize End If 'Insert the append string Mid$(zsBuffer, zlLength + 1) = sText 'Store the new length zlLength = zlLength + lLenAppend End If End Sub 'Purpose : Returns the contents of the buffer. 'Inputs : [lLength] The length of the text to return, defaults to returning all. 'Outputs : Returns the requested text. 'Date : 25/03/2001 'Notes : Public Function GetText(Optional lLength As Long = -1) As String If lLength > 0 Then 'Return a sub set GetText = Mid$(zsBuffer, zlStart, lLength) Else 'Return all the text in the buffer GetText = Mid$(zsBuffer, zlStart, zlLength - (zlStart - 1)) End If End Function 'Purpose : Returns the position of the specified text. 'Inputs : sSearch The text to search for. 'Outputs : Returns the position of the specified text, or zero if the text was not found. 'Date : 25/03/2001 'Notes : Public Function FindText(sSearch As String) As Long 'Insert the search string at the end of the buffer (saves searching the empty buffer) Mid$(zsBuffer, zlLength + 1) = sSearch 'Search for the string FindText = VBA.InStr(zlStart, zsBuffer, sSearch) If FindText > zlLength Then 'Didn't find the string within the used buffer FindText = 0 End If End Function 'Purpose : Clears the contents of the buffer. 'Inputs : N/A 'Outputs : N/A 'Date : 25/03/2001 'Notes : Public Sub Clear() zlLength = 0 zlStart = 1 End Sub 'Purpose : Gets or sets the starting position of the text to return. 'Inputs : N/A 'Date : 25/03/2001 'Notes : Public Property Get Start() As Long Start = zlStart End Property Public Property Let Start(Value As Long) zlStart = Value End Property 'Purpose : Removes the all data before the "Start" position and resets the "Start" back to 1. 'Inputs : N/A 'Outputs : N/A 'Date : 25/03/2001 'Notes : Useful for reclaiming unused space, but results in copying the whole of the used buffer. Public Sub Compact() If zlStart <> 1 Then 'Copy the used portion of the buffer back to the start of the buffer Mid$(zsBuffer, 1) = Mid$(zsBuffer, zlStart, zlLength - (zlStart - 1)) 'Move the length back zlLength = (zlLength - zlStart) + 1 'Reset the start position zlStart = 1 End If End Sub 'Purpose : Gets or sets the length of the text in the buffer. 'Inputs : N/A 'Date : 25/03/2001 'Notes : Public Property Get Length() As Long Length = zlLength End Property Public Property Let Length(Value As Long) zlLength = Value End Property 'Purpose : Gets or sets the amount to resize the buffer by when the appended string exceeds the buffer size. 'Inputs : N/A 'Date : 25/03/2001 'Notes : Public Property Get ResizeIncrement() As Long ResizeIncrement = zlResizeIncrement End Property Public Property Let ResizeIncrement(Value As Long) zlResizeIncrement = Value End Property 'Purpose : Gets or sets the current buffer size. 'Inputs : N/A 'Date : 25/03/2001 'Notes : Public Property Get Size() As Long Size = zlSize End Property Public Property Let Size(Value As Long) zlSize = Value End Property Private Sub Class_Initialize() zlStart = 1 zlLength = 0 zlSize = 2024 zlResizeIncrement = 16384 End Sub Private Sub Class_Terminate() 'Erase buffer zsBuffer = "" End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
