VBScript Regular Expressions Examples

[José Roca]

 
The following code illustrates the use of the Execute method.

Code: [Select]

' The following code illustrates the use of the RegExp object.

' Function RegExpTest(patrn, strng)
'   Dim regEx, Match, Matches   ' Create variable.
'   Set regEx = New RegExp   ' Create a regular expression.
'   regEx.Pattern = patrn   ' Set pattern.
'   regEx.IgnoreCase = True   ' Set case insensitivity.
'   regEx.Global = True   ' Set global applicability.
'   Set Matches = regEx.Execute(strng)   ' Execute search.
'   For Each Match in Matches   ' Iterate Matches collection.
'      RetStr = RetStr & "Match found at position "
'      RetStr = RetStr & Match.FirstIndex & ". Match Value is '"
'      RetStr = RetStr & Match.Value & "'." & vbCRLF
'   Next
'   RegExpTest = RetStr
' End Function
' MsgBox(RegExpTest("is.", "IS1 is2 IS3 is4"))

#COMPILE EXE
#DIM ALL
%UNICODE = 1

#INCLUDE "windows.inc"
#INCLUDE "regexp.inc"

FUNCTION PBMAIN

   LOCAL pRegExp AS IRegExp
   LOCAL pMatches AS IMatchCollection
   LOCAL pMatch AS IMatch
   LOCAL nCount AS LONG
   LOCAL i AS LONG
   LOCAL bstrValue AS WSTRING

   ' Creates an instance of the RegExp object
   pRegExp = NEWCOM "VBScript.RegExp"
   IF ISNOTHING(pRegExp) THEN
      MSGBOX "Unable to create an instance of the RegExp object"
      EXIT FUNCTION
   END IF

   ' Set pattern
   pRegExp.Pattern = "is."
   ' Set case insensitivity
   pRegExp.IgnoreCase = %VARIANT_TRUE
   ' Set global applicability
   pRegExp.Global = %VARIANT_TRUE

   ' Execute search
   pMatches = pRegExp.Execute("IS1 is2 IS3 is4")
   IF ISNOTHING(pMatches) THEN
      MSGBOX "No match found"
   ELSE
      nCount = pMatches.Count
      IF nCount = 0 THEN
         MSGBOX "No match found"
         EXIT FUNCTION
      END IF
      ' Iterate the Matches collection
      FOR i = 0 TO nCount - 1
         pMatch = pMatches.Item(i)
         IF ISNOTHING(pMatch) THEN EXIT FOR
         bstrValue += "Match found at position" & STR$(pMatch.FirstIndex) & $CRLF
         bstrValue += "Match value is " & pMatch.Value & $CRLF
         pMatch = NOTHING
      NEXT
      ? bstrValue
   END IF

END FUNCTION


[José Roca]

 
The following code illustrates the use of the Pattern property.

Code: [Select]

' Demonstrates the use of the pattern property.

#COMPILE EXE
#DIM ALL
%UNICODE = 1

#INCLUDE "windows.inc"
#INCLUDE "regexp.inc"

FUNCTION PBMAIN

   LOCAL pRegExp AS IRegExp2
   LOCAL pMatches AS IMatchCollection
   LOCAL pMatch AS IMatch
   LOCAL nCount AS LONG
   LOCAL i AS LONG
   LOCAL bstrValue AS WSTRING

   ' Creates an instance of the RegExp object
   pRegExp = NEWCOM "VBScript.RegExp"
   IF ISNOTHING(pRegExp) THEN
      MSGBOX "Unable to create an instance of the RegExp object"
      EXIT FUNCTION
   END IF

   pRegExp.Pattern = " b.*fox"
   pRegExp.Global = %VARIANT_FALSE
   pRegExp.IgnoreCase = %VARIANT_TRUE
   pRegExp.Multiline = %VARIANT_TRUE

   pMatches = pRegExp.Execute("The quick brown fox jumped over the lazy dog.")
   IF ISNOTHING(pMatches) THEN
      MSGBOX "No match found"
      EXIT FUNCTION
   END IF

   nCount = pMatches.Count
   IF nCount = 0 THEN
      MSGBOX "No match found"
      EXIT FUNCTION
   END IF

   FOR i = 0 TO nCount - 1
      pMatch = pMatches.Item(i)
      IF ISNOTHING(pMatch) THEN EXIT FOR
      bstrValue = pMatch.Value
      MSGBOX bstrValue
      pMatch = NOTHING
   NEXT

END FUNCTION


[José Roca]

 
The following code illustrates the use of the Replace method.

Code: [Select]

' The following code illustrates use of the Replace method.

' Function ReplaceTest(patrn, replStr)
'  Dim regEx, str1               ' Create variables.
'  str1 = "The quick brown fox jumped over the lazy dog."
'  Set regEx = New RegExp            ' Create regular expression.
'  regEx.Pattern = patrn            ' Set pattern.
'  regEx.IgnoreCase = True            ' Make case insensitive.
'  ReplaceTest = regEx.Replace(str1, replStr)   ' Make replacement.
' End Function

' MsgBox(ReplaceTest("fox", "cat"))      ' Replace 'fox' with 'cat'.

' In addition, the Replace method can replace subexpressions in the pattern.
' The following call to the function shown in the previous example swaps the first
' pair of words in the original string:
' MsgBox(ReplaceTest("(\S+)(\s+)(\S+)", "$3$2$1"))   ' Swap first pair of words.

#COMPILE EXE
#DIM ALL
%UNICODE = 1

#INCLUDE "windows.inc"
#INCLUDE "regexp.inc"

FUNCTION PBMAIN

   LOCAL pRegExp AS IRegExp
   LOCAL bstrText AS WSTRING
   LOCAL bstrRetVal AS WSTRING

   ' Creates an instance of the RegExp object
   pRegExp = NEWCOM "VBScript.RegExp"
   IF ISNOTHING(pRegExp) THEN
      MSGBOX "Unable to create an instance of the RegExp object"
      EXIT FUNCTION
   END IF

   ' Set pattern
   pRegExp.Pattern = "fox"
   ' Set case insensitivity
   pRegExp.IgnoreCase = %VARIANT_TRUE

   bstrText = "The quick brown fox jumped over the lazy dog."

   ' Make replacement
   bstrRetVal = pRegExp.Replace(bstrText, "cat")
   ? bstrRetVal

END FUNCTION

In addition, the Replace method can replace subexpressions in the pattern.

Code: [Select]

' The following code illustrates use of the Replace method.

' Function ReplaceTest(patrn, replStr)
'  Dim regEx, str1               ' Create variables.
'  str1 = "The quick brown fox jumped over the lazy dog."
'  Set regEx = New RegExp            ' Create regular expression.
'  regEx.Pattern = patrn            ' Set pattern.
'  regEx.IgnoreCase = True            ' Make case insensitive.
'  ReplaceTest = regEx.Replace(str1, replStr)   ' Make replacement.
' End Function

' MsgBox(ReplaceTest("fox", "cat"))      ' Replace 'fox' with 'cat'.

' In addition, the Replace method can replace subexpressions in the pattern.
' The following call to the function shown in the previous example swaps the first
' pair of words in the original string:
' MsgBox(ReplaceTest("(\S+)(\s+)(\S+)", "$3$2$1"))   ' Swap first pair of words.

#COMPILE EXE
#DIM ALL
%UNICODE = 1

#INCLUDE "windows.inc"
#INCLUDE "regexp.inc"

FUNCTION PBMAIN

   LOCAL pRegExp AS IRegExp
   LOCAL bstrText AS WSTRING
   LOCAL bstrRetVal AS WSTRING

   ' Creates an instance of the RegExp object
   pRegExp = NEWCOM "VBScript.RegExp"
   IF ISNOTHING(pRegExp) THEN
      MSGBOX "Unable to create an instance of the RegExp object"
      EXIT FUNCTION
   END IF

   ' Set pattern
   pRegExp.Pattern = "(\S+)(\s+)(\S+)"
   ' Set case insensitivity
   pRegExp.IgnoreCase = %VARIANT_TRUE

   bstrText = "The quick brown fox jumped over the lazy dog."

   ' Make replacement
   bstrRetVal = pRegExp.Replace(bstrText, "$3$2$1")
   ? bstrRetVal

END FUNCTION


[José Roca]

 
The following code illustrates how to obtain a SubMatches collection from a regular expression search and how to access its individual members:

Code: [Select]

' The following code illustrates how to obtain a SubMatches collection from a regular
' expression search and how to access its individual members.
' Adaptation of the following example from Microsoft:
'
' Function SubMatchTest(inpStr)
'   Dim oRe, oMatch, oMatches
'   Set oRe = New RegExp
'   ' Look for an e-mail address (not a perfect RegExp)
'   oRe.Pattern = "(\w+)@(\w+)\.(\w+)"
'   ' Get the Matches collection
'   Set oMatches = oRe.Execute(inpStr)
'   ' Get the first item in the Matches collection
'   Set oMatch = oMatches(0)
'   ' Create the results string.
'   ' The Match object is the entire match - dragon@xyzzy.com
'   retStr = "Email address is: " & oMatch & vbNewline
'   ' Get the sub-matched parts of the address.
'   retStr = retStr & "Email alias is: " & oMatch.SubMatches(0)  ' dragon
'   retStr = retStr & vbNewline
'   retStr = retStr & "Organization is: " & oMatch. SubMatches(1)' xyzzy
'   SubMatchTest = retStr
' End Function

' MsgBox(SubMatchTest("Please send mail to dragon@xyzzy.com. Thanks!"))

#COMPILE EXE
#DIM ALL
%UNICODE = 1

#INCLUDE "windows.inc"
#INCLUDE "regexp.inc"

FUNCTION PBMAIN

   LOCAL pRegExp AS IRegExp
   LOCAL pMatches AS IMatchCollection
   LOCAL pMatch AS IMatch2
   LOCAL pSubMatches AS ISubMatches
   LOCAL nCount AS LONG
   LOCAL bstrValue AS WSTRING
   LOCAL vValue AS VARIANT

   ' Creates an instance of the RegExp object
   pRegExp = NEWCOM "VBScript.RegExp"
   IF ISNOTHING(pRegExp) THEN
      MSGBOX "Unable to create an instance of the RegExp object"
      EXIT FUNCTION
   END IF

   ' Look for an e-mail address (not a perfect RegExp)
   pRegExp.Pattern = "(\w+)@(\w+)\.(\w+)"

   ' Get the Matches collection
   pMatches = pRegExp.Execute("Please send mail to dragon@xyzzy.com. Thanks!")
   IF ISNOTHING(pMatches) THEN
      MSGBOX "No match found"
      EXIT FUNCTION
   END IF

   nCount = pMatches.Count
   IF nCount = 0 THEN
      MSGBOX "No match found"
      EXIT FUNCTION
   END IF

   ' Get the first item in the Matches collection
   pMatch = pMatches.Item(0)

   ' Create the results string.
   ' The Match object is the entire match - dragon@xyzzy.com
   bstrValue = "Email address is: " & pMatch.Value & $CRLF

   ' Get the SubMatches collection
   pSubMatches = pMatch.SubMatches
   IF ISTRUE ISOBJECT(pSubMatches) THEN
      ' Get the sub-matched parts of the address.
      vValue = pSubMatches.Item(0)
      bstrValue += "Email alias is: " & VARIANT$$(vValue) & $CRLF  ' dragon
      vValue = pSubMatches.Item(1)
      bstrValue += "Organization is: " & VARIANT$$(vValue) & $CRLF  ' xyzzy
   END IF

   ? bstrValue

END FUNCTION


[José Roca]

 
The following code illustrates the use of the Test method.

Code: [Select]

' The following code illustrates the use of the Test method.

#COMPILE EXE
#DIM ALL
%UNICODE = 1

#INCLUDE "windows.inc"
#INCLUDE "regexp.inc"

FUNCTION PBMAIN

   LOCAL pRegExp AS IRegExp

   ' Creates an instance of the RegExp object
   pRegExp = NEWCOM "VBScript.RegExp"
   IF ISNOTHING(pRegExp) THEN
      MSGBOX "Unable to create an instance of the RegExp object"
      EXIT FUNCTION
   END IF

   ' Set pattern
   pRegExp.Pattern = "is."
   ' Set case insensitivity
   pRegExp.IgnoreCase = %VARIANT_TRUE

   ' Execute search
   IF ISTRUE pRegExp.Test("IS1 is2 IS3 is4") THEN
      ? "One or more matches were found"
   ELSE
      ? "No match was found"
   END IF

END FUNCTION


[José Roca]

 

Code: [Select]

' ========================================================================================
' Global, multiline in string function with VBScript regular expressions search patterns.
' Parameters:
' - bstrText = The text to be parsed.
' - bstrPattern = The pattern to match.
' - bIgnoreCase = Ignore case.
' Return Value:
' - Returns a list of comma separated "index, length" value pairs. The pairs are separated
'   by a semicolon.
' Usage Example:
'   LOCAL bstrText AS WSTRING
'   LOCAL bstrPattern AS WSTRING
'   LOCAL bstrOut AS WSTRING
'   bstrText = "blah blah a234 blah blah x345 blah blah"
'   bstrPattern = "[A-Z][0-9][0-9][0-9]"
'   bstrOut = AfxRegExpInStr(bstrText, bstrPattern, %TRUE)
' ========================================================================================
FUNCTION AfxRegExpInStr (BYVAL bstrText AS WSTRING, BYVAL bstrPattern AS WSTRING, OPTIONAL BYVAL bIgnoreCase AS LONG) AS WSTRING

   LOCAL i AS LONG
   LOCAL nCount AS LONG
   LOCAL idx AS LONG
   LOCAL nLen AS LONG
   LOCAL pRegExp AS IRegExp2
   LOCAL pMatch AS IMatch
   LOCAL pMatches AS IMatchCollection
   LOCAL pDisp AS IDispatch
   LOCAL bstrOut AS WSTRING

   pRegExp = NEWCOM "VBScript.RegExp"
   IF ISNOTHING(pRegExp) THEN EXIT FUNCTION

   pRegExp.Pattern = bstrPattern
   pRegExp.Global = -1
   pRegExp.IgnoreCase = (bIgnoreCase <> 0)
   pRegExp.Multiline = -1
   pMatches = pRegExp.Execute(bstrText)
   nCount = pMatches.Count
   IF nCount = 0 THEN EXIT FUNCTION
   FOR i = 0 TO nCount - 1
      pDisp = pMatches.Item(i)
      pMatch = pDisp
      idx = pMatch.FirstIndex
      nLen = pMatch.Length
      bstrOut += FORMAT$(idx + 1) & "," & FORMAT$(nLen) & ";"
   NEXT
   FUNCTION = LEFT$(bstrOut, LEN(bstrOut) - 1)

END FUNCTION
' ========================================================================================

Example:

Code: [Select]

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"
#INCLUDE ONCE "AfxWin.inc"

FUNCTION PBMAIN

   LOCAL bstrText AS WSTRING
   LOCAL bstrPattern AS WSTRING
   LOCAL bstrOut AS WSTRING

   bstrText = "blah blah a234 blah blah x345 blah blah"
   bstrPattern = "[A-Z][0-9][0-9][0-9]"

   bstrOut = AfxRegExpInstr(bstrText, bstrPattern, %TRUE)
   ? bstrOut

END FUNCTION