VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsPacketMgmt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private PacketPool() As objPacket

Public Function Init()
    ReDim PacketPool(0)
    Set PacketPool(0) = New objPacket
End Function

Public Function GetPool() As Object()
    Dim GP() As Object, I As Integer
    ReDim GP(UBound(PacketPool))
    For I = 0 To UBound(PacketPool)
        Set GP(I) = PacketPool(I)
    Next I
    GetPool = GP
End Function

Public Function CreatePacket(PacketID As Byte, Owner As String, Callback As String, CallbackIndex As Integer, Outbound As Boolean, Override As Boolean, Plugin As Boolean) As Object
On Error GoTo hErr:
1   Dim PP As New objPacket
2   PP.PacketID = PacketID
3   PP.Owner = Owner
4   PP.Callback = Callback
5   PP.CallbackIndex = CallbackIndex
6   PP.Outbound = Outbound
7   PP.Override = Override
8   PP.Plugin = Plugin
9   If LenB(PacketPool(0).Callback) > 0 Then ReDim Preserve PacketPool(UBound(PacketPool) + 1)
10  Set PacketPool(UBound(PacketPool)) = PP
11  Set CreatePacket = PacketPool(UBound(PacketPool))
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "PacketManagement", "CreatePacket"
End Function

Public Function DeletePacket(PacketID As Byte, Optional Owner As String) As Boolean
On Error GoTo hErr
    Dim I As Integer
1   For I = UBound(PacketPool) To 0 Step -1
2       Dim Owned As Boolean
3       Owned = True
4       If Len(Owner) > 0 Then Owned = (LCase(PacketPool(I).Owner) = LCase(Owner))
5       If PacketPool(I).PacketID = PacketID And Owned Then
6           Dim r As Integer
7           For r = I To UBound(PacketPool) - 1
8               PacketPool(r) = PacketPool(r + 1)
9           Next
            If UBound(PacketPool) = 0 Then
                ReDim PacketPool(0)
                Set PacketPool(0) = New objPacket
            Else
10              ReDim Preserve PacketPool(UBound(PacketPool) - 1)
            End If
11          DeletePacket = True
            Exit Function
        End If
    Next
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "PacketManagement", "DeletePacket"
End Function

Public Function OpenPacket(PacketID As Byte, Owner As String) As Object
On Error GoTo hErr:
1   Dim I As Integer
2   For I = 0 To UBound(PacketPool)
3       If PacketPool(I).PacketID = PacketID Or LCase(PacketPool(I).Owner) = LCase$(Owner) Then
4           Set OpenPacket = PacketPool(I): Exit Function
        End If
    Next
hErr:
5   Set OpenPacket = Nothing
End Function

Public Sub DeleteType(Owner As String, Script As Boolean)
    Dim I As Integer
    For I = UBound(PacketPool) To 0 Step -1
        If PacketPool(I).Plugin = Not Script Then
            Dim ID As Byte
            If Len(Owner) > 0 Then
                If LCase$(PacketPool(I).Owner) = LCase$(Owner) Then
                    ID = PacketPool(I).PacketID
                    DeletePacket ID, Owner
                End If
            Else
                ID = PacketPool(I).PacketID
                DeletePacket ID
            End If
        End If
    Next I
End Sub

