Prüft ob ein Value auf ein Pattern passt. Die RegExp-Objekte werden gecached. Interessant für SQL

Download lib_rxlib.bas (V-1.0.0)

Manchmalwäre es ganz praktisch in SQL mit Regulären Ausdrücken arbeiten zu können. Dazu habe ich eine Funktionssammlung erstellt, die es mit erlaubt genau dies zu tun. Die RegExp-Objekte werden dabei als statische Objekte gespeichert, damit nicht für jede Zeile ein neues Objekt angelegt werden muss. Es können in einem SL mehrere verschiedene Patterns verwendet werden. Diese kann man mit einem Index ansteuern, damit jeder für sich gespeichert wird.

Boolean = rxMatch(value [,pattern])

Public Function rxMatch( _
        ByVal iValue As Variant, _
        Optional ByVal iPattern As String = Empty _
) As Boolean

• iValue Wert, der geprüft werden soll
• iPattern Reg-Exp-Pattern gemäss cRx(): cRegExp() Beispiele mit Patterns inkl. den Parametern

SELECT t.*
FROM myTable t
WHERE rxMatch(t.username, '/^ruedi$/i');
 
ID | USERNAME
---|---------
7  | Ruedi  
 
 
SELECT t.*
FROM myTable t
WHERE rxMatch(t.username, '/ruedi/i');
 
ID | USERNAME  
---|-----------
4  | Hansruedi 
5  | Hans-Ruedi
7  | Ruedi  
 
 
SELECT t.*,
	rxMatch(t.username, '/ruedi/i') AS like_ruedi,
	rxMatch(t.username, '/ueli/i') AS like_ueli,
	rxMatch(t.username, '/hans/i') AS like_hans,
	rxMatch(t.username, '/hans-?(ueli|peter)/i') AS test4
FROM myTable t;
 
ID | USERNAME   | like_ruedi | like_ueli | like_hans | test4
---|------------|------------|-----------|-----------|------
1  | Hans       | 0          | 0         | -1        | 0    
2  | Hans-Ueli  | 0          | -1        | -1        | -1   
3  | Hansueli   | 0          | -1        | -1        | -1   
4  | Hansruedi  | -1         | 0         | -1        | 0    
5  | Hans-Ruedi | -1         | 0         | -1        | 0    
6  | Ueli       | 0          | -1        | 0         | 0    
7  | Ruedi      | -1         | 0         | 0         | 0    
8  | Peter      | 0          | 0         | 0         | 0    
9  | Hanspeter  | 0          | 0         | -1        | -1   
10 | Hans-Peter | 0          | 0         | -1        | -1   

Result = rxLookup(value [,pattern [,iPosition]])

Public Function rxLookup( _
        ByVal iValue As Variant, _
        Optional ByVal iPattern As String = Empty, _
        Optional ByVal iPosition As Long = 0 _
) As String

• iValue Wert, der geprüft werden soll
• iPattern Reg-Exp-Pattern gemäss cRx(): cRegExp() Beispiele mit Patterns inkl. den Parametern
• iPosition Index des SubMatches des ersten Treffers: rxObject.execute(iPattern)(0).SubMatches(iPosition). Bei -1 wird der geammte Treffer ausgegeben

SELECT t.username, rxLookup(t.username, '/(ruedi)/i', -1) AS Ruedi
FROM myTable t
WHERE rxMatch(t.username, '/(ruedi)/i');
 
username   | Ruedi
-----------|------
Hansruedi  | ruedi
Hans-Ruedi | Ruedi
Ruedi      | Ruedi

Result = rxReplace(value [,pattern [,iPosition]])

Public Function rxReplace( _
        ByVal iValue As Variant, _
        Optional ByVal iPattern As String = Empty, _
        Optional ByVal iReplace As String = Empty _
) As String

• iValue Wert, der geprüft werden soll
• iPattern Reg-Exp-Pattern gemäss cRx(): cRegExp() Beispiele mit Patterns inkl. den Parametern
• iReplace Replace-Value geäss RegExp

SELECT t.username, rxReplace(t.username, '/(hans)([-\s]?)ruedi/i', '$1$2Peter') AS Ruedi
FROM myTable t
WHERE rxMatch(t.username, '/(ruedi)/i');
 
username   | Ruedi     
-----------|-----------
Hansruedi  | HansPeter 
Hans-Ruedi | Hans-Peter
Ruedi      | Ruedi

lib_rxlib.bas

Attribute VB_Name = "lib_rxLib"
'-------------------------------------------------------------------------------
'File         : lib_rxLib.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/rxlib
'Environment  : VBA 2010 +
'Version      : 1.0.0
'Name         : lib_rxLib
'Author       : Stefan Erb (ERS)
'History      : 03.10.2016 - ERS - Creation udf_rxMatch
'-------------------------------------------------------------------------------
Option Explicit
 
' Eine Sammlung von RegExp-Funktionen um innerhalb eines SQL-Statements verwendet zu werden.
' Es können mehrere RegExp-Objekte initialziert und gecached werden.
 
Private Const C_CACHE_TIMEOUT = 300 'Sekunden
 
'-------------------------------------------------------------------------------
' -- Public Methodes
'-------------------------------------------------------------------------------
'/**
' * Prüft ob ein Value auf eon Pattern passt. Die RegExp-Objekte werden gecached. Interessant für SQL
' * Ist geeignet für die Anwendung in SQL.
' *
' * @example            rxMatch("infa@yaslaw.info", "/@.*\.INFO$/i") = True
' *
' * @param  Variant     Wert, der geprüft werden soll
' * @param  String      Reg-Exp-Pattern gemäss cRx(): http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#beispiele_mit_patterns_inkl_den_parametern
' * @return Boolean
' */
Public Function rxMatch( _
        ByVal iValue As Variant, _
        Optional ByVal iPattern As String = Empty _
) As Boolean
On Error GoTo Err_Handler
 
    rxMatch = rxCache(iPattern).test(NZ(iValue))
    Exit Function
 
Err_Handler:
    Err.Raise Err.Number, Err.source & ".rxMatch", "rxMatch: " & Err.Description
End Function
 
'/**
' * Prüft ob ein Value auf ein Pattern passt. Die RegExp-Objekte werden gecached. Interessant für SQL.
' * Es wird nur der erste Treffer berücksichtigt
' * Ist geeignet für die Anwendung in SQL.
' *
' * @example            rxLookup("Er sagte ""Hallo 'schöne' Welt""","/(['""])([^\1]+)\1/i",1)       => Hallo 'schöne' Welt
' *                     rxLookup("Sie sagte 'Grüss dich ""altes Haus""'","/(['""])([^\1]+)\1/i",1)  => Grüss dich "altes Haus"
' *
' * @param  Variant     Wert, der geprüft werden soll
' * @param  String      Reg-Exp-Pattern gemäss cRx(): http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#beispiele_mit_patterns_inkl_den_parametern
' * @param  Long        Index des SubMatches des ersten Treffers: rxObject.execute(iPattern)(0).SubMatches(iPosition). Bei -1 wird der geammte Treffer ausgegeben
' * @return Boolean
' */
Public Function rxLookup( _
        ByVal iValue As Variant, _
        Optional ByVal iPattern As String = Empty, _
        Optional ByVal iPosition As Long = 0 _
) As String
On Error GoTo Err_Handler
 
    Dim rx As Object: Set rx = rxCache(iPattern)
    If rx.test(NZ(iValue)) Then
        If iPosition = -1 Then
            rxLookup = rx.execute(NZ(iValue))(0).value
        Else
            rxLookup = rx.execute(NZ(iValue))(0).subMatches(iPosition)
        End If
    End If
    Exit Function
 
Err_Handler:
    Err.Raise Err.Number, Err.source & ".rxLookup", "rxLookup: " & Err.Description
End Function
 
'/**
' * Wendet den Replacebefehl an
' * Ist geeignet für die Anwendung in SQL.
' *
' * @example            rxReplace("Hallo Welt", "/\s+(WELT)/i", " schöne '$1'")     => Hallo schöne 'Welt'
' *
' * @param  Variant     Wert, der geprüft werden soll
' * @param  String      Reg-Exp-Pattern gemäss cRx(): http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#beispiele_mit_patterns_inkl_den_parametern
' * @param  String      Replace-Value geäss RegExp
' * @return Boolean
' */
Public Function rxReplace( _
        ByVal iValue As Variant, _
        Optional ByVal iPattern As String = Empty, _
        Optional ByVal iReplace As String = Empty _
) As String
On Error GoTo Err_Handler
 
    rxReplace = rxCache(iPattern).Replace(NZ(iValue), iReplace)
    Exit Function
 
Err_Handler:
    Err.Raise Err.Number, Err.source & ".rxReplace", "rxReplace: " & Err.Description
End Function
 
'/**
' * leert den cache der RegExp-Objekte
' */
Public Sub rxResetCache()
    Dim dummy As Object: Set dummy = rxCache(, True)
End Sub
 
'-------------------------------------------------------------------------------
' -- Private Properties
'-------------------------------------------------------------------------------
'/**
' * Verwaltet die RegExp Objekte
' * @param  String      Reg-Exp-Pattern gemäss cRx(): http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#beispiele_mit_patterns_inkl_den_parametern
' * @param  Boolean     Den Cache zurücksetzen
' * @return RegExp
' */
Private Property Get rxCache( _
        Optional ByVal iPattern As String = Empty, _
        Optional ByVal iReset As Boolean = False _
) As Object
    Static cache As Dictionary
'    Static handler As Dictionary
On Error GoTo Err_Handler
 
    If cache Is Nothing Or iReset Then Set cache = CreateObject("scripting.Dictionary")
'    If handler Is Nothing Or iReset Then Set handler = CreateObject("scripting.Dictionary")
 
    If iPattern = Empty Then Exit Property
 
    If Not cache.exists(iPattern) Then
        cache.add iPattern, cRx(iPattern)
'        handler.add iPattern, Now
    End If
    If cache(iPattern) Is Nothing Then
        Set cache(iPattern) = cRx(iPattern)
'        handler(iPattern) = Now
    End If
    Set rxCache = cache(iPattern)
'    handler(iPattern) = Now
 
'    'Cache aufräumen
'    Dim keys() As Variant: keys = handler.keys
'    Dim key As Variant: For Each key In keys
'        If DateDiff("s", handler(key), Now) > C_CACHE_TIMEOUT Then
'            cache.remove (key)
'            handler.remove (key)
'        End If
'    Next key
    Exit Property
 
Err_Handler:
    Err.Raise Err.Number, Err.source, Err.Description
End Property
 
'-------------------------------------------------------------------------------
' -- Libraries
'-------------------------------------------------------------------------------
 
'/**
' * 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