summaryrefslogtreecommitdiff
path: root/wizards
diff options
context:
space:
mode:
authorJean-Pierre Ledure <jp@ledure.be>2016-10-13 16:54:15 +0200
committerJean-Pierre Ledure <jp@ledure.be>2016-10-13 17:00:10 +0200
commit3cac16941b775e02159af75d9b390b7dcc08d7ec (patch)
treec8d8fffc5509df8675b67183300f39eb83871766 /wizards
parent5f55b7d00a70db5dddaa0e74ccef52c021770f95 (diff)
Access2Base - CopyObject applied on tables belonging to different databases
So far, only tables belonging to the SAME database could be copied. Copying tables between databases from different sources (HSQLDB 1.8/2.3, MySQL, PostGres, Sqlite) is admitted. Field type conversions are in this case based on empiric rules. A case study based on getMetadatInfo() is available on request. Change-Id: Iae4ea7c4df4799cde3c8f973746513bad56246d8
Diffstat (limited to 'wizards')
-rw-r--r--wizards/source/access2base/Application.xba22
-rw-r--r--wizards/source/access2base/Database.xba127
-rw-r--r--wizards/source/access2base/DoCmd.xba254
-rw-r--r--wizards/source/access2base/Field.xba2
-rw-r--r--wizards/source/access2base/L10N.xba4
-rw-r--r--wizards/source/access2base/Recordset.xba5
-rw-r--r--wizards/source/access2base/Utils.xba204
-rw-r--r--wizards/source/access2base/_License.xba2
-rw-r--r--wizards/source/access2base/acConstants.xba3
9 files changed, 518 insertions, 105 deletions
diff --git a/wizards/source/access2base/Application.xba b/wizards/source/access2base/Application.xba
index 95f81dffb5ea..31e034048b14 100644
--- a/wizards/source/access2base/Application.xba
+++ b/wizards/source/access2base/Application.xba
@@ -72,6 +72,8 @@ Global Const ERRTABLECREATION = 1551
Global Const ERRFIELDCREATION = 1552
Global Const ERRSUBFORMNOTFOUND = 1553
Global Const ERRWINDOW = 1554
+Global Const ERRCOMPATIBILITY = 1555
+Global Const ERRPRECISION = 1556
REM -----------------------------------------------------------------------------------------------------------------------
Global Const DBCONNECTBASE = 1 &apos; Connection from Base document (OpenConnection)
@@ -79,6 +81,17 @@ Global Const DBCONNECTFORM = 2 &apos; Connection from a database-aware form
Global Const DBCONNECTANY = 3 &apos; Connection from any document for data access only (OpenDatabase)
REM -----------------------------------------------------------------------------------------------------------------------
+Global Const DBMS_UNKNOWN = 0
+Global Const DBMS_HSQLDB1 = 1
+Global Const DBMS_HSQLDB2 = 2
+Global Const DBMS_FIREBIRD = 3
+Global Const DBMS_MSACCESS2003 = 4
+Global Const DBMS_MSACCESS2007 = 5
+Global Const DBMS_MYSQL = 6
+Global Const DBMS_POSTGRES = 7
+Global Const DBMS_SQLITE = 8
+
+REM -----------------------------------------------------------------------------------------------------------------------
Global Const COLLALLDIALOGS = &quot;ALLDIALOGS&quot;
Global Const COLLALLFORMS = &quot;ALLFORMS&quot;
Global Const COLLCOMMANDBARS = &quot;COMMANDBARS&quot;
@@ -1039,7 +1052,12 @@ Const cstThisSub = &quot;OpenConnection&quot;
vDocContainer.DbConnect = DBCONNECTBASE
._DbConnect = DBCONNECTBASE
Set .MetaData = .Connection.MetaData
- ._ReadOnly = .Connection.isReadOnly()
+ ._LoadMetadata()
+ If .MetaData.DatabaseProductName = &quot;MySQL&quot; Then
+ ._ReadOnly = .MetaData.isReadOnly()
+ Else
+ ._ReadOnly = .Connection.isReadOnly() &apos; Always True in Mysql ??
+ End If
Set .Document = oComponent
.Title = oComponent.Title
.URL = vDocContainer.URL
@@ -1064,6 +1082,7 @@ Const cstThisSub = &quot;OpenConnection&quot;
Set .Connection = .Form.ActiveConnection &apos; Might be Nothing in Windows at AOO/LO startup (not met in Linux)
If Not IsNull(.Connection) Then
Set .MetaData = .Connection.MetaData
+ ._LoadMetadata()
._ReadOnly = .Connection.isReadOnly()
TraceLog(TRACEANY, .MetaData.getDatabaseProductName() &amp; &quot; &quot; &amp; .MetaData.getDatabaseProductVersion, False)
End If
@@ -1163,6 +1182,7 @@ Const cstThisSub = &quot;OpenDatabase&quot;
Set odbDatabase.Connection = oBaseSource.getConnection(pvUser, pvPassword)
If Not IsNull(odbDatabase.Connection) Then &apos; Null when standalone and target db does not exist
Set odbDatabase.MetaData = odbDatabase.Connection.MetaData
+ odbDatabase._LoadMetadata()
Else
Goto Trace_Error
End If
diff --git a/wizards/source/access2base/Database.xba b/wizards/source/access2base/Database.xba
index d022d4ce178f..a68c64ee0b94 100644
--- a/wizards/source/access2base/Database.xba
+++ b/wizards/source/access2base/Database.xba
@@ -23,6 +23,13 @@ Private Connection As Object &apos; com.sun.star.sdbc.drivers.OConnectionW
Private URL As String
Private _ReadOnly As Boolean
Private MetaData As Object &apos; interface XDatabaseMetaData
+Private _RDBMS As Integer &apos; DBMS constants
+Private _ColumnTypes() As Variant &apos; Part of Metadata.GetTypeInfo()
+Private _ColumnTypeNames() As Variant
+Private _ColumnPrecisions() As Variant
+Private _ColumnTypesReference() As Variant
+Private _ColumnTypesAlias() As Variant &apos; To what should a field whose origin is another DBMS be converted ? See DataTypes By RDBMS.ods
+Private _BinaryStream As Boolean &apos; False = binary fields must NOT be streamed f.i. via ReadAllBytes or WriteAllBytes
Private Form As Object &apos; com.sun.star.form.XForm
Private FormName As String
Private RecordsetMax As Integer
@@ -41,6 +48,13 @@ Private Sub Class_Initialize()
URL = &quot;&quot;
_ReadOnly = False
Set MetaData = Nothing
+ _RDBMS = DBMS_UNKNOWN
+ _ColumnTypes = Array()
+ _ColumnTypeNames = Array()
+ _ColumnPrecisions = Array()
+ _ColumnTypesReference = Array()
+ _ColumnTypesAlias() = Array()
+ _BinaryStream = False
Set Form = Nothing
FormName = &quot;&quot;
RecordsetMax = 0
@@ -1061,6 +1075,119 @@ Error_Function: &apos; Item by key aborted
End Function &apos; _hasRecordset V0.9.5
REM -----------------------------------------------------------------------------------------------------------------------
+Private Sub _LoadMetadata()
+&apos; Load essentially getTypeInfo() results from Metadata
+
+Dim sProduct As String
+Dim iInfo As Integer, oTypeInfo As Object, sName As String, lType As Integer
+
+Const cstMaxInfo = 40
+ ReDim _ColumnTypes(0 To cstMaxInfo)
+ ReDim _ColumnTypeNames(0 To cstMaxInfo)
+ ReDim _ColumnPrecisions(0 To cstMaxInfo)
+Const cstHSQLDB1 = &quot;HSQL Database Engine 1.&quot;
+Const cstHSQLDB2 = &quot;HSQL Database Engine 2.&quot;
+Const cstMSAccess2003 = &quot;MS Jet 0&quot;
+Const cstMSAccess2007 = &quot;MS Jet 04.&quot;
+Const cstMYSQL = &quot;MySQL&quot;
+Const cstPOSTGRES = &quot;PostgreSQL&quot;
+Const cstSQLITE = &quot;SQLite&quot;
+
+ With com.sun.star.sdbc.DataType
+ _ColumnTypesReference = Array( _
+ .ARRAY _
+ , .BIGINT _
+ , .BINARY _
+ , .BIT _
+ , .BLOB _
+ , .BOOLEAN _
+ , .CHAR _
+ , .CLOB _
+ , .DATE _
+ , .DECIMAL _
+ , .DISTINCT _
+ , .DOUBLE _
+ , .FLOAT _
+ , .INTEGER _
+ , .LONGVARBINARY _
+ , .LONGVARCHAR _
+ , .NUMERIC _
+ , .OBJECT _
+ , .OTHER _
+ , .REAL _
+ , .REF _
+ , .SMALLINT _
+ , .SQLNULL _
+ , .STRUCT _
+ , .TIME _
+ , .TIMESTAMP _
+ , .TINYINT _
+ , .VARBINARY _
+ , .VARCHAR _
+ )
+ End With
+
+ With Metadata
+ sProduct = .getDatabaseProductName() &amp; &quot; &quot; &amp; .getDatabaseProductVersion
+ Select Case True
+ Case Len(sProduct) &gt; Len(cstHSQLDB1) And Left(sProduct, Len(cstHSQLDB1)) = cstHSQLDB1
+ _RDBMS = DBMS_HSQLDB1
+ _ColumnTypesAlias = Array(0, -5, -2, 16, -4, 16, 1, -1, 91, 3, 0, 8, 6, 4, -4, -1, 2, 0, 0, 7, 0, 5, 0, 0, 92, 93, -6, -3, 12)
+ _BinaryStream = True
+ Case Len(sProduct) &gt; Len(cstHSQLDB2) And Left(sProduct, Len(cstHSQLDB2)) = cstHSQLDB2
+ _RDBMS = DBMS_HSQLDB2
+ _ColumnTypesAlias = Array(0, -5, -3, -7, 2004, 16, 1, 2005, 91, 3, 0, 8, 8, 4, -3, 12, 2, 0, 0, 8, 0, 5, 0, 0, 92, 93, -6, -3, 12)
+ _BinaryStream = True
+ Case Len(sProduct) &gt; Len(cstMSAccess2007) And Left(sProduct, Len(cstMSAccess2007)) = cstMSAccess2007
+ _RDBMS = DBMS_MSACCESS2007
+ _ColumnTypesAlias = Array(0, 4, -2, 16, -2, 16, 12, 12, 93, 8, 0, 8, 6, 4, -3, 12, 2, 0, 0, 8, 0, 5, 0, 0, 93, 93, -6, -2, 12)
+ _BinaryStream = True
+ Case Len(sProduct) &gt; Len(cstMSAccess2003) And Left(sProduct, Len(cstMSAccess2003)) = cstMSAccess2003
+ _RDBMS = DBMS_MSACCESS2003
+ _ColumnTypesAlias = Array(0, 4, -2, 16, -2, 16, 12, 12, 93, 8, 0, 8, 6, 4, -3, 12, 2, 0, 0, 8, 0, 5, 0, 0, 93, 93, -6, -2, 12)
+ _BinaryStream = True
+ Case Len(sProduct) &gt; Len(cstMYSQL) And Left(sProduct, Len(cstMYSQL)) = cstMYSQL
+ _RDBMS = DBMS_MYSQL
+ _ColumnTypesAlias = Array(0, -5, -2, -7, -4, -7, 1, -1, 91, 3, 0, 8, 8, 4, -4, -1, 2, 0, 0, 7, 0, 5, 0, 0, 92, 93, -6, -3, -1)
+ _BinaryStream = False
+ Case Len(sProduct) &gt; Len(cstPOSTGRES) And Left(sProduct, Len(cstPOSTGRES)) = cstPOSTGRES
+ _RDBMS = DBMS_POSTGRES
+ _ColumnTypesAlias = Array(0, -5, -3, 16, -3, 16, 1, 12, 91, 8, 0, 8, 8, 4, -3, 12, 2, 0, 0, 7, 0, 5, 0, 0, 92, 93, 4, -3, 12)
+ _BinaryStream = True
+ Case Len(sProduct) &gt; Len(cstSQLITE) And Left(sProduct, Len(cstSQLITE)) = cstSQLITE
+ _RDBMS = DBMS_SQLITE
+ _ColumnTypesAlias = Array(0, -5, -4, -7, -4, -7, 1, -1, 91, 8, 0, 8, 6, 4, -4, -1, 8, 0, 0, 8, 0, 5, 0, 0, 92, 93, -6, -4, 12)
+ _BinaryStream = True
+ Case Else &apos; Firebird TODO
+ _RDBMS = DBMS_UNKNOWN
+ _BinaryStream = True
+ End Select
+
+ iInfo = -1
+ Set oTypeInfo = MetaData.getTypeInfo()
+ With oTypeInfo
+ .next()
+ Do While Not .isAfterLast() And iInfo &lt; cstMaxInfo
+ sName = .getString(1)
+ lType = .getLong(2)
+ If _RDBMS = DBMS_POSTGRES And (Left(sName, 1) &lt;&gt; &quot;_&quot; Or lType &lt;&gt; -1) Then &apos; Skip
+ Else
+ iInfo = iInfo + 1
+ _ColumnTypeNames(iInfo) = sName
+ _ColumnTypes(iInfo) = lType
+ _ColumnPrecisions(iInfo) = .getLong(3)
+ End If
+ .next()
+ Loop
+ End With
+ ReDim Preserve _ColumnTypes(0 To iInfo)
+ ReDim Preserve _ColumnTypeNames(0 To iInfo)
+ ReDim Preserve _ColumnPrecisions(0 To iInfo)
+ End With
+
+End Sub &apos; _LoadMetadata V1.6.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
Private Function _OutputBooleanToHTML(ByVal pbBool As Boolean) As String
&apos; Converts input boolean value to HTML compatible string
diff --git a/wizards/source/access2base/DoCmd.xba b/wizards/source/access2base/DoCmd.xba
index 1b914a4c75dd..f85f3c0f615d 100644
--- a/wizards/source/access2base/DoCmd.xba
+++ b/wizards/source/access2base/DoCmd.xba
@@ -193,7 +193,9 @@ Const cstThisSub = &quot;CopyObject&quot;
CopyObject = False
If IsMissing(pvSourceDatabase) Then pvSourceDatabase = &quot;&quot;
- If Not Utils._CheckArgument(pvSourceDatabase, 1, vbString, &quot;&quot;) Then Goto Exit_Function
+ If VarType(pvSourceDatabase) &lt;&gt; vbString Then
+ If Not Utils._CheckArgument(pvSourceDatabase, 1, OBJDATABASE) Then Goto Exit_Function
+ End If
If IsMissing(pvNewName) Then Call _TraceArguments()
If Not Utils._CheckArgument(pvNewName, 2, vbString) Then Goto Exit_Function
If IsMissing(pvSourceType) Then Call _TraceArguments()
@@ -202,21 +204,36 @@ Const cstThisSub = &quot;CopyObject&quot;
If IsMissing(pvSourceName) Then Call _TraceArguments()
If Not Utils._CheckArgument(pvSourceName, 2, vbString) Then Goto Exit_Function
-Dim oSource As Object, oSourceDatabase As Object, oTarget As Object, oDatabase As Object
-Dim oSourceTable As Object, oSourceColumns As Object, oSourceCol As Object, oTargetCol As Object
+Dim oSource As Object, oSourceDatabase As Object, oTarget As Object, oDatabase As Object, bSameDatabase As Boolean
+Dim oSourceTable As Object, oSourceColumns As Object, oSourceCol As Object, oTargetCol As Object, iRDBMS As Integer
Dim oSourceKeys As Object, oSourceKey As Object, oTargetKey As Object
Dim i As Integer, j As Integer, sSql As String, vPrimaryKeys() As Variant
Dim vNameComponents() As Variant, iNames As Integer, sSurround As String
+Dim vInputFields() As Variant, vFieldBinary() As Variant, vOutputFields() As Variant
+Dim oInput as Object, oOutput As Object, iNbFields As Integer, vValue As Variant
+Dim vBinary As Variant, lInputSize As Long, lOutputSize As Long
+Dim lInputRecs As Long, lInputMax As Long, vField As Variant, bProgressMeter As Boolean, sFile As String
+
+Const cstMaxBinlength = 2 * 65535
+Const cstChunkSize = 2 * 65535
+Const cstProgressMeterLimit = 100
Set oDatabase = Application._CurrentDb()
- If pvSourceDatabase = &quot;&quot; Then
- Set oSourceDatabase = oDatabase
+ bSameDatabase = False
+ If VarType(pvSourceDatabase) = vbString Then
+ If pvSourceDatabase = &quot;&quot; Then
+ Set oSourceDatabase = oDatabase
+ bSameDatabase = True
+ Else
+ Set oSourceDatabase = Application.OpenDatabase(ConvertToUrl(pvSourceDatabase), , , True)
+ If IsNull(oSourceDatabase) Then Goto Exit_Function
+ End If
Else
- Set oSourceDatabase = Application.OpenDatabase(ConvertToUrl(pvSourceDatabase), &quot;&quot;, &quot;&quot;, True)
- If IsNull(oSourceDatabase) Then Goto Exit_Function
+ Set oSourceDatabase = pvSourceDatabase
End If
With oDatabase
+ iRDBMS = ._RDBMS
If ._DbConnect &lt;&gt; DBCONNECTBASE Then Goto Error_NotApplicable
Select Case pvSourceType
@@ -237,7 +254,8 @@ Dim vNameComponents() As Variant, iNames As Integer, sSurround As String
Set oSource = oSourceDatabase.TableDefs(pvSourceName, True)
If IsNull(oSource) Then Goto Error_NotFound
Set oTarget = .TableDefs(pvNewName, True)
- If Not IsNull(oTarget) Then .Connection.getTables.dropByName(oTarget.Name) &apos; a table with same name exists already ... drop it
+ &apos; A table with same name exists already ... drop it
+ If Not IsNull(oTarget) Then .Connection.getTables.dropByName(oTarget.Name)
&apos; Copy source table columns
Set oSourceTable = oSource.Table
Set oTarget = .Connection.getTables.createDataDescriptor
@@ -253,18 +271,7 @@ Dim vNameComponents() As Variant, iNames As Integer, sSurround As String
For i = 0 To oSourceColumns.getCount() - 1
&apos; Append each individual column to the table descriptor
Set oSourceCol = oSourceColumns.getByIndex(i)
- oTargetCol.Name = oSourceCol.Name
- oTargetCol.ControlDefault = oSourceCol.ControlDefault
- oTargetCol.Description = oSourceCol.Description
- oTargetCol.FormatKey = oSourceCol.FormatKey
- oTargetCol.HelpText = oSourceCol.HelpText
- oTargetCol.Hidden = oSourceCol.Hidden
- oTargetCol.IsCurrency = oSourceCol.IsCurrency
- oTargetCol.IsNullable = oSourceCol.IsNullable
- oTargetCol.Precision = oSourceCol.Precision
- oTargetCol.Scale = oSourceCol.Scale
- oTargetCol.Type = oSourceCol.Type
- oTargetCol.TypeName = oSourceCol.TypeName
+ _ConvertDataDescriptor oSourceCol, oSourceDatabase._RDBMS, oTargetCol, oDatabase
oTarget.Columns.appendByDescriptor(oTargetCol)
Next i
&apos; Copy keys
@@ -277,29 +284,96 @@ Dim vNameComponents() As Variant, iNames As Integer, sSurround As String
oTargetKey.Name = oSourceKey.Name
oTargetKey.ReferencedTable = oSourceKey.ReferencedTable
oTargetKey.Type = oSourceKey.Type
-&apos; If oSourceKey.Type = com.sun.star.sdbcx.KeyType.PRIMARY Then vPrimaryKeys = oSourceKey.Columns.getElementNames()
oTargetKey.UpdateRule = oSourceKey.UpdateRule
Set oTargetCol = oTargetKey.Columns.createDataDescriptor()
For j = 0 To oSourceKey.Columns.getCount() - 1
Set oSourceCol = oSourceKey.Columns.getByIndex(j)
- oTargetCol.Name = oSourceCol.Name
- oTargetCol.Description = oSourceCol.Description
- oTargetCol.IsCurrency = oSourceCol.IsCurrency
- oTargetCol.IsNullable = oSourceCol.IsNullable
- oTargetCol.Precision = oSourceCol.Precision
- oTargetCol.Scale = oSourceCol.Scale
- oTargetCol.Type = oSourceCol.Type
- oTargetCol.TypeName = oSourceCol.TypeName
+ _ConvertDataDescriptor oSourceCol, oSourceDatabase._RDBMS, oTargetCol, oDatabase, True
oTargetKey.Columns.appendByDescriptor(oTargetCol)
Next j
oTarget.Keys.appendByDescriptor(oTargetKey)
Next i
&apos; Duplicate table whole design
.Connection.getTables.appendByDescriptor(oTarget)
+
&apos; Copy data
- sSurround = Utils._Surround(oSource.Name)
- sSql = &quot;INSERT INTO &quot; &amp; Utils._Surround(pvNewName) &amp; &quot; SELECT &quot; &amp; sSurround &amp; &quot;.* FROM &quot; &amp; sSurround
- DoCmd.RunSQL(sSql, dbSQLPassthrough)
+ Select Case bSameDatabase
+ Case True
+ &apos; Build SQL statement to copy data
+ sSurround = Utils._Surround(oSource.Name)
+ sSql = &quot;INSERT INTO &quot; &amp; Utils._Surround(pvNewName) &amp; &quot; SELECT &quot; &amp; sSurround &amp; &quot;.* FROM &quot; &amp; sSurround
+ DoCmd.RunSQL(sSql)
+ Case False
+ &apos; Copy data row by row and field by field
+ &apos; As it is slow ... display a progress meter
+ Set oInput = oSourceDatabase.OpenRecordset(oSource.Name, , , dbReadOnly)
+ Set oOutput = .Openrecordset(pvNewName)
+
+ With oInput
+ If Not ( ._BOF And ._EOF ) Then
+ .MoveLast
+ lInputMax = .RecordCount
+ lInputRecs = 0
+ .MoveFirst
+ bProgressMeter = ( lInputMax &gt; cstProgressMeterLimit )
+
+ iNbFields = .Fields().Count - 1
+ vInputFields = Array()
+ vFieldBinary = Array()
+ vOutputFields = Array()
+ ReDim vInputFields(0 To iNbFields), vFieldBinary(0 To iNbFields), vOutputFields(0 To iNbFields)
+ For i = 0 To iNbFields
+ Set vInputFields(i) = .Fields(i)
+ vFieldBinary(i) = Utils._IsBinaryType(vInputFields(i).Column.Type)
+ Set vOutputFields(i) = oOutput.Fields(i)
+ Next i
+ Else
+ bProgressMeter = False
+ End If
+ If bProgressMeter Then Application.SysCmd acSysCmdInitMeter, pvNewName &amp; &quot; 0 %&quot;, lInputMax
+ Do While Not .EOF()
+ oOutput.RowSet.moveToInsertRow()
+ oOutput._EditMode = dbEditAdd
+ For i = 0 To iNbFields
+ If vFieldBinary(i) Then
+ lInputSize = vInputFields(i).FieldSize
+ If lInputSize &lt;= cstMaxBinlength Then
+ vField = Utils._getResultSetColumnValue(.RowSet, i + 1, True)
+ Utils._updateResultSetColumnValue(iRDBMS, oOutput.RowSet, i + 1, vField)
+ ElseIf oDatabase._BinaryStream Then
+ &apos; Typically for SQLite where binary fields are limited
+ If lInputSize &gt; vOutputFields(i).Column.Precision Then
+ TraceError(TRACEWARNING, ERRPRECISION, Utils._CalledSub(), 0, 1, Array(vOutputFields(i)._Name, lInputRecs + 1))
+ Utils._updateResultSetColumnValue(iRDBMS, oOutput.RowSet, i + 1, Null)
+ Else
+ sFile = Utils._GetRandomFileName(&quot;BINARY&quot;)
+ vInputFields(i)._WriteAll(sFile, &quot;WriteAllBytes&quot;)
+ vOutputFields(i)._ReadAll(sFile, &quot;ReadAllBytes&quot;)
+ Kill ConvertToUrl(sFile)
+ End If
+ End If
+ Else
+ vField = Utils._getResultSetColumnValue(.RowSet, i + 1)
+ Utils._updateResultSetColumnValue(iRDBMS, oOutput.RowSet, i + 1, vField)
+ End If
+ Next i
+ If oOutput.RowSet.IsNew And oOutput.RowSet.IsModified Then oOutput.RowSet.insertRow()
+ oOutput._EditMode = dbEditNone
+ lInputRecs = lInputRecs + 1
+ If bProgressMeter Then
+ If lInputRecs Mod (lInputMax / 100) = 0 Then _
+ Application.SysCmd acSysCmdUpdateMeter, pvNewName &amp; &quot; &quot; &amp; CStr(CLng(lInputRecs * 100 / lInputMax)) &amp; &quot;%&quot;, lInputRecs
+ End If
+ .MoveNext
+ Loop
+ End With
+
+ oOutput.mClose()
+ Set oOutput = Nothing
+ oInput.mClose()
+ Set oInput = Nothing
+ if bProgressMeter Then Application.SysCmd acSysCmdClearStatus
+ End Select
Case Else
End Select
@@ -308,10 +382,15 @@ Dim vNameComponents() As Variant, iNames As Integer, sSurround As String
CopyObject = True
Exit_Function:
- If pvSourceDatabase &lt;&gt; &quot;&quot; Then &apos; Avoid closing the current database
+ &apos; Avoid closing the current database or the database object given as source argument
+ If VarType(pvSourceDatabase) = vbString And Not bSameDatabase Then
If Not IsNull(oSourceDatabase) Then oSourceDatabase.mClose()
End If
- Utils._ResetCalledSub(cstThisSub)
+ Set oSourceDatabase = Nothing
+ If Not IsNull(oOutput) Then oOutput.mClose()
+ Set oOutput = Nothing
+ If Not IsNull(oInput) Then oInput.mClose()
+ Set oInput = Nothing
Set oSourceCol = Nothing
Set oSourceKey = Nothing
Set oSourceKeys = Nothing
@@ -321,6 +400,7 @@ Exit_Function:
Set oTargetCol = Nothing
Set oTargetKey = Nothing
Set oTarget = Nothing
+ Utils._ResetCalledSub(cstThisSub)
Exit Function
Error_NotFound:
TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(Iif(pvSourceType = acQuery, _GetLabel(&quot;QUERY&quot;), _GetLabel(&quot;TABLE&quot;)), pvSourceName))
@@ -1803,7 +1883,7 @@ Const cstSemiColon = &quot;;&quot;
pvObjectType = acSendForm
pvObjectName = oWindow._Name
End If
- sDirectory = _getTempDirectoryURL()
+ sDirectory = Utils._getTempDirectoryURL()
If Right(sDirectory, 1) &lt;&gt; &quot;/&quot; Then sDirectory = sDirectory &amp; &quot;/&quot;
If pvOutputFormat = &quot;&quot; Then
sOutputFormat = _PromptFormat(Array(&quot;PDF&quot;, &quot;ODT&quot;, &quot;DOC&quot;, &quot;HTML&quot;)) &apos; Prompt user for format
@@ -2000,6 +2080,89 @@ Dim bFound As Boolean
End Function &apos; _CheckColumnType V0.9.1
REM -----------------------------------------------------------------------------------------------------------------------
+Sub _ConvertDataDescriptor( ByRef poSource As Object _
+ , ByVal piSourceRDBMS As Integer _
+ , ByRef poTarget As Object _
+ , ByRef poDatabase As Object _
+ , ByVal Optional pbKey As Boolean _
+ )
+&apos; Convert source column descriptor to target descriptor
+&apos; If RDMSs identical, simply move property by property
+&apos; Otherwise
+&apos; - Use Type conversion tables (cfr. DataTypes By RDBMS.ods case study)
+&apos; - Select among synonyms the entry with the lowest Precision at least &gt;= source Precision
+&apos; - Derive TypeName and Precision values
+
+Dim vTypesReference() As Variant, vTypes() As Variant, vTypeNames() As Variant
+Dim i As Integer, iType As Integer, iTypeAlias As Integer
+Dim iNbTypes As Integer, iBestFit As Integer, lFitPrecision As Long, lPrecision As Long
+
+ On Local Error Goto Error_Sub
+ If IsMissing(pbKey) Then pbKey = False
+
+ poTarget.Name = poSource.Name
+ poTarget.Description = poSource.Description
+ If Not pbKey Then
+ poTarget.ControlDefault = poSource.ControlDefault
+ poTarget.FormatKey = poSource.FormatKey
+ poTarget.HelpText = poSource.HelpText
+ poTarget.Hidden = poSource.Hidden
+ End If
+ poTarget.IsCurrency = poSource.IsCurrency
+ poTarget.IsNullable = poSource.IsNullable
+ poTarget.Scale = poSource.Scale
+
+ If piSourceRDBMS = poDatabase._RDBMS Or poDatabase._RDBMS = DBMS_UNKNOWN Then
+ poTarget.Type = poSource.Type
+ poTarget.Precision = poSource.Precision
+ poTarget.TypeName = poSource.TypeName
+ Goto Exit_Sub
+ End If
+
+ &apos; Search DataType compatibility
+ With poDatabase
+ &apos; Find source datatype entry in Reference array
+ iType = -1
+ For i = 0 To UBound(._ColumnTypesReference)
+ If ._ColumnTypesReference(i) = poSource.Type Then
+ iType = i
+ Exit For
+ End If
+ Next i
+ If iType = -1 Then Goto Error_Compatibility
+ iTypeAlias = ._ColumnTypesAlias(iType)
+ &apos; Find best choice for the datatype of the target column
+ iNbTypes = UBound(._ColumnTypes)
+ iBestFit = -1
+ lFitPrecision = -2 &apos; Some POSTGRES datatypes have a precision of -1
+ For i = 0 To iNbTypes
+ If ._ColumnTypes(i) = iTypeAlias Then &apos; Minimal fit = correct datatype
+ lPrecision = ._ColumnPrecisions(i)
+ If iBestFit = -1 _
+ Or (iBestFit &gt; -1 And poSource.Precision &gt; 0 And lPrecision &gt;= poSource.Precision And lPrecision &lt; lFitPrecision) _
+ Or (iBestFit &gt; -1 And poSource.Precision = 0 And lPrecision &gt; lFitPrecision) Then &apos; First fit or better fit
+ iBestFit = i
+ lFitPrecision = lPrecision
+ End If
+ End If
+ Next i
+ If iBestFit = -1 Then Goto Error_Compatibility
+ poTarget.Type = iTypeAlias
+ poTarget.Precision = lFitPrecision
+ poTarget.TypeName = ._ColumnTypeNames(iBestFit)
+ End With
+
+Exit_Sub:
+ Exit Sub
+Error_Compatibility:
+ TraceError(TRACEFATAL, ERRCOMPATIBILITY, Utils._CalledSub(), 0, 1, poSource.Name)
+ Goto Exit_Sub
+Error_Sub:
+ TraceError(TRACEABORT, Err, &quot;_ConvertDataDescriptor&quot;, Erl)
+ Goto Exit_Sub
+End Sub &apos; ConvertDataDescriptor V1.6.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
Private Function _DatabaseForm(psForm As String, psControl As String)
&apos;Return DatabaseForm element of Form object (based on psForm which is known as a real form name)
&apos;or of SubForm object (based on psControl which is checked for being a subform)
@@ -2056,27 +2219,6 @@ Dim sCommand As String
End Sub &apos; _DispatchCommand V1.3.0
REM -----------------------------------------------------------------------------------------------------------------------
-Private Function _getTempDirectoryURL() As String
-&apos; Return the temporary directory defined in the OO Options (Paths)
-Dim sDirectory As String, oSettings As Object, oPathSettings As Object
-
- If _ErrorHandler() Then On Local Error Goto Error_Function
-
- _getTempDirectoryURL = &quot;&quot;
- oPathSettings = createUnoService( &quot;com.sun.star.util.PathSettings&quot; )
- sDirectory = oPathSettings.GetPropertyValue( &quot;Temp&quot; )
-
- _getTempDirectoryURL = sDirectory
-
-Exit_Function:
- Exit Function
-Error_Function:
- TraceError(&quot;ERROR&quot;, Err, &quot;_getTempDirectoryURL&quot;, Erl)
- _getTempDirectoryURL = &quot;&quot;
- Goto Exit_Function
-End Function &apos; _getTempDirectoryURL V0.8.5
-
-REM -----------------------------------------------------------------------------------------------------------------------
Public Function _getUpperShortcut(ByVal psShortcut As String, ByVal psLastComponent As String) As String
&apos; Return &quot;Forms!myForm&quot; from &quot;Forms!myForm!datField&quot; and &quot;datField&quot;
diff --git a/wizards/source/access2base/Field.xba b/wizards/source/access2base/Field.xba
index 5b94ba2f8bee..d08bcfbd37d6 100644
--- a/wizards/source/access2base/Field.xba
+++ b/wizards/source/access2base/Field.xba
@@ -151,7 +151,7 @@ Dim iChunkType As Integer
Select Case Column.Type &apos; DOES NOT WORK FOR CHARACTER TYPES
&apos; Case .CHAR, .VARCHAR, .LONGVARCHAR, .CLOB
&apos; iChunkType = vbString
- Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
+ Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB, .CHAR &apos; .CHAR added for Sqlite3
iChunkType = vbByte
Case Else
Goto Trace_Error
diff --git a/wizards/source/access2base/L10N.xba b/wizards/source/access2base/L10N.xba
index 2dbbdfc5d032..db39159055c9 100644
--- a/wizards/source/access2base/L10N.xba
+++ b/wizards/source/access2base/L10N.xba
@@ -78,6 +78,8 @@ Dim sLocal As String
Case &quot;ERR&quot; &amp; ERRFIELDCREATION : sLocal = &quot;Field &apos;%0&apos; could not be created&quot;
Case &quot;ERR&quot; &amp; ERRSUBFORMNOTFOUND : sLocal = &quot;Subform &apos;%0&apos; not found in parent form &apos;%1&apos;&quot;
Case &quot;ERR&quot; &amp; ERRWINDOW : sLocal = &quot;Current window is not a document&quot;
+ Case &quot;ERR&quot; &amp; ERRCOMPATIBILITY : sLocal = &quot;Field &apos;%0&apos; could not be converted due to incompatibility of field types between database systems&quot;
+ Case &quot;ERR&quot; &amp; ERRPRECISION : sLocal = &quot;Field &apos;%0&apos; could not be loaded in record #%1 due to capacity shortage&quot;
&apos;----------------------------------------------------------------------------------------------------------------------
Case &quot;OBJECT&quot; : sLocal = &quot;Object&quot;
Case &quot;TABLE&quot; : sLocal = &quot;Table&quot;
@@ -187,6 +189,8 @@ Dim sLocal As String
Case &quot;ERR&quot; &amp; ERRFIELDCREATION : sLocal = &quot;Le champ &apos;%0&apos; n&apos;a pas pu être créé&quot;
Case &quot;ERR&quot; &amp; ERRSUBFORMNOTFOUND : sLocal = &quot;Sous-formulaire &apos;%0&apos; non trouvé dans le formulaire parent &apos;%1&apos;&quot;
Case &quot;ERR&quot; &amp; ERRWINDOW : sLocal = &quot;La fenêtre courante n&apos;est pas un document&quot;
+ Case &quot;ERR&quot; &amp; ERRCOMPATIBILITY : sLocal = &quot;Le champ &apos;%0&apos; n&apos;a pas pu être converti à cause d&apos;une incompatibilité entre les types de champs supportés par les systèmes de bases de données respectifs&quot;
+ Case &quot;ERR&quot; &amp; ERRPRECISION : sLocal = &quot;Le champ &apos;%0&apos; n&apos;a pas pu être chargé dans l&apos;enregistrement #%1 par manque de capacité&quot;
&apos;----------------------------------------------------------------------------------------------------------------------
Case &quot;OBJECT&quot; : sLocal = &quot;Objet&quot;
Case &quot;TABLE&quot; : sLocal = &quot;Table&quot;
diff --git a/wizards/source/access2base/Recordset.xba b/wizards/source/access2base/Recordset.xba
index 698c6e4a1a08..b16b15390097 100644
--- a/wizards/source/access2base/Recordset.xba
+++ b/wizards/source/access2base/Recordset.xba
@@ -816,7 +816,7 @@ Public Function _AppendChunk(ByVal psFieldName As String, ByRef pvChunk As Varia
If _ErrorHandler() Then On Local Error GoTo Error_Function
Dim oFileAccess As Object
-Dim i As Integer, oChunk As Object, iChunk As Integer, sRandom As String
+Dim i As Integer, oChunk As Object, iChunk As Integer
&apos; Do nothing if chunk meaningless
_AppendChunk = False
@@ -844,8 +844,7 @@ Dim i As Integer, oChunk As Object, iChunk As Integer, sRandom As String
If Not .ChunksRequested Then &apos; First chunk
.ChunksRequested = True
.ChunkType = piChunkType
- sRandom = Right(&quot;000000&quot; &amp; Int(999999 * Rnd), 6)
- .FileName = DoCmd._getTempDirectoryURL() &amp; &quot;/&quot; &amp; &quot;A2B_TEMP_&quot; &amp; _Name &amp; &quot;_&quot; &amp; sRandom
+ .FileName = Utils._GetRandomFileName(_Name)
Set oFileAccess = CreateUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
.FileHandler = oFileAccess.openFileWrite(.FileName)
End If
diff --git a/wizards/source/access2base/Utils.xba b/wizards/source/access2base/Utils.xba
index ecae60efe23e..a7be0b3551e9 100644
--- a/wizards/source/access2base/Utils.xba
+++ b/wizards/source/access2base/Utils.xba
@@ -38,7 +38,7 @@ Dim i As Integer, vNewList() As Variant, vNumeric() As Variant, iSize As Integer
vNewList = Array(pvTypes)
End If
- vNumeric = Array(vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal)
+ vNumeric = Array(vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal, vbBoolean)
iSize = UBound(vNewlist)
ReDim Preserve vNewList(iSize + UBound(vNumeric) + 1)
@@ -115,7 +115,6 @@ Dim iVarType As Integer
If VarType(pvItem) = vbCurrency Or VarType(pvItem) = vbDecimal Or VarType(pvItem) = vbBigint Then pvItem = CDbl(pvItem)
Exit_Function:
-Const cstObject = &quot;[com.sun.star.script.NativeObjectWrapper]&quot;
If Not _CheckArgument Then
If IsMissing(pvError) Then pvError = True
If pvError Then
@@ -198,7 +197,7 @@ Dim oPip As Object, sLocation As String
End Function &apos; ExtensionLocation
REM -----------------------------------------------------------------------------------------------------------------------
-Private Function _getResultSetColumnValue(poResultSet As Object _
+Private Function _GetResultSetColumnValue(poResultSet As Object _
, ByVal piColIndex As Integer _
, Optional ByVal pbReturnBinary As Boolean _
) As Variant
@@ -207,7 +206,7 @@ REM get the data for the column specified by ColIndex
REM If pbReturnBinary = False (default) then return length of binary field
REM get type name from metadata
-Dim vValue As Variant, sType As String, vDateTime As Variant, oValue As Object
+Dim vValue As Variant, iType As Integer, vDateTime As Variant, oValue As Object
Dim bNullable As Boolean, lSize As Long
Const cstMaxTextLength = 65535
Const cstMaxBinlength = 2 * 65535
@@ -215,15 +214,15 @@ Const cstMaxBinlength = 2 * 65535
On Local Error Goto 0 &apos; Disable error handler
vValue = Null &apos; Default value if error
If IsMissing(pbReturnBinary) Then pbReturnBinary = False
- With poResultSet
- sType = .MetaData.getColumnTypeName(piColIndex)
- bNullable = ( .MetaData.IsNullable(piColIndex) = com.sun.star.sdbc.ColumnValue.NULLABLE )
- Select Case sType
- Case &quot;ARRAY&quot;: vValue = .getArray(piColIndex)
- Case &quot;BINARY&quot;, &quot;VARBINARY&quot;, &quot;LONGVARBINARY&quot;, &quot;BLOB&quot;
- Set oValue = .getBinaryStream(piColIndex)
+ With com.sun.star.sdbc.DataType
+ iType = poResultSet.MetaData.getColumnType(piColIndex)
+ bNullable = ( poResultSet.MetaData.IsNullable(piColIndex) = com.sun.star.sdbc.ColumnValue.NULLABLE )
+ Select Case iType
+ Case .ARRAY : vValue = poResultSet.getArray(piColIndex)
+ Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
+ Set oValue = poResultSet.getBinaryStream(piColIndex)
If bNullable Then
- If Not .wasNull() Then
+ If Not poResultSet.wasNull() Then
If Not _hasUNOMethod(oValue, &quot;getLength&quot;) Then &apos; When no recordset
lSize = cstMaxBinLength
Else
@@ -233,57 +232,58 @@ Const cstMaxBinlength = 2 * 65535
vValue = Array()
oValue.readBytes(vValue, lSize)
Else &apos; Return length of field, not content
+ vValue = lSize
End If
End If
End If
oValue.closeInput()
- Case &quot;BIT&quot;, &quot;BOOLEAN&quot;: vValue = .getBoolean(piColIndex)
- Case &quot;BYTE&quot;: vValue = .getByte(piColIndex)
- Case &quot;BYTES&quot;: vValue = .getBytes(piColIndex)
- Case &quot;DATE&quot;: vDateTime = .getDate(piColIndex)
- If Not .wasNull() Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day))
- Case &quot;DOUBLE&quot;, &quot;REAL&quot;: vValue = .getDouble(piColIndex)
- Case &quot;FLOAT&quot;: vValue = .getFloat(piColIndex)
- Case &quot;INTEGER&quot;, &quot;SMALLINT&quot;: vValue = .getInt(piColIndex)
- Case &quot;LONG&quot;, &quot;BIGINT&quot;: vValue = .getLong(piColIndex)
- Case &quot;DECIMAL&quot;, &quot;NUMERIC&quot;: vValue = .getDouble(piColIndex)
- Case &quot;NULL&quot;: vValue = .getNull(piColIndex)
- Case &quot;OBJECT&quot;: vValue = Null &apos; .getObject(piColIndex) does not work that well in Basic ...
- Case &quot;REF&quot;: vValue = .getRef(piColIndex)
- Case &quot;SHORT&quot;, &quot;TINYINT&quot;: vValue = .getShort(piColIndex)
- Case &quot;CHAR&quot;, &quot;VARCHAR&quot;: vValue = .getString(piColIndex)
- Case &quot;LONGVARCHAR&quot;, &quot;CLOB&quot;
- Set oValue = .getCharacterStream(piColIndex)
+ Case .BIT, .BOOLEAN : vValue = poResultSet.getBoolean(piColIndex)
+ Case .DATE : vDateTime = poResultSet.getDate(piColIndex)
+ If Not poResultSet.wasNull() Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day))
+ Case .DISTINCT, .OBJECT, .OTHER, .STRUCT
+ vValue = Null
+ Case .DOUBLE, .REAL : vValue = poResultSet.getDouble(piColIndex)
+ Case .FLOAT : vValue = poResultSet.getFloat(piColIndex)
+ Case .INTEGER, .SMALLINT : vValue = poResultSet.getInt(piColIndex)
+ Case .BIGINT : vValue = poResultSet.getLong(piColIndex)
+ Case .DECIMAL, .NUMERIC : vValue = poResultSet.getDouble(piColIndex)
+ Case .SQLNULL : vValue = poResultSet.getNull(piColIndex)
+ Case .OBJECT, .OTHER, .STRUCT : vValue = Null
+ Case .REF : vValue = poResultSet.getRef(piColIndex)
+ Case .TINYINT : vValue = poResultSet.getShort(piColIndex)
+ Case .CHAR, .VARCHAR : vValue = poResultSet.getString(piColIndex)
+ Case .LONGVARCHAR, .CLOB
+ Set oValue = poResultSet.getCharacterStream(piColIndex)
If bNullable Then
- If Not .wasNull() Then
+ If Not poResultSet.wasNull() Then
If Not _hasUNOMethod(oValue, &quot;getLength&quot;) Then &apos; When no recordset
lSize = cstMaxTextLength
Else
lSize = CLng(oValue.getLength())
End If
oValue.closeInput()
- If lSize &lt;= cstMaxBinLength Then vValue = .getString(piColIndex) Else vValue = &quot;&quot;
+ If lSize &lt;= cstMaxBinLength Then vValue = poResultSet.getString(piColIndex) Else vValue = &quot;&quot;
End If
Else
oValue.closeInput()
End If
- Case &quot;TIME&quot;: vDateTime = .getTime(piColIndex)
- If Not .wasNull() Then vValue = TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)&apos;, vDateTime.HundredthSeconds)
- Case &quot;TIMESTAMP&quot;: vDateTime = .getTimeStamp(piColIndex)
- If Not .wasNull() Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day)) _
+ Case .TIME : vDateTime = poResultSet.getTime(piColIndex)
+ If Not poResultSet.wasNull() Then vValue = TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)&apos;, vDateTime.HundredthSeconds)
+ Case .TIMESTAMP : vDateTime = poResultSet.getTimeStamp(piColIndex)
+ If Not poResultSet.wasNull() Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day)) _
+ TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)&apos;, vDateTime.HundredthSeconds)
Case Else
- vValue = .getString(piColIndex) &apos;GIVE STRING A TRY
+ vValue = poResultSet.getString(piColIndex) &apos;GIVE STRING A TRY
If IsNumeric(vValue) Then vValue = Val(vValue) &apos;Required when type = &quot;&quot;, sometimes numeric fields are returned as strings (query/MSAccess)
End Select
If bNullable Then
- If .wasNull() Then vValue = Null
+ If poResultSet.wasNull() Then vValue = Null
End If
End With
- _getResultSetColumnValue = vValue
+ _GetResultSetColumnValue = vValue
-End Function &apos; getResultSetColumnValue V 1.5.0
+End Function &apos; GetResultSetColumnValue V 1.5.0
REM -----------------------------------------------------------------------------------------------------------------------
Public Function _FinalProperty(psShortcut As String) As String
@@ -327,6 +327,16 @@ Dim sProdName as String
End Function &apos; GetProductName V1.0.0
REM -----------------------------------------------------------------------------------------------------------------------
+Public Function _GetRandomFileName(ByVal psName As String) As String
+&apos; Return the full name of a random temporary file suffixed by psName
+
+Dim sRandom As String
+ sRandom = Right(&quot;000000&quot; &amp; Int(999999 * Rnd), 6)
+ _GetRandomFileName = Utils._getTempDirectoryURL() &amp; &quot;/&quot; &amp; &quot;A2B_TEMP_&quot; &amp; psName &amp; &quot;_&quot; &amp; sRandom
+
+End Function &apos; GetRandomFileName
+
+REM -----------------------------------------------------------------------------------------------------------------------
Public Function _GetRegistryKeyContent(sKeyName as string, Optional bforUpdate as Boolean) As Variant
&apos;Implement ConfigurationProvider service
&apos;Derived from Tools library
@@ -345,6 +355,27 @@ Dim aNodePath(0) as new com.sun.star.beans.PropertyValue
End Function &apos; GetRegistryKeyContent V0.8.5
REM -----------------------------------------------------------------------------------------------------------------------
+Public Function _getTempDirectoryURL() As String
+&apos; Return the temporary directory defined in the OO Options (Paths)
+Dim sDirectory As String, oSettings As Object, oPathSettings As Object
+
+ If _ErrorHandler() Then On Local Error Goto Error_Function
+
+ _getTempDirectoryURL = &quot;&quot;
+ oPathSettings = createUnoService( &quot;com.sun.star.util.PathSettings&quot; )
+ sDirectory = oPathSettings.GetPropertyValue( &quot;Temp&quot; )
+
+ _getTempDirectoryURL = sDirectory
+
+Exit_Function:
+ Exit Function
+Error_Function:
+ TraceError(&quot;ERROR&quot;, Err, &quot;_getTempDirectoryURL&quot;, Erl)
+ _getTempDirectoryURL = &quot;&quot;
+ Goto Exit_Function
+End Function &apos; _getTempDirectoryURL V0.8.5
+
+REM -----------------------------------------------------------------------------------------------------------------------
Public Function _getUNOTypeName(pvObject As Variant) As String
&apos; Return the symbolic name of the pvObject (UNO-object) type
&apos; Code-snippet from XRAY
@@ -493,6 +524,20 @@ Dim iLength As Integer
End Function
REM -----------------------------------------------------------------------------------------------------------------------
+Public Function _IsBinaryType(ByVal lType As Long) As Boolean
+
+ With com.sun.star.sdbc.DataType
+ Select Case lType
+ Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
+ _IsBinaryType = True
+ Case Else
+ _IsBinaryType = False
+ End Select
+ End With
+
+End Function &apos; IsBinaryType V1.6.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
Public Function _IsPseudo(pvObject As Variant, ByVal pvType As Variant) As Boolean
&apos; Test pvObject: does it exist ?
&apos; is the _Type item = one of the proposed pvTypes ?
@@ -542,7 +587,7 @@ Dim oDoc As Object, oForms As Variant
End If
End If
Case OBJDATABASE
- If ._DbConnect = DBCONNECTFORM Then bPseudoExists = True Else bPseudoExists = .Document.CurrentController.IsConnected
+ If ._DbConnect = DBCONNECTFORM Then bPseudoExists = True Else bPseudoExists = Not IsNull(.Connection)
Case OBJDIALOG
If ._Name &lt;&gt; &quot;&quot; Then &apos; Check validity of dialog name
bPseudoExists = ( _A2B_.hasItem(COLLALLDIALOGS, ._Name) )
@@ -652,7 +697,7 @@ Dim lChar As Long, sByte1 As String, sByte2 As String, sByte3 As String
_PercentEncode = psChar
Case Asc(&quot;-&quot;), Asc(&quot;.&quot;), Asc(&quot;_&quot;), Asc(&quot;~&quot;)
_PercentEncode = psChar
- Case Asc(&quot;!&quot;), Asc(&quot;$&quot;), Asc(&quot;&amp;&quot;), Asc(&quot;&apos;&quot;), Asc(&quot;(&quot;), Asc(&quot;)&quot;), Asc(&quot;*&quot;), Asc(&quot;+&quot;), Asc(&quot;,&quot;), Asc(&quot;;&quot;), Asc(&quot;=&quot;) &apos; Reserved characters used as delimiter in query strings
+ Case Asc(&quot;!&quot;), Asc(&quot;$&quot;), Asc(&quot;&amp;&quot;), Asc(&quot;&apos;&quot;), Asc(&quot;(&quot;), Asc(&quot;)&quot;), Asc(&quot;*&quot;), Asc(&quot;+&quot;), Asc(&quot;,&quot;), Asc(&quot;;&quot;), Asc(&quot;=&quot;) &apos; Reserved characters used as delimitors in query strings
_PercentEncode = psChar
Case Asc(&quot; &quot;), Asc(&quot;%&quot;)
_PercentEncode = &quot;%&quot; &amp; Right(&quot;00&quot; &amp; Hex(lChar), 2)
@@ -831,6 +876,81 @@ Dim sTrim As String, vTrim() As Variant, i As Integer, j As Integer, iCount As I
End Function &apos; TrimArray V0.9.0
REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _UpdateResultSetColumnValue(piRDBMS As Integer _
+ , poResultSet As Object _
+ , ByVal piColIndex As Integer _
+ , ByVal pvValue As Variant _
+ ) As Boolean
+REM store the pvValue for the column specified by ColIndex
+REM get type name from metadata
+
+Dim iType As Integer, vDateTime As Variant, oValue As Object
+Dim bNullable As Boolean, lSize As Long, iValueType As Integer, sValueTypeName As String
+Const cstMaxTextLength = 65535
+Const cstMaxBinlength = 2 * 65535
+
+ On Local Error Goto 0 &apos; Disable error handler
+ _UpdateResultSetColumnValue = False
+ With com.sun.star.sdbc.DataType
+ iType = poResultSet.MetaData.getColumnType(piColIndex)
+ iValueType = VarType(pvValue)
+ sValueTypeName = UCase(poResultSet.MetaData.getColumnTypeName(piColIndex))
+ bNullable = ( poResultSet.MetaData.IsNullable(piColIndex) = com.sun.star.sdbc.ColumnValue.NULLABLE )
+
+ If bNullable And IsNull(pvValue) Then
+ poResultSet.updateNull(piColIndex)
+ Else
+ Select Case iType
+ Case .ARRAY, .DISTINCT, .OBJECT, .OTHER, .REF, .SQLNULL, .STRUCT
+ poResultSet.updateNull(piColIndex)
+ Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
+ poResultSet.updateBytes(piColIndex, pvValue)
+ Case .BIT, .BOOLEAN : poResultSet.updateBoolean(piColIndex, pvValue)
+ Case .DATE : vDateTime = CreateUnoStruct(&quot;com.sun.star.util.Date&quot;)
+ vDateTime.Year = Year(pvValue)
+ vDateTime.Month = Month(pvValue)
+ vDateTime.Day = Day(pvValue)
+ poResultSet.updateDate(piColIndex, vDateTime)
+ Case .DECIMAL, .NUMERIC : poResultSet.updateDouble(piColIndex, pvValue)
+ Case .DOUBLE, .REAL : poResultSet.updateDouble(piColIndex, pvValue)
+ Case .FLOAT : poResultSet.updateFloat(piColIndex, pvValue)
+ Case .INTEGER, .SMALLINT : poResultSet.updateInt(piColIndex, pvValue)
+ Case .BIGINT : poResultSet.updateLong(piColIndex, pvValue)
+ 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, &quot;BINARY&quot;) &gt;0 Then &apos; Sqlite exception ... !
+ poResultSet.updateBytes(piColIndex, pvValue)
+ Else
+ poResultSet.updateString(piColIndex, pvValue)
+ End If
+ Case .TIME : vDateTime = CreateUnoStruct(&quot;com.sun.star.util.Time&quot;)
+ vDateTime.Hours = Hour(pvValue)
+ vDateTime.Minutes = Minute(pvValue)
+ vDateTime.Seconds = Second(pvValue)
+ &apos;vDateTime.HundredthSeconds = 0
+ poResultSet.updateTime(piColIndex, vDateTime)
+ Case .TIMESTAMP : vDateTime = CreateUnoStruct(&quot;com.sun.star.util.DateTime&quot;)
+ vDateTime.Year = Year(pvValue)
+ vDateTime.Month = Month(pvValue)
+ vDateTime.Day = Day(pvValue)
+ vDateTime.Hours = Hour(pvValue)
+ vDateTime.Minutes = Minute(pvValue)
+ vDateTime.Seconds = Second(pvValue)
+ &apos;vDateTime.HundredthSeconds = 0
+ poResultSet.updateTimestamp(piColIndex, vDateTime)
+ Case Else
+ If bNullable Then poResultSet.updateNull(piColIndex)
+ End Select
+ End If
+
+ End With
+
+ _UpdateResultSetColumnValue = True
+
+End Function &apos; UpdateResultSetColumnValue V 1.6.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
Private Function _URLEncode(ByVal psToEncode As String) As String
&apos; http://www.w3schools.com/tags/ref_urlencode.asp
&apos; http://xkr.us/articles/javascript/encode-compare/
@@ -897,4 +1017,4 @@ Private Function _UTF8Encode(ByVal psChar As String) As String
End Function &apos; _UTF8Encode V1.4.0
-</script:module>
+</script:module> \ No newline at end of file
diff --git a/wizards/source/access2base/_License.xba b/wizards/source/access2base/_License.xba
index 4fc58ca39958..7f53269fd893 100644
--- a/wizards/source/access2base/_License.xba
+++ b/wizards/source/access2base/_License.xba
@@ -1,6 +1,6 @@
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
-<script:module xmlns:script="http://openoffice.org/2000/script" script:name="_License" script:language="StarBasic">&apos; Copyright 2012-2013 Jean-Pierre LEDURE
+<script:module xmlns:script="http://openoffice.org/2000/script" script:name="_License" script:language="StarBasic">&apos; Copyright 2012-2017 Jean-Pierre LEDURE
REM =======================================================================================================================
REM === The Access2Base library is a part of the LibreOffice project. ===
diff --git a/wizards/source/access2base/acConstants.xba b/wizards/source/access2base/acConstants.xba
index 959a71bc99bf..f80407410a15 100644
--- a/wizards/source/access2base/acConstants.xba
+++ b/wizards/source/access2base/acConstants.xba
@@ -8,7 +8,7 @@ REM ============================================================================
Option Explicit
REM Access2Base -----------------------------------------------------
-Global Const Access2Base_Version = &quot;1.5.0&quot;
+Global Const Access2Base_Version = &quot;1.6.0&quot;
REM AcCloseSave
REM -----------------------------------------------------------------
@@ -87,6 +87,7 @@ Global Const vbUShort = 18
Global Const vbULong = 19
Global Const vbBigint = 35
Global Const vbDecimal = 37
+Global Const vbArray = 8192
REM MsgBox constants
REM -----------------------------------------------------------------