Registros aleatorios no repetidos

[mrgubu]

Hola, lo que tengo hasta ahora es lo siguiente, pero ya digo que creo que habría que optimiar el código para no tener que incluir dentro del último bucle la apertura y el cierre del recordset.

Código:

<!--#include file="conexion.inc" -->

<%

Class RandomRS
	'=================================================    =========
	Private Function RandomPwd ( length, repeat )

	'----------------------------------------------------------
	Dim vPass(), I, J ' our vector plus two counters
	Dim vNumbers()	  ' vector to store
	Dim n, bRep		  
	Dim vChars	  ' vector where possible chars are

	vChars = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "0")

	'Vector's length
	Redim vPass(Length-1)
	'Y del vector auxiliar que guarda los caracteres ya escogidos
	Redim vNumbers(Length-1)
	I = 0
	'Starting random
	Randomize
	'Till if finds all of the chars
	do until I = length
		'Finding a numbre between 0 & the maximum number
		' from the char's vector
		n = int(rnd*Ubound(vChars))
		'If can't repeat...
		if not Repeat then
			bRep = False
			'Looking for the number among the chosen ones
			for J = 0 to UBound(vNumbers)
				if n = vNumbers(J) then
				'If it's there, we point it
					bRep = True
				end if
			next
			'If it was there, we need to repeat it
			
			if bRep then 
				I = I - 1
			else
				vNumbers(I) = n
				vPass(I) = vChars(n)	
			end if
		else
		'I don't care if it's repeated
			vNumbers(I) = n
			vPass(I) = vCaracteres(n)
		end if
	'Next Char!
	I = I + 1
	loop

	'Returning the string. Joining the array's indexes
	'Let's use the second parameter as a separator, nothing in this case -> "".
	RandomPwd = Join(vPass, "")

	End Function 'Random Pwd
	'=================================================    =========



'Funcion para ordenar arreglo, metodo de la burbuja, recibe un arreglo
	Function OrdenaArreglo(arreglo)
		Dim x, y, temp
                'Si es arreglo el valor que recibe la función
		If isArray(arreglo) Then
			'Dim temp
                        'Desde que x vale 0 hasta el máximo índice del arreglo
			For x = 0 to uBound(arreglo)
                                'Desde y = índice del arreglo en x + 1, hasta  el máximo índice del arreglo
				For y = x + 1 to uBound(arreglo)	
                                        'Si matriz en fila de x, columna 0 es mayor que fila de y, columna 0	
					If arreglo(x, 0) > arreglo(y, 0) Then
                                                'Guarda valores temporales
						temp = arreglo(x, 0)
						temp2 = arreglo(x, 1)
                                                'Intercambia los valores, se manejan dos columnas, 0 y 1, ya que estamos trabajando con una matriz
						arreglo(x, 0) = arreglo(y, 0)
						arreglo(x, 1) = arreglo(y, 1)
						arreglo(y, 0) = temp
						arreglo(y, 1) = temp2
					End If
				Next
			Next
                'Si no es arreglo, regresa un nulo
		Else
			OrdenaArreglo = Null
		End If
                'La función regresa a la matriz ordenada, de acuerdo a la columna 0
		OrdenaArreglo = arreglo
	End Function

	'Función que recibe una sentencia SQL, intenta regresar una matriz con la columna 0, un valor aleatorio, columna 1, el índice resultante de un recordset
	Public Function GetRandomRS(qry)
                'Dimensionamos las variables necesarias
		Dim ObjConn
		Dim rs 
		Dim cmd
		Dim arrRandom 
		Dim mtxRandom
		Dim j
		
                'Instanciamos los objetos necesarios, utilizaremos un comando parametrizado para abrir el recordset
		'Set ObjConn = Server.CreateObject("ADODB.Connection")
		Set rs = Server.CreateObject("ADODB.Recordset")
		Set cmd = Server.CreateObject("ADODB.Command")
		'ObjConn.Open strConnect
		cmd.ActiveConnection = Conn
		'cmd.CommandType = adCmdText
		cmd.CommandText = qry
		rs.CursorType = 3
                'Ejecutamos el comando al abrir el recordset
		rs.Open cmd
                'Si se encontraron registros entonces
		if not rs.EOF then
                         'utilizamos el método GetRows del recordset para trabajar con un arreglo
			arrRandom = rs.GetRows()
                        'Redimensionamos un arreglo y lo convertimos en la matriz, con esta matriz trabajaremos durante todo el proceso
			Redim mtxRandom(uBound(arrRandom,2), 1)
                        'Desde j =0 hasta el número de filas de nuestra matriz anterior
			For j = 0 to uBound(arrRandom,2)
                                'Matriz actual(fila de j, columna 0) = número aleatorio regresado de la función RandomPwd
				mtxRandom(j,0) = RandomPwd(4, false)
                                'Matriz actual(fila de j, columna de 1 = getrows en fila de 0, columna de j)
				mtxRandom(j,1) = arrRandom(0,j)
                        'Itera
			Next
                        'Solo por consistencia trasladamos nuestra matriz a arrRandom
			arrRandom = mtxRandom
                         'Borramos la matriz mtxRandom, no la necesitamos mas
			erase mtxRandom
                         'Envíamos la matriz a ordenarse de acuerdo al índice de 0, que es nuestro valor aleatorio
			arrRandom = OrdenaArreglo(arrRandom)
                 'Si no hay registros, regresamos un string vacio, en realidad por consistencia de la aplicación podríamos regresar un nulo
		else
			arrRandom = ""
		end if
                 'Regresamos nuestra matriz ordenada
		GetRandomRS = arrRandom
	End Function

End Class

Set ObjRandom = New RandomRS
ds = ObjRandom.GetRandomRS("SELECT id FROM excavaciones")
dim id(9)
if isArray(ds) then
	For i = 0 to 9
		id(i) = ds(i,1)
	Next
else
	response.Write("no")
end if


'y por fin...
For i = 0 to 9

strSQL = "select * from excavaciones where id = "& id(i) &" "
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open strSQL, conn

Response.write rs("yacimiento") & " | " & rs("ciudad") & " | ,etc"
rs.close
set rs nothing

Next

	%>