[Libreoffice-commits] core.git: wizards/source

[Jean-Pierre Ledure]

 wizards/source/access2base/DoCmd.xba     |    8 +++++++-
 wizards/source/access2base/Field.xba     |    8 ++++++--
 wizards/source/access2base/Recordset.xba |    1 +
 wizards/source/access2base/Utils.xba     |    2 +-
 4 files changed, 15 insertions(+), 4 deletions(-)

New commits:
commit 3107a5d0e9ff7a3ccaac536606a733767886d438
Author: Jean-Pierre Ledure <jp at ledure.be>
Date:   Fri Jan 13 15:24:08 2017 +0100

    Access2Base - Review size limits of VARCHAR fields
    
    - Basic has no practical limit anymore for string variables
    - LONGVARCHAR fields can vary a lot in size across RDBMS's (f.i. Sqlite < 64K)
    This forces an overflow check when setting a field value and no check when getting it
    
    Change-Id: I4c9629f63164fbbdb84497e7002fa3186d7c63b7

diff --git a/wizards/source/access2base/DoCmd.xba b/wizards/source/access2base/DoCmd.xba
index 9b6500c..b52cbbd 100644
--- a/wizards/source/access2base/DoCmd.xba
+++ b/wizards/source/access2base/DoCmd.xba
@@ -340,7 +340,7 @@ Const cstProgressMeterLimit = 100
 											Utils._updateResultSetColumnValue(iRDBMS, oOutput.RowSet, i + 1, vField)
 										ElseIf oDatabase._BinaryStream Then
 											'	Typically for SQLite where binary fields are limited
-											If lInputSize > vOutputField.Column.Precision Then
+											If lInputSize > vOutputField._Precision Then
 												TraceError(TRACEWARNING, ERRPRECISION, Utils._CalledSub(), 0, 1, Array(vOutputField._Name, lInputRecs + 1))
 												Utils._updateResultSetColumnValue(iRDBMS, oOutput.RowSet, i + 1, Null)
 											Else
@@ -352,6 +352,12 @@ Const cstProgressMeterLimit = 100
 										End If
 									Else
 										vField =  Utils._getResultSetColumnValue(.RowSet, i + 1)
+										If VarType(vField) = vbString Then
+											If Len(vField) > vOutputField._Precision Then
+												TraceError(TRACEWARNING, ERRPRECISION, Utils._CalledSub(), 0, 1, Array(vOutputField._Name, lInputRecs + 1))
+											End If
+										End If
+										'	Update is done anyway, if too long, with truncation
 										Utils._updateResultSetColumnValue(iRDBMS, oOutput.RowSet, i + 1, vField)
 									End If
 								Next i
diff --git a/wizards/source/access2base/Field.xba b/wizards/source/access2base/Field.xba
index 35d5bc6..5a7fcc4c 100644
--- a/wizards/source/access2base/Field.xba
+++ b/wizards/source/access2base/Field.xba
@@ -16,6 +16,7 @@ REM ----------------------------------------------------------------------------
 
 Private	_Type					As String				'	Must be FIELD
 Private _Name					As String
+Private _Precision				As Long
 Private _ParentName				As String
 Private _ParentType				As String
 Private _ParentDatabase			As Object
@@ -400,7 +401,6 @@ Dim cstThisSub As String
 
 Dim bCond1 As Boolean, bCond2 As Boolean, vValue As Variant, oValue As Object, sValue As String
 Dim oSize As Object, lSize As Long, bNullable As Boolean, bNull As Boolean
-Const cstMaxTextLength = 65535
 Const cstMaxBinlength = 2 * 65535
 
 	_PropertyGet = EMPTY
@@ -551,7 +551,6 @@ Const cstMaxBinlength = 2 * 65535
 						If Not bNull Then
 							lSize = CLng(oValue.getLength())
 							oValue.closeInput()
-							If lSize > cstMaxTextLength Then Goto Trace_Length
 							vValue = Column.getString()									'	vbString
 						Else
 							oValue.closeInput()
@@ -686,6 +685,7 @@ Dim oParent As Object
 							End If
 						Case .CHAR, .VARCHAR, .LONGVARCHAR, .CLOB
 							If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
+							If Len(pvValue) > _Precision Then Goto Trace_Error_Length
 							Column.updateString(pvValue)						'	vbString
 						Case .DATE
 							If Not Utils._CheckArgument(pvValue, iArgNr, vbDate, , False) Then Goto Trace_Error_Value
@@ -756,6 +756,10 @@ Trace_Error_Updatable:
 	TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0, 1)
 	_PropertySet = False
 	Goto Exit_Function
+Trace_Error_Length:
+	TraceError(TRACEFATAL, ERROVERFLOW, Utils._CalledSub(), 0, , Array(lSize, "AppendChunk"))
+	_PropertySet = False
+	Goto Exit_Function
 Error_Function:
 	TraceError(TRACEABORT, Err, cstThisSub, Erl)
 	_PropertySet = False
diff --git a/wizards/source/access2base/Recordset.xba b/wizards/source/access2base/Recordset.xba
index d04f2e6..0bc968f 100644
--- a/wizards/source/access2base/Recordset.xba
+++ b/wizards/source/access2base/Recordset.xba
@@ -545,6 +545,7 @@ Dim i As Integer, oFields As Object, iIndex As Integer
 		Set oObject = New Field
 		oObject._Name = sObjectName
 		Set oObject.Column = oFields.getByName(sObjectName)
+		If Utils._hasUNOProperty(oObject.Column, "Precision") Then oObject._Precision = oObject.Column.Precision
 		oObject._ParentName = _Name
 		oObject._ParentType = _Type
 		Set oObject._ParentDatabase = _ParentDatabase
diff --git a/wizards/source/access2base/Utils.xba b/wizards/source/access2base/Utils.xba
index 7367e4e..3b71d0a 100644
--- a/wizards/source/access2base/Utils.xba
+++ b/wizards/source/access2base/Utils.xba
@@ -1166,7 +1166,7 @@ Const cstMaxBinlength = 2 * 65535
 				Case .DECIMAL, .NUMERIC			:		poResultSet.updateDouble(piColIndex, pvValue)
 				Case .TINYINT					:		poResultSet.updateShort(piColIndex, pvValue)
 				Case .CHAR, .VARCHAR, .LONGVARCHAR, .CLOB
-														If piRDBMS = DBMS_SQLITE And InStr(sValueTypeName, "BINARY") >0 Then		'	Sqlite exception ... !
+														If piRDBMS = DBMS_SQLITE And InStr(sValueTypeName, "BINARY") > 0 Then		'	Sqlite exception ... !
 															poResultSet.updateBytes(piColIndex, pvValue)
 														Else
 															poResultSet.updateString(piColIndex, pvValue)