Attribute VB_Name = "cast_cRegExp"
'-------------------------------------------------------------------------------
'File         : cast_cRegExp.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba
'Environment  : VBA 2010 +
'Version      : 2.1.0
'Name         : cRegExp
'Author       : Stefan Erb (ERS)
'History      : 19.06.2014 - ERS - Creation cls_regExp
'               04.09.2014 - ERS - Pattern mit Modifiers ergänzt. Umbennent zu cast_cregexp
'               31.10.2014 - ERS - Cache auf Static geändert
'               01.12.2014 - ERS - cRx hinzugefügt
'-------------------------------------------------------------------------------
Option Explicit

' /**
' * Wird für die regExp Funktionen verwendet
' * Setzte die Flags für das RegExp Object
' */
Public Enum rxpFlagsEnum
    rxpnone = 2 ^ 0          'Value 1
    rxpGlobal = 2 ^ 1        'Value 2   Modifier g Global
    rxpIgnorCase = 2 ^ 2     'Value 4   Modifier i IgnoreCase
    rxpMultiline = 2 ^ 3     'Value 8   Modifier m multiLine
End Enum

'/**
' * Erstellt ein RegExp-Object mit den Grundeinstellungen

' * @param  String          Pattern analog RegExp oder mit Delimiter und Modifier analog zu PHP
' * @param  rxpFlagsEnum    Eigenschaften von Regexp. Global, IgnoreCase und Multiline.
' *                         Die Eigenschaften können mit + kombiniert werden
' * @return RegExp
' */
Public Function cRegExp( _
        ByVal iPattern As String, _
        Optional ByVal iFlag As rxpFlagsEnum = rxNone _
) As Object
    Static rxPattern As Object
    If rxPattern Is Nothing Then
        Set rxPattern = CreateObject("VBScript.RegExp")
        rxPattern.pattern = "^([@&!/~#=\|])?(.*)\1(?:([Ii])|([Gg])|([Mm]))*$"
    End If
    Set cRegExp = CreateObject("VBScript.RegExp")
    If rxPattern.Test(iPattern) Then
        Dim sm As Object: Set sm = rxPattern.Execute(iPattern)(0).subMatches
        cRegExp.pattern = sm(1)
        cRegExp.IgnoreCase = Not isEmpty(sm(2))
        cRegExp.Global = Not isEmpty(sm(3))
        cRegExp.Multiline = Not isEmpty(sm(4))
    Else
        cRegExp.pattern = iPattern
        cRegExp.Global = iFlag And rxpGlobal
        cRegExp.IgnoreCase = iFlag And rxpIgnorCase
        cRegExp.Multiline = iFlag And rxpMultiline
    End If
End Function

'------------------------------------------------------
' Kurzversion um in andere Funktionen einzubinden
'------------------------------------------------------
' Die folgende Version cRx() verwende ich als Library in anderen Funktion.
' Sie entspricht der Version mit den Modifier im String.

'/**
' * Dies ist die Minimalversion von cRegExp
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#abgespeckte_version
' * mögliche Delemiter: @&!/~#=\|
' * mögliche Modifiers: g (Global), i (IgnoreCode, m (Mulitline)
' *
' * @example    myRx = cRx("/([a]{2,})/i") 'Finde alle folgen von a. Flag:IgnoreCase
' * @version    2.1.0 (01.12.2014)
' * @param      String      Pattern mit Delimiter und Modifier analog zu PHP
' * @return     Object      RegExp-Object
' */
Private Function cRx(ByVal iPattern As String) As Object
    Static rxP As Object:       Set cRx = CreateObject("VBScript.RegExp")
    If rxP Is Nothing Then:     Set rxP = CreateObject("VBScript.RegExp"): rxP.pattern = "^([@&!/~#=\|])?(.*)\1(?:([Ii])|([Gg])|([Mm]))*$"
    Dim sm As Object:           Set sm = rxP.Execute(iPattern)(0).subMatches
    cRx.pattern = sm(1):        cRx.IgnoreCase = Not isEmpty(sm(2)):       cRx.Global = Not isEmpty(sm(3)):     cRx.Multiline = Not isEmpty(sm(4))
End Function