FunctSearch

Public Function DoSearch(ByVal startoffset As Double, ByVal intxt As String, _
ByVal thepatt As String, ByRef stloc As Double, ByRef enloc As Double, _
ByVal nonCS As Boolean) As Boolean

Dim pattlist() As String
Dim pattlistcnt As Double
Dim startloc As Double
Dim endloc As Double
Dim stillLooking As Boolean
Dim goodmatch As Boolean
Dim nextisstart As Boolean
Dim lastwaswild As Boolean
Dim hld As String
Dim pattlen As Double
Dim origlen As Double
Dim frontaccum As Double

pattlistcnt = 0
hld = ""
stillLooking = True
startloc = 0
endloc = 0

If nonCS Then
intxt = UCase(intxt)
thepatt = UCase(thepatt)
End If

pattlen = Len(thepatt)
origlen = Len(intxt)

If startoffset < 1 Or startoffset >= origlen Then
enloc = 0
stloc = 0
DoSearch = False
Exit Function
Else
curroffset = startoffset
End If

'0.1) clean pattern - **, *%, %*, etc.

Do While stillLooking
stillLooking = False
For i = 1 To pattlen
ch1 = Mid(thepatt, i, 1)
ch2 = Mid(thepatt, i + 1, 1)
If (ch1 = "*" And ch2 = "%") Or (ch1 = "%" And ch2 = "*") _
Or (ch1 = "*" And ch2 = "*") Then
hld = hld & "*"
i = i + 1
stillLooking = True
Else
hld = hld & ch1
End If
Next
thepatt = hld
pattlen = Len(thepatt)
hld = ""
Loop

'0.2) is it a 'everything' query? - just a * ..............


If thepatt = "*" Then
'do exit here...

enloc = origlen
stloc = 1
DoSearch = True
Exit Function
End If

' 1) parse pattern - build list ........


pattaccum = ""

For i = 1 To pattlen
ch1 = Mid(thepatt, i, 1)
If ch1 = "*" Or ch1 = "%" Then
If pattaccum <> "" Then
pattlistcnt = pattlistcnt + 1
ReDim Preserve pattlist(pattlistcnt)
pattlist(pattlistcnt) = pattaccum
End If
If pattlistcnt > 0 Then
If Left(pattlist(pattlistcnt), 1) = "%" Then
pattlist(pattlistcnt) = pattlist(pattlistcnt) & ch1
Else
pattlistcnt = pattlistcnt + 1
ReDim Preserve pattlist(pattlistcnt)
pattlist(pattlistcnt) = ch1
pattaccum = ""
End If
Else
pattlistcnt = pattlistcnt + 1
ReDim Preserve pattlist(pattlistcnt)
pattlist(pattlistcnt) = ch1
pattaccum = ""
End If
Else
pattaccum = pattaccum & ch1
End If
Next
If pattaccum <> "" Then
pattlistcnt = pattlistcnt + 1
ReDim Preserve pattlist(pattlistcnt)
pattlist(pattlistcnt) = pattaccum
End If

' 2) apply criteria - from pattern list

currchunk = 1
nextisstart = False
goodmatch = True
lastwaswild = False
frontaccum = 0
hld = intxt
Do While goodmatch And currchunk <= pattlistcnt And curroffset <= origlen
patttxt = pattlist(currchunk)

If patttxt = "*" Then
If startloc = 0 Then
startloc = curroffset
End If
ElseIf Left(patttxt, 1) = "%" Then
plen = Len(patttxt)
curroffset = curroffset + plen
If startloc = 0 Then
frontaccum = plen
nextisstart = True
End If
lastwaswild = True
Else
offset1 = InStr(curroffset, hld, patttxt)
If nextisstart Then
startloc = offset1 - frontaccum
lastwaswild = False ' new
Else
If lastwaswild Then
If offset1 <> curroffset + 1 Then
' needed to skip more than one char per

'%' to find patt

goodmatch = False
End If
lastwaswild = False
End If
End If
If offset1 = 0 Then
goodmatch = False
Else
curroffset = offset1 + Len(patttxt) - 1
If nextisstart Then
startloc = offset1 - frontaccum
nextisstart = False
End If
End If
If startloc = 0 Then
startloc = offset1
End If
End If

' post checks


If curroffset > origlen Then
goodmatch = False
End If

If goodmatch Then
endloc = curroffset
End If

currchunk = currchunk + 1
Loop

If Right(thepatt, 1) = "*" Then
endloc = origlen
End If

If Not goodmatch Then
startloc = 0
endloc = 0
End If

stloc = startloc
enloc = endloc

DoSearch = goodmatch
End Function
startoffset: Where In the String to start looking
intxt : The String To search in
thepatt : The pattern you are looking For
stloc : If the pattern is found, this value will
hold the location where the pattern
started within the 'intxt' String
enloc : If the pattern is found, this value will
hold the location where the pattern
ended within the 'intxt' String
nonCS: Set True If you want the search To be non Case sensitive.

Returns:
True or False If the pattern was matched within the target string.
Also returns values In stloc and enloc that signify where in the target String the pattern was found. These are passed back by reference as data Type Double.

'Assumes:

Es:
Dim st As Double, en As Double
retval = DoSearch(1,"This is cool","i*co",st,en,TRUE)
retval will be True
st will equal 3
en will equal 10
retval = DoSearch(1,"This is cool","i%co",st,en,TRUE)
retval will be False
st will be invalid
en will be invalid


' * = 0 to len(strg) characters

' % = 1 and only 1 character