diff options
author | Jean-Pierre Ledure <jp@ledure.be> | 2016-12-01 16:10:54 +0100 |
---|---|---|
committer | Jean-Pierre Ledure <jp@ledure.be> | 2017-01-12 11:40:49 +0100 |
commit | 047d1ed3df0d5714574ebc8e278cca11f96d490b (patch) | |
tree | f99fe7f46d79d5bdfd39742e45c163aade2a7dee /wizards | |
parent | 62e508c2a78ac4a9cabe0d9bb878f0f7bd487f88 (diff) |
Access2Base - Implement regex search
Based on XTextSearch UNO service
_CStr also refined
Change-Id: Ibeceeeb549511e575c6842e43e5a76c8308db1aa
Diffstat (limited to 'wizards')
-rw-r--r-- | wizards/source/access2base/Root_.xba | 2 | ||||
-rw-r--r-- | wizards/source/access2base/Utils.xba | 104 |
2 files changed, 103 insertions, 3 deletions
diff --git a/wizards/source/access2base/Root_.xba b/wizards/source/access2base/Root_.xba index 3aceacddcc87..42475c927d70 100644 --- a/wizards/source/access2base/Root_.xba +++ b/wizards/source/access2base/Root_.xba @@ -29,6 +29,7 @@ Private DebugPrintShort As Boolean Private Introspection As Object ' com.sun.star.beans.Introspection Private VersionNumber As String ' Actual Access2Base version number Private Locale As String +Private TextSearch As Object Private FindRecord As Object Private StatusBar As Object Private Dialogs As Object ' Collection @@ -51,6 +52,7 @@ Dim vCurrentDoc() As Variant DebugPrintShort = True Locale = L10N._GetLocale() Set Introspection = CreateUnoService("com.sun.star.beans.Introspection") + Set TextSearch = CreateUnoService("com.sun.star.util.TextSearch") Set FindRecord = Nothing Set StatusBar = Nothing Set Dialogs = New Collection diff --git a/wizards/source/access2base/Utils.xba b/wizards/source/access2base/Utils.xba index 8514d95feae5..583348b096a8 100644 --- a/wizards/source/access2base/Utils.xba +++ b/wizards/source/access2base/Utils.xba @@ -127,7 +127,7 @@ End Function ' CheckArgument V0.9.0 REM ----------------------------------------------------------------------------------------------------------------------- Public Function _CStr(ByVal pvArg As Variant, ByVal Optional pbShort As Boolean) As String ' Convert pvArg into a readable string (truncated if too long and pbShort = True or missing) -' pvArg may be a byte-array. Other arrays are rejected +' pvArg may be a byte-array. Other arrays are processed recursively into a semicolon separated string Dim sArg As String, sObject As String, oArg As Object, sLength As String, i As Long, iMax As Long Const cstLength = 50 @@ -174,9 +174,17 @@ Const cstByteLength = 25 End If Case vbVariant : sArg = "[VARIANT]" Case vbString - ' Replace CR + LF by \n + ' Replace CR + LF by \n and HT by \t ' Replace semicolon by \; to allow semicolon separated rows - sArg = Replace(Replace(Replace(pvArg, Chr(13), ""), Chr(10), "\n"), ";", "\;") + sArg = Replace( _ + Replace( _ + Replace( _ + Replace( _ + Replace(pvArg, "\", "\\") _ + , Chr(13), "") _ + , Chr(10), "\n") _ + , Chr(9), "\t") _ + , ";", "\;") Case vbBoolean : sArg = Iif(pvArg, "[TRUE]", "[FALSE]") Case vbByte : sArg = Right("00" & Hex(pvArg), 2) Case vbSingle, vbDouble, vbCurrency @@ -197,6 +205,61 @@ Const cstByteLength = 25 End Function ' CStr V0.9.5 REM ----------------------------------------------------------------------------------------------------------------------- +Public Function _CVar(ByRef psArg As String) As Variant +' psArg is presumed an output of _CStr (stored in the mean time in a text file f.i.) +' _CVar returns the corresponding original variant variable or Null/Nothing if not possible +' Return values may of types Array, Long, Double, Date, Boolean, String, Null or Empty + +Dim cstEscape1 As String, cstEscape2 As String, vEMPTY As Variant + cstEscape1 = Chr(14) ' Form feed used as temporary escape character for \\ + cstEscape2 = Chr(27) ' ESC used as temporary escape character for \; + + _CVar = "" + If Len(psArg) = 0 Then Exit Function + +Dim sArg As String, vArgs() As Variant, vVars() As Variant, i As Integer + sArg = Replace( _ + Replace( _ + Replace( _ + Replace(psArg, "\\", cstEscape1) _ + , "\;", cstEscape2) _ + , "\n", Chr(10)) _ + , "\t", Chr(9)) + + ' Semicolon separated string + vArgs = Split(sArg, ";") + If UBound(vArgs) > LBound(vArgs) Then ' Process each item recursively + vVars = Array() + Redim vVars(LBound(vArgs) To UBound(vArgs)) + For i = LBound(vVars) To UBound(vVars) + vVars(i) = _CVar(vArgs(i)) + Next i + _CVar = vVars + Exit Function + End If + + ' Usual case + Select Case True + Case sArg = "[EMPTY]" : _CVar = vEMPTY + Case sArg = "[NULL]" Or sArg = "[VARIANT]" : _CVar = Null + Case sArg = "[OBJECT]" : _CVar = Nothing + Case sArg = "[TRUE]" : _CVar = True + Case sArg = "[FALSE]" : _CVar = False + Case IsDate(sArg) : _CVar = CDate(sArg) + Case IsNumeric(sArg) + If InStr(sArg, ".") > 0 Then + _CVar = Val(sArg) + Else + _CVar = CLng(Val(sArg)) ' Val always returns a double + End If + Case _RegexSearch(sArg, "^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$" <> "" + _CVar = Val(sArg) ' Scientific notation + Case Else : _CVar = Replace(Replace(sArg, cstEscape1, "\"), cstEscape2, ";") + End Select + +End Function ' CVar V1.7.0 + +REM ----------------------------------------------------------------------------------------------------------------------- Public Function _DecimalPoint() As String 'Return locale decimal point _DecimalPoint = Mid(Format(0, "0.0"), 2, 1) @@ -847,6 +910,41 @@ Error_Function: End Function ' _ReadFileIntoArray V1.4.0 REM ----------------------------------------------------------------------------------------------------------------------- +Function _RegexSearch(ByRef psString As String _ + , ByVal psRegex As String _ + , Optional ByRef plStart As Long _ + ) As String +' Return "" if regex not found, otherwise returns the matching string +' plStart = start position of psString to search (starts at 1) +' In output plStart contains the first position of the matching string +' To search again the same or another pattern => plStart = plStart + Len(matching string) + +Dim oTextSearch As Object +Dim vOptions As New com.sun.star.util.SearchOptions, vResult As Object +Dim lEnd As Long + + _RegexSearch = "" + Set oTextSearch = _A2B_.TextSearch ' UNO XTextSearch service + With vOptions + .algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP + .searchFlag = 0 + .searchString = psRegex ' Pattern to be searched + End With + oTextSearch.setOptions(vOptions) + If IsMissing(plStart) Then plStart = 1 + lEnd = Len(psString) + vResult = oTextSearch.searchForward(psString, plStart - 1, lEnd) + With vResult + If .subRegExpressions >= 1 Then + plStart = .startOffset(0) + 1 + lEnd = .endOffset(0) + 1 + _RegexSearch = Mid(psString, plStart, lEnd - plStart) + End If + End With + +End Function + +REM ----------------------------------------------------------------------------------------------------------------------- Function _RegisterEventScript(poObject As Object _ , ByVal psEvent As String _ , ByVal psListener As String _ |