vbscript VBScript或VBA数组函数

Posted 2021-05-22

Function getUBound(arr)
    getUBound = -1
    On Error Resume Next
    getUBound = UBound(arr)
    On Error GoTo 0
End Function

Function getLength(arr)
    getLength = getUBound(arr) + 1
End Function

Sub push(arr, item)
    Dim newIndex: newIndex = getUBound(arr) + 1
    ReDim Preserve arr(newIndex)
    On Error Resume Next
    arr(newIndex) = item
    On Error GoTo 0
    If Err.Number <> 0 Then Set arr(newIndex) = item
End Sub

Function pop(arr)
    Dim top: top = getUBound(arr)
    If top < 0 Then 'array is empty
        pop = Null
    Else
        On Error Resume Next
        pop = arr(top)
        On Error GoTo 0
        If Err.Number <> 0 Then Set pop = arr(top)
        ReDim Preserve arr(top - 1)
    End If
End Function

Sub unshift(arr, item)
    Dim i, top: top = getUBound(arr)
    ReDim Preserve arr(top + 1)
    For i = top + 1 To 1 Step -1
        On Error Resume Next
        arr(i) = arr(i - 1)
        On Error GoTo 0
        If Err.Number <> 0 Then Set arr(i) = arr(i - 1)
    Next
    On Error Resume Next
    arr(0) = item
    On Error GoTo 0
    If Err.Number <> 0 Then Set arr(0) = item
End Sub

Function shift(arr)
    Dim i, top: top = getUBound(arr)
    If top < 0 Then 'array is empty
        shift = Null
    Else
        On Error Resume Next
        shift = arr(0)
        On Error GoTo 0
        If Err.Number <> 0 Then Set shift = arr(0)
        For i = 1 To top
            On Error Resume Next
            arr(i - 1) = arr(i)
            On Error GoTo 0
            If Err.Number <> 0 Then Set arr(i - 1) = arr(i)
        Next
        ReDim Preserve arr(top - 1)
    End If
End Function