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
'---------------------------------------------------------------------------------------
' 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
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.
ClearNull would immediately change that, though, and cut off all empty slots.
Nice code documentation! :) +1
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
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
Erase QList
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.