Registros aleatorios no repetidos

[mrgubu]

u_goldman, estooooooooo..... no sé como ensamblar lo que teníamos hasta ahora con el código de tu último mensaje. Te prometo que me he tirado dos horas pero no consigo nada.

Veamos, lo que yo he conseguido hacer funcionar es esto:

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 * FROM yacimientos")
if isArray(ds) then
	For i = 0 to 9
		Response.Write(ds(i,0) & " | " & ds(i,1) & "<br>")
	Next
else
	response.Write("no")
end if

	%>

Ejecutando el código me da la pareja de nºs de 4 cifras y de ids aleatorios:

2576 | 41
2698 | 48
3725 | 40
4362 | 36
4956 | 44
5934 | 47
6273 | 45
7469 | 46
8265 | 43
9728 | 42

Supongo que habría que sustituir la función GetRandomRS(qry) por el sub GetRec(intID) que has puesto en el mensaje nuevo, pero no estoy del todo seguro. Lo he probado, pero no llego a ningún lado.

Por cierto, el código que he puesto funciona tanto si el select es "SELECT * FROM yacimientos" como si es "SELECT id FROM yacimientos".