[Libreoffice-commits] core.git: wizards/source
Jean-Pierre Ledure
jp at ledure.be
Thu Oct 13 15:04:03 UTC 2016
wizards/source/access2base/Application.xba | 22 ++
wizards/source/access2base/Database.xba | 127 ++++++++++++++
wizards/source/access2base/DoCmd.xba | 254 ++++++++++++++++++++++-------
wizards/source/access2base/Field.xba | 2
wizards/source/access2base/L10N.xba | 4
wizards/source/access2base/Recordset.xba | 5
wizards/source/access2base/Utils.xba | 204 ++++++++++++++++++-----
wizards/source/access2base/_License.xba | 2
wizards/source/access2base/acConstants.xba | 3
9 files changed, 518 insertions(+), 105 deletions(-)
New commits:
commit 3cac16941b775e02159af75d9b390b7dcc08d7ec
Author: Jean-Pierre Ledure <jp at ledure.be>
Date: Thu Oct 13 16:54:15 2016 +0200
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
diff --git a/wizards/source/access2base/Application.xba b/wizards/source/access2base/Application.xba
index 95f81df..31e0340 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 ' Connection from Base document (OpenConnection)
@@ -79,6 +81,17 @@ Global Const DBCONNECTFORM = 2 ' Connection from a database-aware form
Global Const DBCONNECTANY = 3 ' 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 = "ALLDIALOGS"
Global Const COLLALLFORMS = "ALLFORMS"
Global Const COLLCOMMANDBARS = "COMMANDBARS"
@@ -1039,7 +1052,12 @@ Const cstThisSub = "OpenConnection"
vDocContainer.DbConnect = DBCONNECTBASE
._DbConnect = DBCONNECTBASE
Set .MetaData = .Connection.MetaData
- ._ReadOnly = .Connection.isReadOnly()
+ ._LoadMetadata()
+ If .MetaData.DatabaseProductName = "MySQL" Then
+ ._ReadOnly = .MetaData.isReadOnly()
+ Else
+ ._ReadOnly = .Connection.isReadOnly() ' Always True in Mysql ??
+ End If
Set .Document = oComponent
.Title = oComponent.Title
.URL = vDocContainer.URL
@@ -1064,6 +1082,7 @@ Const cstThisSub = "OpenConnection"
Set .Connection = .Form.ActiveConnection ' 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() & " " & .MetaData.getDatabaseProductVersion, False)
End If
@@ -1163,6 +1182,7 @@ Const cstThisSub = "OpenDatabase"
Set odbDatabase.Connection = oBaseSource.getConnection(pvUser, pvPassword)
If Not IsNull(odbDatabase.Connection) Then ' 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 d022d4c..a68c64e 100644
--- a/wizards/source/access2base/Database.xba
+++ b/wizards/source/access2base/Database.xba
@@ -23,6 +23,13 @@ Private Connection As Object ' com.sun.star.sdbc.drivers.OConnectionW
Private URL As String
Private _ReadOnly As Boolean
Private MetaData As Object ' interface XDatabaseMetaData
+Private _RDBMS As Integer ' DBMS constants
+Private _ColumnTypes() As Variant ' Part of Metadata.GetTypeInfo()
+Private _ColumnTypeNames() As Variant
+Private _ColumnPrecisions() As Variant
+Private _ColumnTypesReference() As Variant
+Private _ColumnTypesAlias() As Variant ' To what should a field whose origin is another DBMS be converted ? See DataTypes By RDBMS.ods
+Private _BinaryStream As Boolean ' False = binary fields must NOT be streamed f.i. via ReadAllBytes or WriteAllBytes
Private Form As Object ' com.sun.star.form.XForm
Private FormName As String
Private RecordsetMax As Integer
@@ -41,6 +48,13 @@ Private Sub Class_Initialize()
URL = ""
_ReadOnly = False
Set MetaData = Nothing
+ _RDBMS = DBMS_UNKNOWN
+ _ColumnTypes = Array()
+ _ColumnTypeNames = Array()
+ _ColumnPrecisions = Array()
+ _ColumnTypesReference = Array()
+ _ColumnTypesAlias() = Array()
+ _BinaryStream = False
Set Form = Nothing
FormName = ""
RecordsetMax = 0
@@ -1061,6 +1075,119 @@ Error_Function: ' Item by key aborted
End Function ' _hasRecordset V0.9.5
REM -----------------------------------------------------------------------------------------------------------------------
+Private Sub _LoadMetadata()
+' 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 = "HSQL Database Engine 1."
+Const cstHSQLDB2 = "HSQL Database Engine 2."
+Const cstMSAccess2003 = "MS Jet 0"
+Const cstMSAccess2007 = "MS Jet 04."
+Const cstMYSQL = "MySQL"
+Const cstPOSTGRES = "PostgreSQL"
+Const cstSQLITE = "SQLite"
+
+ 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() & " " & .getDatabaseProductVersion
+ Select Case True
+ Case Len(sProduct) > 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) > 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) > 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) > 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) > 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) > 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) > 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 ' Firebird TODO
+ _RDBMS = DBMS_UNKNOWN
+ _BinaryStream = True
+ End Select
+
+ iInfo = -1
+ Set oTypeInfo = MetaData.getTypeInfo()
+ With oTypeInfo
+ .next()
+ Do While Not .isAfterLast() And iInfo < cstMaxInfo
+ sName = .getString(1)
+ lType = .getLong(2)
+ If _RDBMS = DBMS_POSTGRES And (Left(sName, 1) <> "_" Or lType <> -1) Then ' 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 ' _LoadMetadata V1.6.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
Private Function _OutputBooleanToHTML(ByVal pbBool As Boolean) As String
' Converts input boolean value to HTML compatible string
diff --git a/wizards/source/access2base/DoCmd.xba b/wizards/source/access2base/DoCmd.xba
index 1b914a4..f85f3c0 100644
--- a/wizards/source/access2base/DoCmd.xba
+++ b/wizards/source/access2base/DoCmd.xba
@@ -193,7 +193,9 @@ Const cstThisSub = "CopyObject"
CopyObject = False
If IsMissing(pvSourceDatabase) Then pvSourceDatabase = ""
- If Not Utils._CheckArgument(pvSourceDatabase, 1, vbString, "") Then Goto Exit_Function
+ If VarType(pvSourceDatabase) <> 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 = "CopyObject"
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 = "" Then
- Set oSourceDatabase = oDatabase
+ bSameDatabase = False
+ If VarType(pvSourceDatabase) = vbString Then
+ If pvSourceDatabase = "" 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), "", "", True)
- If IsNull(oSourceDatabase) Then Goto Exit_Function
+ Set oSourceDatabase = pvSourceDatabase
End If
With oDatabase
+ iRDBMS = ._RDBMS
If ._DbConnect <> 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) ' a table with same name exists already ... drop it
+ ' A table with same name exists already ... drop it
+ If Not IsNull(oTarget) Then .Connection.getTables.dropByName(oTarget.Name)
' 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
' 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
' 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
-' 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
' Duplicate table whole design
.Connection.getTables.appendByDescriptor(oTarget)
+
' Copy data
- sSurround = Utils._Surround(oSource.Name)
- sSql = "INSERT INTO " & Utils._Surround(pvNewName) & " SELECT " & sSurround & ".* FROM " & sSurround
- DoCmd.RunSQL(sSql, dbSQLPassthrough)
+ Select Case bSameDatabase
+ Case True
+ ' Build SQL statement to copy data
+ sSurround = Utils._Surround(oSource.Name)
+ sSql = "INSERT INTO " & Utils._Surround(pvNewName) & " SELECT " & sSurround & ".* FROM " & sSurround
+ DoCmd.RunSQL(sSql)
+ Case False
+ ' Copy data row by row and field by field
+ ' 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 > 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 & " 0 %", 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 <= cstMaxBinlength Then
+ vField = Utils._getResultSetColumnValue(.RowSet, i + 1, True)
+ Utils._updateResultSetColumnValue(iRDBMS, oOutput.RowSet, i + 1, vField)
+ ElseIf oDatabase._BinaryStream Then
+ ' Typically for SQLite where binary fields are limited
+ If lInputSize > 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("BINARY")
+ vInputFields(i)._WriteAll(sFile, "WriteAllBytes")
+ vOutputFields(i)._ReadAll(sFile, "ReadAllBytes")
+ 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 & " " & CStr(CLng(lInputRecs * 100 / lInputMax)) & "%", 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 <> "" Then ' Avoid closing the current database
+ ' 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("QUERY"), _GetLabel("TABLE")), pvSourceName))
@@ -1803,7 +1883,7 @@ Const cstSemiColon = ";"
pvObjectType = acSendForm
pvObjectName = oWindow._Name
End If
- sDirectory = _getTempDirectoryURL()
+ sDirectory = Utils._getTempDirectoryURL()
If Right(sDirectory, 1) <> "/" Then sDirectory = sDirectory & "/"
If pvOutputFormat = "" Then
sOutputFormat = _PromptFormat(Array("PDF", "ODT", "DOC", "HTML")) ' Prompt user for format
@@ -2000,6 +2080,89 @@ Dim bFound As Boolean
End Function ' _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 _
+ )
+' Convert source column descriptor to target descriptor
+' If RDMSs identical, simply move property by property
+' Otherwise
+' - Use Type conversion tables (cfr. DataTypes By RDBMS.ods case study)
+' - Select among synonyms the entry with the lowest Precision at least >= source Precision
+' - 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
+
+ ' Search DataType compatibility
+ With poDatabase
+ ' 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)
+ ' Find best choice for the datatype of the target column
+ iNbTypes = UBound(._ColumnTypes)
+ iBestFit = -1
+ lFitPrecision = -2 ' Some POSTGRES datatypes have a precision of -1
+ For i = 0 To iNbTypes
+ If ._ColumnTypes(i) = iTypeAlias Then ' Minimal fit = correct datatype
+ lPrecision = ._ColumnPrecisions(i)
+ If iBestFit = -1 _
+ Or (iBestFit > -1 And poSource.Precision > 0 And lPrecision >= poSource.Precision And lPrecision < lFitPrecision) _
+ Or (iBestFit > -1 And poSource.Precision = 0 And lPrecision > lFitPrecision) Then ' 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, "_ConvertDataDescriptor", Erl)
+ Goto Exit_Sub
+End Sub ' ConvertDataDescriptor V1.6.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
Private Function _DatabaseForm(psForm As String, psControl As String)
'Return DatabaseForm element of Form object (based on psForm which is known as a real form name)
'or of SubForm object (based on psControl which is checked for being a subform)
@@ -2056,27 +2219,6 @@ Dim sCommand As String
End Sub ' _DispatchCommand V1.3.0
REM -----------------------------------------------------------------------------------------------------------------------
-Private Function _getTempDirectoryURL() As String
-' 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 = ""
- oPathSettings = createUnoService( "com.sun.star.util.PathSettings" )
- sDirectory = oPathSettings.GetPropertyValue( "Temp" )
-
- _getTempDirectoryURL = sDirectory
-
-Exit_Function:
- Exit Function
-Error_Function:
- TraceError("ERROR", Err, "_getTempDirectoryURL", Erl)
- _getTempDirectoryURL = ""
- Goto Exit_Function
-End Function ' _getTempDirectoryURL V0.8.5
-
-REM -----------------------------------------------------------------------------------------------------------------------
Public Function _getUpperShortcut(ByVal psShortcut As String, ByVal psLastComponent As String) As String
' Return "Forms!myForm" from "Forms!myForm!datField" and "datField"
diff --git a/wizards/source/access2base/Field.xba b/wizards/source/access2base/Field.xba
index 5b94ba2..d08bcfb 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 ' DOES NOT WORK FOR CHARACTER TYPES
' Case .CHAR, .VARCHAR, .LONGVARCHAR, .CLOB
' iChunkType = vbString
- Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
+ Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB, .CHAR ' .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 2dbbdfc..db39159 100644
--- a/wizards/source/access2base/L10N.xba
+++ b/wizards/source/access2base/L10N.xba
@@ -78,6 +78,8 @@ Dim sLocal As String
Case "ERR" & ERRFIELDCREATION : sLocal = "Field '%0' could not be created"
Case "ERR" & ERRSUBFORMNOTFOUND : sLocal = "Subform '%0' not found in parent form '%1'"
Case "ERR" & ERRWINDOW : sLocal = "Current window is not a document"
+ Case "ERR" & ERRCOMPATIBILITY : sLocal = "Field '%0' could not be converted due to incompatibility of field types between database systems"
+ Case "ERR" & ERRPRECISION : sLocal = "Field '%0' could not be loaded in record #%1 due to capacity shortage"
'----------------------------------------------------------------------------------------------------------------------
Case "OBJECT" : sLocal = "Object"
Case "TABLE" : sLocal = "Table"
@@ -187,6 +189,8 @@ Dim sLocal As String
Case "ERR" & ERRFIELDCREATION : sLocal = "Le champ '%0' n'a pas pu être créé"
Case "ERR" & ERRSUBFORMNOTFOUND : sLocal = "Sous-formulaire '%0' non trouvé dans le formulaire parent '%1'"
Case "ERR" & ERRWINDOW : sLocal = "La fenêtre courante n'est pas un document"
+ Case "ERR" & ERRCOMPATIBILITY : sLocal = "Le champ '%0' n'a pas pu être converti à cause d'une incompatibilité entre les types de champs supportés par les systèmes de bases de données respectifs"
+ Case "ERR" & ERRPRECISION : sLocal = "Le champ '%0' n'a pas pu être chargé dans l'enregistrement #%1 par manque de capacité"
'----------------------------------------------------------------------------------------------------------------------
Case "OBJECT" : sLocal = "Objet"
Case "TABLE" : sLocal = "Table"
diff --git a/wizards/source/access2base/Recordset.xba b/wizards/source/access2base/Recordset.xba
index 698c6e4..b16b153 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
' 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 ' First chunk
.ChunksRequested = True
.ChunkType = piChunkType
- sRandom = Right("000000" & Int(999999 * Rnd), 6)
- .FileName = DoCmd._getTempDirectoryURL() & "/" & "A2B_TEMP_" & _Name & "_" & sRandom
+ .FileName = Utils._GetRandomFileName(_Name)
Set oFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
.FileHandler = oFileAccess.openFileWrite(.FileName)
End If
diff --git a/wizards/source/access2base/Utils.xba b/wizards/source/access2base/Utils.xba
index ecae60e..a7be0b3 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 = "[com.sun.star.script.NativeObjectWrapper]"
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 ' 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 ' Disable error handler
vValue = Null ' 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 "ARRAY": vValue = .getArray(piColIndex)
- Case "BINARY", "VARBINARY", "LONGVARBINARY", "BLOB"
- 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, "getLength") Then ' When no recordset
lSize = cstMaxBinLength
Else
@@ -233,57 +232,58 @@ Const cstMaxBinlength = 2 * 65535
vValue = Array()
oValue.readBytes(vValue, lSize)
Else ' Return length of field, not content
+ vValue = lSize
End If
End If
End If
oValue.closeInput()
- Case "BIT", "BOOLEAN": vValue = .getBoolean(piColIndex)
- Case "BYTE": vValue = .getByte(piColIndex)
- Case "BYTES": vValue = .getBytes(piColIndex)
- Case "DATE": vDateTime = .getDate(piColIndex)
- If Not .wasNull() Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day))
- Case "DOUBLE", "REAL": vValue = .getDouble(piColIndex)
- Case "FLOAT": vValue = .getFloat(piColIndex)
- Case "INTEGER", "SMALLINT": vValue = .getInt(piColIndex)
- Case "LONG", "BIGINT": vValue = .getLong(piColIndex)
- Case "DECIMAL", "NUMERIC": vValue = .getDouble(piColIndex)
- Case "NULL": vValue = .getNull(piColIndex)
- Case "OBJECT": vValue = Null ' .getObject(piColIndex) does not work that well in Basic ...
- Case "REF": vValue = .getRef(piColIndex)
- Case "SHORT", "TINYINT": vValue = .getShort(piColIndex)
- Case "CHAR", "VARCHAR": vValue = .getString(piColIndex)
- Case "LONGVARCHAR", "CLOB"
- 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, "getLength") Then ' When no recordset
lSize = cstMaxTextLength
Else
lSize = CLng(oValue.getLength())
End If
oValue.closeInput()
- If lSize <= cstMaxBinLength Then vValue = .getString(piColIndex) Else vValue = ""
+ If lSize <= cstMaxBinLength Then vValue = poResultSet.getString(piColIndex) Else vValue = ""
End If
Else
oValue.closeInput()
End If
- Case "TIME": vDateTime = .getTime(piColIndex)
- If Not .wasNull() Then vValue = TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)', vDateTime.HundredthSeconds)
- Case "TIMESTAMP": 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)', 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)', vDateTime.HundredthSeconds)
Case Else
- vValue = .getString(piColIndex) 'GIVE STRING A TRY
+ vValue = poResultSet.getString(piColIndex) 'GIVE STRING A TRY
If IsNumeric(vValue) Then vValue = Val(vValue) 'Required when type = "", 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 ' getResultSetColumnValue V 1.5.0
+End Function ' GetResultSetColumnValue V 1.5.0
REM -----------------------------------------------------------------------------------------------------------------------
Public Function _FinalProperty(psShortcut As String) As String
@@ -327,6 +327,16 @@ Dim sProdName as String
End Function ' GetProductName V1.0.0
REM -----------------------------------------------------------------------------------------------------------------------
+Public Function _GetRandomFileName(ByVal psName As String) As String
+' Return the full name of a random temporary file suffixed by psName
+
+Dim sRandom As String
+ sRandom = Right("000000" & Int(999999 * Rnd), 6)
+ _GetRandomFileName = Utils._getTempDirectoryURL() & "/" & "A2B_TEMP_" & psName & "_" & sRandom
+
+End Function ' GetRandomFileName
+
+REM -----------------------------------------------------------------------------------------------------------------------
Public Function _GetRegistryKeyContent(sKeyName as string, Optional bforUpdate as Boolean) As Variant
'Implement ConfigurationProvider service
'Derived from Tools library
@@ -345,6 +355,27 @@ Dim aNodePath(0) as new com.sun.star.beans.PropertyValue
End Function ' GetRegistryKeyContent V0.8.5
REM -----------------------------------------------------------------------------------------------------------------------
+Public Function _getTempDirectoryURL() As String
+' 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 = ""
+ oPathSettings = createUnoService( "com.sun.star.util.PathSettings" )
+ sDirectory = oPathSettings.GetPropertyValue( "Temp" )
+
+ _getTempDirectoryURL = sDirectory
+
+Exit_Function:
+ Exit Function
+Error_Function:
+ TraceError("ERROR", Err, "_getTempDirectoryURL", Erl)
+ _getTempDirectoryURL = ""
+ Goto Exit_Function
+End Function ' _getTempDirectoryURL V0.8.5
+
+REM -----------------------------------------------------------------------------------------------------------------------
Public Function _getUNOTypeName(pvObject As Variant) As String
' Return the symbolic name of the pvObject (UNO-object) type
' 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 ' IsBinaryType V1.6.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
Public Function _IsPseudo(pvObject As Variant, ByVal pvType As Variant) As Boolean
' Test pvObject: does it exist ?
' 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 <> "" Then ' 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("-"), Asc("."), Asc("_"), Asc("~")
_PercentEncode = psChar
- Case Asc("!"), Asc("$"), Asc("&"), Asc("'"), Asc("("), Asc(")"), Asc("*"), Asc("+"), Asc(","), Asc(";"), Asc("=") ' Reserved characters used as delimiter in query strings
+ Case Asc("!"), Asc("$"), Asc("&"), Asc("'"), Asc("("), Asc(")"), Asc("*"), Asc("+"), Asc(","), Asc(";"), Asc("=") ' Reserved characters used as delimitors in query strings
_PercentEncode = psChar
Case Asc(" "), Asc("%")
_PercentEncode = "%" & Right("00" & 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 ' 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 ' 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("com.sun.star.util.Date")
+ 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, "BINARY") >0 Then ' Sqlite exception ... !
+ poResultSet.updateBytes(piColIndex, pvValue)
+ Else
+ poResultSet.updateString(piColIndex, pvValue)
+ End If
+ Case .TIME : vDateTime = CreateUnoStruct("com.sun.star.util.Time")
+ vDateTime.Hours = Hour(pvValue)
+ vDateTime.Minutes = Minute(pvValue)
+ vDateTime.Seconds = Second(pvValue)
+ 'vDateTime.HundredthSeconds = 0
+ poResultSet.updateTime(piColIndex, vDateTime)
+ Case .TIMESTAMP : vDateTime = CreateUnoStruct("com.sun.star.util.DateTime")
+ vDateTime.Year = Year(pvValue)
+ vDateTime.Month = Month(pvValue)
+ vDateTime.Day = Day(pvValue)
+ vDateTime.Hours = Hour(pvValue)
+ vDateTime.Minutes = Minute(pvValue)
+ vDateTime.Seconds = Second(pvValue)
+ '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 ' UpdateResultSetColumnValue V 1.6.0
+
+REM -----------------------------------------------------------------------------------------------------------------------
Private Function _URLEncode(ByVal psToEncode As String) As String
' http://www.w3schools.com/tags/ref_urlencode.asp
' http://xkr.us/articles/javascript/encode-compare/
@@ -897,4 +1017,4 @@ Private Function _UTF8Encode(ByVal psChar As String) As String
End Function ' _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 4fc58ca..7f53269 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">' Copyright 2012-2013 Jean-Pierre LEDURE
+<script:module xmlns:script="http://openoffice.org/2000/script" script:name="_License" script:language="StarBasic">' 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 959a71b..f804074 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 = "1.5.0"
+Global Const Access2Base_Version = "1.6.0"
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 -----------------------------------------------------------------
More information about the Libreoffice-commits
mailing list