[Libreoffice-commits] core.git: wizards/source
Jean-Pierre Ledure (via logerrit)
logerrit at kemper.freedesktop.org
Wed Aug 26 14:11:24 UTC 2020
wizards/source/access2base/DataDef.xba | 29 ++++++++++++++++++---------
wizards/source/access2base/Database.xba | 28 +++++++++++++++++---------
wizards/source/access2base/DoCmd.xba | 4 +--
wizards/source/access2base/PropertiesGet.xba | 2 -
wizards/source/access2base/Recordset.xba | 18 +++++++++++-----
wizards/source/access2base/Trace.xba | 12 ++++++++---
wizards/source/access2base/Utils.xba | 6 +++--
wizards/source/access2base/acConstants.xba | 1
8 files changed, 68 insertions(+), 32 deletions(-)
New commits:
commit 57666b8ba70f27c7250ef32f4cb9e7660e258521
Author: Jean-Pierre Ledure <jp at ledure.be>
AuthorDate: Wed Aug 26 16:05:27 2020 +0200
Commit: Jean-Pierre Ledure <jp at ledure.be>
CommitDate: Wed Aug 26 16:05:27 2020 +0200
Access2Base - tdf#136063 Workaround Basic missing argument handling (2)
Complementary modifs where behaviour described in bug report
could happen in the same way.
Root cause IMHO is due to Basic error reported in bug#136143
Change-Id: Ib275f74a0c28995e6b05af31a1fd53b6ae069691
diff --git a/wizards/source/access2base/DataDef.xba b/wizards/source/access2base/DataDef.xba
index 338e99c550f2..214987ca1151 100644
--- a/wizards/source/access2base/DataDef.xba
+++ b/wizards/source/access2base/DataDef.xba
@@ -362,22 +362,33 @@ Dim cstThisSub As String
Utils._SetCalledSub(cstThisSub)
Const cstNull = -1
Dim lCommandType As Long, sCommand As String, oObject As Object,bPassThrough As Boolean
+Dim iType As Integer, iOptions As Integer, iLockEdit As Integer
+
Set oObject = Nothing
- If IsMissing(pvType) Then
- pvType = cstNull
+ If VarType(pvType) = vbError Then
+ iType = cstNull
+ ElseIf IsMissing(pvType) Then
+ iType = cstNull
Else
If Not Utils._CheckArgument(pvType, 1, Utils._AddNumeric(), Array(cstNull, dbOpenForwardOnly)) Then Goto Exit_Function
+ iType = pvType
End If
- If IsMissing(pvOptions) Then
- pvOptions = cstNull
+ If VarType(pvOptions) = vbError Then
+ iOptions = cstNull
+ ElseIf IsMissing(pvOptions) Then
+ iOptions = cstNull
Else
If Not Utils._CheckArgument(pvOptions, 2, Utils._AddNumeric(), Array(cstNull, dbSQLPassThrough)) Then Goto Exit_Function
+ iOptions = pvOptions
End If
- If IsMissing(pvLockEdit) Then
- pvLockEdit = cstNull
+ If VarType(pvLockEdit) = vbError Then
+ iLockEdit = cstNull
+ ElseIf IsMissing(pvLockEdit) Then
+ iLockEdit = cstNull
Else
If Not Utils._CheckArgument(pvLockEdit, 3, Utils._AddNumeric(), Array(cstNull, dbReadOnly)) Then Goto Exit_Function
+ iLockEdit = pvLockEdit
End If
Select Case _Type
@@ -387,7 +398,7 @@ Dim lCommandType As Long, sCommand As String, oObject As Object,bPassThrough As
Case OBJQUERYDEF
lCommandType = com.sun.star.sdb.CommandType.QUERY
sCommand = _Name
- If pvOptions = dbSQLPassThrough Then bPassThrough = True Else bPassThrough = Not Query.EscapeProcessing
+ If iOptions = dbSQLPassThrough Then bPassThrough = True Else bPassThrough = Not Query.EscapeProcessing
End Select
Set oObject = New Recordset
@@ -396,9 +407,9 @@ Dim lCommandType As Long, sCommand As String, oObject As Object,bPassThrough As
._Command = sCommand
._ParentName = _Name
._ParentType = _Type
- ._ForwardOnly = ( pvType = dbOpenForwardOnly )
+ ._ForwardOnly = ( iType = dbOpenForwardOnly )
._PassThrough = bPassThrough
- ._ReadOnly = ( (pvLockEdit = dbReadOnly) Or _ReadOnly )
+ ._ReadOnly = ( (iLockEdit = dbReadOnly) Or _ReadOnly )
Set ._ParentDatabase = _ParentDatabase
Set ._This = oObject
Call ._Initialize()
diff --git a/wizards/source/access2base/Database.xba b/wizards/source/access2base/Database.xba
index 2e361cecfc13..7b35585bfee7 100644
--- a/wizards/source/access2base/Database.xba
+++ b/wizards/source/access2base/Database.xba
@@ -588,25 +588,35 @@ Const cstNull = -1
Dim lCommandType As Long, sCommand As String, oObject As Object
Dim sSource As String, i As Integer, iCount As Integer
Dim sObjects() As String, bFound As Boolean, oTables As Object, oQueries As Object
+Dim iType As Integer, iOptions As Integer, iLockEdit As Integer
If _ErrorHandler() Then On Local Error Goto Error_Function
Set oObject = Nothing
If IsMissing(pvSource) Then Call _TraceArguments()
If pvSource = "" Then Call _TraceArguments()
- If IsMissing(pvType) Then
- pvType = cstNull
+ If VarType(pvType) = vbError Then
+ iType = cstNull
+ ElseIf IsMissing(pvType) Then
+ iType = cstNull
Else
If Not Utils._CheckArgument(pvType, 2, Utils._AddNumeric(), Array(cstNull, dbOpenForwardOnly)) Then Goto Exit_Function
+ iType = pvType
End If
- If IsMissing(pvOptions) Then
- pvOptions = cstNull
+ If VarType(pvOptions) = vbError Then
+ iOptions = cstNull
+ ElseIf IsMissing(pvOptions) Then
+ iOptions = cstNull
Else
If Not Utils._CheckArgument(pvOptions, 3, Utils._AddNumeric(), Array(cstNull, dbSQLPassThrough)) Then Goto Exit_Function
+ iOptions = pvOptions
End If
- If IsMissing(pvLockEdit) Then
- pvLockEdit = cstNull
+ If VarType(pvLockEdit) = vbError Then
+ iLockEdit = cstNull
+ ElseIf IsMissing(pvLockEdit) Then
+ iLockEdit = cstNull
Else
If Not Utils._CheckArgument(pvLockEdit, 4, Utils._AddNumeric(), Array(cstNull, dbReadOnly)) Then Goto Exit_Function
+ iLockEdit = pvLockEdit
End If
sSource = Split(UCase(Trim(pvSource)), " ")(0)
@@ -651,9 +661,9 @@ Dim sObjects() As String, bFound As Boolean, oTables As Object, oQueries As Obje
._Command = sCommand
._ParentName = Title
._ParentType = _Type
- ._ForwardOnly = ( pvType = dbOpenForwardOnly )
- ._PassThrough = ( pvOptions = dbSQLPassThrough )
- ._ReadOnly = ( (pvLockEdit = dbReadOnly) Or _ReadOnly )
+ ._ForwardOnly = ( iType = dbOpenForwardOnly )
+ ._PassThrough = ( iOptions = dbSQLPassThrough )
+ ._ReadOnly = ( (iLockEdit = dbReadOnly) Or _ReadOnly )
Set ._This = oObject
Set ._ParentDatabase = _This
Call ._Initialize()
diff --git a/wizards/source/access2base/DoCmd.xba b/wizards/source/access2base/DoCmd.xba
index 27b0d74be34f..089486a872fa 100644
--- a/wizards/source/access2base/DoCmd.xba
+++ b/wizards/source/access2base/DoCmd.xba
@@ -226,7 +226,7 @@ Const cstProgressMeterLimit = 100
Set oSourceDatabase = oDatabase
bSameDatabase = True
Else
- Set oSourceDatabase = Application.OpenDatabase(ConvertToUrl(pvSourceDatabase), , , True)
+ Set oSourceDatabase = Application.OpenDatabase(ConvertToUrl(pvSourceDatabase), "", "", True)
If IsNull(oSourceDatabase) Then Goto Exit_Function
End If
Else
@@ -1861,7 +1861,7 @@ Public Function SendObject(ByVal Optional pvObjectType As Variant _
If IsMissing(pvEditMessage) Then pvEditMessage = True
If Not Utils._CheckArgument(pvEditMessage, 9, vbBoolean) Then Goto Exit_Function
If IsMissing(pvTemplateFile) Then pvTemplateFile = ""
- If Not Utils._CheckArgument(pvTemplateFile,10, vbString, "") Then Goto Exit_Function
+ If Not Utils._CheckArgument(pvTemplateFile, 10, vbString, "") Then Goto Exit_Function
Dim vTo() As Variant, vCc() As Variant, vBcc() As Variant, oWindow As Object
Dim sDirectory As String, sOutputFile As String, sSuffix As String, sOutputFormat As String
diff --git a/wizards/source/access2base/PropertiesGet.xba b/wizards/source/access2base/PropertiesGet.xba
index e6d481ec68e5..59fc8db31218 100644
--- a/wizards/source/access2base/PropertiesGet.xba
+++ b/wizards/source/access2base/PropertiesGet.xba
@@ -1005,7 +1005,7 @@ Error_Function:
End Function ' _getProperty V0.9.1
REM -----------------------------------------------------------------------------------------------------------------------
-Public Function _hasProperty(ByVal psObject As String, ByVal pvPropertiesList() As Variant, ByVal pvProperty As Variant) As Boolean
+Public Function _hasProperty(ByVal psObject As String, ByVal pvPropertiesList() As Variant, Optional ByVal pvProperty As Variant) As Boolean
' Return True if object has a valid property called pvProperty (case-insensitive comparison !)
' Generic hasProperty function called from all class modules
diff --git a/wizards/source/access2base/Recordset.xba b/wizards/source/access2base/Recordset.xba
index 094bba000d7b..8260a900eef2 100644
--- a/wizards/source/access2base/Recordset.xba
+++ b/wizards/source/access2base/Recordset.xba
@@ -955,10 +955,18 @@ REM ----------------------------------------------------------------------------
Public Sub _Initialize(ByVal Optional pvFilter As Variant, Optional poRowSet As Object)
' Initialize new recordset
+Dim sFilter As String
+
If _Command = "" Then Exit Sub
If _ErrorHandler() Then On Local Error Goto Error_Sub
- If IsMissing(pvFilter) Then pvFilter = ""
+ If VarType(pvFilter) = vbError Then
+ sFilter = ""
+ ElseIf IsMissing(pvFilter) Then
+ sFilter = ""
+ Else
+ sFilter = pvFilter
+ End If
If Not IsMissing(poRowSet) Then ' Clone
Set RowSet = poRowSet.createResultSet()
_IsClone = True
@@ -983,11 +991,9 @@ Public Sub _Initialize(ByVal Optional pvFilter As Variant, Optional poRowSet As
End If
End With
- If Not IsMissing(pvFilter) Then ' Filter must be set before execute()
- If pvFilter <> "" Then
- RowSet.Filter = pvFilter
- RowSet.ApplyFilter = True
- End If
+ If sFilter <> "" Then ' Filter must be set before execute()
+ RowSet.Filter = sFilter
+ RowSet.ApplyFilter = True
End If
On Local Error Goto SQL_Error
RowSet.execute()
diff --git a/wizards/source/access2base/Trace.xba b/wizards/source/access2base/Trace.xba
index 220f1f623e5a..990bb49d77c8 100644
--- a/wizards/source/access2base/Trace.xba
+++ b/wizards/source/access2base/Trace.xba
@@ -155,7 +155,7 @@ Public Sub TraceError(ByVal psErrorLevel As String _
On Local Error Resume Next
If IsEmpty(_A2B_) Then Call Application._RootInit() ' First use of Access2Base in current LibO/AOO session
-Dim sErrorText As String, sErrorDesc As String, oDb As Object
+Dim sErrorText As String, sErrorDesc As String, oDb As Object, bMsgBox As Boolean
sErrorDesc = _ErrorMessage(piErrorCode, pvArgs)
sErrorText = _GetLabel("ERR#") & CStr(piErrorCode) _
& " (" & sErrorDesc & ") " & _GetLabel("ERROCCUR") _
@@ -168,8 +168,14 @@ Dim sErrorText As String, sErrorDesc As String, oDb As Object
.ErrorLongText = sErrorText
.CalledSub = ""
End With
- If IsMissing(pvMsgBox) Then pvMsgBox = ( psErrorLevel = TRACEERRORS Or psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT )
- TraceLog(psErrorLevel, sErrorText, pvMsgBox)
+ If VarType(pvMsgBox) = vbError Then
+ bMsgBox = ( psErrorLevel = TRACEERRORS Or psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT )
+ ElseIf IsMissing(pvMsgBox) Then
+ bMsgBox = ( psErrorLevel = TRACEERRORS Or psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT )
+ Else
+ bMsgBox = pvMsgBox
+ End If
+ TraceLog(psErrorLevel, sErrorText, bMsgBox)
' Unexpected error detected in user program or in Access2Base
If psErrorLevel = TRACEFATAL Or psErrorLevel = TRACEABORT Then
diff --git a/wizards/source/access2base/Utils.xba b/wizards/source/access2base/Utils.xba
index b5dee5214447..abd48d018f9d 100644
--- a/wizards/source/access2base/Utils.xba
+++ b/wizards/source/access2base/Utils.xba
@@ -105,12 +105,14 @@ Public Function _CheckArgument(pvItem As Variant _
_CheckArgument = False
-Dim iVarType As Integer
+Dim iVarType As Integer, bValidIsMissing As Boolean
If IsArray(pvType) Then iVarType = VarType(pvType(LBound(pvType))) Else iVarType = VarType(pvType)
If iVarType = vbString Then ' pvType is a pseudo-type string
_CheckArgument = Utils._IsPseudo(pvItem, pvType)
Else
- If IsMissing(pvValid) Then _CheckArgument = Utils._IsScalar(pvItem, pvType) Else _CheckArgument = Utils._IsScalar(pvItem, pvType, pvValid)
+ bValidIsMissing = ( VarType(pvValid) = vbError )
+ If Not bValidIsMissing Then bValidIsMissing = IsMissing(pvValid)
+ If bValidIsMissing Then _CheckArgument = Utils._IsScalar(pvItem, pvType) Else _CheckArgument = Utils._IsScalar(pvItem, pvType, pvValid)
End If
If VarType(pvItem) = vbCurrency Or VarType(pvItem) = vbDecimal Or VarType(pvItem) = vbBigint Then pvItem = CDbl(pvItem)
diff --git a/wizards/source/access2base/acConstants.xba b/wizards/source/access2base/acConstants.xba
index 9678a5b205dc..d0a24ef5da2c 100644
--- a/wizards/source/access2base/acConstants.xba
+++ b/wizards/source/access2base/acConstants.xba
@@ -81,6 +81,7 @@ Global Const vbCurrency = 6
Global Const vbDate = 7
Global Const vbString = 8
Global Const vbObject = 9
+Global Const vbError = 10
Global Const vbBoolean = 11
Global Const vbVariant = 12
Global Const vbByte = 17
More information about the Libreoffice-commits
mailing list