Quelle  SF_Dataset.xba   Sprache: unbekannt

<?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 through 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 statement
'''    - 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 will 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

Private _DatasetIndex  As Long   ' Index of the dataset in the _Datasets array of the parent database

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
 _DatasetIndex = -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
  If _DatasetIndex >= 0 Then Set _ParentDatabase._Datasets(_DatasetIndex) = Nothing
  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, True) 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
 If MaxRows < 0 Then MaxRows = 1

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
    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
    If MaxRows = 0 Or lRows < MaxRows - 1 Then bRead = .next() Else bRead = False
   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, True) 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 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
'''  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, True) 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, True) 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, True) 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, True) 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, True) 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, True) 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 .IsWritable 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
 
 ' Insert the instance in the _Datasets array of the parent database
 _DatasetIndex = _ParentDatabase._AddToDatasets([Me])

 bDataset = ( _DatasetIndex >= 0 )

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 (with case-sensitive comparison of keys)
    vValuesDict = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Dictionary", True)
    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 (with case-sensitive comparison of keys)
      vValuesDict = ScriptForge.SF_Services.CreateScriptService("ScriptForge.Dictionary", True)
      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
--> --------------------

--> maximum size reached

--> --------------------