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 338e99c..214987c 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 2e361ce..7b35585 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 27b0d74..089486a 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 e6d481e..59fc8db 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 094bba0..8260a90 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 220f1f62..990bb49 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 b5dee52..abd48d0 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 9678a5b..d0a24ef 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
