Quelle  Recordset.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="Recordset" script:language="StarBasic">
REM =======================================================================================================================
REM ===     The Access2Base library is a part of the LibreOffice project.         ===
REM ===     Full documentation is available on http://www.access2base.com         ===
REM =======================================================================================================================

Option Compatible
Option ClassModule

Option Explicit

REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS ROOT FIELDS                               ---
REM -----------------------------------------------------------------------------------------------------------------------

Private _Type     As String    ' Must be RECORDSET
Private _This     As Object    ' Workaround for absence of This builtin function
Private _Parent     As Object
Private _Name     As String    ' Unique, generated
Private _Fields()    As Variant
Private _ParentName    As String
Private _ParentType    As String
Private _ParentDatabase   As Object
Private _ForwardOnly   As Boolean
Private _PassThrough   As Boolean
Private _ReadOnly    As Boolean
Private _CommandType   As Long
Private _Command    As String
Private _DataSet    As Boolean    ' True if execute() successful
Private _BOF     As Boolean
Private _EOF     As Boolean
Private _Filter     As String
Private _EditMode    As Integer    ' dbEditxxx constants
Private _BookmarkBeforeNew  As Variant
Private _BookmarkLastModified As Variant
Private _IsClone    As Boolean
Private _ManageChunks   As Variant    ' Array of ChunkDescriptors
Private RowSet     As Object    ' com.sun.star.comp.dba.ORowSet

Type ChunkDescriptor
 ChunksRequested    As Boolean
 FieldName     As String
 ChunkType     As Integer    ' vbString or vbByte
 FileName     As String
 FileHandler     As Object
End Type

REM -----------------------------------------------------------------------------------------------------------------------
REM --- CONSTRUCTORS / DESTRUCTORS                            ---
REM -----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
 _Type = OBJRECORDSET
 Set _This = Nothing
 Set _Parent = Nothing
 _Name = ""
 _Fields = Array()
 _ParentName = ""
 Set _ParentDatabase = Nothing
 _ParentType = ""
 _ForwardOnly = False
 _PassThrough = False
 _ReadOnly = False
 _CommandType = 0
 _Command = ""
 _DataSet = False
 _BOF = True
 _EOF = True
 _Filter = ""
 _EditMode = dbEditNone
 _BookmarkBeforeNew = Null
 _BookmarkLastModified = Null
 _IsClone = False
 Set _ManageChunks = Array()
 Set RowSet = Nothing
End Sub  ' Constructor

REM -----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Terminate()
 On Local Error Resume Next
 mClose()
End Sub

REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS GET/LET/SET PROPERTIES                           ---
REM -----------------------------------------------------------------------------------------------------------------------

REM -----------------------------------------------------------------------------------------------------------------------
Property Get AbsolutePosition() As Variant
 AbsolutePosition = _PropertyGet("AbsolutePosition")
End Property  ' AbsolutePosition (get)

Property Let AbsolutePosition(ByVal pvValue As Variant)
 Call _PropertySet("AbsolutePosition", pvValue)
End Property ' AbsolutePosition (set)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get BOF() As Boolean
 BOF = _PropertyGet("BOF")
End Property  ' BOF (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get Bookmark() As Variant
 Bookmark = _PropertyGet("Bookmark")
End Property  ' Bookmark (get)

Property Let Bookmark(ByVal pvValue As Variant)
 Call _PropertySet("Bookmark", pvValue)
End Property ' Bookmark (set)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get Bookmarkable() As Boolean
 Bookmarkable = _PropertyGet("Bookmarkable")
End Property  ' Bookmarkable (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get EOF() As Boolean
 EOF = _PropertyGet("EOF")
End Property  ' EOF (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get EditMode() As Integer
 EditMode = _PropertyGet("EditMode")
End Property  ' EditMode (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get Filter() As Variant
 Filter = _PropertyGet("Filter")
End Property  ' Filter (get)

Property Let Filter(ByVal pvValue As Variant)
 Call _PropertySet("Filter", pvValue)
End Property ' Filter (set)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get LastModified() As Variant
' DO NOT PUBLISH
 LastModified = _PropertyGet("LastModified")
End Property  ' LastModified (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get Name() As String
 Name = _PropertyGet("Name")
End Property  ' Name (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get ObjectType() As String
 ObjectType = _PropertyGet("ObjectType")
End Property  ' ObjectType (get)

REM -----------------------------------------------------------------------------------------------------------------------
Property Get RecordCount() As Long
 RecordCount = _PropertyGet("RecordCount")
End Property  ' RecordCount (get)

REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS METHODS                                ---
REM -----------------------------------------------------------------------------------------------------------------------

REM -----------------------------------------------------------------------------------------------------------------------
Public Function AddNew() As Boolean
' Initiates the creation of a new record

Const cstThisSub = "Recordset.AddNew"
Dim i As Integer, iFieldsCount As Integer, oField As Object
Dim sDefault As String, oColumn As Object
Dim iValue As Integer, lValue As Long, sgValue As Single, dbValue As Double, dValue As Date
Dim vTemp As Variant
 If _ErrorHandler() Then On Local Error Goto Error_Function
 Utils._SetCalledSub(cstThisSub)
 AddNew = False
 
 With RowSet
  'Is inserting a new row allowed ?
  If _ForwardOnly Or _ReadOnly Then Goto Error_NoUpdate
  If Not .CanUpdateInsertedRows Then Goto Error_NoUpdate
  If Not .IsBookmarkable Then Goto Error_NoUpdate
  If _EditMode <> dbEditNone Then CancelUpdate()
  If _BOF And _EOF Then  ' Records before first or after last do not have a bookmark
   _BookmarkBeforeNew = "_BOF_"
  ElseIf .isBeforeFirst() Then
   _BookmarkBeforeNew = "_BOF_"
  ElseIf .isAfterLast() Then
   _BookmarkBeforeNew = "_EOF_"
  Else
   _BookmarkBeforeNew = .getBookmark()
  End If

  .moveToInsertRow()
  
  'Set all fields to their default value
  iFieldsCount = Fields().Count
  On Local Error Resume Next   ' Do not stop if default setting fails
  For i = 0 To iFieldsCount - 1
   Set oField = Fields(i)
   Set oColumn = oField.Column
   sDefault = oField.DefaultValue
   If sDefault = "" Then    ' No default value
    If oColumn.IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE Then oColumn.updateNull()
   Else
    With com.sun.star.sdbc.DataType
     Select Case oColumn.Type
      Case .BIT, .BOOLEAN
       If sDefault = "1" Then oColumn.updateBoolean(True) Else oColumn.updateBoolean(False)
      Case .TINYINT
       iValue = CInt(sDefault)
       If iValue >= -128 And iValue <= +127 Then oColumn.updateShort(iValue)
      Case .SMALLINT
       lValue = CLng(sDefault)
       If lValue >= -32768 And lValue <= 32767 Then oColumn.updateInt(lValue)
      Case .INTEGER
       lValue = CLng(sDefault)
       If lValue >= -2147483648 And lValue <= 2147483647 Then oColumn.updateInt(lValue)
      Case .BIGINT
       lValue = CLng(sDefault)
       Column.updateLong(lValue)  ' No proper type conversion for HYPER data type
      Case .FLOAT
       sgValue = CSng(sDefault)
       If Abs(sgValue) < 3.402823E38 And Abs(sgValue) > 1.401298E-45 Then oColumn.updateFloat(sgValue)
      Case .REAL, .DOUBLE
       dbValue = CDbl(sDefault)
       'If Abs(dbValue) < 1.79769313486232E308 And Abs(dbValue) > 4.94065645841247E-307 Then oColumn.updateDouble(dbValue)
       oColumn.updateDouble(dbValue)
      Case .NUMERIC, .DECIMAL
       dbValue = CDbl(sDefault)
       If Utils._hasUNOProperty(Column, "Scale") Then
        If Column.Scale > 0 Then
         'If Abs(dbValue) < 1.79769313486232E308 And Abs(dbValue) > 4.94065645841247E-307 Then oColumn.updateDouble(dbValue)
         oColumn.updateDouble(dbValue)
        Else
         oColumn.updateString(sDefault)
        End If
       Else
        oColumn.updateString(sDefault)
       End If
      Case .CHAR, .VARCHAR, .LONGVARCHAR
       oColumn.updateString(sDefault)      ' vbString
      Case .DATE
       dValue = DateValue(sDefault)
       vTemp = New com.sun.star.util.Date
       With vTemp
        .Day = Day(dValue)
        .Month = Month(dValue)
        .Year = Year(dValue)
       End With
       oColumn.updateDate(vTemp)
      Case .TIME
       dValue = TimeValue(sDefault)
       vTemp = New com.sun.star.util.Time
       With vTemp
        .Hours = Hour(dValue)
        .Minutes = Minute(dValue)
        .Seconds = Second(dValue)
        '.HundredthSeconds = 0
       End With
       oColumn.updateTime(vTemp)
      Case .TIMESTAMP
       dValue = DateValue(sDefault)
       vTemp = New com.sun.star.util.DateTime
       With vTemp
        .Day = Day(dValue)
        .Month = Month(dValue)
        .Year = Year(dValue)
        .Hours = Hour(dValue)
        .Minutes = Minute(dValue)
        .Seconds = Second(dValue)
        '.HundredthSeconds = 0
       End With
       oColumn.updateTimestamp(vTemp)
'      Case .BINARY, .VARBINARY, .LONGVARBINARY
 '     Case .BLOB
'      Case .CLOB
      Case Else
     End Select
    End With
   End If
  Next i
 End With
 If _ErrorHandler() Then On Local Error Goto Error_Function Else On Local Error Goto 0

 _EditMode = dbEditAdd
 AddNew = True

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function 
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
Error_NoUpdate:
 TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0)
 Goto Exit_Function
End Function  ' AddNew

REM -----------------------------------------------------------------------------------------------------------------------
Public Function CancelUpdate() As Boolean
' Cancel any edit action

Const cstThisSub = "Recordset.CancelUpdate"

 If _ErrorHandler() Then On Local Error Goto Error_Function
 Utils._SetCalledSub(cstThisSub)
 CancelUpdate = False
 
 With RowSet
  Select Case _EditMode
   Case dbEditNone
   Case dbEditAdd
    _AppendChunkClose(True)
    If Not IsNull(_BookmarkBeforeNew) Then
     Select Case _BookmarkBeforeNew
      Case "_BOF_"  :  .beforeFirst()
      Case "_EOF_"  :  .afterLast()
      Case Else   :  .moveToBookmark(_BookmarkBeforeNew)
     End Select
    End If
   Case dbEditInProgress
    .cancelRowUpdates()
    _AppendChunkClose(True)
  End Select
 End With
 
 _EditMode = dbEditNone
 _BookmarkBeforeNew = Null
 _BookmarkLastModified = Null
 CancelUpdate = True

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function 
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
End Function  ' CancelUpdate

REM -----------------------------------------------------------------------------------------------------------------------
Public Function Clone() As Object
' Duplicate an existing recordset

Const cstThisSub = "Recordset.Clone"

Const cstNull = -1
Dim iType As Integer, iOptions As Integer, iLockEdit As Integer
 If _ErrorHandler() Then On Local Error Goto Error_Function
 Utils._SetCalledSub(cstThisSub)
 Set Clone = Nothing
 
 If _IsClone Then Goto Error_Clone
 If _ForwardOnly Then iType = dbOpenForwardOnly Else iType = cstNull
 If _PassThrough Then iOptions = dbSQLPassThrough Else iOptions = cstNull
 iLockEdit = dbReadOnly   ' Always read-only
 
 Set Clone = OpenRecordset(iType, iOptions, iLockEdit, True)
 
Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function 
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
Error_Clone:
 TraceError(TRACEFATAL, ERRRECORDSETCLONE, Utils._CalledSub(), 0)
 Goto Exit_Function
End Function  ' Clone

REM -----------------------------------------------------------------------------------------------------------------------
Public Function mClose(ByVal Optional pbRemove As Boolean) As Variant
' Dispose UNO objects
' If pbRemove = True, remove recordset from Recordsets collection

Const cstThisSub = "Recordset.Close"
Dim i As Integer

 If _ErrorHandler() Then On Local Error Goto Exit_Function  ' Do not stop execution
 Utils._SetCalledSub(cstThisSub)
 If Not IsNull(RowSet) Then
  RowSet.close()
  RowSet.dispose()
 End If
 _ForwardOnly = False
 _PassThrough = False
 _ReadOnly = False
 _CommandType = 0
 _Command = ""
 _ParentName = ""
 _ParentType = ""
 _DataSet = False
 _BOF = True
 _EOF = True
 _Filter = ""
 _EditMode = dbEditNone
 _BookmarkBeforeNew = Null
 _BookmarkLastModified = Null
 _IsClone = False
 For i = 0 To UBound(_Fields)
  If Not IsNull(_Fields(i)) Then
   _Fields(i).Dispose()
   Set _Fields(i) = Nothing
  End If
 Next i
 _Fields = Array()
 Set RowSet = Nothing
 If IsMissing(pbRemove) Then pbRemove = True
 If pbRemove Then _ParentDatabase.RecordsetsColl.Remove(_Name)
 Set _ParentDatabase = Nothing

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function 
End Function  ' Close

REM -----------------------------------------------------------------------------------------------------------------------
Public Function Delete() As Boolean
' Deletes the current record

Const cstThisSub = "Recordset.Delete"

 If _ErrorHandler() Then On Local Error Goto Error_Function
 Utils._SetCalledSub(cstThisSub)
 Delete = False
 
 'Is deleting a row allowed ?
 If _ForwardOnly Or _ReadOnly Then Goto Error_NoUpdate
 If _EditMode <> dbEditNone Then
  CancelUpdate()
  Goto Error_Sequence
 End If
 If RowSet.rowDeleted() Then Goto Error_RowDeleted

 RowSet.deleteRow()
 Delete = True

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function 
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
Error_NoUpdate:
 TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0)
 Goto Exit_Function
Error_RowDeleted:
 TraceError(TRACEFATAL, ERRROWDELETED, Utils._CalledSub(), 0)
 Goto Exit_Function
Error_Sequence:
 TraceError(TRACEFATAL, ERRUPDATESEQUENCE, Utils._CalledSub(), 0, 1)
 Goto Exit_Function
End Function  ' Delete

REM -----------------------------------------------------------------------------------------------------------------------
Public Function Edit() As Boolean
' Updates the current record

Const cstThisSub = "Recordset.Edit"

 If _ErrorHandler() Then On Local Error Goto Error_Function
 Utils._SetCalledSub(cstThisSub)
 Edit = False
 
 'Is updating a row allowed ?
 If _ForwardOnly Or _ReadOnly Then Goto Error_NoUpdate
 If _EditMode <> dbEditNone Then CancelUpdate()
 If RowSet.rowDeleted() Then Goto Error_RowDeleted

 _EditMode = dbEditInProgress
 Edit = True

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function 
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
Error_NoUpdate:
 TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0)
 Goto Exit_Function
Error_RowDeleted:
 TraceError(TRACEFATAL, ERRROWDELETED, Utils._CalledSub(), 0)
 Goto Exit_Function
End Function  ' Edit

REM -----------------------------------------------------------------------------------------------------------------------
Public Function Fields(ByVal Optional pvIndex As Variant) As Object

 If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "Recordset.Fields"
 Utils._SetCalledSub(cstThisSub)

 Set Fields = Nothing
 If Not IsMissing(pvIndex) Then
  If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
 End If
   
Dim sObjects() As String, sObjectName As String, oObject As Object
Dim i As Integer, oFields As Object, iIndex As Integer

 ' No argument, return a collection
 If IsMissing(pvIndex) Then
  Set oObject = New Collect
  Set oObject._This = oObject
  oObject._CollType = COLLFIELDS
  Set oObject._Parent = _This
  oObject._Count = RowSet.getColumns().Count
  Goto Exit_Function
 End If

 Set oFields = RowSet.getColumns()
 sObjects = oFields.ElementNames()

 ' Argument is the field name
 If VarType(pvIndex) = vbString Then
  iIndex = -1
  ' Check existence of object and find its exact (case-sensitive) name
  For i = 0 To UBound(sObjects)
   If UCase(pvIndex) = UCase(sObjects(i)) Then
    sObjectName = sObjects(i)
    iIndex = i
    Exit For
   End If
  Next i
  If iIndex < 0 Then Goto Trace_NotFound
 ' Argument is numeric
 Else
  If pvIndex < 0 Or pvIndex > UBound(sObjects) Then Goto Trace_IndexError
  sObjectName = sObjects(pvIndex)
  iIndex = pvIndex
 End If

 ' Check if field object already buffered in _Fields() array
 If UBound(_Fields) < 0 Then  ' Initialize _Fields
  ReDim _Fields(0 To UBound(sObjects))
  For i = 0 To UBound(sObjects)
   Set _Fields(i) = Nothing
  Next i
 End If
 If Not IsNull(_Fields(iIndex)) Then
  Set oObject = _Fields(iIndex)
 ' Otherwise create new field object
 Else
  Set oObject = New Field
  Set oObject._This = oObject
  oObject._Name = sObjectName
  Set oObject.Column = oFields.getByName(sObjectName)
  If Utils._hasUNOProperty(oObject.Column, "Precision") Then oObject._Precision = oObject.Column.Precision
  oObject._ParentName = _Name
  oObject._ParentType = _Type
  Set oObject._ParentDatabase = _ParentDatabase
  Set oObject._ParentRecordset = _This
  Set _Fields(iIndex) = oObject
 End If

Exit_Function:
 Set Fields = oObject
 Set oObject = Nothing
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
Trace_NotFound:
 TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel("FIELD"), pvIndex))
 Goto Exit_Function
Trace_IndexError:
 TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
 Goto Exit_Function
End Function  ' Fields

REM -----------------------------------------------------------------------------------------------------------------------
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
' Return property value of psProperty property name

Const cstThisSub = "Recordset.getProperty"
 Utils._SetCalledSub(cstThisSub)
 If IsMissing(pvProperty) Then Call _TraceArguments()
 getProperty = _PropertyGet(pvProperty)
 Utils._ResetCalledSub(cstThisSub)
 
End Function  ' getProperty

REM -----------------------------------------------------------------------------------------------------------------------
Public Function GetRows(ByVal Optional pvNumRows As variant, ByVal Optional pbStrDate As Boolean) As Variant
' UNPUBLISHED - pbStrDate = True forces all dates to be converted into strings

 If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = "Recordset.GetRows"
 Utils._SetCalledSub(cstThisSub)
 If IsMissing(pbStrDate) Then pbStrDate = False

Dim vMatrix() As Variant, lSize As Long, iNumFields As Integer, i As Integer
 vMatrix() = Array()
 If IsMissing(pvNumRows) Then Call _TraceArguments()
 If Not Utils._CheckArgument(pvNumRows, 1, Utils._AddNumeric()) Then Goto Exit_Function
 If pvNumRows < 1 Then Goto Trace_Error
 If IsNull(RowSet) Then Goto Trace_Closed
 If Not _DataSet Then Goto Exit_Function

 If _EditMode <> dbEditNone Then CancelUpdate()
 
 If _EOF Then Goto Exit_Function

 lSize = -1
 iNumFields = RowSet.getColumns().Count - 1
 If iNumFields < 0 Then Goto Exit_Function

 ReDim vMatrix(0 To iNumFields, 0 To pvNumRows - 1)
 
 Do While Not _EOF And lSize < pvNumRows - 1
  lSize = lSize + 1
  For i = 0 To iNumFields
   vMatrix(i, lSize) = Utils._getResultSetColumnValue(RowSet, i + 1)
   If pbStrDate And IsDate(vMatrix(i, lSize)) Then vMatrix(i, lSize) = _CStr(vMatrix(i, lSize))
  Next i
  _Move("NEXT")
 Loop
 If lSize < pvNumRows - 1 Then    ' Resize to number of fetched records
  ReDim Preserve vMatrix(0 To iNumFields, 0 To lSize)
 End If

Exit_Function:
 GetRows() = vMatrix()
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
Trace_Error:
 TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, , Array(1, pvNumRows))
 Set Controls = Nothing
 Goto Exit_Function
Trace_Closed:
 TraceError(TRACEFATAL, ERRRECORDSETCLOSED, Utils._CalledSub(), 0)
 Goto Exit_Function
End Function  ' GetRows V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
' Return True if object has a valid property called pvProperty (case-insensitive comparison !)

Const cstThisSub = "Recordset.hasProperty"
 Utils._SetCalledSub(cstThisSub)
 If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
 
End Function ' hasProperty

REM -----------------------------------------------------------------------------------------------------------------------
Public Function Move(ByVal Optional pvRelative As Variant, ByVal Optional pvBookmark As variant) As Boolean
' Move record pointer Relative rows vs. bookmark or current record

 If IsMissing(pvRelative) Then Call _TraceArguments()
 If Not Utils._CheckArgument(pvRelative, 1, Utils._AddNumeric()) Then Goto Exit_Function
 
 If IsMissing(pvBookmark) Then Move = _Move(pvRelative) Else Move = _Move(pvRelative, pvBookmark)

Exit_Function:
 Exit Function
End Function  ' Move

REM -----------------------------------------------------------------------------------------------------------------------
Public Function MoveFirst() As Boolean
 MoveFirst = _Move("First")
End Function  ' MoveFirst

REM -----------------------------------------------------------------------------------------------------------------------
Public Function MoveLast() As Boolean
 MoveLast = _Move("Last")
End Function  ' MoveLast

REM -----------------------------------------------------------------------------------------------------------------------
Public Function MoveNext() As Boolean
 MoveNext = _Move("Next")
End Function  ' MoveNext

REM -----------------------------------------------------------------------------------------------------------------------
Public Function MovePrevious() As Boolean
 MovePrevious = _Move("Previous")
End Function  ' MovePrevious

REM -----------------------------------------------------------------------------------------------------------------------
Public Function OpenRecordset(ByVal Optional pvType As Variant _
        , ByVal Optional pvOptions As Variant _
        , ByVal Optional pvLockEdit As Variant _
        , ByVal Optional pbClone As Boolean) As Object
'Return a Recordset object based on current recordset object with filter addition

 If _ErrorHandler() Then On Local Error Goto Error_Function
Dim cstThisSub As String
 cstThisSub = Utils._PCase(_Type) & ".OpenRecordset"
 Utils._SetCalledSub(cstThisSub)
 Set OpenRecordset = Nothing
Const cstNull = -1

Dim oObject As Object
 Set oObject = Nothing
 If IsMissing(pvType) Then
  pvType = cstNull
 Else
  If Not Utils._CheckArgument(pvType, 1, Utils._AddNumeric(), Array(cstNull, dbOpenForwardOnly)) Then Goto Exit_Function
 End If
 If IsMissing(pvOptions) Then
  pvOptions = cstNull
 Else
  If Not Utils._CheckArgument(pvOptions, 2, Utils._AddNumeric(), Array(cstNull, dbSQLPassThrough)) Then Goto Exit_Function
 End If
 If IsMissing(pvLockEdit) Then
  pvLockEdit = cstNull
 Else
  If Not Utils._CheckArgument(pvLockEdit, 3, Utils._AddNumeric(), Array(cstNull, dbReadOnly)) Then Goto Exit_Function
 End If
 If IsMissing(pbClone) Then pbClone = False  ' pbClone is a not published argument

 Set oObject = New Recordset
 With oObject
  ._CommandType = _CommandType
  ._Command = _Command
  ._ParentName = _Name
  ._ParentType = _Type
  Set ._ParentDatabase = _ParentDatabase
  Set ._This = oObject
  ._ForwardOnly = ( pvType = dbOpenForwardOnly )
  ._PassThrough = ( pvOptions = dbSQLPassThrough )
  ._ReadOnly = ( (pvLockEdit = dbReadOnly) Or _ReadOnly )
  Select Case True
   Case pbClone  : Call ._Initialize(, RowSet)
   Case _Filter <> ""  : Call ._Initialize(_Filter)
   Case Else   : Call ._Initialize()
  End Select
 End With
 With _ParentDatabase
  .RecordsetMax = .RecordsetMax + 1
  oObject._Name = Format(.RecordsetMax, "0000000")
  .RecordsetsColl.Add(oObject, UCase(oObject._Name))
 End With
 
 If Not ( oObject._BOF And oObject._EOF ) Then oObject.MoveFirst()  ' Do nothing if resultset empty

Exit_Function:
 Set OpenRecordset = oObject
 Set oObject = Nothing
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
 GoTo Exit_Function
End Function ' OpenRecordset

REM -----------------------------------------------------------------------------------------------------------------------
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
' Return
'  a Collection object if pvIndex absent
'  a Property object otherwise

Const cstThisSub = "Recordset.Properties"
 Utils._SetCalledSub(cstThisSub)
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
 vPropertiesList = _PropertiesList()
 sObject = Utils._PCase(_Type)
 If IsMissing(pvIndex) Then
  vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList)
 Else
  vProperty = PropertiesGet._Properties(sObject, _This, vPropertiesList, pvIndex)
  vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
 End If
 Set vProperty._ParentDatabase = _ParentDatabase
 
Exit_Function:
 Set Properties = vProperty
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
End Function ' Properties

REM -----------------------------------------------------------------------------------------------------------------------
Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
' Return True if property setting OK
Const cstThisSub = "Recordset.setProperty"
 Utils._SetCalledSub(cstThisSub)
 setProperty = _PropertySet(psProperty, pvValue)
 Utils._ResetCalledSub(cstThisSub)
End Function

REM -----------------------------------------------------------------------------------------------------------------------
Public Function Update() As Boolean
' Finalize the updates of the current record

Const cstThisSub = "Recordset.Update"

 If _ErrorHandler() Then On Local Error Goto Error_Function
 Utils._SetCalledSub(cstThisSub)
 Update = False
 
 'Is updating a row allowed ?
 If _ForwardOnly Or _ReadOnly Then Goto Error_NoUpdate
 With RowSet
  If .rowDeleted() Then Goto Error_RowDeleted
  Select Case _EditMode
   Case dbEditNone
    Goto Trace_Error_Update
   Case dbEditAdd
    _AppendChunkClose(False)
    If .IsNew And .IsModified Then .insertRow()
    _BookmarkLastModified = .getBookmark()
    If Not IsNull(_BookmarkBeforeNew) Then
     Select Case _BookmarkBeforeNew
      Case "_BOF_"  :  .beforeFirst()
      Case "_EOF_"  :  .afterLast()
      Case Else   :  .moveToBookmark(_BookmarkBeforeNew)
     End Select
    End If
   Case dbEditInProgress
    _AppendChunkClose(False)
    If .IsModified Then
     .updateRow()
     _BookmarkLastModified = .getBookmark()
    End If
  End Select
 End With
 _EditMode = dbEditNone
 Update = True

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function 
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Function
Error_NoUpdate:
 TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0)
 Goto Exit_Function
Trace_Error_Update:
 TraceError(TRACEFATAL, ERRUPDATESEQUENCE, Utils._CalledSub(), 0, 1)
 Goto Exit_Function
Error_RowDeleted:
 TraceError(TRACEFATAL, ERRROWDELETED, Utils._CalledSub(), 0)
 Goto Exit_Function
End Function  ' Update

REM -----------------------------------------------------------------------------------------------------------------------
REM --- PRIVATE FUNCTIONS                               ---
REM -----------------------------------------------------------------------------------------------------------------------

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _AppendChunk(ByVal psFieldName As String, ByRef pvChunk As Variant, piChunkType) As Boolean
' Write chunk at the end of the file dedicated to the given field

 If _ErrorHandler() Then On Local Error GoTo Error_Function
Dim oFileAccess As Object
Dim i As Integer, oChunk As Object, iChunk As Integer

 ' Do nothing if chunk meaningless
 _AppendChunk = False
 If IsNull(pvChunk) Then GoTo Exit_Function
 If IsArray(pvChunk) Then
  If UBound(pvChunk) < LBound(pvChunk) Then GoTo Exit_Function  ' Empty array
 End If

 ' Find or create relevant chunk entry
 iChunk = -1
 For i = 0 To UBound(_ManageChunks)
  Set oChunk = _ManageChunks(i)
  If oChunk.FieldName = psFieldName Then
   iChunk = i
   Exit For
  End If
 Next i
 If iChunk = -1 Then
  _AppendChunkInit(psFieldName)
  iChunk = UBound(_ManageChunks)
 End If

 Set oChunk = _ManageChunks(iChunk)
 With oChunk
  If Not .ChunksRequested Then  ' First chunk
   .ChunksRequested = True
   .ChunkType = piChunkType
   .FileName = Utils._GetRandomFileName(_Name)
   Set oFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
   .FileHandler = oFileAccess.openFileWrite(.FileName)
  End If
  .FileHandler.writeBytes(pvChunk)
 End With
 _AppendChunk = True

Exit_Function:
 Exit Function
Error_Function:
 TraceError(TRACEABORT, Err, "Recordset._AppendChunk", Erl)
 GoTo Exit_Function
End Function ' AppendChunk V1.5.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _AppendChunkClose(ByVal pbCancel As Boolean) As Boolean
' Stores file content to database field(s)
' Called from Update() [pbCancel = False] or CancelUpdate() [pbCancel = True]

 If _ErrorHandler() Then On Local Error GoTo Error_Function
Dim oFileAccess As Object, oStream As Object, lFileLength As Long, oField As Object
Dim i As Integer, oChunk As Object

 _AppendChunkClose = False
 For i = 0 To UBound(_ManageChunks)
  Set oChunk = _ManageChunks(i)
  With oChunk
   If Not .ChunksRequested Then GoTo Exit_Function
   If IsNull(.FileHandler) Then GoTo Exit_Function
   .Filehandler.closeOutput
   Set oFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
   ' Copy file to field
   If Not pbCancel Then
    Set oStream = oFileAccess.openFileRead(.FileName)
    lFileLength = oStream.getLength()
    If lFileLength > 0 Then
     Set oField = RowSet.getColumns.getByName(.FieldName)
     Select Case .ChunkType
      Case vbByte
       oField.updateBinaryStream(oStream, lFileLength)
'      Case vbString   ' DOES NOT WORK FOR CHARACTER TYPES
'       oField.updateCharacterStream(oStream, lFileLength)
     End Select
    End If
    oStream.closeInput()
   End If
   If oFileAccess.exists(.FileName) Then oFileAccess.kill(.FileName)
  End With
 Next i
 Set _ManageChunks = Array()
 _AppendChunkClose = True

Exit_Function:
 Exit Function 
Error_Function:
 TraceError(TRACEABORT, Err, "Recordset._AppendChunkClose", Erl)
 GoTo Exit_Function
End Function ' AppendChunkClose V1.5.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _AppendChunkInit(psFieldName As String) As Boolean
' Initialize chunks manager

Dim iSize As Integer
 iSize = UBound(_ManageChunks) + 1
 ReDim Preserve _ManageChunks(0 To iSize)
 Set _ManageChunks(iSize) = New ChunkDescriptor
 With _ManageChunks(iSize)
  .ChunksRequested = False
  .FieldName = psFieldName
  .FileName = ""
  Set .FileHandler = Nothing
 End With

End Function ' AppendChunkInit V1.5.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Sub _Initialize(ByVal Optional pvFilter As Variant, Optional poRowSet As Object)
' Initialize new recordset

Dim sFilter As String

 If _Command = "" Then Exit Sub
 
 If _ErrorHandler() Then On Local Error Goto Error_Sub
 If VarType(pvFilter) = vbError Then
  sFilter = ""
 ElseIf IsMissing(pvFilter) Then
  sFilter = ""
 Else
  sFilter = pvFilter
 End If
 If Not IsMissing(poRowSet) Then  ' Clone
  Set RowSet = poRowSet.createResultSet()
  _IsClone = True
  RowSet.last()  ' Solves bookmark desynchro when parent bookmark is used ?!?
 Else
  Set RowSet = CreateUnoService("com.sun.star.sdb.RowSet")
  _IsClone = False
  With RowSet
   If IsNull(.ActiveConnection) Then Set .ActiveConnection = _ParentDatabase.Connection
   .CommandType = _CommandType
   .Command = _Command
   If _ForwardOnly Then .ResultSetType = com.sun.star.sdbc.ResultSetType.FORWARD_ONLY _
       Else .ResultSetType = com.sun.star.sdbc.ResultSetType.SCROLL_SENSITIVE
   If _PassThrough Then .EscapeProcessing = False _
       Else .EscapeProcessing = True
   If _ReadOnly Then
    .ResultSetConcurrency = com.sun.star.sdbc.ResultSetConcurrency.READ_ONLY
    .TransactionIsolation = com.sun.star.sdbc.TransactionIsolation.READ_UNCOMMITTED  ' Dirty read
   Else
    .ResultSetConcurrency = com.sun.star.sdbc.ResultSetConcurrency.UPDATABLE
    .TransactionIsolation = com.sun.star.sdbc.TransactionIsolation.READ_COMMITTED
   End If
  End With

  If sFilter <> "" Then   ' Filter must be set before execute()
   RowSet.Filter = sFilter
   RowSet.ApplyFilter = True
  End If
  On Local Error Goto SQL_Error
  RowSet.execute()
  On Local Error Goto Error_Sub
 End If
 _DataSet = True
'If the Recordset contains no records, the BOF and EOF properties are True, and there is no current record.
 _BOF = ( RowSet.IsRowCountFinal And RowSet.RowCount = 0 )
 _EOF = _BOF

Exit_Sub:
 Exit Sub
SQL_Error:
 TraceError(TRACEFATAL, ERRSQLSTATEMENT, Utils._CalledSub(), 0, , _Command)
 Goto Exit_Sub
Error_Sub:
 TraceError(TRACEABORT, Err, "Recordset._Initialize", Erl)
 GoTo Exit_Sub
End Sub   ' _Initialize

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _Move(pvTarget As Variant, ByVal Optional pvBookmark As Variant, ByVal Optional pbAbsolute As Boolean) As Boolean
'Move to the first, last, next, or previous record in a specified Recordset object and make that record the current record.

Dim cstThisSub As String
 cstThisSub = "Recordset.Move" & Iif(VarType(pvTarget) = vbString, pvTarget, "")
 Utils._SetCalledSub(cstThisSub)
 If _ErrorHandler() Then On Local Error Goto Error_Function

 If IsNull(RowSet) Then Goto Trace_Closed
 If Not _DataSet Then Goto Trace_NoData
 If _BOF And _EOF Then Goto Trace_NoData
 _Move = False
 CancelUpdate()  ' Any Move cancels all updates, even Move(0) !
 
Dim l As Long, lRow As Long
 With RowSet 
  Select Case VarType(pvTarget)
   Case vbString
    Select Case UCase(pvTarget)
     Case "FIRST"
      If _ForwardOnly Then
       If Not ( .isBeforeFirst() Or .isFirst() ) Then
        Goto Trace_Forward
       Else
        .next()
       End If
      Else
       .first()
      End If
     Case "LAST"
      If _ForwardOnly Then
       If .isAfterLast() Then Goto Trace_Forward
       Do While Not ( .isRowCountFinal And .Row = .RowCount ) ' isLast() = True after reading of first records chunk
        .next()
       Loop
      Else
       .last()
      End If
     Case "NEXT"
      If _EOF Then Goto Trace_OutOfRange
      .next()
     Case "PREVIOUS"
      If _ForwardOnly Then Goto Trace_Forward
      If _BOF Then Goto Trace_OutOfRange
      .previous()
    End Select
   Case Else   ' Relative or absolute move
    If IsMissing(pbAbsolute) Then pbAbsolute = False  ' Relative move is default
    If _ForwardOnly And pvTarget < 0 then Goto Trace_Forward
    If IsMissing(pvBookmark) Then
     If pvTarget = 0 Then Goto Exit_Function  ' Do nothing
     If _ForwardOnly Then
      If pbAbsolute Then lRow = .getRow() Else lRow = 0
      For l = 1 To pvTarget - lRow
       If .isAfterLast() Then Exit For
       .next()
      Next l
     Else
      If pbAbsolute Then .absolute(pvTarget) Else .relative(pvTarget)
     End If
    Else  ' Move is always relative when bookmark argument present
     If _ForwardOnly Then Goto Trace_Forward
     If pvTarget = 0 Then
      .moveToBookmark(pvBookmark)
     Else
      .moveRelativeToBookmark(pvBookmark, pvTarget)
     End If
    End If
  End Select

  _BOF = .isBeforeFirst()   ' https://forum.openoffice.org/en/forum/viewtopic.php?f=47&t=76640
  _EOF = .isAfterlast()
  If _BOF Or _EOF Then
   _Move = False
  Else
   If .rowDeleted() Then Goto Error_RowDeleted
   If .rowUpdated() Then .refreshRow()
   _Move = True
  End If
 End With

Exit_Function:
 Utils._ResetCalledSub(cstThisSub)
 Exit Function
Exit_Close:       ' Force close of recordset when error raised
 mClose()
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub, Erl)
 GoTo Exit_Close
Trace_Forward:
 TraceError(TRACEFATAL, ERRRECORDSETFORWARD, Utils._CalledSub(), 0)
 Goto Exit_Close
Trace_NoData:
 TraceError(TRACEFATAL, ERRRECORDSETNODATA, Utils._CalledSub(), 0)
 Goto Exit_Close
Trace_OutOfRange:
 TraceError(TRACEFATAL, ERRRECORDSETRANGE, Utils._CalledSub(), 0)
 Goto Exit_Close
Error_RowDeleted:
 TraceError(TRACEFATAL, ERRROWDELETED, Utils._CalledSub(), 0)
 Goto Exit_Function
Trace_Closed:
 TraceError(TRACEFATAL, ERRRECORDSETCLOSED, Utils._CalledSub(), 0)
 Goto Exit_Close
End Function  ' Move

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertiesList() As Variant

 _PropertiesList = Array("AbsolutePosition", "BOF", "Bookmarkable", "Bookmark", "EditMode" _
   , "EOF", "Filter", "LastModified", "Name", "ObjectType" , "RecordCount" _
   )

End Function ' _PropertiesList

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertyGet(ByVal psProperty As String) As Variant
' Return property value of the psProperty property name

 If _ErrorHandler() Then On Local Error Goto Error_Function
Dim cstThisSub As String
 cstThisSub = "Recordset.get"
 Utils._SetCalledSub(cstThisSub & psProperty)

 _PropertyGet = EMPTY
 
 Select Case UCase(psProperty)
  Case UCase("AbsolutePosition")
   If IsNull(RowSet) Then Goto Trace_Closed
   With RowSet
    Select Case True
     Case _BOF And _EOF      : _PropertyGet = -1
     Case .isBeforeFirst() Or .isAfterLast() : _PropertyGet = -1
     Case Else        : _PropertyGet = .getRow() ' Not getRow() - 1 as MSAccess requires
    End Select
   End With
  Case UCase("BOF")
   If IsNull(RowSet) Then Goto Trace_Closed
   Select Case True
    Case _BOF And _EOF     : _PropertyGet = True
    Case RowSet.isBeforeFirst()   : _PropertyGet = True
    Case Else       : _PropertyGet = False
   End Select
  Case UCase("Bookmarkable")
   If IsNull(RowSet) Then Goto Trace_Closed
   If _ForwardOnly Then _PropertyGet = False Else _PropertyGet = RowSet.IsBookmarkable
  Case UCase("Bookmark")
   If IsNull(RowSet) Then Goto Trace_Closed
   If RowSet.IsBookmarkable And Not _ForwardOnly Then
    If _BOF Or _EOF Then _PropertyGet = Null Else _PropertyGet = RowSet.getBookmark()
   Else
    _PropertyGet = Null
    If _ForwardOnly Then Goto Trace_Forward
   End If
  Case UCase("EditMode")
   If IsNull(RowSet) Then Goto Trace_Closed
   _PropertyGet = _EditMode
  Case UCase("EOF")
   If IsNull(RowSet) Then Goto Trace_Closed
   Select Case True
    Case _BOF And _EOF     : _PropertyGet = True
    Case RowSet.isAfterLast()   : _PropertyGet = True
    Case Else       : _PropertyGet = False
   End Select
  Case UCase("Filter")
   If IsNull(RowSet) Then Goto Trace_Closed
   _PropertyGet = RowSet.Filter
  Case UCase("LastModified")
   If IsNull(RowSet) Then Goto Trace_Closed
   If RowSet.IsBookmarkable And Not _ForwardOnly Then
    _PropertyGet = _BookmarkLastModified
   Else
    _PropertyGet = Null
    If _ForwardOnly Then Goto Trace_Forward
   End If
  Case UCase("Name")
   _PropertyGet = _Name
  Case UCase("ObjectType")
   _PropertyGet = _Type
  Case UCase("RecordCount")
   If IsNull(RowSet) Then Goto Trace_Closed
   _PropertyGet = RowSet.RowCount
  Case Else
   Goto Trace_Error
 End Select
 
Exit_Function:
 Utils._ResetCalledSub(cstThisSub & psProperty)
 Exit Function
Trace_Error:
 TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
 _PropertyGet = EMPTY
 Goto Exit_Function
Trace_Forward:
 TraceError(TRACEFATAL, ERRRECORDSETFORWARD, Utils._CalledSub(), 0)
 Goto Exit_Function
Trace_Closed:
 TraceError(TRACEFATAL, ERRRECORDSETCLOSED, Utils._CalledSub(), 0)
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, cstThisSub & "._PropertyGet", Erl)
 _PropertyGet = EMPTY
 GoTo Exit_Function
End Function  ' _PropertyGet

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean

Dim cstThisSub As String
 cstThisSub = "Recordset.set"
 Utils._SetCalledSub(cstThisSub & psProperty)
 If _ErrorHandler() Then On Local Error Goto Error_Function
 _PropertySet = True

'Execute
Dim iArgNr As Integer
Dim oObject As Object

 If _IsLeft(_A2B_.CalledSub, "Recordset.") Then iArgNr = 1 Else iArgNr = 2
 Select Case UCase(psProperty)
  Case UCase("AbsolutePosition")
   If Not Utils._CheckArgument(pvValue, iArgNr, Utils._AddNumeric(), , False) Then Goto Trace_Error_Value
   If pvValue < 1 Then Goto Trace_Error_Value
   _Move(pvValue, , True)
  Case UCase("Bookmark")
   If IsNull(RowSet) Then Goto Trace_Closed
   _Move(0, pvValue)
  Case UCase("Filter")
   If IsNull(RowSet) Then Goto Trace_Closed
   If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
   _Filter = _ParentDatabase._ReplaceSquareBrackets(pvValue)
  Case Else
   Goto Trace_Error
 End Select

Exit_Function:
 Utils._ResetCalledSub(cstThisSub & psProperty)
 Exit Function
Trace_Error:
 TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, 1, psProperty)
 _PropertySet = False
 Goto Exit_Function
Trace_Error_Value:
 TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
 _PropertySet = False
 Goto Exit_Function
Trace_Closed:
 TraceError(TRACEFATAL, ERRRECORDSETCLOSED, Utils._CalledSub(), 0)
 Goto Exit_Function
Error_Function:
 TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
 _PropertySet = False
 GoTo Exit_Function
End Function  ' _PropertySet

</script:module>