Access2Base store (wizards + scp2)

License text modified after gerrit review

Change-Id: I193d6d1fd477cca4c2880760f21f8d978643f634
Reviewed-on: https://gerrit.libreoffice.org/6232Reviewed-by: Lionel Elie Mamane <lionel@mamane.lu>
Tested-by: Lionel Elie Mamane <lionel@mamane.lu>

scp2/source/ooo/directory_ooo.scp

@@ -255,6 +255,11 @@ Directory gid_Dir_Basic
     DosName = "basic";
 End
 
+Directory gid_Dir_Basic_Access2Base
+    ParentID = gid_Dir_Basic;
+    DosName = "Access2Base";
+End
+
 Directory gid_Dir_Basic_Euro
     ParentID = gid_Dir_Basic;
     DosName = "Euro";

scp2/source/ooo/file_ooo.scp

@@ -27,6 +27,13 @@
 
 #include "macros.inc"
 
+File gid_File_Basic_Access2Base
+    Dir = FILELIST_DIR;
+    TXT_FILE_BODY;
+    Styles = (FILELIST);
+    Name = "wizards_basicsrvaccess2base.filelist";
+End
+
 File gid_File_Basic_Depot
     Dir = FILELIST_DIR;
     TXT_FILE_BODY;

scp2/source/ooo/module_hidden_ooo.scp

@@ -265,6 +265,7 @@ Module gid_Module_Root_Files_6
 	gid_File_Scripts_Java,
 	gid_File_Scripts_Java_jars,
 	gid_File_Scripts_Javascript,
+	gid_File_Basic_Access2Base,
 	gid_File_Basic_Depot,
 	gid_File_Basic_Euro,
 	gid_File_Basic_Form,

wizards/Module_wizards.mk

@@ -25,6 +25,7 @@ $(eval $(call gb_Module_add_targets,wizards,\
 	AllLangResTarget_imp \
 	AllLangResTarget_tpl \
 	AllLangResTarget_wzi \
+	Package_access2base \
 	Package_depot \
 	Package_euro \
 	Package_form \

wizards/Package_access2base.mk

+# -*- Mode: makefile-gmake; tab-width: 4; indent-tabs-mode: t -*-
+#
+# This file is part of the LibreOffice project.
+#
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+#
+# This file incorporates work covered by the following license notice:
+#
+#   Licensed to the Apache Software Foundation (ASF) under one or more
+#   contributor license agreements. See the NOTICE file distributed
+#   with this work for additional information regarding copyright
+#   ownership. The ASF licenses this file to you under the Apache
+#   License, Version 2.0 (the "License"); you may not use this file
+#   except in compliance with the License. You may obtain a copy of
+#   the License at http://www.apache.org/licenses/LICENSE-2.0 .
+#
+
+$(eval $(call gb_Package_Package,wizards_basicsrvaccess2base,$(SRCDIR)/wizards/source/access2base))
+
+$(eval $(call gb_Package_set_outdir,wizards_basicsrvaccess2base,$(INSTROOT)))
+
+$(eval $(call gb_Package_add_files,wizards_basicsrvaccess2base,$(LIBO_SHARE_FOLDER)/basic/Access2Base,\
+	_License.xba \
+	acConstants.xba \
+	Application.xba \
+	Collect.xba \
+	Compatible.xba \
+	Control.xba \
+	Database.xba \
+	DataDef.xba \
+	Dialog.xba \
+	dialog.xlb \
+	dlgFormat.xdl \
+	dlgTrace.xdl \
+	DoCmd.xba \
+	Event.xba \
+	Field.xba \
+	Form.xba \
+	L10N.xba \
+	Methods.xba \
+	OptionGroup.xba \
+	PropertiesGet.xba \
+	PropertiesSet.xba \
+	Property.xba \
+	Recordset.xba \
+	script.xlb \
+	SubForm.xba \
+	Test.xba \
+	Trace.xba \
+	Utils.xba \
+))
+
+# vim: set noet sw=4 ts=4:

wizards/source/access2base/Collect.xba

+<?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="Collect" script:language="StarBasic">Option Compatible
+Option ClassModule
+
+Option Explicit
+
+REM MODULE NAME &lt;&gt; COLLECTION (seems a reserved name ?)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CLASS ROOT FIELDS 								        														---
+REM -----------------------------------------------------------------------------------------------------------------------
+
+Private _Type		As String		&apos;	Must be COLLECTION
+Private _CollType	As String
+Private _ParentType	As String
+Private _ParentName	As String		&apos;	Name or shortcut
+Private _Count		As Long
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CONSTRUCTORS / DESTRUCTORS						        														---
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Sub Class_Initialize()
+	_Type = OBJCOLLECTION
+	_CollType = &quot;&quot;
+	_ParentType = &quot;&quot;
+	_ParentName = &quot;&quot;
+	_Count = 0
+End Sub		&apos;	Constructor
+
+REM -----------------------------------------------------------------------------------------------------------------------
+&apos;Private Sub Class_Terminate()
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CLASS GET/LET/SET PROPERTIES					        														---
+REM -----------------------------------------------------------------------------------------------------------------------
+
+Property Get Count() As Long
+	Count = _PropertyGet(&quot;Count&quot;)
+End Property		&apos;	Count (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get Item(ByVal Optional pvItem As Variant) As Variant
+&apos;Return property value.
+&apos;pvItem either numeric index or property name
+
+Const cstThisSub = &quot;Collection.getItem&quot;
+	Utils._SetCalledSub(cstThisSub)
+	If IsMissing(pvItem) Then Call _TraceArguments()
+	If Not Utils._CheckArgument(pvItem, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
+
+Dim vNames() As Variant, oProperty As Object
+
+	Set Item = Nothing
+	Select Case _CollType
+		Case COLLALLDIALOGS
+			Set Item = Application.AllDialogs(pvItem)
+		Case COLLALLFORMS
+			Set Item = Application.AllForms(pvItem)
+		Case COLLCONTROLS
+			Select Case _ParentType
+				Case OBJCONTROL, OBJSUBFORM
+					Set Item = getObject(_ParentName).Controls(pvItem)
+				Case OBJDIALOG
+					Set Item = Application.AllDialogs(_ParentName).Controls(pvItem)
+				Case OBJFORM
+					Set Item = Application.Forms(_ParentName).Controls(pvItem)
+				Case OBJOPTIONGROUP
+					&apos; NOT SUPPORTED
+			End Select
+		Case COLLFORMS
+			Set Item = Application.Forms(pvItem)
+		Case COLLFIELDS
+			Select Case _ParentType
+				Case OBJQUERYDEF
+					Set Item = Application.CurrentDb().QueryDefs(_ParentName).Fields(pvItem)
+				Case OBJRECORDSET
+					Set Item = Application.CurrentDb().Recordsets(_ParentName).Fields(pvItem)
+				Case OBJTABLEDEF
+					Set Item = Application.CurrentDb().TableDefs(_ParentName).Fields(pvItem)
+			End Select
+		Case COLLPROPERTIES
+			Select Case _ParentType
+				Case OBJCONTROL, OBJSUBFORM
+					Set Item = getObject(_ParentName).Properties(pvItem)
+				Case OBJDATABASE
+					Set Item = Application.CurrentDb().Properties(pvItem)
+				Case OBJDIALOG
+					Set Item = Application.AllDialogs(_ParentName).Properties(pvItem)
+				Case OBJFIELD
+					vNames() = Split(_ParentName, &quot;/&quot;)
+					Select Case vNames(0)
+						Case OBJQUERYDEF
+							Set Item = Application.CurrentDb().QueryDefs(vNames(1)).Fields(vNames(2)).Properties(pvItem)
+						Case OBJRECORDSET
+							Set Item = Application.CurrentDb().Recordsets(vNames(1)).Fields(vNames(2)).Properties(pvItem)
+						Case OBJTABLEDEF
+							Set Item = Application.CurrentDb().TableDefs(vNames(1)).Fields(vNames(2)).Properties(pvItem)
+					End Select
+				Case OBJFORM
+					Set Item = Application.Forms(_ParentName).Properties(pvItem)
+				Case OBJQUERYDEF
+					Set Item = Application.CurrentDb().QueryDefs(_ParentName).Properties(pvItem)
+				Case OBJRECORDSET
+					Set Item = Application.CurrentDb().Recordsets(_ParentName).Properties(pvItem)
+				Case OBJTABLEDEF
+					Set Item = Application.CurrentDb().TableDefs(_ParentName).Properties(pvItem)
+				Case OBJCOLLECTION, OBJEVENT, OBJOPTIONGROUP
+					&apos; NOT SUPPORTED
+			End Select
+		Case COLLQUERYDEFS
+			Set Item = Application.CurrentDb().QueryDefs(pvItem)
+		Case COLLRECORDSETS
+			Set Item = Application.CurrentDb().Recordsets(pvItem)
+		Case COLLTABLEDEFS
+			Set Item = Application.CurrentDb().TableDefs(pvItem)
+		Case Else
+	End Select
+
+Exit_Function:
+	Exit Property
+Error_Function:
+	TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
+	Set Item = Nothing
+	GoTo Exit_Function
+End Property		&apos;	V0.9.5
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get ObjectType() As String
+	ObjectType = _PropertyGet(&quot;ObjectType&quot;)
+End Property		&apos;	ObjectType (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
+&apos;	Return
+&apos;		a Collection object if pvIndex absent
+&apos;		a Property object otherwise
+
+Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
+	vPropertiesList = _PropertiesList()
+	sObject = Utils._PCase(_Type)
+	If IsMissing(pvIndex) Then
+		vProperty = PropertiesGet._Properties(sObject, _ParentName, vPropertiesList)
+	Else
+		vProperty = PropertiesGet._Properties(sObject, _ParentName, vPropertiesList, pvIndex)
+		vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
+	End If
+	
+Exit_Function:
+	Set Properties = vProperty
+	Exit Function
+End Function	&apos;	Properties
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CLASS METHODS	 								        														---
+REM -----------------------------------------------------------------------------------------------------------------------
+
+Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
+&apos;	Return property value of psProperty property name
+
+	Utils._SetCalledSub(&quot;Collection.getProperty&quot;)
+	If IsMissing(pvProperty) Then Call _TraceArguments()
+	getProperty = _PropertyGet(pvProperty)
+	Utils._ResetCalledSub(&quot;Collection.getProperty&quot;)
+	
+End Function		&apos;	getProperty
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
+&apos;	Return True if object has a valid property called pvProperty (case-insensitive comparison !)
+
+	If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
+	Exit Function
+	
+End Function	&apos;	hasProperty
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- PRIVATE FUNCTIONS 								        														---
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _PropertiesList() As Variant
+	 _PropertiesList = Array(&quot;Count&quot;, &quot;ObjectType&quot;)
+End Function	&apos;	_PropertiesList
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _PropertyGet(ByVal psProperty As String) As Variant
+&apos;	Return property value of the psProperty property name
+
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+	Utils._SetCalledSub(&quot;Collection.get&quot; &amp; psProperty)
+	_PropertyGet = Nothing
+	
+	Select Case UCase(psProperty)
+		Case UCase(&quot;Count&quot;)
+			_PropertyGet = _Count
+		Case UCase(&quot;ObjectType&quot;)
+			_PropertyGet = _Type
+		Case Else
+			Goto Trace_Error
+	End Select
+	
+Exit_Function:
+	Utils._ResetCalledSub(&quot;Collection.get&quot; &amp; psProperty)
+	Exit Function
+Trace_Error:
+	TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
+	_PropertyGet = Nothing
+	Goto Exit_Function
+Error_Function:
+	TraceError(TRACEABORT, Err, &quot;Collection._PropertyGet&quot;, Erl)
+	_PropertyGet = Nothing
+	GoTo Exit_Function
+End Function		&apos;	_PropertyGet
+
+
+</script:module>
\ No newline at end of file

wizards/source/access2base/Compatible.xba

+<?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="Compatible" script:language="StarBasic">Option Compatible
+Option Explicit
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Sub DebugPrint(ParamArray pvArgs() As Variant)
+
+&apos;Print arguments unconditionnally in console
+&apos;Arguments are separated by a TAB (simulated by spaces)
+&apos;Some pvArgs might be missing: a TAB is still generated
+
+Dim vVarTypes() As Variant, i As Integer
+Const cstTab = 5
+	On Local Error Goto Exit_Sub	&apos;	Never interrupt processing
+	Utils._SetCalledSub(&quot;DebugPrint&quot;)
+	vVarTypes = Utils._AddNumeric(Array(vbEmpty, vbNull, vbDate, vbString, vbBoolean, vbObject, vbVariant))
+	
+	If UBound(pvArgs) &gt;= 0 Then
+		For i = 0 To UBound(pvArgs)
+&apos;			If IsError(pvArgs(i)) Then		&apos;	IsError gives &quot;Object variable not set&quot; in LO 4,0 ?!?
+&apos;				pvArgs(i) = &quot;[ERROR]&quot;
+&apos;			Else
+				If Not Utils._CheckArgument(pvArgs(i), i + 1, vVarTypes(), , False) Then pvArgs(i) = &quot;[TYPE?]&quot;
+&apos;			End If
+		Next i
+	End If
+
+Dim sOutput As String, sArg As String
+	sOutput = &quot;&quot;	
+	For i = 0 To UBound(pvArgs)
+		sArg = Utils._CStr(pvArgs(i))
+		&apos; Add argument to output
+		If i = 0 Then
+			sOutput = sArg
+		Else
+			sOutput = sOutput &amp; Space(cstTab - (Len(sOutput) Mod cstTab)) &amp; sArg
+		End If
+	Next i
+	
+	TraceLog(TRACEANY, sOutput, False)
+	
+Exit_Sub:
+	Utils._ResetCalledSub(&quot;DebugPrint&quot;)
+	Exit Sub
+End Sub			&apos;	DebugPrint		V0.9.5
+</script:module>
\ No newline at end of file

wizards/source/access2base/Property.xba

+<?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="Property" script:language="StarBasic">Option Compatible
+Option ClassModule
+
+Option Explicit
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CLASS ROOT FIELDS 								        														---
+REM -----------------------------------------------------------------------------------------------------------------------
+
+Private _Type		As String		&apos;	Must be PROPERTY
+Private _Name		As String
+Private _Value		As Variant
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CONSTRUCTORS / DESTRUCTORS						        														---
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Sub Class_Initialize()
+	_Type = OBJPROPERTY
+	_Name = &quot;&quot;
+	_Value = Null
+End Sub		&apos;	Constructor
+
+REM -----------------------------------------------------------------------------------------------------------------------
+&apos;Private Sub Class_Terminate()
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CLASS GET/LET/SET PROPERTIES					        														---
+REM -----------------------------------------------------------------------------------------------------------------------
+
+Property Get Name() As String
+	Name = _PropertyGet(&quot;Name&quot;)
+End Property		&apos;	Name (get)
+
+Public Function pName() As String		&apos;	For compatibility with &lt; V0.9.0
+	pName = _PropertyGet(&quot;Name&quot;)
+End Function		&apos;	pName (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get ObjectType() As String
+	ObjectType = _PropertyGet(&quot;ObjectType&quot;)
+End Property		&apos;	ObjectType (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
+&apos;	Return
+&apos;		a Collection object if pvIndex absent
+&apos;		a Property object otherwise
+
+Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
+	vPropertiesList = _PropertiesList()
+	sObject = Utils._PCase(_Type)
+	If IsMissing(pvIndex) Then
+		vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList)
+	Else
+		vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList, pvIndex)
+		vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
+	End If
+	
+Exit_Function:
+	Set Properties = vProperty
+	Exit Function
+End Function	&apos;	Properties
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Property Get Value() As Variant
+	Value = _PropertyGet(&quot;Value&quot;)
+End Property		&apos;	Value (get)
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CLASS METHODS	 								        														---
+REM -----------------------------------------------------------------------------------------------------------------------
+
+Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
+&apos;	Return property value of psProperty property name
+
+	Utils._SetCalledSub(&quot;Property.getProperty&quot;)
+	If IsMissing(pvProperty) Then Call _TraceArguments()
+	getProperty = _PropertyGet(pvProperty)
+	Utils._ResetCalledSub(&quot;Property.getProperty&quot;)
+	
+End Function		&apos;	getProperty
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
+&apos;	Return True if object has a valid property called pvProperty (case-insensitive comparison !)
+
+	If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
+	Exit Function
+	
+End Function	&apos;	hasProperty
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- PRIVATE FUNCTIONS 								        														---
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _PropertiesList() As Variant
+	 _PropertiesList = Array(&quot;Name&quot;, &quot;ObjectType&quot;, &quot;Value&quot;)
+End Function	&apos;	_PropertiesList
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Function _PropertyGet(ByVal psProperty As String) As Variant
+&apos;	Return property value of the psProperty property name
+
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+	Utils._SetCalledSub(&quot;Property.get&quot; &amp; psProperty)
+	_PropertyGet = Nothing
+	
+	Select Case UCase(psProperty)
+		Case UCase(&quot;Name&quot;)
+			_PropertyGet = _Name
+		Case UCase(&quot;ObjectType&quot;)
+			_PropertyGet = _Type
+		Case UCase(&quot;Value&quot;)
+			_PropertyGet = _Value
+		Case Else
+			Goto Trace_Error
+	End Select
+	
+Exit_Function:
+	Utils._ResetCalledSub(&quot;Property.get&quot; &amp; psProperty)
+	Exit Function
+Trace_Error:
+	TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
+	_PropertyGet = Nothing
+	Goto Exit_Function
+Error_Function:
+	TraceError(TRACEABORT, Err, &quot;Property._PropertyGet&quot;, Erl)
+	_PropertyGet = Nothing
+	GoTo Exit_Function
+End Function		&apos;	_PropertyGet
+
+
+</script:module>
\ No newline at end of file

wizards/source/access2base/Test.xba

+<?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="Test" script:language="StarBasic">Option Explicit
+&apos;Option Compatible
+
+Sub Main
+	Application._RootInit()
+	_A2B_.CalledSub = &quot;&quot;
+	Application.SysCmd(acSysCmdRemoveMeter)
+Dim a as variant, b as variant, c as variant, d as variant, i as integer, s as string,f as variant, h as variant, j as long, k as integer, l as integer, sFile As String
+Dim lTime1 as Date, lTime2 as Long
+	lTime1=getsystemticks()
+&apos;	TraceConsole()
+
+	lTime2=getsystemticks
+	debugprint lTime2 - lTime1
+	exit sub
+End Sub
+</script:module>
\ No newline at end of file

wizards/source/access2base/dialog.xlb

+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
+<library:library xmlns:library="http://openoffice.org/2000/library" library:name="Access2Base" library:readonly="false" library:passwordprotected="false">
+ <library:element library:name="dlgTrace"/>
+ <library:element library:name="dlgFormat"/>
+</library:library>
\ No newline at end of file

wizards/source/configshare/dialog.xlc

@@ -9,4 +9,5 @@
  <library:library library:name="Euro" xlink:href="$(INST)/$(SHARE_SUBDIR_NAME)/basic/Euro/dialog.xlb/" xlink:type="simple" library:link="true" library:readonly="false"/>
  <library:library library:name="Depot" xlink:href="$(INST)/$(SHARE_SUBDIR_NAME)/basic/Depot/dialog.xlb/" xlink:type="simple" library:link="true" library:readonly="false"/>
  <library:library library:name="ScriptBindingLibrary" xlink:href="$(INST)/$(SHARE_SUBDIR_NAME)/basic/ScriptBindingLibrary/dialog.xlb/" xlink:type="simple" library:link="true" library:readonly="false"/>
-</library:libraries>
+ <library:library library:name="Access2Base" xlink:href="$(INST)/$(SHARE_SUBDIR_NAME)/basic/Access2Base/dialog.xlb/" xlink:type="simple" library:link="true" library:readonly="false"/>
+ </library:libraries>