Difference between revisions of "VbzCart/archive/code/VBA/clsPackageQueue"
Jump to navigation
Jump to search
(Created page with "<VB> ' CLASS: clsPackageQueue Option Compare Database Option Explicit Private rs As Recordset Private intAccessCount As Long Public Sub Init() intAccessCount = 0 Set...") |
(No difference)
|
Revision as of 00:49, 8 May 2014
<VB> ' 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 </VB>