1672 lines
No EOL
70 KiB
XML
1672 lines
No EOL
70 KiB
XML
<?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
|
|
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> |