12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274 |
- <?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>
|