Access2Base - CopyObject method extended to MySql and Sqlite

Tables must belong to the same database.
INSERT SQL statement syntax extended
Table- and fieldnames correct surrounding
Correction of incident declared in
https://ask.libreoffice.org/en/question/69795/access2base-findrecord-only-for-numbers/

Change-Id: Ice148d872cacfc80df421132020ab1717e7c908c

3 files changed, 64 insertions, 34 deletions

diff --git a/wizards/source/access2base/Application.xba b/wizards/source/access2base/Application.xba
index ae7483b0ac8e..95f81dffb5ea 100644
--- a/wizards/source/access2base/Application.xba
+++ b/wizards/source/access2base/Application.xba
@@ -1112,7 +1112,7 @@ Public Function OpenDatabase ( _
 				
 '	Return a database object based on input arguments:
 '	Call template:
-'		Call OpenConnection("... databaseURL ..."[, "", "", True/False])
+'		Call OpenDatabase("... databaseURL ..."[, "", "", True/False])
 '	pvDatabaseURL maby be the name of a registered database or the URL of the targeted .odb file
 '	Might be called from any AOO/LibO application, independently from OpenConnection
 
@@ -1120,7 +1120,10 @@ Dim odbDatabase As Variant, oBaseContext As Object, sDbNames() As String, oBaseS
 Dim i As Integer, bFound As Boolean
 Dim sDatabaseURL As String
 
-	If IsEmpty(_A2B_) Then Call Application._RootInit()	'	First use of Access2Base in current AOO/LibO session
+	If IsEmpty(_A2B_) Then					'	First use of Access2Base in current AOO/LibO session
+		Call Application._RootInit()
+		TraceLog(TRACEANY, Utils._GetProductName() & " - " & Application.ProductCode(), False)
+	End If
 	Set OpenDatabase = Nothing
 	
 	If _ErrorHandler() Then On Local Error Goto Error_Function
@@ -1173,7 +1176,6 @@ Const cstThisSub = "OpenDatabase"
 
 	Set OpenDatabase = odbDatabase
 	
-	TraceLog(TRACEANY, Utils._GetProductName() & " - " & Application.ProductCode(), False)
 	TraceLog(TRACEANY, odbDatabase.MetaData.getDatabaseProductName() & " " & odbDatabase.MetaData.getDatabaseProductVersion, False)
 	TraceLog(TRACEANY, UCase(cstThisSub) & " " & odbDatabase.URL, False)
 	
diff --git a/wizards/source/access2base/DoCmd.xba b/wizards/source/access2base/DoCmd.xba
index 8fe7ec990da7..1b914a4c75dd 100644
--- a/wizards/source/access2base/DoCmd.xba
+++ b/wizards/source/access2base/DoCmd.xba
@@ -181,7 +181,7 @@ Error_NotApplicable:
 End Function	'	(m)Close	V1.1.0
 
 REM -----------------------------------------------------------------------------------------------------------------------
-Public Function CopyObject(ByVal Optional pvDestinationDatabase As Variant _
+Public Function CopyObject(ByVal Optional pvSourceDatabase As Variant _
 							, ByVal Optional pvNewName As Variant _
 							, ByVal Optional pvSourceType As Variant _
 							, ByVal Optional pvSourceName As Variant _
@@ -192,8 +192,8 @@ Const cstThisSub = "CopyObject"
 	Utils._SetCalledSub(cstThisSub)
 	CopyObject = False
 
-	If IsMissing(pvDestinationDatabase) Then pvDestinationDatabase = ""
-	If Not Utils._CheckArgument(pvDestinationDatabase, 1, vbString, "") Then Goto Exit_Function
+	If IsMissing(pvSourceDatabase) Then pvSourceDatabase = ""
+	If Not Utils._CheckArgument(pvSourceDatabase, 1, vbString, "") Then Goto Exit_Function
 	If IsMissing(pvNewName) Then Call _TraceArguments()
 	If Not Utils._CheckArgument(pvNewName, 2, vbString) Then Goto Exit_Function
 	If IsMissing(pvSourceType) Then Call _TraceArguments()
@@ -202,19 +202,26 @@ Const cstThisSub = "CopyObject"
 	If IsMissing(pvSourceName) Then Call _TraceArguments()
 	If Not Utils._CheckArgument(pvSourceName, 2, vbString) Then Goto Exit_Function
 	
-Dim oSource As Object, oTarget As Object, oDatabase As Object
+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 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
 
 	Set oDatabase = Application._CurrentDb()
+	If pvSourceDatabase = "" Then
+		Set oSourceDatabase = oDatabase
+	Else
+		Set oSourceDatabase = Application.OpenDatabase(ConvertToUrl(pvSourceDatabase), "", "", True)
+		If IsNull(oSourceDatabase) Then Goto Exit_Function
+	End If
 	
 	With oDatabase
 		If ._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
 		Select Case pvSourceType
 
 			Case acQuery
-				Set oSource = .QueryDefs(pvSourceName, True)
+				Set oSource = oSourceDatabase.QueryDefs(pvSourceName, True)
 				If IsNull(oSource) Then Goto Error_NotFound
 				Set oTarget = .QueryDefs(pvNewName, True)
 				If Not IsNull(oTarget) Then .Connection.getQueries.dropByName(oTarget.Name)		'	a query with same name exists already ... drop it
@@ -227,7 +234,7 @@ Dim i As Integer, j As Integer, sSql As String, vPrimaryKeys() As Variant
 				.Document.store()
 
 			Case acTable
-				Set oSource = .TableDefs(pvSourceName, True)
+				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
@@ -235,7 +242,11 @@ Dim i As Integer, j As Integer, sSql As String, vPrimaryKeys() As Variant
 				Set oSourceTable = oSource.Table
 				Set oTarget = .Connection.getTables.createDataDescriptor
 				oTarget.Description = oSourceTable.Description
-				oTarget.Name = pvNewName
+				vNameComponents = Split(pvNewName, ".")
+				iNames = UBound(vNameComponents)
+				If iNames >= 2 Then oTarget.CatalogName = vNameComponents(iNames - 2) Else oTarget.CatalogName = ""
+				If iNames >= 1 Then oTarget.SchemaName = vNameComponents(iNames - 1) Else oTarget.SchemaName = ""
+				oTarget.Name = vNameComponents(iNames)
 				oTarget.Type = oSourceTable.Type
 				Set oSourceColumns = oSourceTable.Columns
 				Set oTargetCol = oTarget.Columns.createDataDescriptor
@@ -286,7 +297,8 @@ Dim i As Integer, j As Integer, sSql As String, vPrimaryKeys() As Variant
 				'	Duplicate table whole design
 				.Connection.getTables.appendByDescriptor(oTarget)
 				'	Copy data
-				sSql = "INSERT INTO [" & pvNewName & "] SELECT [" & oSource.Name & "].* FROM [" & oSource.Name & "]"
+				sSurround = Utils._Surround(oSource.Name)
+				sSql = "INSERT INTO " & Utils._Surround(pvNewName) & " SELECT " & sSurround & ".* FROM " & sSurround
 				DoCmd.RunSQL(sSql, dbSQLPassthrough)
 				
 			Case Else
@@ -296,6 +308,9 @@ Dim i As Integer, j As Integer, sSql As String, vPrimaryKeys() As Variant
 	CopyObject = True
 	
 Exit_Function:
+	If pvSourceDatabase <> "" Then			'	Avoid closing the current database
+		If Not IsNull(oSourceDatabase) Then oSourceDatabase.mClose()
+	End If
 	Utils._ResetCalledSub(cstThisSub)
 	Set oSourceCol = Nothing
 	Set oSourceKey = Nothing
@@ -390,26 +405,30 @@ Dim vFindValue As Variant, oFindrecord As Object
 						Case vbDate, vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal
 							bFound = ( .FindWhat = vFindValue )
 						Case vbString
-							Select Case .Match
-								Case acStart
-									If .MatchCase Then
-										bFound = ( Left(.FindWhat, Len(.FindWhat)) = vFindValue )
-									Else
-										bFound = ( UCase(Left(.FindWhat, Len(.FindWhat))) = UCase(vFindValue) )
-									End If
-								Case acAnyWhere
-									If .MatchCase Then
-										bFound = ( InStr(1, vFindValue, .FindWhat, 0) > 0 )
-									Else
-										bFound = ( InStr(vFindValue, .FindWhat) > 0 )
-									End If	
-								Case acEntire
-									If .MatchCase Then
-										bFound = ( .FindWhat = vFindValue )
-									Else
-										bFound = ( UCase(.FindWhat) = UCase(vFindValue) )
-									End If
-							End Select
+							If VarType(vFindValue) = vbString Then
+								Select Case .Match
+									Case acStart
+										If .MatchCase Then
+											bFound = ( Left(.FindWhat, Len(.FindWhat)) = vFindValue )
+										Else
+											bFound = ( UCase(Left(.FindWhat, Len(.FindWhat))) = UCase(vFindValue) )
+										End If
+									Case acAnyWhere
+										If .MatchCase Then
+											bFound = ( InStr(1, vFindValue, .FindWhat, 0) > 0 )
+										Else
+											bFound = ( InStr(vFindValue, .FindWhat) > 0 )
+										End If	
+									Case acEntire
+										If .MatchCase Then
+											bFound = ( .FindWhat = vFindValue )
+										Else
+											bFound = ( UCase(.FindWhat) = UCase(vFindValue) )
+										End If
+								End Select
+							Else
+								bFound = False
+							End If
 					End Select
 					If bFound Then
 						.LastColumn = i
diff --git a/wizards/source/access2base/Utils.xba b/wizards/source/access2base/Utils.xba
index 16f73cd636cd..6f9135cce559 100644
--- a/wizards/source/access2base/Utils.xba
+++ b/wizards/source/access2base/Utils.xba
@@ -615,7 +615,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 delimiters 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)
@@ -722,13 +722,22 @@ End Sub			'	SetCalledSub
 REM -----------------------------------------------------------------------------------------------------------------------
 Public Function _Surround(ByVal psName As String) As String
 ' Return [Name] if Name contains spaces
+' Return [Name1].[Name2].[Name3] if Name1.Name2.Name3 contains dots
+
 Const cstSquareOpen = "["
 Const cstSquareClose = "]"
-	If InStr(psName, " ") > 0 Then
+Const cstDot = "."
+Dim sName As String
+
+	If InStr(psName, ".") > 0 Then
+		sName = Join(Split(psName, cstDot), cstSquareClose & cstDot & cstSquareOpen
+		_Surround = cstSquareOpen & sName & cstSquareClose
+	ElseIf InStr(psName, " ") > 0 Then
 		_Surround = cstSquareOpen & psName & cstSquareClose
 	Else
 		_Surround = psName
 	End If
+
 End Function	'	Surround
 
 REM -----------------------------------------------------------------------------------------------------------------------
@@ -851,4 +860,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