Platforms to show: All Mac Windows Linux Cross-Platform
/Tools/RegEx/RegEx Speed Test
Function:
Required plugins for this example: MBS Tools Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Tools/RegEx/RegEx Speed Test
This example is the version from Thu, 7th Oct 2015.
Function:
Required plugins for this example: MBS Tools Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Tools/RegEx/RegEx Speed Test
This example is the version from Thu, 7th Oct 2015.
Project "RegEx Speed Test.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
End Class
Class Window1 Inherits Window
Const kMarker = "\rEND:VCARD\r"
Const kMarkerPattern = "(?U-i)^END:VCARD\R"
Control btnMakeString Inherits PushButton
ControlInstance btnMakeString Inherits PushButton
EventHandler Sub Action()
dim size as integer = fldTargetSize.Text.Val * 1024 * 1024
dim occurrences as integer = fldOccurrences.Text.Val
if size < 1 or occurrences < 1 or ( kMarker.LenB * occurrences ) > size then
AddToResult "The entered numbers are not valid."
return
end if
dim diff as integer = size - ( kMarker.LenB * occurrences )
dim diffPerOccurrence as integer = diff \ occurrences
dim s as string = "0123456789 abcdefghijklmnopqrstuvwxyz" + EndOfLine
while s.LenB < diffPerOccurrence
s = s + s
wend
s = s.LeftB( diffPerOccurrence ) + kMarker
dim targetSize as integer = s.LenB * occurrences
while s.LenB < targetSize
s = s + s
wend
s = s.LeftB( targetSize )
TestString = s
AddToResult "String Created: " + format( s.LenB, "#," ) + " bytes"
End EventHandler
End Control
Control fldResult Inherits TextArea
ControlInstance fldResult Inherits TextArea
End Control
Control btnRegExMBS Inherits PushButton
ControlInstance btnRegExMBS Inherits PushButton
EventHandler Sub Action()
dim msg as string
dim startTime, diffTime as double
if TestString = "" then
AddToResult "Create the string first."
return
end if
AddToResult "RegExMBS"
'AddToResult "String Length: " + format( TestString.LenB, "#," )
'AddToResult "Marker: " + kMarker
startTime = microseconds
dim rx as new RegExMBS
rx.CompileOptionCaseLess = True
rx.CompileOptionDotAll = False
rx.CompileOptionUngreedy = False
rx.CompileOptionNewLineAnyCRLF = True
rx.ExecuteOptionNotEmpty = False
rx.CompileOptionMultiline = True
rx.CompileOptionNoUTF8Check = true
rx.CompileOptionUTF8 = true
if not rx.Compile( kMarkerPattern ) then
AddToResult "Could not compile the pattern."
AddToResult rx.ErrorMessage
return
end if
if not rx.Study then
AddToResult "Study not successful."
return
end if
dim foundCount as integer
dim offset as integer = rx.Execute( TestString, 0 )
while offset > 0
foundCount = foundCount + 1
offset = rx.Execute( rx.Offset( 1 ) + 1 )
wend
diffTime = microseconds - startTime
msg = format( diffTime, "#," ) + " microsecs"
AddToResult msg
msg = format( foundCount, "#," ) + " found"
AddToResult msg
End EventHandler
End Control
Control fldOccurrences Inherits TextField
ControlInstance fldOccurrences Inherits TextField
End Control
Control Label1 Inherits Label
ControlInstance Label1(0) Inherits Label
ControlInstance Label1(1) Inherits Label
ControlInstance Label1(2) Inherits Label
ControlInstance Label1(3) Inherits Label
End Control
Control fldTargetSize Inherits TextField
ControlInstance fldTargetSize Inherits TextField
End Control
Control btnRegEx Inherits PushButton
ControlInstance btnRegEx Inherits PushButton
EventHandler Sub Action()
dim msg as string
dim startTime, diffTime as double
if TestString = "" then
AddToResult "Create the string first."
return
end if
AddToResult "RegEx"
'AddToResult "String Length: " + format( TestString.LenB, "#," )
'AddToResult "Marker: " + kMarker
startTime = microseconds
dim rx as new RegEx
rx.Options.CaseSensitive = False
rx.Options.DotMatchAll = False
rx.Options.Greedy = True
rx.Options.LineEndType = 0
rx.Options.MatchEmpty = true
rx.Options.TreatTargetAsOneLine = false
rx.SearchPattern = kMarkerPattern
dim foundCount as integer
dim match as RegExMatch = rx.Search( TestString )
while match <> nil
foundCount = foundCount + 1
match = rx.Search
wend
diffTime = microseconds - startTime
msg = format( diffTime, "#," ) + " microsecs"
AddToResult msg
msg = format( foundCount, "#," ) + " found"
AddToResult msg
End EventHandler
End Control
Control btnRegExGlue Inherits PushButton
ControlInstance btnRegExGlue Inherits PushButton
EventHandler Sub Action()
dim msg as string
dim startTime, diffTime as double
if TestString = "" then
AddToResult "Create the string first."
return
end if
AddToResult "RegEx"
'AddToResult "String Length: " + format( TestString.LenB, "#," )
'AddToResult "Marker: " + kMarker
startTime = microseconds
dim rx as new RegExMBSGlue_MTC
rx.Options.CaseSensitive = False
rx.Options.DotMatchAll = False
rx.Options.Greedy = True
rx.Options.LineEndType = 0
rx.Options.MatchEmpty = true
rx.Options.TreatTargetAsOneLine = false
rx.SearchPattern = kMarkerPattern
dim foundCount as integer
dim match as RegExMBSMatch_MTC = rx.Search( TestString )
while match <> nil
foundCount = foundCount + 1
match = rx.Search
wend
diffTime = microseconds - startTime
msg = format( diffTime, "#," ) + " microsecs"
AddToResult msg
msg = format( foundCount, "#," ) + " found"
AddToResult msg
End EventHandler
End Control
Sub AddToResult(msg As String)
fldResult.AppendText msg
fldResult.AppendText EndOfLine
End Sub
Property TestString As String
End Class
MenuBar MenuBar1
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "Select &All"
End MenuBar
Class RegExMBSGlue_MTC Inherits RegExMBS
ComputedProperty Options As RegExOptions
Sub Set()
if value = nil then
pSetDefaultOptions
else
zOptions = value
// When search is called, if the options are different, will recompile
end if
End Set
Sub Get()
if zOptions = nil then
pSetDefaultOptions
end if
return zOptions
End Get
End ComputedProperty
ComputedProperty ReplacementPattern As String
Sub Set()
zReplacementPattern = value.ConvertEncoding( Encodings.UTF8 )
End Set
Sub Get()
return zReplacementPattern
End Get
End ComputedProperty
ComputedProperty SearchPattern As String
Sub Set()
value = value.ConvertEncoding( Encodings.UTF8 )
if StrComp( value, zSearchPattern, 0 ) <> 0 then
zSearchPattern = value
zNeedsCompile = true
end if
End Set
Sub Get()
return zSearchPattern
End Get
End ComputedProperty
ComputedProperty SearchStartPosition As Integer
Sub Set()
if value < 0 then value = 0
zSearchStartPosition = value
End Set
Sub Get()
return zSearchStartPosition
End Get
End ComputedProperty
Function Replace() As String
return me.Replace( zTargetString, SearchStartPosition )
End Function
Function Replace(targetString As String) As String
return me.Replace( targetString, SearchStartPosition )
End Function
Function Replace(targetString As String, startPosition As Integer = 0) As String
dim r as string
if startPosition < 0 then startPosition = 0
pDoCompile()
if zNeedsCompile then return ""
if Options.ReplaceAllMatches then
r = me.ReplaceAll( targetString, ReplacementPattern )
if me.Lasterror <> 0 then
r = ""
pRaiseRegExSearchPatternException( me.ErrorMessage, me.Lasterror )
end if
else
dim offset as integer = me.Execute( targetString, startPosition )
if offset = 0 then
r = targetString
else
r = super.Replace( ReplacementPattern )
if me.Lasterror <> 0 then
r = ""
pRaiseRegExSearchPatternException( me.ErrorMessage, me.Lasterror )
end if
end if
SearchStartPosition = startPosition
end if
return r
End Function
Function Search() As RegExMBSMatch_MTC
return me.Search( zTargetString, SearchStartPosition )
End Function
Function Search(startPosition As Integer) As RegExMBSMatch_MTC
return me.Search( zTargetString, startPosition )
End Function
Function Search(targetString As String, startPosition As Integer = 0) As RegExMBSMatch_MTC
if startPosition < 0 then startPosition = 0
pDoCompile()
if zNeedsCompile then return nil
zTargetString = targetString
SearchStartPosition = startPosition
dim err as integer = me.Execute( targetString, startPosition )
if err < 0 then
pRaiseRegExSearchPatternException( me.ErrorMessage, err )
return nil
elseif err = 0 then
return nil
else
SearchStartPosition = me.Offset( 1 ) + 1
return new RegExMBSMatch_MTC( me )
end if
End Function
Private Sub pCompareOptionsToMyOptions()
// Compares zOptions and, if they are different, sets zNeedsCompile to true
if zNeedsCompile then return // Already needs to be compiled
if zOptions is nil then
pSetDefaultOptions
else
zNeedsCompile = true // Assume this
// This gets a little confusing since some of the RegExMBS options are opposite of the RegExOptions.
// For example, if me.CompileOptionUngreedy = RegExOptions.Greedy, they are actually different.
select case true
case zOptions.CaseSensitive = me.CompileOptionCaseLess
case zOptions.DotMatchAll <> me.CompileOptionDotAll
case zOptions.Greedy = me.CompileOptionUngreedy
case zOptions.MatchEmpty = me.ExecuteOptionNotEmpty
case zOptions.TreatTargetAsOneLine = me.CompileOptionMultiline
else
zNeedsCompile = false
end select // true
end if // zOptions is nil
End Sub
Private Sub pDoCompile()
pCompareOptionsToMyOptions()
if zNeedsCompile then
pSetMyOptionsFromRegExOptions()
if not me.Compile( searchPattern ) or not me.Study() then
pRaiseRegExSearchPatternException( me.ErrorMessage, me.Lasterror )
return
end if
zNeedsCompile = false
end if
End Sub
Private Sub pRaiseRegExSearchPatternException(msg As String, code As Integer = 0)
dim err as new RegExSearchPatternException
err.Message = msg
err.ErrorNumber = code
raise err
End Sub
Private Sub pSetDefaultOptions()
dim rx as new RegEx
zOptions = rx.Options
zNeedsCompile = true
End Sub
Private Sub pSetMyOptionsFromRegExOptions()
if zOptions is nil then pSetDefaultOptions
me.CompileOptionAnchored = false
me.CompileOptionBSRUnicode = true
me.CompileOptionCaseLess = not zOptions.CaseSensitive
me.CompileOptionDotAll = zOptions.DotMatchAll
me.CompileOptionMultiline = not zOptions.TreatTargetAsOneLine
me.CompileOptionUngreedy = not zOptions.Greedy
me.ExecuteOptionNotEmpty = not zOptions.MatchEmpty
// No equivalents for StringBeginIsLineBegin and StringEndIsLineEnd
dim lineEndType as integer = zOptions.LineEndType
if lineEndType = 1 then // Default for platform
dim eol as string = EndOfLine
if eol = EndOfLine.Windows then
lineEndType = 3
elseif eol = EndOfLine.Macintosh then
lineEndType = 2
else // Unix
lineEndType = 4
end if
end if
select case lineEndType
case 0
me.CompileOptionNewLineAnyCRLF = true
case 2
me.CompileOptionNewLineCR = true
case 3
me.CompileOptionNewLineCRLF = true
case 4
me.CompileOptionNewLineLF = true
end select
// Some additional stuff
me.CompileOptionUTF8 = true
me.CompileOptionNoUTF8Check = true
End Sub
Property Private zNeedsCompile As Boolean = True
Property Private zOptions As RegExOptions
Property Private zReplacementPattern As String
Property Private zSearchPattern As String
Property Private zSearchStartPosition As Integer
Property Private zTargetString As String
End Class
Class RegExMBSMatch_MTC
Sub Constructor(rx As RegExMBS)
zMyRegExMBS = rx
zSubExpressionCount = rx.Count
dim lastIndex as integer = zSubExpressionCount - 1
redim zSubExpressionStartB( lastIndex )
redim zSubExpressionEndB( lastIndex )
redim zSubExpressionString( lastIndex )
dim offsetIndex as integer
for i as integer = 0 to lastIndex
zSubExpressionStartB( i ) = rx.Offset( offsetIndex )
zSubExpressionEndB( i ) = rx.Offset( offsetIndex + 1 )
zSubExpressionString( i ) = rx.Substring( i )
offSetIndex = offSetIndex + 2
next
if rx IsA RegExMBSGlue_MTC then
zReplacementPattern = RegExMBSGlue_MTC( rx ).ReplacementPattern
end if
End Sub
Function Replace() As String
// See comments in other Replace.
// This is a different call because it expects the Replacement Pattern to be take from the parent
// RegExMBSGlue_MTC object.
if zMyRegExMBS is nil or not ( zMyRegExMBS isA RegExMBSGlue_MTC ) then
pRaiseRegExException( "The replacement pattern must be specified." )
end if
return me.Replace( zReplacementPattern )
End Function
Function Replace(replacementPattern As String) As String
// Not a perfect substitute because it must be used before the next execute, the results will be arbitrary.
dim rx as RegExMBS = zMyRegExMBS
if rx is nil then
pRaiseNilObjectException( "The parent RegExMBS object no longer exists." )
end if
if rx.Count <> zSubExpressionCount or _
rx.Offset( 0 ) <> zSubExpressionStartB( 0 ) or _
StrComp( rx.Substring( 0 ), zSubExpressionString( 0 ), 0 ) <> 0 then
pRaiseRegExException( "Replace must be used before Execute is called again in the parent RegExMBS." )
end if
dim r as string = rx.ReplaceSelection( replacementPattern )
return r
End Function
Function SubExpressionCount() As Integer
return zSubExpressionCount
End Function
Function SubExpressionEndB(index As Integer) As Integer
return zSubExpressionEndB( index )
End Function
Function SubExpressionStartB(index As Integer) As Integer
return zSubExpressionStartB( index )
End Function
Function SubExpressionString(index As Integer) As String
return zSubExpressionString( index )
End Function
Private Sub pRaiseNilObjectException(msg As String, code As Integer = 0)
dim err as new NilObjectException
err.ErrorNumber = code
err.Message = msg
raise err
End Sub
Private Sub pRaiseRegExException(msg As String, code As Integer = 0)
dim err as new RegExException
err.ErrorNumber = code
err.Message = msg
raise err
End Sub
Property Private zMyRegExMBS As RegExMBS
Property Private zReplacementPattern As String
Property Private zSubExpressionCount As Integer
Property Private zSubExpressionEndB() As Integer
Property Private zSubExpressionStartB() As Integer
Property Private zSubExpressionString() As String
End Class
End Project
See also:
The items on this page are in the following plugins: MBS Tools Plugin.
Feedback: Report problem or ask question.