1274 lines
45 KiB
Java
1274 lines
45 KiB
Java
<?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> |