Component File /CConCat.vb (VB.NET)
1: Option Strict Off
2: Option Explicit On
3: Friend Class CConCat
4: 'Code from http://www.awprofessional.com/articles/article.asp?p=25175&seqNum=3
5: ' =================================================== '
6: ' CConCat: '
7: ' This class provides an alternative, more efficient '
8: ' approach to string concatenation. Concatenation of '
9: ' large VB strings requires reallocation of memory at '
10: ' each concatenation. The approach used here reduces '
11: ' the number of memory reallocations. '
12: ' '
13: ' Empirical results indicate that this is faster than '
14: ' standard VB concatenation for strings greater than '
15: ' 1K in length, with the level of improvement growing '
16: ' with the size of the string. '
17: ' '
18: ' Public Property Get Text() as String '
19: ' Public Property Let Text(ByVal sNew as String) '
20: ' Public Property Get Increment() as Long '
21: ' Public Property Let Increment(ByVal nNew as Long) '
22: ' Public Property Get Length() as Long '
23: ' Public Sub Cat(ByVal sNewPart as String) '
24: ' '
25: ' Copyright © 2001 by Scott R. Loban. ' ===================================================== '
26:
27: Private m_sText As String '-- Text being stored in object
28: Private m_nPointer As Integer '-- Pointer to end of string
29: Private m_nIncrement As Integer '-- Number of bytes to add at a time
30:
31: '--- Return the Text Stored in the Class ---'
32:
33: '--- Set (replace) the Text Stored in the Class ---'
34: Public Property Text() As String
35: Get
36: Dim ErDesc, ErNum, ErSrc As Object
37: On Error GoTo ErrHandler
38: Return Left(m_sText, m_nPointer)
39: Exit Property
40: ErrHandler:
41: 'UPGRADE_WARNING: Couldn't resolve default property of object ErNum. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
42: ErNum = Err.Number
43: 'UPGRADE_WARNING: Couldn't resolve default property of object ErDesc. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
44: ErDesc = Err.Description
45: 'UPGRADE_WARNING: Couldn't resolve default property of object ErSrc. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
46: ErSrc = Err.Source & ", CConCat.Text"
47: 'UPGRADE_WARNING: Couldn't resolve default property of object ErNum. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
48: Err.Raise(ErNum, ErSrc, ErDesc)
49: End Get
50: Set(ByVal Value As String)
51: Dim ErDesc, ErNum, ErSrc As Object
52: On Error GoTo ErrHandler
53: m_sText = Value
54: m_nPointer = Len(m_sText)
55: Exit Property
56: ErrHandler:
57: 'UPGRADE_WARNING: Couldn't resolve default property of object ErNum. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
58: ErNum = Err.Number
59: 'UPGRADE_WARNING: Couldn't resolve default property of object ErDesc. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
60: ErDesc = Err.Description
61: 'UPGRADE_WARNING: Couldn't resolve default property of object ErSrc. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
62: ErSrc = Err.Source & ", CConCat.Text"
63: 'UPGRADE_WARNING: Couldn't resolve default property of object ErNum. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
64: Err.Raise(ErNum, ErSrc, ErDesc)
65: End Set
66: End Property
67:
68: '--- Return the Current Reallocation Increment ---'
69:
70: '--- Set a New Reallocation Increment ---'
71: Public Property Increment() As Integer
72: Get
73: Dim ErDesc, ErNum, ErSrc As Object
74: On Error GoTo ErrHandler
75: Increment = m_nIncrement
76: Exit Property
77: ErrHandler:
78: 'UPGRADE_WARNING: Couldn't resolve default property of object ErNum. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
79: ErNum = Err.Number
80: 'UPGRADE_WARNING: Couldn't resolve default property of object ErDesc. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
81: ErDesc = Err.Description
82: 'UPGRADE_WARNING: Couldn't resolve default property of object ErSrc. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
83: ErSrc = Err.Source & ", CConCat.Increment"
84: 'UPGRADE_WARNING: Couldn't resolve default property of object ErNum. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
85: Err.Raise(ErNum, ErSrc, ErDesc)
86: End Get
87: Set(ByVal Value As Integer)
88: Dim ErDesc, ErNum, ErSrc As Object
89: On Error GoTo ErrHandler
90: If Value > 0 Then
91: m_nIncrement = Value
92: End If
93: Exit Property
94: ErrHandler:
95: 'UPGRADE_WARNING: Couldn't resolve default property of object ErNum. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
96: ErNum = Err.Number
97: 'UPGRADE_WARNING: Couldn't resolve default property of object ErDesc. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
98: ErDesc = Err.Description
99: 'UPGRADE_WARNING: Couldn't resolve default property of object ErSrc. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
100: ErSrc = Err.Source & ", CConCat.Increment"
101: 'UPGRADE_WARNING: Couldn't resolve default property of object ErNum. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
102: Err.Raise(ErNum, ErSrc, ErDesc)
103: End Set
104: End Property
105:
106: '--- Return the Length of the Text Stored in the Class ---'
107: Public ReadOnly Property Length() As Integer
108: Get
109: Dim ErDesc, ErNum, ErSrc As Object
110: On Error GoTo ErrHandler
111: Length = m_nPointer
112: Exit Property
113: ErrHandler:
114: 'UPGRADE_WARNING: Couldn't resolve default property of object ErNum. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
115: ErNum = Err.Number
116: 'UPGRADE_WARNING: Couldn't resolve default property of object ErDesc. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
117: ErDesc = Err.Description
118: 'UPGRADE_WARNING: Couldn't resolve default property of object ErSrc. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
119: ErSrc = Err.Source & ", CConCat.Length"
120: 'UPGRADE_WARNING: Couldn't resolve default property of object ErNum. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
121: Err.Raise(ErNum, ErSrc, ErDesc)
122: End Get
123: End Property
124:
125: '--- Concatenate the Text Stored in the Class and a Passed String ---'
126: Public Sub Cat(ByVal sNewPart As String)
127: Dim nLen As Integer
128: Dim ErDesc, ErNum, ErSrc As Object
129:
130: On Error GoTo ErrHandler
131:
132: nLen = Len(sNewPart)
133:
134: If (m_nPointer + nLen) >= Len(m_sText) Then '-- Not enough room
135: If nLen > m_nIncrement Then '-- Need nLen more bytes
136: m_sText = m_sText & Space(nLen) '-- Do Reallocation
137: Else '-- Add more space
138: m_sText = m_sText & Space(m_nIncrement) '-- Do Reallocation
139: End If
140: End If
141:
142: '--- Store the NewPart in the String ---'
143: Mid(m_sText, m_nPointer + 1, nLen) = sNewPart
144:
145: '--- Adjust the Pointer ---'
146: m_nPointer = m_nPointer + nLen
147: Exit Sub
148: ErrHandler:
149: 'UPGRADE_WARNING: Couldn't resolve default property of object ErNum. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
150: ErNum = Err.Number
151: 'UPGRADE_WARNING: Couldn't resolve default property of object ErDesc. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
152: ErDesc = Err.Description
153: 'UPGRADE_WARNING: Couldn't resolve default property of object ErSrc. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
154: ErSrc = Err.Source & ", CConCat.Cat"
155: 'UPGRADE_WARNING: Couldn't resolve default property of object ErNum. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
156: Err.Raise(ErNum, ErSrc, ErDesc)
157: End Sub
158:
159: 'UPGRADE_NOTE: Class_Initialize was upgraded to Class_Initialize_Renamed. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1061"'
160: Private Sub Class_Initialize_Renamed()
161: Dim ErDesc, ErNum, ErSrc As Object
162: On Error GoTo ErrHandler
163: m_nIncrement = 50000
164: m_sText = ""
165: m_nPointer = 0
166: Exit Sub
167: ErrHandler:
168: 'UPGRADE_WARNING: Couldn't resolve default property of object ErNum. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
169: ErNum = Err.Number
170: 'UPGRADE_WARNING: Couldn't resolve default property of object ErDesc. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
171: ErDesc = Err.Description
172: 'UPGRADE_WARNING: Couldn't resolve default property of object ErSrc. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
173: ErSrc = Err.Source & ", CConCat.Class_Initialize"
174: 'UPGRADE_WARNING: Couldn't resolve default property of object ErNum. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
175: Err.Raise(ErNum, ErSrc, ErDesc)
176: End Sub
177: Public Sub New()
178: MyBase.New()
179: Class_Initialize_Renamed()
180: End Sub
181: End Class