John Colby
jwcolby at ColbyConsulting.com
Sun Jan 15 10:07:22 CST 2006
Have you ever wanted the ability to replace markers in boiler plate?
I have been building up a wizard for building class /controller class pairs,
something I use all the time. Part of the process is to insert boilerplate
text such as:
'CopyRight: |CopyRightVal|
'.=========================================================================
'.Description :
'.
'.Written By : |AuthorVal|
'.Date Created : |DateVal|
' Rev. History :
'
' Comments :
'THESE CONSTANTS AND VARIABLES ARE USED INTERNALLY TO THE CLASS
'*+ Class constant declaration
Private Const DebugPrint As Boolean = False
Private Const mcstrModuleName As String = "|ClsNameVal|"
And then be able to replace the markers:
|CopyRightVal|
|AuthorVal|
|DateVal|
|ClsNameVal|
With values either pulled from a string replacement table or generated by
the code.
|CopyRightVal|
|AuthorVal|
Come from a table of marker / replacement strings, and
|DateVal|
|ClsNameVal|
Are values that the class generation code determines at run time.
In order to do this I built a child class / controller pair. The child
class holds the data from tblStringReplacement where the data looks like:
Orig Text
Replacement Memo
The controller class loads the data from the table into child class
instances, then has a pair of methods to do the replacements. One method
replaces all markers that it can find in the table (looking in the child
classes), the other method performs a replacement of a marker passed in and
a replacement string passed in (used for Runtime marker replacements).
The classes look like:
'*******************
'Begin Code Code Code Code
'*******************
Option Compare Database
Option Explicit
Private mOrig As String
Private mReplacement As String
Function mInit(lOrig As String, lReplacement As String)
mOrig = lOrig
mReplacement = lReplacement
End Function
Property Get pOrig() As String
pOrig = mOrig
End Property
Property Get pReplacement() As String
pReplacement = mReplacement
End Property
'*******************
'End Code Code Code Code
'*******************
Which holds the data in the tblStringReplacement - one class per record and:
'*******************
'Begin Code Code Code Code
'*******************
Private mstrTblName As String
Private mstrIdentFldName As String
Private mcolclsSystem As Collection
Private Sub Class_Initialize()
Set mcolclsSystem = New Collection
End Sub
Private Sub Class_Terminate()
Set mcolclsSystem = Nothing
End Sub
'
'strIdentFldName used as the key into the collection if present
'
Function mInit(strTblName As String, Optional strIdentFldName As String =
"Orig")
On Error GoTo Err_mInit
mstrTblName = strTblName
mstrIdentFldName = strIdentFldName
ClsFactory
Exit_mInit:
Exit Function
Err_mInit:
MsgBox Err.Description, , "Error in Function clsStrReplaceCtl.mInit"
Resume Exit_mInit
Resume 0 '.FOR TROUBLESHOOTING
End Function
Private Function ClsFactory()
On Error GoTo Err_ClsFactory
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim lcls As clsStrReplace
Dim fld As ADODB.Field
Set cnn = CodeProject.Connection
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM " & mstrTblName, cnn, adOpenStatic,
adLockPessimistic
With rst
While Not .EOF
Set lcls = New clsStrReplace
lcls.mInit .Fields("Orig"), .Fields("Replacement")
If Len(mstrIdentFldName) > 0 Then
mcolclsSystem.Add lcls, CStr(.Fields(mstrIdentFldName))
Else
mcolclsSystem.Add lcls
End If
.MoveNext
Wend
End With
Exit_ClsFactory:
On Error Resume Next
If Not (rst Is Nothing) Then rst.Close: Set rst = Nothing
If Not (cnn Is Nothing) Then cnn.Close: Set cnn = Nothing
Exit Function
Err_ClsFactory:
MsgBox Err.Description, , "Error in Function
clsSystemsCtrl.ClsFactory"
Resume Exit_ClsFactory
Resume 0 '.FOR TROUBLESHOOTING
End Function
Property Get cStrReplace(varVal As Variant) As clsStrReplace
On Error GoTo Err_cStrReplace
Set cStrReplace = mcolclsSystem(CStr(varVal))
Exit_cStrReplace:
Exit Property
Err_cStrReplace:
MsgBox Err.Description, , "Error in Property Get clsStrReplaceCtl.
cStrReplace"
Resume Exit_cStrReplace
Resume 0 '.FOR TROUBLESHOOTING
End Property
'
'This function will search a string for a specific marker passed in.
'Where found, the marker will be replaced by the replacement passed in.
'
Public Function mReplaceMarker(strToProcess As String, strMarker As String,
strReplacement As String)
On Error GoTo Err_mReplaceMarker
Dim intPos1 As Integer
Dim intPos2 As Integer
Dim lstrToProcess As String
Dim lstrProcessed As String
Dim lstrMarker As String
'Dim lstrReplacement As String
Dim blnMarkerNotFound As Boolean
lstrToProcess = strToProcess
'intPos1 = 1
Do
blnMarkerNotFound = True
lstrMarker = ""
'
'Look for a marker
'
intPos1 = InStr(intPos1 + 1, lstrToProcess, "|")
If intPos1 > intPos2 Then
intPos2 = InStr(intPos1 + 1, lstrToProcess, "|")
If intPos2 > intPos1 Then
lstrMarker = mID$(lstrToProcess, intPos1 + 1, intPos2 -
intPos1 - 1)
If Len(lstrMarker) > 0 Then
blnMarkerNotFound = False
On Error Resume Next
If lstrMarker = strMarker Then
'
'I only use the lstrProcessed so I can watch the
process as I am programming it.
'Replace this when debugged
'
'lstrReplacement =
cStrReplace(lstrMarker).pReplacement
lstrProcessed = Replace(lstrToProcess, "|" &
lstrMarker & "|", strReplacement)
lstrToProcess = lstrProcessed
Else
intPos1 = intPos2 + 1
End If
'intPos1 = intPos2 + 1
Else
End If
Else
End If
Else
End If
Loop Until blnMarkerNotFound
mReplaceMarker = lstrToProcess
Exit_mReplaceMarker:
Exit Function
Err_mReplaceMarker:
MsgBox Err.Description, , "Error in Function
clsStrReplaceCtl.mReplaceMarker"
Resume Exit_mReplaceMarker
Resume 0 '.FOR TROUBLESHOOTING
End Function
'
'This function will search strings for embedded "replacement markers"
denoted by |SomeValue|
'Where found, these replacement markers will be looked up in the
tblStrReplacement (the loaded collection)
'and if found, the replacement marker will be replaced with the replacement
value.
'
'If not found, the Replacement marker will be left in place untouched.
'
Public Function mReplaceMarkers(strToProcess As String) As String
On Error GoTo Err_mReplaceMarkers
Dim intPos1 As Integer
Dim intPos2 As Integer
Dim lstrToProcess As String
Dim lstrProcessed As String
Dim lstrMarker As String
Dim lstrReplacement As String
Dim cSR As clsStrReplace
Dim blnMarkerNotFound As Boolean
lstrToProcess = strToProcess
'intPos1 = 1
Do
blnMarkerNotFound = True
lstrMarker = ""
'
'Look for a marker
'
intPos1 = InStr(intPos1 + 1, lstrToProcess, "|")
If intPos1 > intPos2 Then
intPos2 = InStr(intPos1 + 1, lstrToProcess, "|")
If intPos2 > intPos1 Then
lstrMarker = mID$(lstrToProcess, intPos1 + 1, intPos2 -
intPos1 - 1)
If Len(lstrMarker) > 0 Then
blnMarkerNotFound = False
On Error Resume Next
Set cSR = mcolclsSystem(lstrMarker)
If Err = 0 Then
'
'I only use the lstrProcessed so I can watch the
process as I am programming it.
'Replace this when debugged
'
lstrReplacement =
cStrReplace(lstrMarker).pReplacement
lstrProcessed = Replace(lstrToProcess, "|" &
lstrMarker & "|", lstrReplacement)
lstrToProcess = lstrProcessed
Else
intPos1 = intPos2 + 1
End If
On Error GoTo Err_mReplaceMarkers
'intPos1 = intPos2 + 1
Else
End If
Else
End If
Else
End If
Loop Until blnMarkerNotFound
mReplaceMarkers = lstrToProcess
Exit_mReplaceMarkers:
Exit Function
Err_mReplaceMarkers:
MsgBox Err.Description, , "Error in Function
clsStrReplaceCtl.mReplaceMarkers"
Resume Exit_mReplaceMarkers
Resume 0 '.FOR TROUBLESHOOTING
End Function
'*******************
'End Code Code Code Code
'*******************
The following code tests the control class clsStrReplaceCtl:
'*******************
'Begin Code Code Code Code
'*******************
Option Compare Database
Option Explicit
Private mclsStrReplaceCtl As clsStrReplaceCtl
Function StrReplaceInit(strTbl As String)
If mclsStrReplaceCtl Is Nothing Then
Set mclsStrReplaceCtl = New clsStrReplaceCtl
mclsStrReplaceCtl.mInit strTbl
End If
End Function
Function StrReplaceTerm()
Set mclsStrReplaceCtl = Nothing
End Function
Public Function cSRC() As clsStrReplaceCtl
Set cSRC = mclsStrReplaceCtl
End Function
Function TestReplace()
Dim strToTest As String
Dim strResults As String
StrReplaceInit "tblStrReplace"
strToTest = "This is a |specific| test. |Author| is a very nice guy.
His phone is |Phone|. His email is |email|. I hope that this is enough to
|test|"
strResults = cSRC.mReplaceMarkers(strToTest)
Debug.Print strResults
strToTest = strResults
strResults = cSRC.mReplaceMarker(strToTest, "specific", "Very specific")
Debug.Print strResults
strToTest = strResults
strResults = cSRC.mReplaceMarker(strToTest, "test", "work with")
Debug.Print strResults
End Function
'*******************
'End Code Code Code Code
'*******************
Author, Phone and Email will be found in the table, Specific and Test will
be "run time replacement" tests.
This is a rather example of how I use child / controller classes. The data
gets cached to speed up access to what would non-changing data in a table,
and then accessed from child classes stored in a collection in the
controller.
I have pretty much finished an Add-in to build the child / controller class
pair for a given table. The add-in uses this string replacement system. It
was an interesting exercise in frustration trying to get the finished
classes to save properly (thanks Shamil for the solution).
John W. Colby
www.ColbyConsulting.com