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

核心提示：<%Sub Shuffle (ByRef arrInput) 'declare local variables: Dim arrIndices, iSize, x Dim arrOriginal 'calculate size of given array: iSize = UBound

<%
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 />"))
%>