Review of my Code

[R.a.B.B.i.T]

Okay, a while back I wrote a class to handle my queues my new bots.  I was wondering if anyone has any ideas on how to make it better than it is.

*Note: I added the headers today, everything else has remained unchanged for ~3 months

Code Select Expand

'---------------------------------------------------------------------------------------
' Module    : clsQueue
' DateTime  : 11/20/2004 14:41
' Author    : R.a.B.B.i.T)DK(
'             www.clandke.net
' Purpose   : Queue handler, very useful :)
' Notes     : All these handy comments, error handlers, and line numbers were
'             made with the help of MZTools (http://www.mztools.com/)
'---------------------------------------------------------------------------------------

Option Explicit
Private QList() As String

'---------------------------------------------------------------------------------------
' Procedure : Clear
' DateTime  : 11/20/2004 14:44
' Author    : R.a.B.B.i.T)DK(
'             www.clandke.net
' Purpose   : Reset the queue manually
'---------------------------------------------------------------------------------------

Public Sub Clear()
On Error GoTo Clear_Error

    ReDim QList(0)

On Error GoTo 0
Exit Sub

Clear_Error:
    Err.Raise Err.Number, Err.Source, Err.Description, _
              Err.HelpFile, Err.HelpContext
End Sub

'---------------------------------------------------------------------------------------
' Procedure : GetDelay
' DateTime  : 11/20/2004 14:44
' Author    : R.a.B.B.i.T)DK(
'             www.clandke.net
' Purpose   : Get the delay which should be used before sending the message
'---------------------------------------------------------------------------------------

Public Function GetDelay() As Long
    Dim buf As Long, buffer$
On Error GoTo GetDelay_Error

    buffer = QList(LBound(QList))
    buf = Len(buffer) * 100

On Error GoTo 0
Exit Function

GetDelay_Error:
    Err.Raise Err.Number, Err.Source, Err.Description, _
              Err.HelpFile, Err.HelpContext
End Function

'---------------------------------------------------------------------------------------
' Procedure : Add
' DateTime  : 11/20/2004 14:44
' Author    : R.a.B.B.i.T)DK(
'             www.clandke.net
' Purpose   : Add a message to the queue, setting Force = True moves everything else
'             up by 1 index and inserts the new message at slot 0
'---------------------------------------------------------------------------------------

Public Sub Add(ByVal Message As String, Optional ByVal Force As Boolean = False)
On Error GoTo Add_Error

    If Force Then
        Shift
        QList(0) = Message
    Else
        If QList(UBound(QList)) <> "" Then
            ReDim Preserve QList(UBound(QList) + 1)
        End If
        QList(UBound(QList)) = Message
    End If

On Error GoTo 0
Exit Sub

Add_Error:
    Err.Raise Err.Number, Err.Source, Err.Description, _
              Err.HelpFile, Err.HelpContext
End Sub

'---------------------------------------------------------------------------------------
' Procedure : Del
' DateTime  : 11/20/2004 14:44
' Author    : R.a.B.B.i.T)DK(
'             www.clandke.net
' Purpose   : Delete a message based on what it is
'---------------------------------------------------------------------------------------

Public Sub Del(ByVal Message As String)
    Dim i&
On Error GoTo Del_Error

    For i = LBound(QList) To UBound(QList)
        DoEvents
        If QList(i) = Message Then
            QList(i) = vbNullString
            GoTo EndSub
        End If
    Next i
    Exit Sub
EndSub:
    ClearNull

On Error GoTo 0
Exit Sub

Del_Error:
    Err.Raise Err.Number, Err.Source, Err.Description, _
              Err.HelpFile, Err.HelpContext
End Sub

'---------------------------------------------------------------------------------------
' Procedure : DelIndex
' DateTime  : 11/20/2004 14:44
' Author    : R.a.B.B.i.T)DK(
'             www.clandke.net
' Purpose   : Delete the message in slot INDEX regardless of the data in that slot
'---------------------------------------------------------------------------------------

Public Sub DelIndex(ByVal Index As Integer)
On Error GoTo DelIndex_Error

    If Index <= UBound(QList) And Index >= LBound(QList) Then
        QList(Index) = vbNullString
        ClearNull
    End If
EndSub:
    ClearNull

On Error GoTo 0
Exit Sub

DelIndex_Error:
    Err.Raise Err.Number, Err.Source, Err.Description, _
              Err.HelpFile, Err.HelpContext
End Sub

'---------------------------------------------------------------------------------------
' Procedure : Shift
' DateTime  : 11/20/2004 14:44
' Author    : R.a.B.B.i.T)DK(
'             www.clandke.net
' Purpose   : Shift the queue X places north.  Useful for forcing multiple messages at
'             one time
'---------------------------------------------------------------------------------------

Public Sub Shift(Optional ByVal Offset As Integer = 1)
    Dim TempQ() As String
    Dim i As Integer
On Error GoTo Shift_Error

    For i = LBound(QList) To UBound(QList)
        DoEvents
        ReDim Preserve TempQ(i + Offset)
        TempQ(i + Offset) = QList(i)
    Next i
    For i = LBound(TempQ) To UBound(TempQ)
        DoEvents
        If i > UBound(QList) Then
            ReDim Preserve QList(i)
        End If
        QList(i) = TempQ(i)
    Next i

On Error GoTo 0
Exit Sub

Shift_Error:
    Err.Raise Err.Number, Err.Source, Err.Description, _
              Err.HelpFile, Err.HelpContext
End Sub

'---------------------------------------------------------------------------------------
' Procedure : ClearNull
' DateTime  : 11/20/2004 14:44
' Author    : R.a.B.B.i.T)DK(
'             www.clandke.net
' Purpose   : Remove all blank entries to help reduce clutter and search time (in larger
'             arrays)
'---------------------------------------------------------------------------------------

Private Sub ClearNull()
    Dim TempQ() As String
On Error GoTo ClearNull_Error

    ReDim TempQ(0)
    Dim i As Long
    For i = LBound(QList) To UBound(QList)
        DoEvents
        If TempQ(UBound(TempQ)) <> vbNullString Then ReDim Preserve TempQ(UBound(TempQ) + 1)
        If QList(i) <> vbNullString Then TempQ(UBound(TempQ)) = QList(i)
    Next i
    ReDim QList(0)
    For i = LBound(TempQ) To UBound(TempQ)
        DoEvents
        If QList(UBound(QList)) <> vbNullString Then ReDim Preserve QList(UBound(QList) + 1)
        If TempQ(i) <> vbNullString Then QList(UBound(QList)) = TempQ(i)
    Next i

On Error GoTo 0
Exit Sub

ClearNull_Error:
    Err.Raise Err.Number, Err.Source, Err.Description, _
              Err.HelpFile, Err.HelpContext
End Sub

'---------------------------------------------------------------------------------------
' Procedure : GetCount
' DateTime  : 11/20/2004 14:44
' Author    : R.a.B.B.i.T)DK(
'             www.clandke.net
' Purpose   : Get the total number of items in the queue
'---------------------------------------------------------------------------------------

Public Function GetCount() As Integer
On Error GoTo GetCount_Error

    GetCount = UBound(QList) + 1

On Error GoTo 0
Exit Function

GetCount_Error:
    Err.Raise Err.Number, Err.Source, Err.Description, _
              Err.HelpFile, Err.HelpContext
End Function

'---------------------------------------------------------------------------------------
' Procedure : GetLBound
' DateTime  : 11/20/2004 14:44
' Author    : R.a.B.B.i.T)DK(
'             www.clandke.net
' Purpose   : Get the LBound of the queue array
'---------------------------------------------------------------------------------------

Public Function GetLBound() As Long
On Error GoTo GetLBound_Error

    GetLBound = LBound(QList)

On Error GoTo 0
Exit Function

GetLBound_Error:
    Err.Raise Err.Number, Err.Source, Err.Description, _
              Err.HelpFile, Err.HelpContext
End Function

'---------------------------------------------------------------------------------------
' Procedure : GetUBound
' DateTime  : 11/20/2004 14:45
' Author    : R.a.B.B.i.T)DK(
'             www.clandke.net
' Purpose   : Get the UBound of the queue array
'---------------------------------------------------------------------------------------

Public Function GetUBound() As Long
On Error GoTo GetUBound_Error

    GetUBound = UBound(QList)

On Error GoTo 0
Exit Function

GetUBound_Error:
    Err.Raise Err.Number, Err.Source, Err.Description, _
              Err.HelpFile, Err.HelpContext
End Function

'---------------------------------------------------------------------------------------
' Procedure : GetItem
' DateTime  : 11/20/2004 14:45
' Author    : R.a.B.B.i.T)DK(
'             www.clandke.net
' Purpose   : Get the data in slot X
'---------------------------------------------------------------------------------------

Public Function GetItem(ByVal Index As Integer) As String
On Error GoTo GetItem_Error

    GetItem = QList(Index)

On Error GoTo 0
Exit Function

GetItem_Error:
    Err.Raise Err.Number, Err.Source, Err.Description, _
              Err.HelpFile, Err.HelpContext
End Function

'---------------------------------------------------------------------------------------
' Procedure : disp
' DateTime  : 11/20/2004 14:45
' Author    : R.a.B.B.i.T)DK(
'             www.clandke.net
' Purpose   : Mainly for debugging; print the entire queue into the Immediate window
'             along with its index value
'---------------------------------------------------------------------------------------

Public Sub disp()
    Dim i As Integer
On Error GoTo disp_Error

    For i = LBound(QList) To UBound(QList)
        DoEvents
        Debug.Print i & " " & QList(i)
    Next i

On Error GoTo 0
Exit Sub

disp_Error:
    Err.Raise Err.Number, Err.Source, Err.Description, _
              Err.HelpFile, Err.HelpContext
End Sub

'---------------------------------------------------------------------------------------
' Procedure : Class_Initialize
' DateTime  : 11/20/2004 14:45
' Author    : R.a.B.B.i.T)DK(
'             www.clandke.net
' Purpose   : Reset the queue array when the class is loaded
'---------------------------------------------------------------------------------------

Private Sub Class_Initialize()
On Error GoTo Class_Initialize_Error

    ReDim QList(0)

On Error GoTo 0
Exit Sub

Class_Initialize_Error:
    Err.Raise Err.Number, Err.Source, Err.Description, _
              Err.HelpFile, Err.HelpContext
End Sub

'---------------------------------------------------------------------------------------
' Procedure : Class_Terminate
' DateTime  : 11/20/2004 14:45
' Author    : R.a.B.B.i.T)DK(
'             www.clandke.net
' Purpose   : Destroy the queue array when it the class is no longer being used
'---------------------------------------------------------------------------------------

Private Sub Class_Terminate()
On Error GoTo Class_Terminate_Error

    Erase QList

On Error GoTo 0
Exit Sub

Class_Terminate_Error:
    Err.Raise Err.Number, Err.Source, Err.Description, _
              Err.HelpFile, Err.HelpContext
End Sub

[K]

Code Select Expand


ReDim Preserve QList(UBound(QList) + 1)


When you need to resize your array, think ahead; don't keep re-allocating (space + 1); allocate more space than you need, usually 2*space.  This way you won't have to be continually re-allocating / copying memory and your class will be more efficient.

[R.a.B.B.i.T]

ClearNull would immediately change that, though, and cut off all empty slots.

[MyndFyre]

Nice code documentation!   +1

[FrOzeN]

lol Newby is alwayed bugged me about using ''" and " " he always says use vbNullString and Space(1) 's instead so thats only thing i can suggest for that.. :p

[Blaze]

Code Select Expand

Public Sub Clear()
On Error GoTo Clear_Error

    ReDim QList(0)

On Error GoTo 0
Exit Sub

Clear_Error:
    Err.Raise Err.Number, Err.Source, Err.Description, _
              Err.HelpFile, Err.HelpContext
End Sub

Wouldn't

Code Select Expand


Erase QList
be a better solution? Whats the difference between them?

[R.a.B.B.i.T]

Erase deletes the index, and I would get an "Index out of bounds" error the next time I tried to manipulate the queue.  ReDim just clears all indicies besides the ones I specify (in this case, only 0), and resets all data in the array to NULLs.