diff options
| -rw-r--r-- | wizards/source/access2base/Application.xba | 22 | ||||
| -rw-r--r-- | wizards/source/access2base/Database.xba | 127 | ||||
| -rw-r--r-- | wizards/source/access2base/DoCmd.xba | 254 | ||||
| -rw-r--r-- | wizards/source/access2base/Field.xba | 2 | ||||
| -rw-r--r-- | wizards/source/access2base/L10N.xba | 4 | ||||
| -rw-r--r-- | wizards/source/access2base/Recordset.xba | 5 | ||||
| -rw-r--r-- | wizards/source/access2base/Utils.xba | 204 | ||||
| -rw-r--r-- | wizards/source/access2base/_License.xba | 2 | ||||
| -rw-r--r-- | wizards/source/access2base/acConstants.xba | 3 |
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 ' 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 d022d4ce178f..a68c64ee0b94 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 1b914a4c75dd..f85f3c0f615d 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 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 ' 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 2dbbdfc5d032..db39159055c9 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 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 ' 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 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 = "[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 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">' 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 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 = "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 ----------------------------------------------------------------- |