[AccessD] String replacement wizard

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 





More information about the AccessD mailing list