VbzCart/archive/code/VBA/clsPackageQueue
Jump to navigation
Jump to search
' CLASS: clsPackageQueue
Option Compare Database
Option Explicit
Private rs As Recordset
Private intAccessCount As Long
Public Sub Init()
intAccessCount = 0
Set rs = Nothing
End Sub
Public Property Get Data() As Recordset
Set Data = rs
End Property
Public Sub DataOpen()
If intAccessCount = 0 Then
Set rs = CurrentDb.OpenRecordset("Select Packages", dbOpenDynaset)
End If
intAccessCount = intAccessCount + 1
End Sub
Public Sub DataShut()
intAccessCount = intAccessCount - 1
If intAccessCount = 0 Then
rs.Close
Set rs = Nothing
End If
End Sub
Public Sub Add(iPackage As Long, iReport As String)
Dim objItem As clsPackageQueueItem
Set objItem = New clsPackageQueueItem
objItem.Create iPackage, iReport
End Sub
Public Property Get Item(iID As Long) As clsPackageQueueItem
Dim objItem As clsPackageQueueItem
Me.DataOpen
With Me.Data
.FindFirst "ID=" & iID
If .NoMatch Then
Set objItem = Nothing
Else
Set objItem = New clsPackageQueueItem
objItem.Init .Fields
End If
End With
Me.DataShut
Set Item = objItem
End Property
Public Property Get ItemFound(iPackage As Long, iReport As String) As clsPackageQueueItem
Dim objItem As clsPackageQueueItem
Me.DataOpen
With Me.Data
.FindFirst "ID_Package=" & iPackage & " AND ReportName=""" & iReport & """"
If .NoMatch Then
Set objItem = Nothing
Else
Set objItem = New clsPackageQueueItem
objItem.Init .Fields
End If
End With
Me.DataShut
Set ItemFound = objItem
End Property
Public Property Get IsEmpty() As Boolean
' ACTION: Returns TRUE iff the queue is empty
Me.DataOpen
With Me.Data
IsEmpty = (.RecordCount = 0)
End With
Me.DataShut
End Property
Public Sub Clear()
Me.DataOpen
With Me.Data
If .RecordCount Then
.MoveLast
Do Until .BOF
.Delete
.MovePrevious
Loop
End If
End With
Me.DataShut
End Sub