« 上一篇下一篇 »

Asp数组排序,数组操作类

 

Asp数组冒泡排序函数
Function Sort(ary)
Dim KeepChecking‚I‚FirstValue‚SecondValue
KeepChecking = TRUE
Do Until KeepChecking = FALSE
KeepChecking = FALSE
For I = 0 to UBound(ary)
If I = UBound(ary) Then Exit For
If ary(I) > ary(I+1) Then
FirstValue = ary(I)
SecondValue = ary(I+1)
ary(I) = SecondValue
ary(I+1) = FirstValue
KeepChecking = TRUE
End If
Next
Loop
Sort = ary
End Function

dim ID‚ArrayID‚Myarray‚M
ID="55‚48‚78‚10‚90"
ArrayID=split(ID‚"‚")
Myarray=Sort(ArrayID)
'排序测试
For M=0 To Ubound(Myarray)
htm = htm& Myarray(M) & "<br>" & vbCRLF
Next

 

 

<%

Dim aData
aData = Array(3,2,4,1,6,0)
Call ResponseArray(aData, "原来顺序")
Call ResponseArray(SelectSort(aData), "选择排序")
Call ResponseArray(QuickSort(aData), "快速排序")
Call ResponseArray(InsertSort(aData), "插入排序")
Call ResponseArray(BubbleSort(aData), "冒泡排序")

'选择排序
Function SelectSort(a_Data)
Dim i, j, k
Dim bound, t
bound = UBound(a_Data)

For i = 0 To bound-1
k = i
For j = i+1 To bound
If a_Data(k) > a_Data(j) Then
k = j
End If
Next
t = a_Data(i)
a_Data(i) = a_Data(k)
a_Data(k) = t
Next
此内容来源于
SelectSort = a_Data
End Function


'快速排序
Function QuickSort(a_Data)
Dim i, j
Dim bound, t
bound = UBound(a_Data)

For i = 0 To bound-1
For j = i+1 To bound
If a_Data(i) > a_Data(j) Then
t = a_Data(i)
a_Data(i) = a_Data(j)
a_Data(j) = t
End If
Next
Next

QuickSort = a_Data
End Function


'冒泡排序
Function BubbleSort(a_Data)
Dim bound
bound = UBound(a_Data)
Dim bSorted, i, t
bSorted = False

Do While bound > 0 And bSorted = False

bSorted = True
For i = 0 To bound-1
If a_Data(i) > a_Data(i+1) Then
t = a_Data(i)
a_Data(i) = a_Data(i+1)
a_Data(i+1) = t
bSorted = False
End If
Next
bound = bound - 1
Loop

BubbleSort = a_Data
End Function


'插入排序
Function InsertSort(a_Data)
Dim bound
bound = UBound(a_Data)
Dim i, j, t

For i = 1 To bound
t = a_Data(i)
j = i
Do While t<a_Data(j-1) And j>0
a_Data(j) = a_Data(j-1)
j = j - 1
Loop
a_Data(j) = t
Next

InsertSort = a_Data
End Function

'输出数组
Sub ResponseArray(a_Data, str)
Dim s
s = ""
htm = htm& "<b>" & str & ":</b>"
For i = 0 To UBound(a_Data)
s = s & a_Data(i) & ","
Next
s = Left(s, Len(s)-1)
htm = htm& s
htm = htm& "<hr>"
End Sub

%>

 

asp实现ArrayList(数组操作类)

asp中对数组的操作功能太弱,所以写了一个ArrayList类(参考c#中的ArrayList类),可以满足对数组操作的大部分功能.

对数组操作要注意的一些问题:
1,LBound()和UBound()是取得数组里最小的和最大的索引值,并不是数组的长度,
数组的长度是:UBound()+1
2,有时要动态改变数组大小,所以要先声明一个空的数组:
     Dim arr()
     使用这种方式声明的空数组如果用LBound()和UBound()取值的话会出现错误,但可以使用For Each:
     Dim arr()
     For Each v In arr
         htm = htm& v
     Next
   这样就不会出错了

  另一种声明空数组的方法是:
   Dim arr
   arr=array()
   这样的话使用LBound(arr)和UBound(arr)则分别返回0和-1.

 为了避免发生错误,我推荐使用第二种方法声明空数组的 Asp数组排序,数组操作类

ArrayList类功能描述:
'类名:ArrayList.asp
'名称:数组操作类
'日期:2007-11-6
'作者:西楼冷月
'网址:www.xilou.net | www.chinaCMS.org
'版权:转载请注名出处,作者
修改记录:

'---2007-11-11
'1,对所有的错误提示进行修改,提示更加清晰
'2,Add()方法返回当前添加元素的索引值
'3,增加一个内部方法:isNum()用于判断是否是数字
'4.增加一个可读写的属性:Item,用于简化对ArrayList取值赋值的操作
'5,增加一个内部方法:setValue(),可以根据普通值或对象分别赋值
'6,往ArrayList添加的值可以是一个对象

'
___________________________________________________________________________________

 

<%
        '

Class ArrayList

        Private arrList'//内部数组
Private arrLength'//记录数组的长度

Private Sub Class_Initialize()
     arrList=Array()
     arrLength=0
End Sub

Private Sub Class_Terminate()
     Erase arrList
        End Sub

'//数组长度,只读
Public Property Get Length
     Length=arrLength
End Property

'//获取或设置指定索引处的元素
Public Default Property Get Item(index)
     If Not isNum(index) Then
         showErr "ArrayList.Item(index),非法的参数index":Exit Property
     End If
     If index < 0 or index > arrLength-1 Then
         showErr "ArrayList.Item(index),index下标越界":Exit Property
     End If
     setValue Item,arrList(index)
End Property
Public Property Let Item(index,v)
     If Not isNum(index) Then
         showErr "ArrayList.Item(index,v),非法的参数index":Exit Property
     End If
     If index < 0 or index > arrLength-1 Then
         showErr "ArrayList.Item(index,v),index下标越界":Exit Property
     End If
     setValue arrList(index),v
End Property

'//取得某个索引的值
Public Function GetValue(index)
     If Not isNum(index) Then
         showErr "ArrayList.GetValue(index),非法的参数index":Exit Function
     End If
     On Error Resume Next
     setValue GetValue,arrList(index)
     If Err Then showErr "ArrayList.GetValue(index),index"&Err.Description:Err.Clear:Exit Function
End Function

        '//返回整个Array数组
        Public Function GetArray()
     GetArray=arrList
End Function

'//添加元素,将值添加到ArrayList的结尾处,返回当前元素的索引值
Public Function Add(v)
            ReDim Preserve arrList(arrLength)
     setValue arrList(arrLength),v
     Add=arrLength
     arrLength=arrLength+1
End Function

'//将数组添加到ArrayList的结尾处
Public Sub AddArray(arr)
     If Not IsArray(arr) Then showErr "ArrayList.AddArray(arr),arr参数不是数组:":Exit Sub
     Dim I,L,J
     On Error Resume Next
         If arrLength = 0 Then '//如果ArrayList为空则直接附值
      arrList=arr
      arrLength=arrLength+UBound(arr)+1
   Else
             L=arrLength+UBound(arr)'//新的数组长度
      J=0
             ReDim Preserve arrList(L)
      For I = arrLength To L
    setValue arrList(I),arr(J)
          J=J+1
      Next
      arrLength=arrLength+UBound(arr)+1
   End If
     If Err Then showErr "ArrayList.AddArray(arr)"&Err.Description:Err.Clear:Exit Sub
    
End Sub

'//将元素插入ArrayList的指定index索引处,原有的arrList(index)及后面的元素都往后排
Public Sub Insert(index,v)
     If Not isNum(index) Then
         showErr "ArrayList.Insert(index,v),非法的参数index":Exit Sub
     End If
     Dim I,v2
     If index<arrLength And index>=0 Then
         ReDim Preserve arrList(arrLength)
   arrLength=arrLength+1
   For I = index To arrLength - 1
      setValue v2,arrList(I)'//交换值
      setValue arrList(I),v
      setValue v,v2
   Next
     Else
                showErr "ArrayList.Insert(index,v),index下标越界"
     End If
End Sub

'//将一组数组插入到指定的index处
Public Sub InsertArray(index,arr)
     If Not isNum(index) Then
         showErr "ArrayList.InsertArray(index,arr),非法的参数index":Exit Sub
     End If
     If index < 0 or index > arrLength-1 Then
         showErr "ArrayList.InsertArray(index,arr),index下标越界":Exit Sub
     End If
     If Not IsArray(arr) Then showErr "ArrayList.InsertArray(index,arr),arr参数不是数组":Exit Sub
     Dim I,L1,L2,J:J=0
     On Error Resume Next
     L1=UBound(arr)
     L2=arrLength+L1
     ReDim Preserve arrList(L2)
     For I = arrLength -1 To index Step -1
   setValue arrList(I+L1+1),arrList(I)'//把index之后的值往后移
     Next
     For I = index To index+L1
   setValue arrList(I),arr(J)
   J=J+1
     Next
     If Err Then showErr "ArrayList.InsertArray(index,arr),"&Err.Description:Err.Clear:Exit Sub
     arrLength=arrLength+L1+1'//新的数组长度
End Sub

'//更新数组中索引为index的对应值
'//by xilou 39949376
Public Sub Update(index,v)
     If Not isNum(index) Then
         showErr "ArrayList.Update(index,v),非法的参数index:":Exit Sub
     End If
     If index < 0 or index > arrLength-1 Then
         showErr "ArrayList.Update(index,v),index下标越界":Exit Sub
     End If
     setValue arrList(index),v
End Sub

'//从ArrayList中删除第一个匹配项,注意是第一个,将会得到一新的数组
Public Sub Remove(v)
     Dim I,index
     index = -1 '//第一个匹配的索引
     For I = 0 To arrLength - 1
         If arrList(I)=v Then index = I : Exit For
     Next
     If index <> -1 Then
         For I = index To arrLength - 2
      setValue arrList(I),arrList(I+1)'//值向前填充
   Next
   ReDim Preserve arrList(arrLength-1)'//收缩数组
   arrLength = arrLength - 1
     End If
End Sub

'//移除ArrayList的指定索引处的元素,将会得到一新的数组
Public Sub RemoveAt(index)
     If Not isNum(index) Then
         showErr "ArrayList.RemoveAt(index),非法的参数index":Exit Sub
     End If
     If index < 0 or index > arrLength-1 Then
         showErr "ArrayList.RemoveAt(index,v),index下标越界":Exit Sub
     End If
     If index > 0 Then
         For I = index To arrLength - 2
      setValue arrList(I),arrList(I+1)'//值向前填充
         Next
         ReDim Preserve arrList(arrLength-1)'//收缩数组
         arrLength = arrLength - 1
     End If
End Sub

'//从一个数组中移除从索引m到索引n的一段元素,并返回这段移除的数组
Public Function Splice(m,n)
     If Not isNum(m) Then
         showErr "ArrayList.Splice(m,n),非法的参数m":Exit Function
     End If
     If Not isNum(n) Then
         showErr "ArrayList.Splice(m,n),非法的参数n":Exit Function
     End If
     If m < 0 or m > arrLength - 1 Then
         showErr "ArrayList.Splice(),m下标越界":Exit Function
     End If
     If n < 0 or n > arrLength - 1 Then
         showErr "ArrayList.Splice(),n下标越界":Exit Function
     End If
     Dim newArr,x,L,I,J
     newArr=Array()
     If m > n Then x=m:m=n:n=x '//交换数值
     L=n-m
     ReDim Preserve newArr(L)
     For I = m To n     
   setValue newArr(J),arrList(I)'要移除的元素
   J=J+1
     Next
     '//把n后面的元素的值移前
     For I = (n+1) To arrLength -1
   setValue arrList(I-L-1),arrList(I)
     Next
     arrLength=arrLength-L-1
     ReDim Preserve arrList(arrLength)
     Splice=newArr
End Function

'//清空数组,数组将变为空,长度Length=0
Public Sub Clear()
     Erase arrList
     arrLength=0
End Sub

'//将整个 ArrayList 中元素的顺序反转
Public Sub Reverse()
     Dim L,I,J,v
     J=arrLength-1
            If arrLength > 0 Then
         L=Int(arrLength/2)
   For I = 0 To L-1
      setValue v,arrList(I)
      setValue arrList(I),arrList(J)
      setValue arrList(J),v
      J=J-1
   Next
     End If
End Sub

'//返回字符串值,其中包含了连接到一起的数组的所有元素,元素由指定的分隔符分隔开来
Public Function Implode(separator)
     On Error Resume Next
     Implode=Join(arrList,separator)
     If Err Then showErr "ArrayList.Implode(separator),"&Err.Description:Err.Clear:Exit Function
End Function

'//返回ArrayList从m到n的一段数组
Public Function Slice(m,n)
     If Not isNum(m) Then
         showErr "ArrayList.Slice(m,n),非法的参数m":Exit Function
     End If
     If Not isNum(n) Then
         showErr "ArrayList.Slice(m,n),非法的参数n":Exit Function
     End If
     If m < 0 or m > arrLength-1 Then
         showErr "ArrayList.Slice(m,n),m下标越界":Exit Function
     End If
     If n < 0 or n > arrLength-1 Then
         showErr "ArrayList.Slice(m,n),n下标越界":Exit Function
     End If
     Dim I,J,newArr()
     J=0
     If m<=n Then
         ReDim Preserve newArr(n-m)
   For I = m To n
      setValue newArr(J),arrList(I)
      J=J+1
   Next
     Else
         ReDim Preserve newArr(m-n)
   For I = n To m
      setValue newArr(J),arrList(I)
      J=J+1
   Next
     End If
     Slice=newArr
     Erase newArr
End Function

'//查找,返回ArrayList第一个匹配项的从零开始的索引。没找到返回-1。
'//by xilou 39949376
Public Function IndexOf(v)
     Dim I
     For I = 0 To arrLength - 1
   If arrList(I)=v Then IndexOf=I:Exit Function
     Next
     IndexOf=-1
End Function

'//返回ArrayList的最后一个匹配项的从零开始的索引。没找到返回-1。
Public Function LastIndexOf(v)
     Dim I
     If arrLength=0 Then
         LastIndexOf=-1:Exit Function
     Else
         For I = (arrLength-1) To 0 Step -1
      If arrList(I)=v Then LastIndexOf=I:Exit Function
         Next
     End If
     LastIndexOf=-1
End Function

'//将v2赋值给v1,设置不同的值(对象或普通值)
Private Sub setValue(byref v1,v2)
     If IsObject(v2) Then
         Set v1=v2
     Else
         v1=v2
     End If
End Sub
'//判断是否是数字,返回true or false
Private Function isNum(v)
     If Not IsNumeric(v) or IsEmpty(v) Then
         isNum=False
     Else
         isNum=True
     End If
End Function
'//显示错误
Private Sub showErr(errInfo)
     htm = htm& "<div id=""ERRORINFO"" style=""font-size:12px;color:#990000;font-family:""新宋体"", Arial"">"
     htm = htm& errInfo
     htm = htm& "</div>"
     'Response.End()
End Sub
End Class
%>

Leave a Comment

◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。