wizards/Package_sfdatabases.mk | 1
wizards/source/scriptforge/SF_Exception.xba | 19
wizards/source/scriptforge/SF_PythonHelper.xba | 4
wizards/source/scriptforge/SF_Root.xba | 49
wizards/source/scriptforge/po/ScriptForge.pot | 65
wizards/source/scriptforge/po/en.po | 65
wizards/source/scriptforge/python/scriptforge.py | 88 +
wizards/source/sfdatabases/SF_Database.xba | 146 +-
wizards/source/sfdatabases/SF_Dataset.xba | 1664 +++++++++++++++++++++++
wizards/source/sfdatabases/SF_Datasheet.xba | 8
wizards/source/sfdatabases/script.xlb | 1
11 files changed, 2066 insertions(+), 44 deletions(-)
New commits:
commit 7b2a6f04443c5d80ce681e5f1c89bf140fdb5c3a
Author: Jean-Pierre Ledure <j...@ledure.be>
AuthorDate: Sat Nov 11 17:02:38 2023 +0100
Commit: Jean-Pierre Ledure <j...@ledure.be>
CommitDate: Sat Nov 11 18:20:15 2023 +0100
ScriptForge (SFDatabases) new Dataset service
A dataset represents a set of tabular data
stored/produced by a database.
To use datasets, the database instance must exist
but the Base document may not be open.
A Dataset instance is create either with
- the (new) database.CreateDataset() method
- from an existing dataset with the (new)
dataset.CreateDataset() method.
The proposed API supports next main purposes:
- browse for- and backward thru the dataset to get its content
- update any record with new values
- create new records or delete some.
In summary, the AKA "CRUD" operations
(create, read, update, delete).
The originality of the proposed API is the use
of a dense syntax to make insertions and updates
easy and readable:
Example:
(BASIC)
Dim newID As Long
newID = dataset.Insert("LastName", "Doe", "FirstName", "John")
' ... is equivalent to:
Dim dict As Object, newID As Long
Set dict = CreateScriptService("ScriptForge.Dictionary")
dict.Add("LastName", "Doe")
dict.Add("FirstName", "John")
newID = dataset.Insert(dict)
(PYTHON) - next statements are equivalent
newid = dataset.Insert('LastName', 'Doe', 'FirstName', 'John')
newid = dataset.Insert({'LastName': 'Doe', 'FirstName': 'John'})
newid = dataset.Insert(dict(LastName = 'Doe', FirstName = 'John'))
newid = dataset.Insert(LastName = 'Doe', FirstName = 'John')
You will notice that the returned value is the AutoValue primery
key (when it exists) which makes it reuse as a foreign key
immediate.
The API is fully available both in Basic and Python user scripts.
The new service will require its inclusion in the user documentation.
Change-Id: I4f834c4234e5b96ec8fddfffbad791ecf31899df
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/159325
Reviewed-by: Jean-Pierre Ledure <j...@ledure.be>
Tested-by: Jenkins
diff --git a/wizards/Package_sfdatabases.mk b/wizards/Package_sfdatabases.mk
index bc5636fa1b2f..2919c84dce3c 100644
--- a/wizards/Package_sfdatabases.mk
+++ b/wizards/Package_sfdatabases.mk
@@ -21,6 +21,7 @@ $(eval $(call
gb_Package_Package,wizards_basicsrvsfdatabases,$(SRCDIR)/wizards/s
$(eval $(call
gb_Package_add_files,wizards_basicsrvsfdatabases,$(LIBO_SHARE_FOLDER)/basic/SFDatabases,\
SF_Database.xba \
+ SF_Dataset.xba \
SF_Datasheet.xba \
SF_Register.xba \
__License.xba \
diff --git a/wizards/source/scriptforge/SF_Exception.xba
b/wizards/source/scriptforge/SF_Exception.xba
index 38e5b2ef24e0..4b0fdb8d5eb1 100644
--- a/wizards/source/scriptforge/SF_Exception.xba
+++ b/wizards/source/scriptforge/SF_Exception.xba
@@ -132,6 +132,10 @@ Const DUPLICATECONTROLERROR =
"DUPLICATECONTROLERROR"
' SF_Database
Const DBREADONLYERROR = "DBREADONLYERROR"
Const SQLSYNTAXERROR = "SQLSYNTAXERROR"
+Const SQLSYNTAX2ERROR = "SQLSYNTAX2ERROR"
+Const NOCURRENTRECORDERROR = "NOCURRENTRECORDERROR"
+Const RECORDUPDATEERROR =
"RECORDUPDATEERROR"
+Const FIELDEXPORTERROR = "FIELDEXPORTERROR"
' Python
Const PYTHONSHELLERROR = "PYTHONSHELLERROR"
@@ -1035,12 +1039,25 @@ Try:
sMessage = sLocation _
& "\n" &
"\n" & "\n" & .GetText("VALIDATEERROR",
pvArgs(0)) _
& "\n" &
"\n" & .GetText("DUPLICATECONTROL", pvArgs(0),
pvArgs(1), pvArgs(2))
- Case DBREADONLYERROR ' SF_Database.RunSql()
+ Case DBREADONLYERROR ' SF_Database.RunSql(),
SF_Dataset.Delete(), Insert(), Update()
sMessage = sLocation _
& "\n" &
"\n" & .GetText("DBREADONLY", vLocation(2))
Case SQLSYNTAXERROR '
SF_Database._ExecuteSql(SQL)
sMessage = sLocation _
& "\n" &
"\n" & .GetText("SQLSYNTAX", pvArgs(0))
+ Case SQLSYNTAX2ERROR '
SF_Dataset.Reload/_Initialize(SQL, Filter, OrderBy)
+ sMessage = sLocation _
+ & "\n" &
"\n" & .GetText("SQLSYNTAX2", pvArgs(0), pvArgs(1),
pvArgs(2))
+ Case NOCURRENTRECORDERROR '
SF_Dataset.Insert/Update/GetValue/Delete
+ sMessage = sLocation _
+ & "\n" &
"\n" & .GetText("NOCURRENTRECORD")
+ Case RECORDUPDATEERROR '
SF_Dataset.Insert/Update(FieldName, FieldValue, FieldType)
+ sMessage = sLocation _
+ & "\n" &
"\n" & .GetText("RECORDUPDATE", pvArgs(0), pvArgs(1),
pvARgs(2))
+ Case FIELDEXPORTERROR '
SF_Dataset.ExportFieldToFile(Arg1Name, FileName, Arg2, Overwrite)
+ pvArgs(0) = _RightCase(pvArgs(0)) :
pvArgs(2) = _RightCase(pvArgs(2))
+ sMessage = sLocation _
+ & "\n" &
"\n" & .GetText("FIELDEXPORT", pvArgs(0), pvArgs(1),
pvArgs(2), pvArgs(3))
Case PYTHONSHELLERROR '
SF_Exception.PythonShell (Python only)
sMessage = sLocation _
& "\n" &
"\n" & .GetText("PYTHONSHELL")
diff --git a/wizards/source/scriptforge/SF_PythonHelper.xba
b/wizards/source/scriptforge/SF_PythonHelper.xba
index 8ad0dfa7c06c..bcb0f8a61e75 100644
--- a/wizards/source/scriptforge/SF_PythonHelper.xba
+++ b/wizards/source/scriptforge/SF_PythonHelper.xba
@@ -776,6 +776,8 @@ Try:
Select Case sServiceName
Case
"SFDatabases.Database"
If Script =
"GetRows" Then vReturn = vBasicObject.GetRows(vArgs(0),
vArgs(1), vArgs(2), vArgs(3))
+ Case
"SFDatabases.Dataset"
+ If Script =
"GetRows" Then vReturn = vBasicObject.GetRows(vArgs(0),
vArgs(1))
Case
"SFDialogs.Dialog"
If Script =
"Controls" Then vReturn = vBasicObject.Controls(vArgs(0))
Case
"SFDialogs.DialogControl"
@@ -945,7 +947,7 @@ Try:
vReturnArray(1) = V_OBJECT
Select Case True
Case bUno : vReturnArray(2)
= objUNO
- Case bDICT : vReturnArray(2)
= objDICT
+ Case bDict : vReturnArray(2)
= objDICT
Case bBasicClass : vReturnArray(2) =
objCLASS
Case Else : vReturnArray(2)
= objMODULE
End Select
diff --git a/wizards/source/scriptforge/SF_Root.xba
b/wizards/source/scriptforge/SF_Root.xba
index 488e8bfc2e8f..dc1bfa32a49c 100644
--- a/wizards/source/scriptforge/SF_Root.xba
+++ b/wizards/source/scriptforge/SF_Root.xba
@@ -1028,7 +1028,7 @@ Try:
&
"%2: A string\n" _
&
"%3: A dialog name" _
)
- ' SF_Database.RunSql
+ ' SF_Database.RunSql, SF_Dataset.Delete/Insert/Update
.AddText( Context := "DBREADONLY" _
, MsgId := "The database
has been opened in read-only mode.\n" _
&
"The '%1' method must not be executed in this context." _
@@ -1043,6 +1043,53 @@ Try:
, Comment :=
"SF_Database can't interpret SQL statement\n" _
&
"%1: The statement" _
)
+ ' SF_Dataset.Reload/_Initialize
+ .AddText( Context := "SQLSYNTAX2" _
+ , MsgId := "An SQL
statement could not be interpreted or executed by the database system.\n" _
+ &
"Check its syntax, table and/or field names, ...\n\n" _
+ &
"SQL Statement : « %1 »\n" _
+ &
"combined with\n" _
+ &
" « %2 »\n" _
+ &
" « %3 »" _
+ , Comment :=
"SF_Database can't interpret SQL statement\n" _
+ &
"%1: The statement\n" _
+ &
"%2: a WHERE clause\n" _
+ &
"%3: a ORDER BY clause" _
+ )
+ ' SF_Dataset.Update/Insert/Delete/GetValue
+ .AddText( Context := "NOCURRENTRECORD" _
+ , MsgId := "A database
record could not be retrieved, inserted or updated by the database
system.\n" _
+ &
"The current record could not be determined.\n" _
+ , Comment :=
"SF_Dataset can't read field values or store field updates" _
+ )
+ ' SF_Dataset._SetColumnValue
+ .AddText( Context := "RECORDUPDATE" _
+ , MsgId := "A database
record could not be inserted or updated by the database system.\n" _
+ &
"Possible reasons:\n" _
+ &
"- the field is not updatable\n" _
+ &
"- a [NULL] value is provided which is forbidden for the field\n" _
+ &
"- the type of value and the type of field are incompatible\n" _
+ &
"- the input binary file does not exist or is empty\n" _
+ &
"- the field type is not supported\n\n" _
+ &
"Field name : « %1 »\n" _
+ &
"Field value : « %2 »\n" _
+ &
"Field type : « %3 »" _
+ , Comment :=
"SF_Database can't store field updates\n" _
+ &
"%1: The field name\n" _
+ &
"%2: the value to store in the field" _
+ )
+ ' SF_Dataset.ExportFieldToFile
+ .AddText( Context := "FIELDEXPORT" _
+ , MsgId := "The database
field could not be exported.\n" _
+ &
"Either the destination file must not be overwritten, or it has a
read-only attribute set.\n\n" _
+ &
"%1 = '%2'\n" _
+ &
"%3 = %4" _
+ , Comment :=
"SF_Dataset.ExportToFile error message\n" _
+ &
"%1: An identifier\n" _
+ &
"%2: A file name\n" _
+ &
"%3: An identifier\n" _
+ &
"%4: True or False\n" _
+ )
' SF_Exception.PythonShell (Python only)
.AddText( Context := "PYTHONSHELL" _
, MsgId := "The APSO
extension could not be located in your LibreOffice installation." _
diff --git a/wizards/source/scriptforge/po/ScriptForge.pot
b/wizards/source/scriptforge/po/ScriptForge.pot
index 644399bbbd15..814f75ec041f 100644
--- a/wizards/source/scriptforge/po/ScriptForge.pot
+++ b/wizards/source/scriptforge/po/ScriptForge.pot
@@ -14,7 +14,7 @@ msgid ""
msgstr ""
"Project-Id-Version: PACKAGE VERSION\n"
"Report-Msgid-Bugs-To:
https://bugs.libreoffice.org/enter_bug.cgi?product=LibreOffice&bug_status=UNCONFIRMED&component=UI\n";
-"POT-Creation-Date: 2023-09-03 13:05:04\n"
+"POT-Creation-Date: 2023-11-11 15:24:14\n"
"PO-Revision-Date: YYYY-MM-DD HH:MM:SS\n"
"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
"Language-Team: LANGUAGE <EMAIL@ADDRESS>\n"
@@ -990,6 +990,69 @@ msgid ""
"SQL Statement : « %1 »"
msgstr ""
+#. SF_Database can't interpret SQL statement
+#. %1: The statement
+#. %2: a WHERE clause
+#. %3: a ORDER BY clause
+#, kde-format
+msgctxt "SQLSYNTAX2"
+msgid ""
+"An SQL statement could not be interpreted or executed by the "
+"database system.\n"
+"Check its syntax, table and/or field names, ...\n"
+"\n"
+"SQL Statement : « %1 »\n"
+"combined with\n"
+" « %2 »\n"
+" « %3 »"
+msgstr ""
+
+#. SF_Dataset can't read field values or store field updates
+msgctxt "NOCURRENTRECORD"
+msgid ""
+"A database record could not be retrieved, inserted or updated by the "
+"database system.\n"
+"The current record could not be determined.\n"
+""
+msgstr ""
+
+#. SF_Database can't store field updates
+#. %1: The field name
+#. %2: the value to store in the field
+#, kde-format
+msgctxt "RECORDUPDATE"
+msgid ""
+"A database record could not be inserted or updated by the database "
+"system.\n"
+"Possible reasons:\n"
+"- the field is not updatable\n"
+"- a [NULL] value is provided which is forbidden for the field\n"
+"- the type of value and the type of field are incompatible\n"
+"- the input binary file does not exist or is empty\n"
+"- the field type is not supported\n"
+"\n"
+"Field name : « %1 »\n"
+"Field value : « %2 »\n"
+"Field type : « %3 »"
+msgstr ""
+
+#. SF_Dataset.ExportToFile error message
+#. %1: An identifier
+#. %2: A file name
+#. %3: An identifier
+#. %4: True or False
+#.
+#, kde-format
+msgctxt "FIELDEXPORT"
+msgid ""
+"The database field could not be exported.\n"
+"Either the destination file must not be overwritten, or it has a "
+"read-only attribute set.\n"
+"\n"
+"%1 = '%2'\n"
+"%3 = %4"
+msgstr ""
+
#. SF_Exception.PythonShell error messageAPSO: to leave unchanged
msgctxt "PYTHONSHELL"
msgid ""
diff --git a/wizards/source/scriptforge/po/en.po
b/wizards/source/scriptforge/po/en.po
index 644399bbbd15..814f75ec041f 100644
--- a/wizards/source/scriptforge/po/en.po
+++ b/wizards/source/scriptforge/po/en.po
@@ -14,7 +14,7 @@ msgid ""
msgstr ""
"Project-Id-Version: PACKAGE VERSION\n"
"Report-Msgid-Bugs-To:
https://bugs.libreoffice.org/enter_bug.cgi?product=LibreOffice&bug_status=UNCONFIRMED&component=UI\n";
-"POT-Creation-Date: 2023-09-03 13:05:04\n"
+"POT-Creation-Date: 2023-11-11 15:24:14\n"
"PO-Revision-Date: YYYY-MM-DD HH:MM:SS\n"
"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
"Language-Team: LANGUAGE <EMAIL@ADDRESS>\n"
@@ -990,6 +990,69 @@ msgid ""
"SQL Statement : « %1 »"
msgstr ""
+#. SF_Database can't interpret SQL statement
+#. %1: The statement
+#. %2: a WHERE clause
+#. %3: a ORDER BY clause
+#, kde-format
+msgctxt "SQLSYNTAX2"
+msgid ""
+"An SQL statement could not be interpreted or executed by the "
+"database system.\n"
+"Check its syntax, table and/or field names, ...\n"
+"\n"
+"SQL Statement : « %1 »\n"
+"combined with\n"
+" « %2 »\n"
+" « %3 »"
+msgstr ""
+
+#. SF_Dataset can't read field values or store field updates
+msgctxt "NOCURRENTRECORD"
+msgid ""
+"A database record could not be retrieved, inserted or updated by the "
+"database system.\n"
+"The current record could not be determined.\n"
+""
+msgstr ""
+
+#. SF_Database can't store field updates
+#. %1: The field name
+#. %2: the value to store in the field
+#, kde-format
+msgctxt "RECORDUPDATE"
+msgid ""
+"A database record could not be inserted or updated by the database "
+"system.\n"
+"Possible reasons:\n"
+"- the field is not updatable\n"
+"- a [NULL] value is provided which is forbidden for the field\n"
+"- the type of value and the type of field are incompatible\n"
+"- the input binary file does not exist or is empty\n"
+"- the field type is not supported\n"
+"\n"
+"Field name : « %1 »\n"
+"Field value : « %2 »\n"
+"Field type : « %3 »"
+msgstr ""
+
+#. SF_Dataset.ExportToFile error message
+#. %1: An identifier
+#. %2: A file name
+#. %3: An identifier
+#. %4: True or False
+#.
+#, kde-format
+msgctxt "FIELDEXPORT"
+msgid ""
+"The database field could not be exported.\n"
+"Either the destination file must not be overwritten, or it has a "
+"read-only attribute set.\n"
+"\n"
+"%1 = '%2'\n"
+"%3 = %4"
+msgstr ""
+
#. SF_Exception.PythonShell error messageAPSO: to leave unchanged
msgctxt "PYTHONSHELL"
msgid ""
diff --git a/wizards/source/scriptforge/python/scriptforge.py
b/wizards/source/scriptforge/python/scriptforge.py
index 13ceadca96fc..bcaff12f5cc5 100644
--- a/wizards/source/scriptforge/python/scriptforge.py
+++ b/wizards/source/scriptforge/python/scriptforge.py
@@ -29,7 +29,7 @@
program document macros with much less hassle and get quicker results.
The use of the ScriptForge interfaces in user scripts hides the complexity
of the usual UNO interfaces.
- However it does not replace them. At the opposite their coexistence is
ensured.
+ However, it does not replace them. At the opposite their coexistence is
ensured.
Indeed, ScriptForge provides a number of shortcuts to key UNO objects.
The scriptforge.py module
@@ -216,7 +216,7 @@ class ScriptForge(object, metaclass = _Singleton):
"""
def ParseScript(_script):
- # Check ParamArray arguments
+ # Check ParamArray, scope, script to run, arguments
_paramarray = False
if _script[0] == '@':
_script = _script[1:]
@@ -241,7 +241,7 @@ class ScriptForge(object, metaclass = _Singleton):
lib = cls.library + '.' # Default library = ScriptForge
uri =
'vnd.sun.star.script:{0}{1}?language=Basic&location={2}'.format(lib, _script,
scope)
# Get the script object
- _fullscript = ('@' if _paramarray else '') + scope + ':' + _script
+ _fullscript = ('@' if _paramarray else '') + scope + '#' + _script
try:
_xscript = cls.scriptprovider.getScript(uri) #
com.sun.star.script.provider.XScript
except Exception:
@@ -1784,6 +1784,9 @@ class SFDatabases:
def CloseDatabase(self):
return self.ExecMethod(self.vbMethod, 'CloseDatabase')
+ def CreateDataset(self, sqlcommand, directsql = False, filter = '',
orderby = ''):
+ return self.ExecMethod(self.vbMethod, 'CreateDataset', sqlcommand,
directsql, filter, orderby)
+
def DAvg(self, expression, tablename, criteria = ''):
return self.ExecMethod(self.vbMethod, 'DAvg', expression,
tablename, criteria)
@@ -1820,6 +1823,85 @@ class SFDatabases:
def RunSql(self, sqlcommand, directsql = False):
return self.ExecMethod(self.vbMethod, 'RunSql', sqlcommand,
directsql)
+ # #########################################################################
+ # SF_Dataset CLASS
+ # #########################################################################
+ class SF_Dataset(SFServices):
+ """
+ A dataset represents a set of tabular data produced by a database.
+ In the user interface of LibreOffice a dataset corresponds with
the data
+ displayed in a form, a data sheet (table, query).
+ To use datasets, the database instance must exist but the Base
document may not be open.
+ """
+ # Mandatory class properties for service registration
+ serviceimplementation = 'basic'
+ servicename = 'SFDatabases.Dataset'
+ servicesynonyms = () # CreateScriptService is not applicable here
+ serviceproperties = dict(BOF = True, DefaultValues = False, EOF =
True, Fields = False, Filter = False,
+ OrderBy = False, ParentDatabase = False,
RowCount = False, RowNumber = False,
+ Source = False, SourceType = False,
UpdatableFields = False, Values = False,
+ XRowSet = False)
+ forceGetProperty = True
+
+ @classmethod
+ def _dictargs(cls, args, kwargs):
+ """
+ Convert a set of keyword arguments to a dictionary to pass to
the Basic world
+ """
+ if len(args) == 0 and len(kwargs) > 0:
+ return kwargs
+ if len(args) > 0:
+ if len(kwargs) == 0:
+ if isinstance(args[0], dict):
+ return args[0]
+ return {args[i]: args[i + 1] for i in range(0, len(args),
2)}
+ return None
+
+ def CloseDataset(self):
+ return self.ExecMethod(self.vbMethod, 'CloseDataset')
+
+ def CreateDataset(self, filter = ScriptForge.cstSymMissing, orderby =
ScriptForge.cstSymMissing):
+ return self.ExecMethod(self.vbMethod, 'CreateDataset', filter,
orderby)
+
+ def Delete(self):
+ return self.ExecMethod(self.vbMethod, 'Delete')
+
+ def ExportValueToFile(self, fieldname, filename, overwrite = False):
+ return self.ExecMethod(self.vbMethod, 'ExportValueToFile',
fieldname, filename, overwrite)
+
+ def GetRows(self, header = False, maxrows = 0):
+ return self.ExecMethod(self.vbMethod + self.flgArrayRet,
'GetRows', header, maxrows)
+
+ def GetValue(self, fieldname):
+ return self.ExecMethod(self.vbMethod, 'GetValue', fieldname)
+
+ def Insert(self, *args, **kwargs):
+ updateslist = self._dictargs(args, kwargs)
+ if updateslist is None:
+ return -1 # The insertion could not be done
+ return self.ExecMethod(self.vbMethod + self.flgDictArg, 'Insert',
updateslist)
+
+ def MoveFirst(self):
+ return self.ExecMethod(self.vbMethod, 'MoveFirst')
+
+ def MoveLast(self):
+ return self.ExecMethod(self.vbMethod, 'MoveLast')
+
+ def MoveNext(self, offset = 1):
+ return self.ExecMethod(self.vbMethod, 'MoveNext', offset)
+
+ def MovePrevious(self, offset = 1):
+ return self.ExecMethod(self.vbMethod, 'MovePrevious', offset)
+
+ def Reload(self, filter = ScriptForge.cstSymMissing, orderby =
ScriptForge.cstSymMissing):
+ return self.ExecMethod(self.vbMethod, 'Reload', filter, orderby)
+
+ def Update(self, *args, **kwargs):
+ updateslist = self._dictargs(args, kwargs)
+ if updateslist is None:
+ return False # The update could not be done
+ return self.ExecMethod(self.vbMethod + self.flgDictArg, 'Update',
updateslist)
+
# #########################################################################
# SF_Datasheet CLASS
# #########################################################################
diff --git a/wizards/source/sfdatabases/SF_Database.xba
b/wizards/source/sfdatabases/SF_Database.xba
index f280762d8146..50d2e2e41cd3 100644
--- a/wizards/source/sfdatabases/SF_Database.xba
+++ b/wizards/source/sfdatabases/SF_Database.xba
@@ -53,6 +53,7 @@ REM
================================================================== EXCEPTION
Private Const DBREADONLYERROR = "DBREADONLYERROR"
Private Const SQLSYNTAXERROR = "SQLSYNTAXERROR"
+Private Const SQLSYNTAX2ERROR = "SQLSYNTAX2ERROR"
REM ============================================================= PRIVATE
MEMBERS
@@ -153,6 +154,105 @@ Finally:
Exit Sub
End Sub
+REM
-----------------------------------------------------------------------------
+Public Function CreateDataset(Optional ByVal SQLCommand As Variant _
+ ,
Optional ByVal DirectSql As Variant _
+ ,
Optional ByVal Filter As Variant _
+ ,
Optional ByVal OrderBy As Variant _
+ ) As
Object
+''' Create and return a Dataset class instance based on a
table, a query
+''' or an SQL SELECT statement.
+''' Args:
+''' SQLCommand: as a case-sensitive string, a table
name, a query name
+''' or a valid SQL SELECT statement.
Identifiers may be srrounded
+''' with square brackets
+''' DirectSql: when True, the statement is
processed by the targeted RDBMS
+''' Filter: an additional condition that records
must match, expressed
+''' as a valid SQL WHERE clause without the
WHERE keyword
+''' OrderBy: the ordering of the dataset expressed
as a valid SQL ORDER BY clause
+''' without the ORDER BY keywords
+''' Returns:
+''' A SF_Dataset instance or Nothing when not
successful
+''' Exceptions
+''' SQLSYNTAX2ERROR The given SQL
statement is incorrect
+
+Dim oDataset As Object ' Return value
+Dim bDirect As Boolean ' Alias of DirectSql
+Dim sSql As String ' SQL statement
+Dim sType As String ' TABLE, QUERY or SQL
+Dim oQuery As Object ' com.sun.star.ucb.XContent
+Dim ARR As Object : Set ARR =
ScriptForge.SF_Array
+
+Const cstThisSub = "SFDatabases.Database.CreateDataset"
+Const cstSubArgs = "SQLCommand, [DirectSQL=False],
[Filter=""""], [OrderBy=""""]"
+
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+ Set oDataset = Nothing
+
+Check:
+ If IsMissing(DirectSQL) Or IsEmpty(DirectSQL) Then DirectSQL = False
+ If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = ""
+ If IsMissing(OrderBy) Or IsEmpty(OrderBy) Then OrderBy = ""
+ If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
+ If Not ScriptForge.SF_Utils._Validate(SQLCommand,
"SQLCommand", V_STRING) Then GoTo Finally
+ If Not ScriptForge.SF_Utils._Validate(DirectSQL,
"DirectSQL", ScriptForge.V_BOOLEAN) Then GoTo Finally
+ If Not ScriptForge.SF_Utils._Validate(Filter,
"Filter", V_STRING) Then GoTo Finally
+ If Not ScriptForge.SF_Utils._Validate(OrderBy,
"OrderBy", V_STRING) Then GoTo Finally
+ End If
+
+Try:
+ ' Table, query of SQL ? Prepare dataset
+ If ARR.Contains(Tables, SQLCommand, CaseSensitive := True, SortOrder :=
"ASC") Then
+ If Len(Filter) + Len(OrderBy) = 0 Then ' Filter
seems not applicable on pure TABLE resultset
+ sType = "TABLE"
+ sSql = SQLCommand
+ Else
+ sType = "SQL"
+ sSql = "SELECT * FROM [" & SQLCommand
& "]"
+ End If
+ bDirect = DirectSQL
+ ElseIf ARR.Contains(Queries, SQLCommand, CaseSensitive := True,
SortOrder := "ASC") Then
+ Set oQuery = _Connection.Queries.getByName(SQLCommand)
+ If Len(Filter) + Len(OrderBy) = 0 Then ' Filter
seems not applicable on pure QUERY resultset
+ sType = "QUERY"
+ sSql = SQLCommand
+ Else
+ sType = "SQL"
+ sSql = oQuery.Command
+ End If
+ bDirect = Not oQuery.EscapeProcessing
+ ElseIf ScriptForge.SF_String.StartsWith(SQLCommand, "SELECT",
CaseSensitive := False) Then
+ sType = "SQL"
+ sSql = SQLCommand
+ bDirect = DirectSQL
+ Else
+ If Not ScriptForge.SF_Utils._Validate(SQLCommand,
"SQLCommand", V_STRING _
+ , ARR.Flatten(ARR.Append(Tables, Queries))) Then GoTo
Finally
+ End If
+
+ Set oDataset = New SF_Dataset
+ With oDataset
+ Set .[Me] = oDataset
+ Set ._ParentDatabase = [Me]
+ ._DatasetType = sType
+ ._Command = SQLCommand
+ ._Sql = _ReplaceSquareBrackets(sSql)
+ ._DirectSql = bDirect
+ ._Filter = _ReplaceSquareBrackets(Filter)
+ ._OrderBy = _ReplaceSquareBrackets(OrderBy)
+ ._ReadOnly = _ReadOnly
+ ' If creation not successful, then cancel everything
+ If Not ._Initialize() Then Set oDataset = .Dispose()
+ End With
+
+Finally:
+ Set CreateDataset = oDataset
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+End Function ' SFDatabases.SF_Database.CreateDataset
+
REM
-----------------------------------------------------------------------------
Public Function DAvg(Optional ByVal Expression As Variant _
, Optional
ByVal TableName As Variant _
@@ -354,7 +454,7 @@ Try:
With oResult
'Initialize output array with header row
- Set oColumns = oResult.getColumns()
+ Set oColumns = .getColumns()
lCols = oColumns.Count - 1
If Header Then
lRows = 0
@@ -397,6 +497,7 @@ Public Function Methods() As Variant
Methods = Array( _
"CloseDatabase" _
+ , "CreateDataset" _
, "DAvg" _
, "DCount" _
, "DLookup" _
@@ -803,9 +904,7 @@ Try:
' Execute the SQL statement and retain the first column of the
first record
Set oResult = _ExecuteSql(sSql, True)
If Not IsNull(oResult) And Not IsEmpty(oResult) Then
- If Not oResult.first() Then Goto Finally
- If oResult.isAfterLast() Then GoTo Finally
- vResult = _GetColumnValue(oResult, 1, True) '
Force return of binary field
+ If oResult.first() Then vResult = _GetColumnValue(oResult, 1)
Else GoTo Finally
End If
Set oResult = Nothing
@@ -861,6 +960,7 @@ Finally:
Set oStatement = Nothing
Exit Function
Catch_Sql:
+ On Local Error GoTo 0
ScriptForge.SF_Exception.RaiseFatal(SQLSYNTAXERROR, sSql)
GoTo Finally
Catch:
@@ -870,20 +970,17 @@ End Function '
SFDatabases.SF_Database._ExecuteSql
REM
-----------------------------------------------------------------------------
Private Function _GetColumnValue(ByRef poResultSet As Object _
, ByVal
plColIndex As Long _
- ,
Optional ByVal pbReturnBinary As Boolean _
) As
Variant
''' Get the data stored in the current record of a result
set in a given column
''' The type of the column is found in the resultset's
metadata
''' Args:
''' poResultSet: com.sun.star.sdbc.XResultSet or
com.sun.star.awt.XTabControllerModel
''' plColIndex: the index of the column to extract
the value from. Starts at 1
-''' pbReturnBinary: when True, the method returns
the content of a binary field,
-''' as long as its length does not exceed a
maximum length.
-''' Default = False: binary fields are not
returned, only their length
''' Returns:
''' The Variant value found in the column
''' Dates and times are returned as Basic dates
''' Null values are returned as Null
+''' Binary fields are returned as a Long giving
their length
''' Errors or strange data types are returned as
Null as well
Dim vValue As Variant ' Return value
@@ -897,7 +994,6 @@ Const cstMaxBinlength = 2 * 65535
On Local Error Goto 0 ' Disable error handler
vValue = Empty ' Default value
if error
- If IsMissing(pbReturnBinary) Then pbReturnBinary = False
With com.sun.star.sdbc.DataType
lType = poResultSet.MetaData.getColumnType(plColIndex)
@@ -908,20 +1004,11 @@ Const cstMaxBinlength = 2 * 65535
Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
Set oStream =
poResultSet.getBinaryStream(plColIndex)
If bNullable Then
- If Not poResultSet.wasNull() Then
- If Not
ScriptForge.SF_Session.HasUNOMethod(oStream, "getLength") Then '
When no recordset
- lSize = cstMaxBinLength
- Else
- lSize =
CLng(oStream.getLength())
- End If
- If lSize <= cstMaxBinLength
And pbReturnBinary Then
- vValue = Array()
-
oStream.readBytes(vValue, lSize)
- Else ' Return length
of field, not content
- vValue = lSize
- End If
- End If
+ If Not poResultSet.wasNull() Then lSize
= CLng(oStream.getLength()) Else lSize = 0
+ Else
+ lSize = CLng(oStream.getLength())
End If
+ vValue = lSize ' Return length of field,
not content
If Not IsNull(oStream) Then oStream.closeInput()
Case .BIT, .BOOLEAN :
vValue = poResultSet.getBoolean(plColIndex)
Case .DATE
@@ -935,16 +1022,10 @@ Const cstMaxBinlength = 2 * 65535
Case .BIGINT :
vValue = CLng(poResultSet.getLong(plColIndex))
Case .DECIMAL, .NUMERIC : vValue
= poResultSet.getDouble(plColIndex)
Case .SQLNULL :
vValue = poResultSet.getNull(plColIndex)
- Case .OBJECT, .OTHER, .STRUCT : vValue = Null
Case .REF
: vValue = poResultSet.getRef(plColIndex)
Case .TINYINT :
vValue = poResultSet.getShort(plColIndex)
- Case .CHAR, .VARCHAR : vValue
= poResultSet.getString(plColIndex)
- Case .LONGVARCHAR, .CLOB
- If bNullable Then
- If Not poResultSet.wasNull() Then
vValue = poResultSet.getString(plColIndex)
- Else
- vValue = ""
- End If
+ Case .CHAR, .VARCHAR, .LONGVARCHAR, .CLOB
+
vValue = poResultSet.getString(plColIndex)
Case .TIME
vDateTime = poResultSet.getTime(plColIndex)
If Not poResultSet.wasNull() Then vValue =
TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)',
vDateTime.HundredthSeconds)
@@ -956,6 +1037,7 @@ Const cstMaxBinlength = 2 * 65535
vValue = poResultSet.getString(plColIndex)
'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
+ ' .wasNull() must be preceded by getXXX(). Done. Test for
Null here.
If bNullable Then
If poResultSet.wasNull() Then vValue = Null
End If
@@ -963,7 +1045,7 @@ Const cstMaxBinlength = 2 * 65535
_GetColumnValue = vValue
-End Function ' SFDatabases.SF_Database.GetColumnValue
+End Function ' SFDatabases.SF_Database._GetColumnValue
REM
-----------------------------------------------------------------------------
Public Function _OpenDatasheet(Optional ByVal psCommand As Variant _
@@ -1088,4 +1170,4 @@ Private Function _Repr() As String
End Function ' SFDatabases.SF_Database._Repr
REM ============================================ END OF SFDATABASES.SF_DATABASE
-</script:module>
+</script:module>
\ No newline at end of file
diff --git a/wizards/source/sfdatabases/SF_Dataset.xba
b/wizards/source/sfdatabases/SF_Dataset.xba
new file mode 100644
index 000000000000..e25f714f6ddf
--- /dev/null
+++ b/wizards/source/sfdatabases/SF_Dataset.xba
@@ -0,0 +1,1664 @@
+<?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="SF_Dataset" script:language="StarBasic"
script:moduleType="normal">REM
=======================================================================================================================
+REM === The ScriptForge library and its associated
libraries are part of the LibreOffice project. ===
+REM === The SFDatabases library
is one of the associated libraries.
===
+REM === Full documentation is available
on https://help.libreoffice.org/
===
+REM
=======================================================================================================================
+
+Option Compatible
+Option ClassModule
+
+Option Explicit
+
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+''' SF_Dataset
+''' ==========
+''' A dataset represents a set of tabular data
produced by a database.
+''' In the user interface of LibreOffice a dataset
corresponds with the data
+''' displayed in a form or a data sheet (table,
query).
+''' To use datasets, the database instance must
exist but the Base document may not be open.
+'''
+''' In the context of ScriptForge, a dataset may be
created automatically by script code :
+''' - at any moment => in this case the
Base document may or may not be open.
+''' - any SELECT SQL statement may define
the dataset.
+'''
+''' The proposed API supports next main purposes:
+''' - browse for- and backward thru the
dataset to get its content
+''' - update any record with new values
+''' - create new records or delete some.
+''' So-called "CRUD" operations (create,
read, update, delete).
+'''
+''' Service invocation:
+''' A dataset is characterized by
+''' - the parent database
+''' - a table/query name or an SQL
SELECT statemnt
+''' - the DirectSQL option to
bypass the processing of SQL by LibreOffice
+''' - an optional filter
+''' - an optional sorting order
+''' 1) From a database class instance
+''' Dim db As Object, FileName As
String, Dataset As Object, Dataset2 As Object
+''' Set db =
CreateScriptService("SFDatabases.Database", FileName, , ReadOnly :=
False)
+''' Set Dataset =
db.CreateDataset("myTable", DirectSql := False, Filter :=
"[City]='Brussels'")
+''' 2) From an existing dataset
+''' Set Dataset2 =
Dataset.CreateDataset(Filter := "[City]='Paris'")
+'''
+''' Dataset browsing with the MoveNext(),
MovePrevious(), ... methods
+''' After creation of the dataset, the
current record is positioned BEFORE the first record.
+''' Every MoveXXX() method returns False
when no record could be retrieved, otherwise True.
+''' When False, the current record is reset
either in BOF or EOF positions.
+''' Typically:
+''' Set dataset =
db.CreateDataset("myTable")
+''' With Dataset
+''' Do While .MoveNext()
+''' ...
+''' Loop
+''' .CloseDataset()
+''' End With
+'''
+''' Updates performance:
+''' This module provides methods to update
data stored in database tables.
+''' Note that the proposed Update() and
Insert() methods wil always be
+''' SLOWER or MUCH SLOWER than equivalent
SQL statements.
+''' Always privilege SQL when considering
massive updates.
+'''
+''' Detailed user documentation:
+'''
https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/SF_Dataset.html?DbPAR=BASIC
+'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+
+REM ==================================================================
EXCEPTIONS
+
+' Error in the dataset's initial SQL statement
+Private Const SQLSYNTAX2ERROR = "SQLSYNTAX2ERROR"
+' The current record could not be determined
+Private Const NOCURRENTRECORDERROR = "NOCURRENTRECORDERROR"
+' Database is read-only. Method rejected
+Private Const DBREADONLYERROR = "DBREADONLYERROR"
+' Database fields update error
+' Value to store does not fit the type of the field
+' Field is not nullable and value = Null
+' Field is not writable or autovalue
+' Input file does not exist or is empty
+' Field type is not supported
+Private Const RECORDUPDATEERROR =
"RECORDUPDATEERROR"
+' The destination file exists and cannot be overwritten
+Private Const FIELDEXPORTERROR = "FIELDEXPORTERROR"
+
+REM ============================================================= PRIVATE
MEMBERS
+
+Private [Me] As Object
+Private ObjectType As String ' Must be
DATASET
+Private ServiceName As String
+
+Private _ParentDatabase As Object ' The
parent SF_Database instance (must not be void)
+Private _DatasetType As String ' TABLE, QUERY or
SQL
+Private _Command As String ' Table
name, query name or SQL statement
+Private _Sql As String '
Equivalent SQL command
+Private _DirectSql As Boolean ' When
True, SQL processed by RDBMS
+Private _Filter As String '
WHERE clause without WHERE
+Private _OrderBy As String ' ORDER BY
clause without ORDER BY
+Private _ReadOnly As Boolean ' When
True, updates are forbidden
+
+Private _RowSet As Object '
com.sun.star.sdb.RowSet
+
+Private _Fields As Variant '
Array of field names
+Private _UpdatableFields As Variant ' Array of
updatable field names
+Private _DefaultValues As Variant ' Array of field
default values // _Fields
+Private _AutoValue As Long ' Index of
AutoValue field. None = -1
+
+REM ============================================================ MODULE
CONSTANTS
+
+REM ======================================================
CONSTRUCTOR/DESTRUCTOR
+
+REM
-----------------------------------------------------------------------------
+Private Sub Class_Initialize()
+ Set [Me] = Nothing
+ ObjectType = "DATASET"
+ ServiceName = "SFDatabases.Dataset"
+ Set _ParentDatabase = Nothing
+ _DatasetType = ""
+ _Command = ""
+ _DirectSql = False
+ _Filter = ""
+ _OrderBy = ""
+ _ReadOnly = False
+ Set _RowSet = Nothing
+ _Fields = Array()
+ _UpdatableFields = Array()
+ _DefaultValues = Array()
+ _AutoValue = -1
+End Sub ' SFDatabases.SF_Dataset Constructor
+
+REM
-----------------------------------------------------------------------------
+Private Sub Class_Terminate()
+ Call Class_Initialize()
+End Sub ' SFDatabases.SF_Dataset Destructor
+
+REM
-----------------------------------------------------------------------------
+Public Function Dispose() As Variant
+ Call Class_Terminate()
+ Set Dispose = Nothing
+End Function ' SFDatabases.SF_Dataset Explicit Destructor
+
+REM ==================================================================
PROPERTIES
+
+REM
-----------------------------------------------------------------------------
+Property Get BOF() As Variant
+''' The BOF property returns True if the current record
position is before the first record
+''' in the Dataset, otherwise it returns False.
+ Bof = _PropertyGet("BOF")
+End Property ' SFDatabases.SF_Dataset.BOF (get)
+
+REM
-----------------------------------------------------------------------------
+Property Let BOF(Optional ByVal pvBOF As Variant)
+''' Set the updatable property BOF.
+''' Setting BOF to True positions the current record before
the first record.
+''' Setting it to False is ignored. True is the only
relevant value.
+ _PropertySet("BOF", pvBOF)
+End Property ' SFDatabases.SF_Dataset.BOF (let)
+
+REM
-----------------------------------------------------------------------------
+Property Get DefaultValues() As Variant
+''' Returns a dictionary (field name => default value).
+''' The database field type is converted to the
corresponding Basic/Python variable types.
+''' When undefined: returns either Null (field is nullable)
or Empty
+''' The output dictionary should be disposed by the user
script
+ DefaultValues = _PropertyGet("DefaultValues")
+End Property ' SFDatabases.SF_Dataset.DefaultValues (get)
+
+REM
-----------------------------------------------------------------------------
+Property Get EOF() As Variant
+''' The EOF property returns True if the current record
position is after the last record
+''' in the Dataset, otherwise it returns False.
+ EOF = _PropertyGet("EOF")
+End Property ' SFDatabases.SF_Dataset.EOF (get)
+
+REM
-----------------------------------------------------------------------------
+Property Let EOF(Optional ByVal pvEOF As Variant)
+''' Set the updatable property EOF.
+''' Setting EOF to True positions the current record after
the last record.
+''' Setting it to False is ignored. True is the only
relevant value.
+ _PropertySet("EOF", pvEOF)
+End Property ' SFDatabases.SF_Dataset.EOF (let)
+
+REM
-----------------------------------------------------------------------------
+Property Get Fields() As Variant
+''' Returns the list of the field names contained in the
dataset
+ Fields = _PropertyGet("Fields")
+End Property ' SFDatabases.SF_Dataset.Fields (get)
+
+REM
-----------------------------------------------------------------------------
+Property Get Filter() As Variant
+''' The Filter is a SQL WHERE clause without the WHERE
keyword
+ Filter = _PropertyGet("Filter")
+End Property ' SFDatabases.SF_Dataset.Filter (get)
+
+REM
-----------------------------------------------------------------------------
+Property Get OrderBy() As Variant
+''' The OrderBy is an SQL ORDER BY clause without the ORDER
BY keyword
+ OrderBy = _PropertyGet("OrderBy")
+End Property ' SFDatabases.SF_Dataset.OrderBy (get)
+
+REM
-----------------------------------------------------------------------------
+Property Get ParentDatabase() As Object
+''' Returns the database instance to which the dataset
belongs
+ Set ParentDatabase = _PropertyGet("ParentDatabase")
+End Property ' SFDatabases.SF_Dataset.ParentDatabase
+
+REM
-----------------------------------------------------------------------------
+Property Get RowCount() As Long
+''' Returns the number of records present in the dataset
+''' When that number exceeds a certain limit, its
determination requires
+''' that the whole dataset has been read first, up to its
last row.
+''' For huge datasets, this can represent a significant
performance cost.
+ RowCount = _PropertyGet("RowCount")
+End Property ' SFDatabases.SF_Dataset.RowCount
+
+REM
-----------------------------------------------------------------------------
+Property Get RowNumber() As Long
+''' Returns the sequence number >= 1 of the current
record. Returns 0 if unknown.
+ RowNumber = _PropertyGet("RowNumber")
+End Property ' SFDatabases.SF_Dataset.RowNumber
+
+REM
-----------------------------------------------------------------------------
+Property Get Source() As String
+''' Returns the source of the data: table name, query name
or sql statement
+ Source = _PropertyGet("Source")
+End Property ' SFDatabases.SF_Dataset.Source
+
+REM
-----------------------------------------------------------------------------
+Property Get SourceType() As String
+''' Returns the type of source of the data: TABLE, QUERY or
SQL
+ SourceType = _PropertyGet("SourceType")
+End Property ' SFDatabases.SF_Dataset.SourceType
+
+REM
-----------------------------------------------------------------------------
+Property Get UpdatableFields() As Variant
+''' Returns the list of the names of the updatable fields
contained in the dataset
+ UpdatableFields = _PropertyGet("UpdatableFields")
+End Property ' SFDatabases.SF_Dataset.UpdatableFields (get)
+
+REM
-----------------------------------------------------------------------------
+Property Get Values() As Variant
+''' Returns a dictionary (field name => field value)
applied on the current record
+''' Binary fields ? => their length is returned
+''' The output dictionary should be disposed by the user
script
+''' Returns Nothing when there is no current record
+ Values = _PropertyGet("Values")
+End Property ' SFDatabases.SF_Dataset.Values (get)
+
+REM
-----------------------------------------------------------------------------
+Property Get XRowSet() As Object
+''' Returns the com.sun.star.sdb.RowSet UNO object
representing the dataset
+ XRowSet = _PropertyGet("XRowSet")
+End Property ' SFDocuments.SF_Document.XRowSet
+
+REM =====================================================================
METHODS
+
+REM
-----------------------------------------------------------------------------
+Public Function CloseDataset() As Boolean
+''' Close the actual dataset
+''' Args:
+''' Returns:
+''' True when successful
+''' Examples:
+''' dataset.CloseDataset()
+
+Dim bClose As Boolean ' Return value
+Const cstThisSub = "SFDatabases.Sataset.CloseDataset"
+Const cstSubArgs = ""
+
+ If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+ bClose = False
+
+Check:
+ SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
+
+Try:
+ If Not IsNull(_RowSet) Then
+ With _RowSet
+ .close()
+ .dispose()
+ End With
+ Dispose()
+ bClose = True
+ End If
+
+Finally:
+ CloseDataset = bClose
+ SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+End Function ' SFDatabases.SF_Dataset.CloseDataset
+
+REM
-----------------------------------------------------------------------------
+Public Function CreateDataset(Optional ByVal Filter As Variant _
+ ,
Optional ByVal OrderBy As Variant _
+ ) As
Object
+''' Create and return a Dataset class instance based on the
actual Dataset
+''' Filter and OrderBy properties may be redefined.
+''' Args:
+''' Filter: an additional condition that records
must match, expressed
+''' as a valid SQL WHERE clause without the
WHERE keyword
+''' Default: the filter applied on the
actual dataset.
+''' OrderBy: the ordering of the dataset expressed
as a valid SQL ORDER BY clause
+''' without the ORDER BY keywords.
+''' Default: the same sorting order as the
actual dataset.
+''' Returns:
+''' A SF_Dataset instance or Nothing when not
successful
+''' Exceptions
+''' SQLSYNTAX2ERROR The given SQL
statement is incorrect
+''' Examples:
+''' Dim ds1 As Object, ds2 As Object, ds3 As
Object, ds4 As Object
+''' Set ds1 = dataset.CreateDataset()
' dataset and ds1 contain the same set of data
+''' Set ds2 = dataset.CreateDataset(Filter :=
"") ' Suppress the current filter
+''' Set ds3 = dataset.CreateDataset(Filter :=
"[Name] LIKE 'A%'")
+'''
' Define a new filter
+''' Set ds4 = dataset.CreateDataset(Filter :=
"(" & dataset.Filter & ") AND [Name] LIKE
'A%'")
+'''
' Combine actual filter
with an additional condition
+
+Dim oDataset As Object ' Return value
+
+Const cstThisSub = "SFDatabases.Dataset.CreateDataset"
+Const cstSubArgs = "[Filter=""...filter...""],
[OrderBy=""...orderby...""]"
+
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+ Set oDataset = Nothing
+
+Check:
+ If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = _Filter
+ If IsMissing(OrderBy) Or IsEmpty(OrderBy) Then OrderBy = _OrderBy
+ If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
+ If Not ScriptForge.SF_Utils._Validate(Filter,
"Filter", V_STRING) Then GoTo Finally
+ If Not ScriptForge.SF_Utils._Validate(OrderBy,
"OrderBy", V_STRING) Then GoTo Finally
+ End If
+
+Try:
+ Set oDataset = New SF_Dataset
+ With oDataset
+ Set .[Me] = oDataset
+ Set ._ParentDatabase = _ParentDatabase
+ ._DatasetType = _DatasetType
+ ._Command = _Command
+ ._Sql = _Sql
+ ._DirectSql = _DirectSql
+ ._Filter = _ParentDatabase._ReplaceSquareBrackets(Filter)
+ ._OrderBy = _ParentDatabase._ReplaceSquareBrackets(OrderBy)
+ ._ReadOnly = _ReadOnly
+ ' If creation not successful, then cancel everything
+ If Not ._Initialize() Then Set oDataset = .Dispose()
+ End With
+
+Finally:
+ Set CreateDataset = oDataset
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+End Function ' SFDatabases.SF_Dataset.CreateDataset
+
+REM
-----------------------------------------------------------------------------
+Public Function Delete() As Boolean
+''' Deletes the current record, from the dataset and from
the database.
+''' The cursor is set on the record following immediately
the deleted record,
+''' or after the last record if the deleted one was the
last one.
+''' Args:
+''' Returns:
+''' True when successful
+''' Exceptions:
+''' DBREADONLYERROR The actual
method cannot be executed
+''' NOCURRENTRECORDERROR The current record
could not be determined
+''' Examples
+''' dataset.Delete()
+
+Dim bDelete As Boolean ' Return value
+Dim bLast As Boolean ' True when the current record is
the last one
+Const cstThisSub = "SFDatabases.Dataset.Delete"
+Const cstSubArgs = ""
+
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+ bDelete = False
+
+ With _RowSet
+
+Check:
+ ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
+ If _ReadOnly Then GoTo CatchreadOnly
+ If .isBeforeFirst() Or .isAfterLast() Or .rowDeleted() Then
GoTo CatchCurrent
+
+Try:
+ bLast = .isLast()
+ .deleteRow()
+ bDelete = .rowDeleted
+ If bLast Then .afterLast() Else .next()
+
+ End With
+
+Finally:
+ Delete = bDelete
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+CatchCurrent:
+ ScriptForge.SF_Exception.RaiseFatal(NOCURRENTRECORDERROR)
+ GoTo Finally
+CatchReadOnly:
+ ScriptForge.SF_Exception.RaiseFatal(DBREADONLYERROR)
+ GoTo Finally
+End Function ' SFDatabases.SF_Dataset.Delete
+
+REM
-----------------------------------------------------------------------------
+Public Function ExportValueToFile(Optional ByVal FieldName As Variant _
+ ,
Optional ByVal FileName As Variant _
+ ,
Optional ByVal Overwrite As Variant _
+ ) As
Boolean
+''' Export the content of a binary field to a given file
+''' Args:
+''' FieldName: the name of a binary field as a
case-sensitive string
+''' FileName: the destination file name in
ScriptForge.FileSystem service notation
+''' Overwrite: when True, the destination file may
be overwritten
+''' Returns:
+''' True when successful
+''' Exceptions:
+''' NOCURRENTRECORDERROR The current record
could not be determined
+''' FIELDEXPORTERROR The destination
has its readonly attribute set or overwriting rejected
+
+Dim bExport As Variant ' Return value
+Dim oSfa As Object '
com.sun.star.ucb.SimpleFileAccess
+Dim sFile As String ' Alias of FileName
+Dim lColIndex As Long ' Column index
+Dim oColumn As Object ' com.sun.star.sdb.ODataColumn
+Dim oStream As Object ' com.sun.star.io.XInputStream
+Const cstThisSub = "SFDatabases.Dataset.ExportValueToFile"
+Const cstSubArgs = "FieldName, FileName, [Overwrite=False]"
+
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+ bExport = False
+
+Check:
+ If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
+ If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
+ If Not ScriptForge.SF_Utils._Validate(FieldName,
"FieldName", V_STRING, _Fields) Then GoTo Catch
+ If Not ScriptForge.SF_Utils._ValidateFile(FileName,
"FileName") Then GoTo Finally
+ If Not ScriptForge.SF_Utils._Validate(Overwrite,
"Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally
+ End If
+
+ ' Check destination file overwriting
+ sFile = ConvertToUrl(FileName)
+ Set oSfa = ScriptForge.SF_Utils._GetUNOService("FileAccess")
+ If oSfa.exists(sFile) Then
+ If Not Overwrite Then GoTo CatchFile
+ If oSfa.isReadonly(sFile) Then GoTo CatchFile
+ End If
+
+ ' Check the current record
+ With _RowSet
+ If .isBeforeFirst() Or .isAfterLast() Or .rowDeleted() Then
GoTo CatchCurrent
+ End With
+
+Try:
+ lColIndex = ScriptForge.SF_Array.IndexOf(_Fields, FieldName,
CaseSensitive := True)
+ If lColIndex >= 0 Then
+
+ ' Establish the input stream
+ Set oColumn = _RowSet.Columns.getByIndex(lColIndex)
+ With com.sun.star.sdbc.DataType
+ Select Case oColumn.Type
+ Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
+ Set oStream = oColumn.getBinaryStream()
+ 'Case .VARCHAR, .LONGVARCHAR, .CLOB
+ Case Else
+ Set oStream = Nothing
+ End Select
+ End With
+
+ ' Process NULL value
+ If Not IsNull(oStream) And oColumn.IsNullable =
com.sun.star.sdbc.ColumnValue.NULLABLE Then
+ If oColumn.wasNull() Then
+ oStream.closeInput()
+ Set oStream = Nothing
+ End If
+ End If
+
+ ' Dump field into file
+ If Not IsNull(oStream) Then
+ If oStream.getLength() > 0 Then
+ oSfa.writeFile(sFile, oStream)
+ End If
+ oStream.closeInput()
+ End If
+ End If
+
+ bExport = True
+
+Finally:
+ ExportValueToFile = bExport
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+CatchCurrent:
+ ScriptForge.SF_Exception.RaiseFatal(NOCURRENTRECORDERROR)
+ GoTo Finally
+CatchFile:
+ ScriptForge.SF_Exception.RaiseFatal(FIELDEXPORTERROR,
"FileName", FileName, "Overwrite", Overwrite)
+ GoTo Finally
+End Function ' SFDatabases.SF_Dataset.ExportValueToFile
+
+REM
-----------------------------------------------------------------------------
+Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
+''' Return the actual value of the given property
+''' Args:
+''' PropertyName: the name of the property as a
string
+''' Returns:
+''' The actual value of the propRATTCerty
+''' If the property does not exist, returns Null
+
+Const cstThisSub = "SFDatabases.Dataset.GetProperty"
+Const cstSubArgs = ""
+
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+ GetProperty = Null
+
+Check:
+ If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
+ If Not ScriptForge.SF_Utils._Validate(PropertyName,
"PropertyName", V_STRING, Properties()) Then GoTo Catch
+ End If
+
+Try:
+ GetProperty = _PropertyGet(PropertyName)
+
+Finally:
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+End Function ' SFDatabases.SF_Dataset.GetProperty
+
+REM
-----------------------------------------------------------------------------
+Public Function GetRows(Optional ByVal Header As Variant _
+ , Optional ByVal
MaxRows As Variant _
+ ) As Variant
+''' Return the content of the dataset as an array
+''' This operation can be done in chunks:
+''' - The collected data starts at the current row
+ 1
+''' - When MaxRows > 0 then the collection stops
after this limit has been reached.
+''' Otherwise all the data up to the end is
collected.
+''' Args:
+''' Header: When True, a header row is
inserted at the top of the array with the column names. Default = False
+''' MaxRows: The maximum number of returned
rows. If absent, all records up to the end are returned
+''' Returns:
+''' a 2D array(row, column), even if only 1 column
and/or 1 record
+''' an empty array if no records returned
+''' Example:
+''' Dim a As Variant, lMaxRows As Long
+''' lMaxRows = 100
+''' Do
+''' a = dataset.GetRows(Header :=
True, MaxRows := lMaxRows)
+''' If UBound(a, 1) >= 0 Then
+''' ' ...
+''' End If
+''' Loop Until UBound(a, 1) < lMaxRows
' Includes empty array - Use ... < lMaxRows - 1 when Header := False
+
+Dim vResult As Variant ' Return value
+Dim lCols As Long ' Number of columns
+Dim lRows As Long ' Number of rows
+Dim oColumns As Object ' Collection of
com.sun.star.sdb.ODataColumn
+Dim bRead As Boolean ' When True, next record has been
read successfully
+Dim i As Long
+Const cstThisSub = "SFDatabases.Dataset.GetRows"
+Const cstSubArgs = "[Header=False], [MaxRows=0]"
+
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+ vResult = Array()
+
+Check:
+ If IsMissing(Header) Or IsEmpty(Header) Then Header = False
+ If IsMissing(MaxRows) Or IsEmpty(MaxRows) Then MaxRows = 0
+ If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
+ If Not ScriptForge.SF_Utils._Validate(Header,
"Header", ScriptForge.V_BOOLEAN) Then GoTo Finally
+ If Not ScriptForge.SF_Utils._Validate(MaxRows,
"MaxRows", ScriptForge.V_NUMERIC) Then GoTo Finally
+ End If
+
+Try:
+ With _RowSet
+
+ ' Check if there is any data to collect
+ bRead = .next()
+
+ If bRead Then
+ 'Initialize output array with header row
+ Set oColumns = .getColumns()
+ lCols = oColumns.Count - 1
+ If Header Then
+ lRows = 0
+ ReDim vResult(0 To lRows, 0 To lCols)
+ For i = 0 To lCols
+ vResult(lRows, i) =
oColumns.getByIndex(i).Name
+ Next i
+ If MaxRows > 0 Then MaxRows = MaxRows + 1
+ Else
+ lRows = -1
+ End If
+
+ ' Load data
+ Do While bRead And (MaxRows = 0 Or lRows < MaxRows -
1)
+ lRows = lRows + 1
+ If lRows = 0 Then
+ ReDim vResult(0 To lRows, 0 To lCols)
+ Else
+ ReDim Preserve vResult(0 To lRows, 0 To
lCols)
+ End If
+ For i = 0 To lCols
+ vResult(lRows, i) =
_ParentDatabase._GetColumnValue(_RowSet, i + 1)
+ Next i
+ bRead = .next()
+ Loop
+
+ Else
+ vResult = Array()
+ End If
+
+ End With
+
+Finally:
+ GetRows = vResult
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+End Function ' SFDatabases.SF_Dataset.GetRows
+
+REM
-----------------------------------------------------------------------------
+Public Function GetValue(Optional ByVal FieldName As Variant) As Variant
+''' Returns the value of a given field in the current record
+''' Args:
+''' FieldName: the name of a field as a
case-sensitive string
+''' Returns:
+''' The found value as a Basic variable
+''' The length of binary fields is returned,not
their content.
+''' Exceptions:
+''' NOCURRENTRECORDERROR The current record
could not be determined
+
+Dim vValue As Variant ' Return value
+Dim lColIndex As Long ' Column index
+Const cstThisSub = "SFDatabases.Dataset.GetValue"
+Const cstSubArgs = "FieldName"
+
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+ vValue = Null
+
+Check:
+ If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
+ If Not ScriptForge.SF_Utils._Validate(FieldName,
"FieldName", V_STRING, _Fields) Then GoTo Catch
+ End If
+
+ With _RowSet
+ If .isBeforeFirst() Or .isAfterLast() Or .rowDeleted() Then
GoTo CatchCurrent
+ End With
+
+Try:
+ lColIndex = ScriptForge.SF_Array.IndexOf(_Fields, FieldName,
CaseSensitive := True)
+ If lColIndex >= 0 Then vValue =
_ParentDatabase._GetColumnValue(_RowSet, lColIndex + 1)
+
+Finally:
+ GetValue = vValue
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+CatchCurrent:
+ ScriptForge.SF_Exception.RaiseFatal(NOCURRENTRECORDERROR)
+ GoTo Finally
+End Function ' SFDatabases.SF_Dataset.GetValue
+
+REM
-----------------------------------------------------------------------------
+Public Function Insert(ParamArray pvArgs As Variant) As Long
+''' Create a new record in the database and initialize its
fields.
+''' The current record is unchanged. The new record is
inserted at the end of the dataset.
+''' Updatable fields not mentioned in the arguments are
initialized with their default value.
+''' Args:
+''' Either a single argument
+''' UpdatesList: a
ScriptForge.SF_Dictionary object listing pairs of key/item where
+''' the key = an updatable field
+''' the item = its value
+''' or an even number of arguments alternating
+''' FieldName: an updatable field
+''' FieldValue: its value
+''' The first form is particularly convenient in
Python scripts
+''' Returns:
+''' When the primary key is an AutoValue field: the
autovalue of the new record
+''' (to facilitate the use of the new
primary key in foreign keys)
+''' Otherwise: 0 (= successful), -1 (= not
sucessful)
+''' Exceptions:
+''' DBREADONLYERROR The actual
method cannot be executed
+''' RECORDUPDATEERROR When value to
store does not fit the type of the field
+'''
or when field is not nullable and value = Null
+'''
or when field is not writable or is an autovalue
+'''
or when input file does not exist or is empty
+'''
or when field type is not supported
+''' TABLEPRIMARYKEYERROR Primary key duplication
+''' Examples
+''' (Basic)
+''' Dim newID As Long
+''' newID =
dataset.Insert("LastName", "Doe", "FirstName",
"John")
+''' ' ... is equivalent to:
+''' Dim dict As Object, newID As Long
+''' Set dict =
CreateScriptService("ScriptForge.Dictionary")
+''' dict.Add("LastName",
"Doe")
+''' dict.Add("FirstName",
"John")
+''' newID = dataset.Insert(dict)
+''' (Python) - next statements are equivalent
+''' newid =
dataset.Insert('LastName', 'Doe', 'FirstName',
'John')
+''' newid =
dataset.Insert({'LastName': 'Doe', 'FirstName':
'John'})
+''' newid = dataset.Insert(dict(LastName =
'Doe', FirstName = 'John'))
+''' newid = dataset.Insert(LastName =
'Doe', FirstName = 'John')
+
+Dim lInsert As Long ' Return value
+Dim sSubArgs As String ' Alias of cstSubArgs
+Dim sField As String ' A single field name
+Dim oUpdates As Object ' A SF_Dictionary object
+Dim lColIndex As Long ' Column index
+Dim vKeys As Variant ' List of keys in the dictionary
+Dim sKey As String ' A single key in vKeys
+Dim i As Long
+Const cstThisSub = "SFDatabases.Dataset.Insert"
+Const cstSubArgs1 = "UpdatesList"
+Const cstSubArgs2 = "FieldName1, FieldValue1, [FieldName2, FieldValue2],
..."
+
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+ lInsert = -1
+
+Check:
+ If UBound(pvArgs) = 0 Then ' Dictionary case
+ sSubArgs = cstSubArgs1
+ If ScriptForge.SF_Utils._EnterFunction(cstThisSub, sSubArgs)
Then
+ If Not ScriptForge.SF_Utils._Validate(pvArgs(0),
"UpdatesList", ScriptForge.V_OBJECT) Then GoTo Catch
+ End If
+ Set oUpdates = pvArgs(0)
+ Else
+ sSubArgs = cstSubArgs2 ' Arguments list
case
+ ScriptForge.SF_Utils._EnterFunction(cstThisSub, sSubArgs)
+ For i = 0 To UBound(pvArgs) Step 2
+ If Not ScriptForge.SF_Utils._Validate(pvArgs(i),
"FieldName" & i, V_STRING, _UpdatableFields) Then GoTo Catch
+ Next i
+ End If
+
+ If _ReadOnly Then GoTo CatchReadOnly
+
+Try:
+ With _RowSet
+
+ ' Initialize the insertion row
+ .moveToInsertRow()
+ ' Initial storage of default values
+ For Each sField In _UpdatableFields
+ lColIndex = ScriptForge.SF_Array.IndexOf(_Fields,
sField, CaseSensitive := True)
+ _SetColumnValue(lColIndex, _DefaultValues(lColIndex))
+ Next sField
+
+ If UBound(pvArgs) = 0 Then
+ With oUpdates
+ vKeys = .Keys
+ For Each sKey in vKeys
+ lColIndex =
ScriptForge.SF_Array.IndexOf(_Fields, sKey, CaseSensitive := True)
+ If lColIndex >= 0 Then
+ _SetColumnValue(lColIndex,
.Item(sKey))
+ Else ' To force an error
+ If Not
ScriptForge.SF_Utils._Validate(sKey, "FieldName", V_STRING,
_UpdatableFields) Then GoTo Catch
+ End If
+ Next sKey
+ End With
+ Else
+ For i = 0 To UBound(pvArgs) Step 2
+ lColIndex =
ScriptForge.SF_Array.IndexOf(_Fields, pvArgs(i), CaseSensitive := True)
+ If lColIndex >= 0 Then
+ If i < UBound(pvArgs) Then
_SetColumnValue(lColIndex, pvArgs(i + 1))
+ Else ' To force an error
+ If Not
ScriptForge.SF_Utils._Validate(sKey, "FieldName", V_STRING,
_UpdatableFields) Then GoTo Catch
+ End If
+ Next i
+ End If
+
+ .insertRow()
+
+ ' Compute the return value: either 0 or the new content
of the pre-identified AUtoValue field
+ If _AutoValue < 0 Then lInsert = 0 Else lInsert =
_ParentDatabase._GetColumnValue(_RowSet, _AutoValue + 1)
+
+ .moveToCurrentRow()
+
+ End With
+
+Finally:
+ Insert = lInsert
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+CatchReadOnly:
+ ScriptForge.SF_Exception.RaiseFatal(DBREADONLYERROR)
+ GoTo Finally
+End Function ' SFDatabases.SF_Dataset.Insert
+
+REM
-----------------------------------------------------------------------------
+Public Function Methods() As Variant
+''' Return the list of public methods of the Model service
as an array
+
+ Methods = Array( _
+ "CloseDataset" _
+ , "CreateDataset" _
+ , "Delete" _
+ , "ExportValueToFile" _
+ , "GetRows" _
+ , "GetValue" _
+ , "Insert" _
+ , "MoveFirst" _
+ , "MoveLast" _
+ , "MoveNext" _
+ , "MovePrevious" _
+ , "Reload" _
+ , "Update" _
+ )
+
+End Function ' SFDatabases.SF_Dataset.Methods
+
+REM
-----------------------------------------------------------------------------
+Public Function MoveFirst() As Boolean
+''' Move the cursor to the 1st record
+''' Args:
+''' Returns:
+''' False when the Move was unsuccessful
+''' When False the cursor is reset before the first
record
+
+Dim bMove As Boolean ' Return value
+Const cstThisSub = "SFDatabases.Dataset.MoveFirst"
+Const cstSubArgs = ""
+
+Check:
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+ ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
+
+Try:
+ with _RowSet
+ bMove = .first()
+ If Not bMove Then .beforeFirst()
+ End With
+
+Finally:
+ MoveFirst = bMove
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+End Function ' SFDatabases.SF_Dataset.MoveFirst
+
+REM
-----------------------------------------------------------------------------
+Public Function MoveLast() As Boolean
+''' Move the cursor to the last record
+''' Args:
+''' Returns:
+''' False when the Move was unsuccessful
+''' When False the cursor is reset before the first
record
+
+Dim bMove As Boolean ' Return value
+Const cstThisSub = "SFDatabases.Dataset.MoveLast"
+Const cstSubArgs = ""
+
+Check:
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+ ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
+
+Try:
+ with _RowSet
+ bMove = .last()
+ If Not bMove Then .beforeFirst()
+ End With
+
+Finally:
+ MoveLast = bMove
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+End Function ' SFDatabases.SF_Dataset.MoveLast
+
+REM
-----------------------------------------------------------------------------
+Public Function MoveNext(Optional ByVal Offset As Variant) As Boolean
+''' Move the cursor N records forward. Deleted records are
skipped.
+''' Args:
+''' Offset: number of records to go forward (may be
negative). Default = 1
+''' Returns:
+''' False when the Move was unsuccessful
+''' When False the cursor is reset before the first
record when Offset > 0, after the last record otherwise
+''' Examples:
+''' dataset.MoveNext(3) ' 3
records forward
+''' dataset.MoveNext(-1) ' equivalent to
MovePrevious()
+
+Dim bMove As Boolean ' Return value
+Dim lRow As Long ' Row number
+Const cstThisSub = "SFDatabases.Dataset.MoveNext"
+Const cstSubArgs = "[Offset=1]"
+
+Check:
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+
+ If IsMissing(Offset) Or IsEmpty(Offset) Then Offset = 1
+ If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
+ If Not ScriptForge.SF_Utils._Validate(Offset,
"Offset", ScriptForge.V_NUMERIC) Then GoTo Catch
+ End If
+
+Try:
+ with _RowSet
+ Select Case Offset
+ Case 0 : bMove = True
+ Case 1 : bMove = .next()
+ Case -1 : bMove =
.previous()
+ Case > 1 : bMove =
.relative(Offset) ' RowSet.relative() stops at boundary when moving
forward only !?
+ Case Else ' < -1
+ lRow = .Row()
+ If lRow > Abs(Offset) Then bMove =
.relative(Offset) Else bMove = False
+ End Select
+ If bMove Then
+ If .rowDeleted() Then
+ If Offset >= 0 Then bMove = MoveNext()
Else bMove = MovePrevious()
+ End If
+ End If
+ End With
+
+Finally:
+ MoveNext = bMove
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+End Function ' SFDatabases.SF_Dataset.MoveNext
+
+REM
-----------------------------------------------------------------------------
+Public Function MovePrevious(Optional ByVal Offset As Variant) As Boolean
+''' Move the cursor N records backward. Deleted records are
skipped.
+''' Args:
+''' Offset: number of records to go backward (may
be negative). Default = 1
+''' Returns:
+''' False when the Move was unsuccessful
+''' When False the cursor is reset before the first
record
+''' Examples:
+''' dataset.MovePrevious(3) ' 3
records backward
+''' dataset.MovePrevious(-1) '
equivalent to MoveNext()
+
+Dim bMove As Boolean ' Return value
+Dim lRow As Long ' Row number
+Const cstThisSub = "SFDatabases.Dataset.MovePrevious"
+Const cstSubArgs = "[Offset=1]"
+
+Check:
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+
+ If IsMissing(Offset) Or IsEmpty(Offset) Then Offset = 1
+ If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
+ If Not ScriptForge.SF_Utils._Validate(Offset,
"Offset", ScriptForge.V_NUMERIC) Then GoTo Catch
+ End If
+
+Try:
+ with _RowSet
+ Select Case Offset
+ Case 0 : bMove = True
+ Case 1 : bMove =
.previous()
+ Case -1 : bMove = .next()
+ Case < -1 : bMove =
.relative(- Offset) ' RowSet.relative() stops at boundary when moving
forward only !?
+ Case Else ' > 1
+ lRow = .Row()
+ If lRow > Offset Then bMove = .relative(-
Offset) Else bMove = False
+ End Select
+ If bMove Then
+ If .rowDeleted() Then
+ If Offset < 0 Then bMove = MoveNext()
Else bMove = MovePrevious()
+ End If
+ End If
+ End With
+
+Finally:
+ MovePrevious = bMove
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+End Function ' SFDatabases.SF_Dataset.MovePrevious
+
+REM
-----------------------------------------------------------------------------
+Public Function Properties() As Variant
+''' Return the list or properties of the Model class as an
array
+
+ Properties = Array( _
+ "BOF" _
+ , "DefaultValues" _
+ , "EOF" _
+ , "Fields" _
+ , "Filter" _
+ , "OrderBy" _
+ , "ParentDatabase" _
+ , "RowCount" _
+ , "RowNumber" _
+ , "Source" _
+ , "SourceType" _
+ , "UpdatableFields" _
+ , "Values" _
+ , "XRowSet" _
+ )
+
+End Function ' SFDatabases.SF_Dataset.Properties
+
+REM
-----------------------------------------------------------------------------
+Public Function Reload(Optional ByVal Filter As Variant _
+ ,
Optional ByVal OrderBy As Variant _
+ ) As
Boolean
+''' Reload the dataset from the database.
+''' Useful in particular after record deletions and
insertions.
+''' Filter and OrderBy properties may be redefined.
+''' The cursor is reset before the first record.
+''' Args:
+''' Filter: a condition that records must match,
expressed
+''' as a valid SQL WHERE clause without the
WHERE keyword
+''' Default: the actual filter is left
unchanged.
+''' OrderBy: the ordering of the dataset expressed
as a valid SQL ORDER BY clause
+''' without the ORDER BY keywords.
+''' Default: the actual sorting order is
left unchanged.
+''' Returns:
+''' True when successful
+''' Exceptions
+''' SQLSYNTAX2ERROR The given SQL
statement is incorrect
+''' Examples:
+''' dataset.Reload()
' dataset is refreshed
+''' dataset.Reload(Filter := "") '
Suppress the current filter
+''' dataset.Reload(Filter := "[Name] LIKE
'A%'")
+'''
' Define a new filter
+''' dataset.Reload(Filter := "(" &
dataset.Filter & ") AND [Name] LIKE 'A%'")
+'''
' Combine actual filter with an additional condition
+
+Dim bReload As Boolean ' Return value
+Dim bErrorHandler As Boolean ' Can be set off to ease debugging of
complex SQL statements
+Const cstThisSub = "SFDatabases.Dataset.Reload"
+Const cstSubArgs = "[Filter=""...filter...""],
[OrderBy=""...orderby...""]"
+
+ bErrorHandler = ScriptForge.SF_Utils._ErrorHandling()
+ If bErrorHandler Then On Local Error GoTo Catch
+ bReload = False
+
+Check:
+ If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = _Filter
+ If IsMissing(OrderBy) Or IsEmpty(OrderBy) Then OrderBy = _OrderBy
+ If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
+ If Not ScriptForge.SF_Utils._Validate(Filter,
"Filter", V_STRING) Then GoTo Finally
+ If Not ScriptForge.SF_Utils._Validate(OrderBy,
"OrderBy", V_STRING) Then GoTo Finally
+ End If
+
+Try:
+ If Len(Filter) > 0 Then _Filter =
_ParentDatabase._ReplaceSquareBrackets(Filter) Else _Filter = ""
+ If Len(OrderBy) > 0 Then _OrderBy =
_ParentDatabase._ReplaceSquareBrackets(OrderBy) Else _OrderBy = ""
+ With _RowSet
+ .Filter = _Filter
+ .ApplyFilter = ( Len(_Filter) > 0 )
+ .Order = _OrderBy
+ If bErrorhandler Then On Local Error GoTo CatchSql
+ .execute()
+ End With
+
+ bReload = True
+
+Finally:
+ Reload = bReload
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+CatchSql:
+ On Local Error GoTo 0
+ ScriptForge.SF_Exception.RaiseFatal(SQLSYNTAX2ERROR, _Sql, "WHERE
" & _Filter, "ORDER BY " & _OrderBy)
+ GoTo Catch
+End Function ' SFDatabases.SF_Dataset.Reload
+
+REM
-----------------------------------------------------------------------------
+Public Function SetProperty(Optional ByVal PropertyName As Variant _
+ , Optional
ByRef Value As Variant _
+ ) As Boolean
+''' Set a new value to the given property
+''' Args:
+''' PropertyName: the name of the property as a
string
+''' Value: its new value
+''' Exceptions
+''' ARGUMENTERROR The property does not
exist
+
+Const cstThisSub = "SFDatabases.Dataset.SetProperty"
+Const cstSubArgs = "PropertyName, Value"
+
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+ SetProperty = False
+
+Check:
+ If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
+ If Not ScriptForge.SF_Utils._Validate(PropertyName,
"PropertyName", V_STRING, Properties()) Then GoTo Catch
+ End If
+
+Try:
+ SetProperty = _PropertySet(PropertyName, Value)
+
+Finally:
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+End Function ' SFDatabases.SF_Dataset.SetProperty
+
+REM
-----------------------------------------------------------------------------
+Public Function Update(ParamArray pvArgs As Variant) As Boolean
+''' Updates a set of fields in the current record
+''' Args:
+''' Either a single argument
+''' UpdatesList: a
ScriptForge.SF_Dictionary object listing pairs of key/item where
+''' the key = an updatable field
+''' the item = its new value
+''' or an even number of arguments alternating
+''' FieldName: an updatable field
+''' FieldValue: its new value
+''' The first form is particularly convenient in
Python scripts
+''' Returns:
+''' True when successful
+''' Exceptions:
+''' DBREADONLYERROR The actual
method cannot be executed
+''' RECORDUPDATEERROR When value to
store does not fit the type of the field
+'''
or when field is not nullable and value = Null
+'''
or when field is not writable or is an autovalue
+'''
or when input file does not exist or is empty
+'''
or when field type is not supported
+''' NOCURRENTRECORDERROR The current record
could not be determined
+''' Examples
+''' (Basic)
+''' dataset.Update("LastName",
"Doe", "FirstName", "John")
+''' ' ... is equivalent to:
+''' Dim dict As Object
+''' Set dict =
CreateScriptService("ScriptForge.Dictionary")
+''' dict.Add("LastName",
"Doe")
+''' dict.Add("FirstName",
"John")
+''' dataset.Update(dict)
+''' (Python) - next statements are equivalent
+''' dataset.Update({'LastName':
'Doe', 'FirstName': 'John'})
+''' dataset.Update(dict(LastName =
'Doe', FirstName = 'John'))
+''' dataset.Update(LastName =
'Doe', FirstName = 'John')
+
+Dim bUpdate As Boolean ' Return value
+Dim sSubArgs As String ' Alias of cstSubArgs
+Dim oUpdates As Object ' A SF_Dictionary object
+Dim lColIndex As Long ' Column index
+Dim vKeys As Variant ' List of keys in the dictionary
+Dim sKey As String ' A single key in vKeys
+Dim i As Long
+Const cstThisSub = "SFDatabases.Dataset.Update"
+Const cstSubArgs1 = "UpdatesList"
+Const cstSubArgs2 = "FieldName1, FieldValue1, [FieldName2, FieldValue2],
..."
+
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+ bUpdate = False
+
+Check:
+ If UBound(pvArgs) = 0 Then ' Dictionary case
+ sSubArgs = cstSubArgs1
+ If ScriptForge.SF_Utils._EnterFunction(cstThisSub, sSubArgs)
Then
+ If Not ScriptForge.SF_Utils._Validate(pvArgs(0),
"UpdatesList", ScriptForge.V_OBJECT) Then GoTo Catch
+ End If
+ Set oUpdates = pvArgs(0)
+ Else
+ sSubArgs = cstSubArgs2 ' Arguments list
case
+ ScriptForge.SF_Utils._EnterFunction(cstThisSub, sSubArgs)
+ For i = 0 To UBound(pvArgs) Step 2
+ If Not ScriptForge.SF_Utils._Validate(pvArgs(i),
"FieldName" & i, V_STRING, _UpdatableFields) Then GoTo Catch
+ Next i
+ End If
+
+ If _ReadOnly Then GoTo CatchReadOnly
+ With _RowSet
+ If .isBeforeFirst() Or .isAfterLast() Or .rowDeleted() Then
GoTo CatchCurrent
+ End With
+
+Try:
+ If UBound(pvArgs) = 0 Then
+ With oUpdates
+ vKeys = .Keys
+ For Each sKey in vKeys
+ lColIndex =
ScriptForge.SF_Array.IndexOf(_Fields, sKey, CaseSensitive := True)
+ If lColIndex >= 0 Then
+ _SetColumnValue(lColIndex, .Item(sKey))
+ Else ' To force an error
+ If Not
ScriptForge.SF_Utils._Validate(sKey, "FieldName", V_STRING,
_UpdatableFields) Then GoTo Catch
+ End If
+ Next sKey
+ End With
+ Else
+ For i = 0 To UBound(pvArgs) Step 2
+ lColIndex = ScriptForge.SF_Array.IndexOf(_Fields,
pvArgs(i), CaseSensitive := True)
+ If lColIndex >= 0 Then
+ If i < UBound(pvArgs) Then
_SetColumnValue(lColIndex, pvArgs(i + 1))
+ Else ' To force an error
+ If Not ScriptForge.SF_Utils._Validate(sKey,
"FieldName", V_STRING, _UpdatableFields) Then GoTo Catch
+ End If
+ Next i
+ End If
+
+ If _RowSet.IsModified Then _RowSet.updateRow()
+ bUpdate = True
+
+Finally:
+ Update = bUpdate
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+CatchCurrent:
+ ScriptForge.SF_Exception.RaiseFatal(NOCURRENTRECORDERROR)
+ GoTo Finally
+CatchReadOnly:
+ ScriptForge.SF_Exception.RaiseFatal(DBREADONLYERROR)
+ GoTo Finally
+End Function ' SFDatabases.SF_Dataset.Update
+
+REM =========================================================== PRIVATE
FUNCTIONS
+
+REM
-----------------------------------------------------------------------------
+Private Function _ConvertDefaultValue(ByRef poColumn As Object) As Variant
+''' Default values of table fields are stored in the Base
file or in the database as strings.
+''' The actual method converts those strings into a Basic
native type.
+''' Usage: facilitate the initialization of new records
+''' Args:
+''' poColumn: a com.sun.star.sdb.ODataColumn UNO
object
+''' Returns
+''' The default value for the column expressed as a
string, a number, a date, ...
+''' Nullable columns have probably a Null default
value.
+
+Dim sValue As String ' The default value as a string
+Dim vValue As Variant ' The default value as a native
Basic type
+Dim SESSION As Object : Set SESSION =
ScriptForge.SF_Session
+
+Try:
+ With poColumn
+
+ ' Determine the default value as a string
+ If SESSION.HasUnoProperty(poColumn, "DefaultValue")
Then ' Default value in database set via SQL
statement
+ sValue = .DefaultValue
+ ElseIf SESSION.HasUnoProperty(poColumn,
"ControlDefault") Then ' Default value set in Base via
table edition
+ If IsEmpty(.ControlDefault) Then sValue = ""
Else sValue = .ControlDefault
+ Else
+ sValue = ""
+ End If
+
+ ' Convert the string to a native type
+ If sValue = "" Then '
No default value => Null or Empty
+ If .IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE
Then vValue = Null Else vValue = Empty
+ Else
+ vValue = sValue
+ With com.sun.star.sdbc.DataType
+ Select Case poColumn.Type
+ Case .CHAR, .VARCHAR, .LONGVARCHAR
+ Case .BIT, .BOOLEAN
: vValue = CBool( sValue = "1" )
+ Case .TINYINT
: vValue = CInt(sValue)
+ Case .SMALLINT, .INTEGER, .BIGINT
: vValue = CLng(sValue)
+ Case .FLOAT
: vValue = CSng(sValue)
+ Case .REAL, .DOUBLE
: vValue = CDbl(sValue)
+ Case .NUMERIC, .DECIMAL
+ If
SESSION.HasUnoProperty(poColumn, "Scale") Then
+ If poColumn.Scale >
0 Then vValue = CDbl(sValue)
+ End If
+ Case .DATE
: vValue = DateValue(sValue)
+ Case .TIME
: vValue = TimeValue(sValue)
+ Case .TIMESTAMP
: vValue = DateValue(sValue) + TimeValue(sValue)
+ Case .BINARY, .VARBINARY,
.LONGVARBINARY, .BLOB
+ Case .CLOB
+ Case Else
+ End Select
+ End With
+ End If
+
+ End With
+
+Finally:
+ _ConvertDefaultValue = vValue
+ Exit Function
+End Function ' SFDatabases.SF_Dataset._ConvertDefaultValue
+
+REM
-----------------------------------------------------------------------------
+Public Function _Initialize() As Boolean
+''' Called immediately after instance creation to complete
the initial values
+''' An eventual error must be trapped in the calling
routine to cancel the instance creation
+''' Returns:
+''' False when Dataset creation is unsuccessful.
Typically because of SQL error
+
+Dim bDataset As Boolean ' Return value
+Dim bErrorHandler As Boolean ' Can be set off to ease debugging of
complex SQL statements
+Dim sFields As String ' Comma-separated list of field
names
+Dim sUpdatableFields As String ' Comma-separated list of updatable field
names
+Dim oColumn As Object ' com.sun.star.sdb.ODataColumn
+Dim SESSION As Object : Set SESSION =
ScriptForge.SF_Services.CreateScriptService("ScriptForge.Session")
+Dim i As Long
+
+ bErrorHandler = ScriptForge.SF_Utils._ErrorHandling()
+ If bErrorHandler Then On Local Error GoTo Catch
+
+Try:
+ Set _RowSet = CreateUnoService("com.sun.star.sdb.RowSet")
+ With _RowSet
+ Set .ActiveConnection = _ParentDatabase._Connection
+ .Command = _Sql
+ Select Case _DatasetType
+ Case "TABLE" : .CommandType =
com.sun.star.sdb.CommandType.TABLE
+ Case "QUERY" : .CommandType =
com.sun.star.sdb.CommandType.QUERY
+ Case "SQL" : .CommandType =
com.sun.star.sdb.CommandType.COMMAND
+ End Select
+
+ .EscapeProcessing = Not _DirectSql
+ .Filter = _Filter
+ .ApplyFilter = ( Len(_Filter) > 0 )
+ .order = _OrderBy
+ If _ReadOnly Then
+ .TransactionIsolation =
com.sun.star.sdbc.TransactionIsolation.READ_UNCOMMITTED
+ Else
+ .TransactionIsolation =
com.sun.star.sdbc.TransactionIsolation.READ_COMMITTED
+ End If
+
+ If bErrorHandler Then On Local Error GoTo CatchSql
+ .execute()
+
+ If bErrorHandler Then On Local Error GoTo Catch
+ ' Collect info about columns: field name, updatable,
default value, AutoValue
+ With .Columns
+ sFields = ""
+ sUpdatableFields = ""
+ ReDim _DefaultValues (0 To .Count - 1)
+ ' Columns are scanned by index to guarantee that
names and indexes are aligned
+ For i = 0 To .Count - 1
+ Set oColumn = .getByIndex(i)
+ With oColumn
+ ' Field names
+ sFields = sFields & ","
& .Name
+ ' Updatable field names
+ If Not _ReadOnly And
.isDefinitelyWritable And Not .IsAutoIncrement Then sUpdatableFields =
sUpdatableFields & "," & .Name
+ ' Default values
+ _DefaultValues(i) =
_ConvertDefaultValue(oColumn)
+ ' AutoValue
+ If _AutoValue < 0 And
.IsAutoIncrement Then _AutoValue = i
+ End With
+ Next i
+ If Len(sFields) <= 1 Then _Fields = Array() Else
_Fields = Split(Mid(sFields, 2), ",")
+ If Len(sUpdatableFields) <= 1 Then _UpdatableFields
= Array() Else _UpdatableFields = Split(Mid(sUpdatableFields, 2), ",")
+ End With
+ End With
+
+ bDataset = True
+
+Finally:
+ _Initialize = bDataset
+ Exit Function
+Catch:
+ bDataset = False
+ GoTo Finally
+CatchSql:
+ On Local Error GoTo 0
+ ScriptForge.SF_Exception.RaiseFatal(SQLSYNTAX2ERROR, _Sql, "WHERE
" & _Filter, "ORDER BY " & _OrderBy)
+ GoTo Catch
+End Function ' SFDatabases.SF_Dataset._Initialize
+
+REM
-----------------------------------------------------------------------------
+Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant
+''' Return the value of the named property
+''' Args:
+''' psProperty: the name of the property
+
+Dim vBookmark As Variant ' Bookmark on the current
record
+Dim vValue As Variant ' A single record field
value
+Dim vValuesDict As Object ' A dictionary (field name, field
value)
+Dim i As Long
+
+Dim cstThisSub As String
+Const cstSubArgs = ""
+
+ cstThisSub = "SFDatabases.Dataset.get" & psProperty
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+
+ ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
+
+ With _RowSet
+ Select Case psProperty
+ Case "BOF"
+ _PropertyGet = .isBeforeFirst()
+ Case "DefaultValues"
+ ' Load the pairs field name / field
default value in the dictionary
+ vValuesDict =
ScriptForge.SF_Services.CreateScriptService("ScriptForge.Dictionary")
+ For i = 0 To UBound(_DefaultValues)
+ vValuesDict.Add(_Fields(i),
_DefaultValues(i))
+ Next i
+ Set _PropertyGet = vValuesDict
+ Case "EOF"
+ _PropertyGet = .isAfterLast()
+ Case "Fields"
+ _PropertyGet = _Fields
+ Case "Filter"
+ _PropertyGet = _Filter
+ Case "OrderBy"
+ _PropertyGet = _OrderBy
+ Case "ParentDatabase"
+ Set _PropertyGet = _ParentDatabase
+ Case "RowCount"
+ If .IsRowCountFinal Then
+ _PropertyGet = .RowCount
+ Else
+ If .isBeforeFirst() Or
.isAfterLast() Or .rowDeleted() Then vBookmark = Null Else vBookmark =
.getBookmark
+ .last()
+ _PropertyGet = .RowCount
+ If IsNull(vBookmark) Then
.beforeFirst() Else .moveToBookmark(vBookmark)
+ End If
+ Case "RowNumber"
+ If .isBeforeFirst() Or .isAfterLast()
Or .rowDeleted() Then _PropertyGet = 0 Else _PropertyGet = .Row
+ Case "Source"
+ _PropertyGet = _Command
+ Case "SourceType"
+ _PropertyGet = _DatasetType
+ Case "UpdatableFields"
+ _PropertyGet = _UpdatableFields
+ Case "Values"
+ If .isBeforeFirst() Or .isAfterLast()
Or .rowDeleted() Then
+ Set _PropertyGet = Nothing
+ Else
+ ' Load the pairs field
name / field value in the dictionary
+ vValuesDict =
ScriptForge.SF_Services.CreateScriptService("ScriptForge.Dictionary")
+ For i = 0 To UBound(_Fields)
+ vValue =
_ParentDatabase._GetColumnValue(_RowSet, i + 1, False)
+
vValuesDict.Add(_Fields(i), vValue)
+ Next i
+ Set _PropertyGet = vValuesDict
+ End If
+ Case "XRowSet"
+ Set _PropertyGet = _RowSet
+ Case Else
+ _PropertyGet = Null
+ End Select
+ End With
+
+Finally:
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+End Function ' SFDatabases.SF_Dataset._PropertyGet
+
+REM
-----------------------------------------------------------------------------
+Private Function _PropertySet(Optional ByVal psProperty As String _
+ , Optional
ByVal pvValue As Variant _
+ ) As Boolean
+''' Set the new value of the named property
+''' Args:
+''' psProperty: the name of the property
+''' pvValue: the new value of the given property
+''' Returns:
+''' True if successful
+
+Dim bSet As Boolean '
Return value
+Dim cstThisSub As String
+Const cstSubArgs = "Value"
+
+ If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
+ bSet = False
+
+ cstThisSub = "SFDatabases.Dataset.set" & psProperty
+ ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
+
+ bSet = True
+ Select Case UCase(psProperty)
+ Case UCase("BOF")
+ If Not ScriptForge.SF_Utils._Validate(pvValue,
"BOF", ScriptForge.V_BOOLEAN) Then GoTo Finally
+ If pvValue Then _RowSet.beforeFirst() '
Only True is valid
+ Case UCase("EOF")
+ If Not ScriptForge.SF_Utils._Validate(pvValue,
"EOF", ScriptForge.V_BOOLEAN) Then GoTo Finally
+ If pvValue Then _RowSet.afterLast()
' Only True is valid
+ Case Else
+ bSet = False
+ End Select
+
+Finally:
+ _PropertySet = bSet
+ ScriptForge.SF_Utils._ExitFunction(cstThisSub)
+ Exit Function
+Catch:
+ GoTo Finally
+End Function ' SFDatabases.SF_Dataset._PropertySet
+
+REM
-----------------------------------------------------------------------------
+Private Function _Repr() As String
+''' Convert the Dataset instance to a readable string,
typically for debugging purposes (DebugPrint ...)
+''' Args:
+''' Return:
+''' "[DATASET]: tablename,base file url"
+
+ _Repr = "[DATASET]: " & _Command & ","
& _ParentDatabase._Location
+
+End Function ' SFDatabases.SF_Dataset._Repr
+
+REM
-----------------------------------------------------------------------------
+Private Function _SetColumnValue(ByVal plColIndex As Long _
+ , ByRef
pvValue As Variant _
+ ) As
Boolean
+''' Store a value in a given column of the current record
+''' The resultset.insertRow() or resultset.updateRow()
methods are supposed to be executed in the calling routine
+''' The type of the column is found in the resultset's
metadata
+''' Args:
+''' plColIndex: the index of the column to extract
the value from. Starts at 0
+''' Read-only columns are ignored.
+''' pvValue:the Variant value to store in the column
+''' Strings and numbers are supplied
respectively as strings or numeric values
+''' Dates and times are supplied as Basic
dates
+''' Null values are supplied as Null
+''' Errors or other strange data types are
ignored
+''' Returns:
+''' True when successful
+''' Exceptions:
+''' RECORDUPDATEERROR when value to
store does not fit the type of the field
+'''
or when field is not nullable and value = Null
+'''
or when field is not writable or is an autovalue
+'''
or when input file does not exist or is empty
+'''
or when field type is not supported
+
+Dim bSet As Boolean ' Return value
+Dim sColumn As String ' Column name
+Dim oColumn As Object ' com.sun.star.sdb.DataColumn
... etc. - the rest is truncated
