VB6 VBScriptでArraylist

仕事柄未だにVB6を保守することがあるのだが、For eachが使える可変長配列が欲しかったのでVBScript用に作っていたArraylistを移植してみた。「class ArrayList～end class」で囲めばVBScriptでそのまま動く。

ファイル名 Arraylist.cls

Option Explicit
    
    Private m_Item()
    Private m_count

    '末尾にItemを追加
    Public Sub Add(x)
        ReDim Preserve m_Item(m_count)
        If IsObject(x) Then
            Set m_Item(m_count) = x
        Else
            m_Item(m_count) = x
        End If
        m_count = m_count + 1
    End Sub

    'I番目の内容をxで書き換え
    Public Sub Change(I, x)
        If IsObject(x) Then
            Set m_Item(I) = x
        Else
            m_Item(I) = x
        End If
    End Sub

    '総数を返す
    Public Function count()
        count = m_count
    End Function

    '全消去
    Public Function Clear()
        m_count = 0
        Erase m_Item
    End Function

    'For each 用 例 yがArrayListなら For each x in y.item
    Public Function Item()
        Item = m_Item
    End Function

    'n番目のItemを返す
    Public Function Items(n)
        If IsObject(m_Item(n)) Then
            Set Items = m_Item(n)
        Else
            Items = m_Item(n)
        End If
    End Function
    
    'n番目のItemを削除
    Public Sub RemoveAt(n)
        If m_count >= n Then
            Dim I
            For I = n To m_count - 1 - 1
                Call Change(I, Items(I + 1))
            Next I
            m_count = m_count - 1
            ReDim Preserve m_Item(m_count)
        Else
            MsgBox ("引数が範囲外")
        End If
    End Sub

    '引数と同じItemを全て削除
    Public Sub Remove(itm)
        Dim I
        For I = m_count - 1 To 0 Step -1
            If Items(I) = itm Then
                RemoveAt (I)
            End If
        Next I
    End Sub
    
    'ソート
    Public Function Sort()
            
        If m_count = 0 Then
            Exit Function
        End If
            
        Dim I, J, swap
        For I = 0 To m_count - 1
            For J = I To m_count - 1 - 1
                If m_Item(J) > m_Item(J + 1) Then
                    swap = m_Item(J)
                    m_Item(J) = m_Item(J + 1)
                    m_Item(J + 1) = swap
                End If
            Next J
        Next I
    
    End Function

使用例

Private Sub Command1_Click()

    Dim m As New Arraylist

    m.Add (34)
    m.Add (3)
    m.Add (11)
    m.Add (28)
    m.Add (17)
    m.Add (11)
    
    For Each s In m.Item
        Text1.Text = Text1.Text + " " + str$(s)
    Next
    
   m.Remove (11)
   MsgBox (m.count)
   
    For Each s In m.Item
        Text1.Text = Text1.Text + " " + str$(s)
    Next
   
   
   
    For Each s In m.Item
        Text1.Text = Text1.Text + " " + str$(s)
    Next

    m.Sort

    For Each s In m.Item
        Text1.Text = Text1.Text + " " + str$(s)
    Next


End Sub