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
(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 02:08, 19 December 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>