diff options
| author | Jean-Pierre Ledure <jp@ledure.be> | 2023-11-11 17:02:38 +0100 |
|---|---|---|
| committer | Jean-Pierre Ledure <jp@ledure.be> | 2023-11-11 18:20:15 +0100 |
| commit | 7b2a6f04443c5d80ce681e5f1c89bf140fdb5c3a (patch) | |
| tree | 7b0a11529000b44b09c78dc6a79062773590e11e /wizards | |
| parent | c45779ce3d1b95abd037d3d4d706aca511dfdc24 (diff) | |
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 <jp@ledure.be>
Tested-by: Jenkins
Diffstat (limited to 'wizards')
| -rw-r--r-- | wizards/Package_sfdatabases.mk | 1 | ||||
| -rw-r--r-- | wizards/source/scriptforge/SF_Exception.xba | 19 | ||||
| -rw-r--r-- | wizards/source/scriptforge/SF_PythonHelper.xba | 4 | ||||
| -rw-r--r-- | wizards/source/scriptforge/SF_Root.xba | 49 | ||||
| -rw-r--r-- | wizards/source/scriptforge/po/ScriptForge.pot | 65 | ||||
| -rw-r--r-- | wizards/source/scriptforge/po/en.po | 65 | ||||
| -rw-r--r-- | wizards/source/scriptforge/python/scriptforge.py | 88 | ||||
| -rw-r--r-- | wizards/source/sfdatabases/SF_Database.xba | 146 | ||||
| -rw-r--r-- | wizards/source/sfdatabases/SF_Dataset.xba | 1664 | ||||
| -rw-r--r-- | wizards/source/sfdatabases/SF_Datasheet.xba | 8 | ||||
| -rw-r--r-- | wizards/source/sfdatabases/script.xlb | 1 |
11 files changed, 2066 insertions, 44 deletions
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) @@ -1821,6 +1824,85 @@ class SFDatabases: 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 # ######################################################################### class SF_Datasheet(SFServices): 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 @@ -154,6 +155,105 @@ Finally: 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 _ , Optional ByVal Criteria 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 +Dim lType As Long ' SQL column type: com.sun.star.sdbc.DataType +Dim vDateTime As Variant ' com.sun.star.util.DateTime +Dim bNullable As Boolean ' The field is defined as accepting Null values +Dim vTemp As Variant ' Work variable for date and time related conversions +Dim sFile As String ' File name in FileSystem notation +Dim oSimpleFileAccess As Object ' com.sun.star.ucb.SimpleFileAccess +Dim oStream As Object ' com.sun.star.io.XInputStream +Dim lFileLength As Long ' Binary file length in bytes + +Dim UTILS As Object : Set UTILS = ScriptForge.SF_Utils +Dim SESS As Object : Set SESS = ScriptForge.SF_Session + + bSet = False + On Local Error GoTo CatchError + +Check: + Set oColumn = _RowSet.Columns.getByIndex(plColIndex) + sColumn = oColumn.Name + If _ReadOnly Then GoTo CatchError + If Not ScriptForge.SF_Array.Contains(_UpdatableFields, sColumn, CaseSensitive := True) Then GoTo CatchError + +Try: + With com.sun.star.sdbc.DataType + If IsEmpty(pvValue) Then ' An empty default value means not nullable and no default => ignore + ElseIf IsNull(pvValue) Then + If oColumn.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE Then oColumn.updateNull() Else Goto CatchError + Else + Select Case oColumn.Type + Case .BIT, .BOOLEAN + If VarType(pvValue) <> UTILS.V_BOOLEAN Then GoTo CatchError + oColumn.updateBoolean(pvValue) + Case .TINYINT + If UTILS._VarTypeExt(pvValue) <> UTILS.V_NUMERIC Then Goto CatchError + If pvValue < -128 Or pvValue > +127 Then Goto CatchError + oColumn.updateShort(CInt(pvValue)) + Case .SMALLINT + If UTILS._VarTypeExt(pvValue) <> UTILS.V_NUMERIC Then Goto CatchError + If pvValue < -32768 Or pvValue > 32767 Then Goto CatchError + oColumn.updateInt(CInt(pvValue)) + Case .INTEGER + If UTILS._VarTypeExt(pvValue) <> UTILS.V_NUMERIC Then Goto CatchError + If pvValue < -2147483648 Or pvValue > 2147483647 Then Goto CatchError + oColumn.updateInt(CLng(pvValue)) + Case .BIGINT + If UTILS._VarTypeExt(pvValue) <> UTILS.V_NUMERIC Then Goto CatchError + oColumn.updateLong(pvValue) ' No proper type conversion for HYPER data type + Case .FLOAT + If UTILS._VarTypeExt(pvValue) <> UTILS.V_NUMERIC Then Goto CatchError + If Abs(pvValue) < 3.402823E38 And Abs(pvValue) > 1.401298E-45 Then oColumn.updateFloat(CSng(pvValue)) Else Goto CatchError + Case .REAL, .DOUBLE + If UTILS._VarTypeExt(pvValue) <> UTILS.V_NUMERIC Then Goto CatchError + 'If Abs(pvValue) < 1.79769313486232E308 And Abs(pvValue) > 4.94065645841247E-307 Then oColumn.updateDouble(CDbl(pvValue)) Else Goto CatchError + oColumn.updateDouble(CDbl(pvValue)) + Case .NUMERIC, .DECIMAL + If UTILS._VarTypeExt(pvValue) <> UTILS.V_NUMERIC Then Goto CatchError + If SESS.HasUnoProperty(oColumn, "Scale") Then + If oColumn.Scale > 0 Then + 'If Abs(pvValue) < 1.79769313486232E308 And Abs(pvValue) > 4.94065645841247E-307 Then oColumn.updateDouble(CDbl(pvValue)) Else Goto CatchError + oColumn.updateDouble(CDbl(pvValue)) + Else + oColumn.updateString(CStr(pvValue)) + End If + Else + Column.updateString(CStr(pvValue)) + End If + Case .CHAR, .VARCHAR, .LONGVARCHAR, .CLOB + If VarType(pvValue) <> V_STRING Then GoTo CatchError + If SESS.HasUnoProperty(oColumn, "Precision") Then + If oColumn.Precision > 0 And Len(pvValue) > oColumn.Precision Then Goto CatchError + End If + oColumn.updateString(pvValue) + Case .DATE + If VarType(pvValue) <> V_DATE Then GoTo CatchError + vTemp = New com.sun.star.util.Date + With vTemp + .Day = Day(pvValue) + .Month = Month(pvValue) + .Year = Year(pvValue) + End With + oColumn.updateDate(vTemp) + Case .TIME + If VarType(pvValue) <> V_DATE Then GoTo CatchError + vTemp = New com.sun.star.util.Time + With vTemp + .Hours = Hour(pvValue) + .Minutes = Minute(pvValue) + .Seconds = Second(pvValue) + .NanoSeconds = 0 + End With + oColumn.updateTime(vTemp) + Case .TIMESTAMP + If VarType(pvValue) <> V_DATE Then GoTo CatchError + vTemp = New com.sun.star.util.DaWHEREteTime + With vTemp + .Day = Day(pvValue) + .Month = Month(pvValue) + .Year = Year(pvValue) + .Hours = Hour(pvValue) + .Minutes = Minute(pvValue) + .Seconds = Second(pvValue) + .NanoSeconds = 0 + End With + oColumn.updateTimestamp(vTemp) + Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB + If VarType(pvValue) <> V_STRING Then GoTo CatchError + If Not UTILS._ValidateFile(pvValue, "FieldValue") Then GoTo CatchError + ' Verify file + sFile = ConvertToUrl(pvValue) + oSimpleFileAccess = UTILS._GetUnoService("FileAccess") + If Not oSimpleFileAccess.exists(sFile) Then Goto CatchError + ' Load the binary data + Set oStream = oSimpleFileAccess.openFileRead(sFile) + lFileLength = oStream.getLength() + If lFileLength = 0 Then Goto CatchError ' <<<<<<<<<<<<<<<<< PUT NULL + oColumn.updateBinaryStream(oStream, lFileLength) + oStream.closeInput() + Case Else + Goto CatchError + End Select + End If + End With + + bSet = True + +Finally: + _SetColumnValue = bSet + Exit Function +CatchError: + On Local Error GoTo 0 + ScriptForge.SF_Exception.RaiseFatal(RECORDUPDATEERROR, sColumn, ScriptForge.SF_String.Represent(pvValue), oColumn.TypeName) + GoTo Finally +End Function ' SFDatabases.SF_Dataset._SetColumnValue + +REM ============================================ END OF SFDATABASES.SF_DATASET +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdatabases/SF_Datasheet.xba b/wizards/source/sfdatabases/SF_Datasheet.xba index 775984f60d6f..89e66aefd6c6 100644 --- a/wizards/source/sfdatabases/SF_Datasheet.xba +++ b/wizards/source/sfdatabases/SF_Datasheet.xba @@ -668,19 +668,19 @@ Public Function SetProperty(Optional ByVal PropertyName As Variant _ Const cstThisSub = "SFDatabases.Datasheet.SetProperty" Const cstSubArgs = "PropertyName, Value" - If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch SetProperty = False Check: - If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then - If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + 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: - SF_Utils._ExitFunction(cstThisSub) + ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally diff --git a/wizards/source/sfdatabases/script.xlb b/wizards/source/sfdatabases/script.xlb index 15d7cbdbe978..8e12f56515d5 100644 --- a/wizards/source/sfdatabases/script.xlb +++ b/wizards/source/sfdatabases/script.xlb @@ -5,4 +5,5 @@ <library:element library:name="__License"/> <library:element library:name="SF_Database"/> <library:element library:name="SF_Datasheet"/> + <library:element library:name="SF_Dataset"/> </library:library>
\ No newline at end of file |