This is an old revision of the document!
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
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
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
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
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