【转载】ASP 函数 随机输出数组中元素 Shuffle()

  1 <%
  2  Sub Shuffle (ByRef arrInput)
  3      ' declare local variables:
  4       Dim arrIndices, iSize, x
  5      Dim arrOriginal
  6 
  7      ' calculate size of given array:
  8      iSize =  UBound(arrInput)+ 1
  9 
 10      ' build array of random indices:
 11      arrIndices = RandomNoDuplicates( 0, iSize- 1, iSize)
 12 
 13      ' copy:
 14      arrOriginal = CopyArray(arrInput)
 15 
 16      ' shuffle:
 17       For x= 0  To  UBound(arrIndices)
 18         arrInput(x) = arrOriginal(arrIndices(x))
 19      Next
 20  End Sub
 21 
 22  Function CopyArray (arr)
 23      Dim result(), x
 24      ReDim result( UBound(arr))
 25      For x= 0  To  UBound(arr)
 26          If  IsObject(arr(x))  Then
 27              Set result(x) = arr(x)
 28          Else
 29             result(x) = arr(x)
 30          End  If
 31      Next
 32     CopyArray = result
 33  End Function
 34 
 35  Function RandomNoDuplicates (iMin, iMax, iElements)
 36      ' this function will return array with "iElements" elements, each of them is random
 37       ' integer in the range "iMin"-"iMax", no duplicates.
 38 
 39      ' make sure we won't have infinite loop:
 40       If (iMax-iMin+ 1)>iElements  Then
 41          Exit  Function
 42      End  If
 43 
 44      ' declare local variables:
 45       Dim RndArr(), x, curRand
 46      Dim iCount, arrValues()
 47 
 48      ' build array of values:
 49       Redim arrValues(iMax-iMin)
 50      For x=iMin  To iMax
 51         arrValues(x-iMin) = x
 52      Next
 53 
 54      ' initialize array to return:
 55       Redim RndArr(iElements- 1)
 56 
 57      ' reset:
 58       For x= 0  To  UBound(RndArr)
 59         RndArr(x) = iMin- 1
 60      Next
 61 
 62      ' initialize random numbers generator engine:
 63       Randomize
 64     iCount= 0
 65 
 66      ' loop until the array is full:
 67       Do Until iCount>=iElements
 68          ' create new random number:
 69          curRand = arrValues( CLng(( Rnd*(iElements- 1))+ 1)- 1)
 70 
 71          ' check if already has duplicate, put it in array if not
 72           If  Not(InArray(RndArr, curRand))  Then
 73             RndArr(iCount)=curRand
 74             iCount=iCount+ 1
 75          End  If
 76 
 77          ' maybe user gave up by now...
 78           If  Not(Response.IsClientConnected)  Then
 79              Exit  Function
 80          End  If
 81      Loop
 82 
 83      ' assign the array as return value of the function:
 84      RandomNoDuplicates = RndArr
 85  End Function
 86 
 87  Function InArray(arr, val)
 88      Dim x
 89     InArray= True
 90      For x= 0  To  UBound(arr)
 91          If arr(x)=val  Then
 92              Exit  Function
 93          End  If
 94      Next
 95     InArray= False
 96  End Function
 97 
 98  ' usage:
 99  Dim arrTest
100 arrTest =  Array( 5,  8,  10,  15,  2,  30)
101  Call Shuffle(arrTest)
102 Response.Write( Join(arrTest,  " <br /> "))
103 %>

转载于:https://www.cnblogs.com/witrays/archive/2012/02/03/2336619.html