Regular Expression

Posted on 1998-12-22
Medium Priority
Last Modified: 2010-05-03
Can anyone point me to a resource that may have a *free* MODULE or code for regular expression pattern matching? (a la perl--With substrings, etc.)  I don't want to use a .dll or .ocx.
Question by:IsleOfView
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
LVL 13

Expert Comment

ID: 1451977
This one is not free, but it is good. http://aivosto.netgate.net/regexpr.html
LVL 13

Accepted Solution

Mirkwood earned 200 total points
ID: 1451978

' Name: RegularExpression
' Description:This is a class module that performs
'      regular expression searches in a string.
' By: visual basic prof. edition
' Inputs:Use the Init method to initialize to a specific regular expression (which will be precompiled), then use Match to check if a string contains such a substring.
' Returns:None
' Assumes:a) Put this code in a new .CLS file (NOT in a class module).
b) The syntax for range (e.g. [a-z]) is the same as for operator Like.
c) Not calling Init, or passing an empty pattern, will result in an "Illegal function call" error.
' Side Effects:None
'Code provided by Planet Source Code(tm) 'as is', without
'     warranties as to performance, fitness, merchantability,
'     and any other warranty (whether expressed or implied).

 MultiUse = -1 'True

Attribute VB_Name = "RegularExpression"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'     'PRIVATE
'? = edOptional; + = edMulti; * = edOptional or ed
'     Multi
Private Enum RegExpStateTypes
edOptional = 65536
edMulti = 131072
edModifierMask = edOptional Or edMulti
edCharacter = 0
edBracketed = 262144'for example, [a-z]
edAny = 524288
End Enum

Private Type StateStack
    State As Long
    Posi As Long
    MinPosi As Long
End Type

    Private mStack() As StateStack
    Private mCompiled() As Long
    Private mNStates As Long
    Private mPattern As String
    Private mAnchorBeginning As Boolean
    Private mAnchorEnd As Boolean
    Private mMinLength As Long

Private Sub AddState(ByVal Flags As Long, ByVal CharOrPosi As Long)

    If mNStates = UBound(mCompiled) Then
        ReDim Preserve mCompiled(1 To mNStates + 10) As Long
    End If

        mNStates = mNStates + 1
        mCompiled(mNStates) = CharOrPosi Or Flags
End Sub

Public Sub Init(RegExp As String)

    Dim StackSize As Long, Posi As Long, EndPosi As Long
    '     'Initialize member variables
    mPattern = RegExp
    mNStates = 0
    mMinLength = 0
    ReDim mCompiled(1 To 10) As Long
    Posi = 1
EndPosi = Len(RegExp)

    If Left(mPattern, 1) = "^" Then
        Posi = Posi + 1
        mAnchorBeginning = True
    End If

        If Right(mPattern, 1) = "$" And Right(mPattern, 2) <> "\$" Then
        EndPosi = EndPosi - 1

            mAnchorEnd = True
        End If

            Do Until Posi > EndPosi
                Select Case Mid$(mPattern, Posi, 1)
                Case "."
                AddState edAny, 0
                Posi = Posi + 1
                Case "\"
                AddState edCharacter, Asc(Mid$(mPattern, Posi + 1, 1))
                Posi = Posi + 2
                Case "["
                AddState edBracketed, Posi
                Posi = RangeParse(Posi)

                If Posi = -1 Then Err.Raise 5
                    Case Else
                    AddState edCharacter, Asc(Mid$(mPattern, Posi, 1))
                    Posi = Posi + 1
                End Select

                    '     'check for modifiers (?, +, *)
                    Select Case Mid$(mPattern, Posi, 1)
                    Case "?"
                    mCompiled(mNStates) = mCompiled(mNStates) Or edOptional
                    StackSize = StackSize + 1
                    Posi = Posi + 1
                    Case "+"
                    mCompiled(mNStates) = mCompiled(mNStates) Or edMulti
                    StackSize = StackSize + 1
                    Posi = Posi + 1
                    mMinLength = mMinLength + 1
                    Case "*"
                    mCompiled(mNStates) = mCompiled(mNStates) Or edMulti Or edOptional
                    StackSize = StackSize + 1
                    Posi = Posi + 1
                    Case Else
                    mMinLength = mMinLength + 1
                End Select


                    'Minimize wasted memory by dimensioning exact arra
                    '     ys
                    ReDim Preserve mCompiled(1 To mNStates) As Long
                    ReDim mStack(1 To StackSize) As StateStack
            End Sub

Public Function Match(ByRef FromX As Long, ByRef ToX As Long, Text As String) As Boolean

    Dim Match As Boolean
    Dim CurState As Long
    Dim State As Long
    Dim SP As Long
    Dim LenText As Long

    If mNStates = 0 Then Err.Raise 5
        LenText = Len(Text)

        For FromX = FromX To IIf(mAnchorBeginning, 1, LenText - mMinLength)
            ToX = FromX
            State = 1
            SP = 0


                If State > mNStates Then

                    If (Not mAnchorEnd) Or (ToX > LenText) Then
                        'ToX is pointing the first character PAST the matc
                        '     hed string
                        ToX = ToX - 1
                        MatchRight = True
                        Exit Function
                    End If

                    End If

                        GoSub MatchState

                        If Match Then

                            If CurState And edModifierMask Then
                                '     'create a new item in the backtrack stack
                                SP = SP + 1
                                mStack(SP).MinPosi = IIf(CurState And edOptional, ToX, ToX + 1)
                                If (CurState And (edAny Or edMulti)) = (edAny Or edMulti) Then
                                    'When matching .* and .+, we don't need to check t
                                    '     he whole string
                                    ToX = LenText + 1
                                ElseIf CurState And edMulti Then
                                    '     '+ or *, try to get as far as possible

                                        ToX = ToX + 1
                                        GoSub MatchState
                                    Loop Until Not Match

                                        '     '?, you only have to look one character ahead
                                        ToX = ToX + 1
                                    End If

                                        State = State + 1
                                        mStack(SP).Posi = ToX
                                        mStack(SP).State = State
                                        '     'no +, *, nor ?, just advance to the next state
                                        ToX = ToX + 1
                                        State = State + 1
                                    End If

                                    ElseIf CurState And edOptional Then
                                        '     'not matched, but it was optional... no problem
                                        State = State + 1
                                        'backtrack - find the next usable item in the stac
                                        '     k

                                        For SP = SP To 1 Step -1

                                            If mStack(SP).Posi > mStack(SP).MinPosi Then Exit For
                                            Next SP

                                                If SP = 0 Then Exit Do
                                                    mStack(SP).Posi = mStack(SP).Posi - 1
                                                    ToX = mStack(SP).Posi
                                                    State = mStack(SP).State
                                                End If


                                                Next FromX

                                                    Exit Function
                                                    CurState = mCompiled(State)

                                                    If ToX > LenText Then
                                                        Match = False
                                                    ElseIf CurState And edAny Then
                                                        Match = True
                                                    ElseIf CurState And edBracketed Then
                                                        Match = RangeMatch(CurState And 65535, Mid$(Text, ToX, 1))
                                                        Match = (CurState And 65535) = Asc(Mid$(Text, ToX, 1))
                                                    End If

                                                    End Function

Private Function RangeMatch(Posi As Long, ch As String) As Boolean

    RangeMatch = ch Like Mid$(mPattern, Posi, InStr(Posi, mPattern, "]") - Posi + 1)
End Function

    'Return the end of the range (e.g. [a-z]) starting
    '      at position Posi.
    'Return -1 if the regular expression is not well f
    '     ormed.

Private Function RangeParse(Posi As Long) As Long

    Dim EndPosi As Long
EndPosi = InStr(Posi, mPattern, "]")

    'Try using operator Like and check if an error occ
    '     urs
    On Error Resume Next

    If "a" Like Mid(mPattern, Posi, EndPosi - Posi + 1) Then:

        If Err Then
            RangeParse = -1
            RangeParse = EndPosi + 1
        End If

        End Function


Featured Post

On Demand Webinar - Networking for the Cloud Era

This webinar discusses:
-Common barriers companies experience when moving to the cloud
-How SD-WAN changes the way we look at networks
-Best practices customers should employ moving forward with cloud migration
-What happens behind the scenes of SteelConnect’s one-click button

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses

765 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question