Difference between revisions of "VbzCart/archive/code/VBA/clsPackageQueue"

from HTYP, the free directory anyone can edit if they can prove to me that they're not a spambot
< VbzCart‎ | archive‎ | code‎ | VBA
Jump to navigation Jump to search
m
 
Line 1: Line 1:
<VB>
+
<syntaxhighlight lang=VB>
 
' CLASS: clsPackageQueue
 
' CLASS: clsPackageQueue
  
Line 86: Line 86:
 
     Me.DataShut
 
     Me.DataShut
 
End Sub
 
End Sub
</VB>
+
</syntaxhighlight>

Latest revision as of 12:49, 14 October 2022

' 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