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.

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 [,position]])

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') AS Ruedi
FROM myTable t
WHERE rxMatch(t.username, '/(ruedi)/i');
 
username   | Ruedi
-----------|------
Hansruedi  | ruedi
Hans-Ruedi | Ruedi
Ruedi      | Ruedi
 
SELECT t.username, 
	rxLookup(t.username, '/(ns)?([-\s]?)(ruedi)/i', -1) AS fund,
	rxLookup(t.username, '/(ns)?([-\s]?)(ruedi)/i', 0) AS treffer_0,
	rxLookup(t.username, '/(ns)?([-\s]?)(ruedi)/i', 1) AS treffer_1,
	rxLookup(t.username, '/(ns)?([-\s]?)(ruedi)/i', 2) AS treffer_2
FROM myTable t
WHERE rxMatch(t.username, '/(ns)?([-\s])?(ruedi)/i');
 
username   | fund     | treffer_0 | treffer_1 | treffer_2
-----------|----------|-----------|-----------|----------
Hansruedi  | nsruedi  | ns        |           | ruedi    
Hans-Ruedi | ns-Ruedi | ns        | -         | Ruedi    
Ruedi      | Ruedi    |           |           | Ruedi   

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

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