Xojo Conferences
XDCMay2019MiamiUSA

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.
Project "RegEx Speed Test.rbp"
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:

Feedback, Comments & Corrections

The items on this page are in the following plugins: MBS Tools Plugin.




Links
MBS Xojo Plugins