|
Visual Basic (VB and VBA) |
|
Copyright 1999-2001 Christopher Greaves. All rights reserved. Home Page and email to [email protected] |
| If in doubt, record a macro and inspect the entrails! |
Please read the DISCLAIMER.
Here is an INDEX to all the procedures.
You will probably need one copy of my GLOBAL DECLARATIONS.
Public Function strGetNextWord(strSource As String, lngStart As Long, strValid As String, strNesters As String) As String
' Procedure : strGetNextWord
' Description: Return the next availabl word from the source string.
' By: Chris Greaves Inc.
' Inputs: strSource As String - Holds the gigantic buffer of text to be analysed
' Unchanged by this procedure.
' lngStart As Long - Holds the pointer to the starting point for our search.
' Initialised by the caller prior to the first call.
' Updated by this procedure.
' When lngStart >= len(strSource) we are done.
' strValid As String - A series of valid characters,
' each of which will constitute a word-string,
' strNesters As String - A series of pairs of characters which define
' chunks of text to be ignored.
' For example ASC(019) and ASC(021) are the Field Code braces.
' while ASC(040) and ASC(041) are parentheses.
' Returns: STRING of characters NOT containing any one of strDelimiters and strNesters.
' Assumes: Nothing
' Side Effects: lngStart will change between calls and should NOT be managed by the caller.
' Tested: By the calls shown below.
' Method:
' While the stack is non-empty
' Loop along the string until we match top-of-stack
' at which time we pop the stack.
'
' When the stack is empty
' Loop along the string examining one character at a time.
' When a character is found NOT belonging to strValid,
' we return our accumulation as the next string
'
Static strStack As String ' WE need but a simple string for this stack.
Dim strResult As String
strResult = ""
Dim strCH As String ' The character currently being examined.
While (strResult = "") And (lngStart <= Len(strSource))
strCH = Mid$(strSource, lngStart, 1) ' load the next available character
lngStart = lngStart + 1 ' point to the next available character
' At this point the stack is empty (so we are at base level) and we have a character
If InStr(1, strValid, strCH) > 0 Then ' the character is valid
While (InStr(1, strValid, strCH) > 0) And (lngStart <= Len(strSource))
strResult = strResult & strCH
strCH = Mid$(strSource, lngStart, 1) ' load the next available character
lngStart = lngStart + 1 ' point to the next available character
Wend
If (InStr(1, strValid, strCH) > 0) Then
strResult = strResult & strCH
Else
End If
Else ' our character is NOT valid (to form a word-string)
' If our loaded character is a nester IN, push it on to the stack
Dim inStack As Integer
inStack = InStr(1, strNesters, strCH)
If inStack > 0 Then ' it is either an IN or an OUT
If (inStack Mod 2) = 1 Then ' it is an in. Push the Out
strStack = Mid$(strNesters, inStack + 1, 1) & strStack
strCH = Mid$(strSource, lngStart, 1) ' load the next available character
lngStart = lngStart + 1 ' point to the next available character
' Now keep going until our stack is empty
' A better non-empty stack strategy is to Instr to the top-of-stack characters
While (strStack <> "") And (lngStart <= Len(strSource)) ' while the stack is non-empty
If strCH = Left$(strStack, 1) Then ' matches top-of-stack
strStack = Right$(strStack, Len(strStack) - 1) ' pop one item from the stack
Else
inStack = InStr(1, strNesters, strCH)
If inStack > 0 Then ' it is either an IN or an OUT
If (inStack Mod 2) = 1 Then ' it is an in. Push the Out
strStack = Mid$(strNesters, inStack + 1, 1) & strStack
Else ' it is an out, but obviously not the one we want
End If
Else
End If
End If
strCH = Mid$(strSource, lngStart, 1) ' load the next available character
lngStart = lngStart + 1 ' point to the next available character
Wend
' we have navigated the nest.
Else ' it is an out, but obviously not the one we want
End If
Else
End If
End If
Wend
' At this point we have a word formed of valid characters
strGetNextWord = strResult
' What is the residual character? Should it be pushed/popped from the stack?
' The following line is a "fix". better would be to do something with the character
' while it is in hand.
lngStart = lngStart - 1
'Sub TESTstrGetNextWord()
'Dim lngStart As Long
'Dim strValid As String
'Dim strNesters As String
'strValid = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-_'"
'strNesters = ""
'strNesters = strNesters & Chr$(19) & Chr$(21) ' Ignore nested field codes
'strNesters = strNesters & "()" ' Ignore nested parentheses
'strNesters = strNesters & "[]" ' Ignore nested brackets
'Dim strNext As String
'strNext = ""
'Dim strText As String
''
''MsgBox " test 1 : here some stuff"
''strText = "Here (is) some (more (unbelieveable [incredible] ) ) stuff"
''lngStart = 1
''Do
'' strNext = strGetNextWord(strText, lngStart, strValid, strNesters) ' Contents
'' MsgBox strNext
''Loop While strNext <> ""
''
''MsgBox " test 2 : here some "
''strText = "Here (is) some (more (unbelieveable [incredible"
''lngStart = 1
''Do
'' strNext = strGetNextWord(strText, lngStart, strValid, strNesters) ' Contents
'' MsgBox strNext
''Loop While strNext <> ""
''
''MsgBox " test 3 : is more unbelieveable incredible"
''strText = " is) more unbelieveable incredible]"
''lngStart = 1
''Do
'' strNext = strGetNextWord(strText, lngStart, strValid, strNesters) ' Contents
'' MsgBox strNext
''Loop While strNext <> ""
' Dim blnShowFields As Boolean
' blnShowFields = ActiveWindow.View.ShowFieldCodes
' ActiveWindow.View.ShowFieldCodes = True
' MsgBox " test 4 : from the source document"
' strNesters = ""
' strNesters = strNesters & Chr$(19) & Chr$(21) ' Ignore nested field codes
' strValid = strValid & Chr$(160) ' Accept hard spaces (Ctrl-Shift-Space)
' strValid = strValid & Chr$(30) ' Accept hard hyphens (Ctrl-Shift-Hyphen)
' strValid = strValid & "()" ' Useful in telephone numbers!
' strText = ActiveDocument.Range.Text
' lngStart = 1
' Do
' strNext = strGetNextWord(strText, lngStart, strValid, strNesters) ' Contents
' MsgBox strNext
' Loop While strNext <> ""
' ActiveWindow.View.ShowFieldCodes = blnShowFields
'End Sub
End Function
| We all knew nothing when we started … |
|
Home Page and Contact Information Send email to [email protected]. This page was last updated Thursday, November 15, 2001 |