VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsRealmChars"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'-----------------------------------------------------
' MirageBot Chars Class
' Written by Christopher Nevin (lancergli@gmail.com)
'-----------------------------------------------------

Option Explicit

Private Chars() As New objCharacter

Public Function Count() As Integer
    Count = UBound(Chars)
End Function

Public Sub Clear()
    ReDim Chars(0)
End Sub

Public Sub Add(ExpiryDate As Long, Character As String, Statstring As String)
On Error GoTo hErr
    If UBound(Chars) > 0 Or Chars(0).Character = Suffix(Character) Then Remove Character
    Dim U As New objCharacter
    U.ExpiryDate = ExpiryDate
    U.Character = Character
    U.Statstring = Statstring
    
    If (LenB(Chars(0).Character) = 0) Then
        Set Chars(0) = U
    Else
        ReDim Preserve Chars(UBound(Chars) + 1)
        Set Chars(UBound(Chars)) = U
    End If
    Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Chars", "Add"
End Sub

Public Function Match(strMatch As String) As String()
    Dim I As Integer, S() As String, C As Integer
    ReDim S(0)
    C = UBound(Chars)
    For I = 0 To C
        If Matches(Chars(I).Character, strMatch) Then
            If LenB(S(0)) = 0 Then
                S(0) = Chars(I).Character
            Else
                ReDim Preserve S(UBound(S) + 1)
                S(UBound(S)) = Chars(I).Character
            End If
        End If
    Next I
    Match = S
End Function

Public Sub Remove(Character As String)
On Error GoTo hErr
    Dim I As Integer
    I = Find(Character)
    If I > -1 Then
        If I = 0 Then
            Set Chars(0) = New objCharacter
        Else
            Dim R As Integer, C As Integer
            C = UBound(Chars) - 1
            For R = I To C
                Set Chars(R) = Chars(R + 1)
            Next
            ReDim Preserve Chars(C)
        End If
    End If
    Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Chars", "Remove"
End Sub

Public Function Find(ByVal Character As String) As Integer
On Error GoTo hErr
    Dim I As Integer, C As Integer
    Character = LCase$(Suffix(Character))
    C = UBound(Chars)
    For I = 0 To C
        If (Character = LCase$(Chars(I).Character)) Then
            Find = I
            Exit Function
        End If
    Next I
    Find = -1
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Chars", "Find"
End Function

Public Function GetByName(Character As String) As objCharacter
On Error GoTo hErr
    Dim I As Integer
    I = Find(Character)
    If I > -1 Then Set GetByName = Chars(I)
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Chars", "GetByName"
End Function

Public Function GetByIndex(Index As Integer) As objCharacter
On Error GoTo hErr
    If Index < 0 Or Index > UBound(Chars) Then Exit Function
    Set GetByIndex = Chars(Index)
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Chars", "GetByIndex"
End Function

Public Function GetAll(Optional ByRef Success As Boolean) As Object()
    On Error Resume Next
    Dim U() As Object
    ReDim U(0)
    ReDim U(LBound(Chars) To UBound(Chars))
    Dim I As Integer, C1 As Integer, C2 As Integer
    C1 = LBound(Chars): C2 = UBound(Chars)
    For I = C1 To C2
        Set U(I) = Chars(I)
    Next I
    GetAll = U
    If Err.Number = 0 Then Success = True
End Function

Public Sub Class_Initialize()
    ReDim Chars(0) As New objCharacter
End Sub

Public Sub Class_Terminate()
    On Error Resume Next
    ReDim Chars(0)
End Sub

