点击这里给我发消息 点击这里给我发消息

ASP函数 随机输出数组中元素Shuffle()

添加时间:2013-12-6
    相关阅读: ASP

<%
Sub Shuffle (ByRef arrInput)
    'declare local variables:
    Dim arrIndices, iSize, x
    Dim arrOriginal

    'calculate size of given array:
    iSize = UBound(arrInput)+1

    'build array of random indices:
    arrIndices = RandomNoDuplicates(0, iSize-1, iSize)

    'copy:
    arrOriginal = CopyArray(arrInput)

    'shuffle:
    For x=0 To UBound(arrIndices)
        arrInput(x) = arrOriginal(arrIndices(x))
    Next
End Sub

Function CopyArray (arr)
    Dim result(), x
    ReDim result(UBound(arr))
    For x=0 To UBound(arr)
        If IsObject(arr(x)) Then
            Set result(x) = arr(x)
        Else
            result(x) = arr(x)
        End If
    Next
    CopyArray = result
End Function

Function RandomNoDuplicates (iMin, iMax, iElements)
    'this function will return array with "iElements" elements, each of them is random
    'integer in the range "iMin"-"iMax", no duplicates.

    'make sure we won't have infinite loop:
    If (iMax-iMin+1)>iElements Then
        Exit Function
    End If

    'declare local variables:
    Dim RndArr(), x, curRand
    Dim iCount, arrValues()

    'build array of values:
    Redim arrValues(iMax-iMin)
    For x=iMin To iMax
        arrValues(x-iMin) = x
    Next

    'initialize array to return:
    Redim RndArr(iElements-1)

    'reset:
    For x=0 To UBound(RndArr)
        RndArr(x) = iMin-1
    Next

    'initialize random numbers generator engine:
    Randomize
    iCount=0

    'loop until the array is full:
    Do Until iCount>=iElements
        'create new random number:
        curRand = arrValues(CLng((Rnd*(iElements-1))+1)-1)

        'check if already has duplicate, put it in array if not
        If Not(InArray(RndArr, curRand)) Then
            RndArr(iCount)=curRand
            iCount=iCount+1
        End If

        'maybe user gave up by now...
        If Not(Response.IsClientConnected) Then
            Exit Function
        End If
    Loop

    'assign the array as return value of the function:
    RandomNoDuplicates = RndArr
End Function

Function InArray(arr, val)
    Dim x
    InArray=True
    For x=0 To UBound(arr)
        If arr(x)=val Then
            Exit Function
        End If
    Next
    InArray=False
End Function

'usage:
Dim arrTest
arrTest = Array(5, 8, 10, 15, 2, 30)
Call Shuffle(arrTest)
Response.Write(Join(arrTest, "<br />"))
%>
 

 

咨询热线:020-85648757 85648755 85648616 0755-27912581 客服:020-85648756 0755-27912581 业务传真:020-32579052
广州市网景网络科技有限公司 Copyright◎2003-2008 Veelink.com. All Rights Reserved.
广州商务地址:广东省广州市黄埔大道中203号(海景园区)海景花园C栋501室
= 深圳商务地址:深圳市宝源路华丰宝源大厦606
研发中心:广东广州市天河软件园海景园区 粤ICP备05103322号 工商注册