Ver Mensaje Individual
  #22 (permalink)  
Antiguo 25/03/2005, 11:40
Avatar de u_goldman
u_goldman
Moderador
 
Fecha de Ingreso: enero-2002
Mensajes: 8.031
Antigüedad: 23 años, 3 meses
Puntos: 98
Código:
%>
<!--#include file = "../datastore.asp"-->
<%
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
	Function OrdenaArreglo(arreglo)
		Dim x, y, temp
		If isArray(arreglo) Then
			'Dim temp
			For x = 0 to uBound(arreglo)
				For y = x + 1 to uBound(arreglo)		
					If arreglo(x, 0) > arreglo(y, 0) Then
						temp = arreglo(x, 0)
						temp2 = arreglo(x, 1)
						arreglo(x, 0) = arreglo(y, 0)
						arreglo(x, 1) = arreglo(y, 1)
						arreglo(y, 0) = temp
						arreglo(y, 1) = temp2
					End If
				Next
			Next
		Else
			OrdenaArreglo = Null
		End If
		OrdenaArreglo = arreglo
	End Function

	
	Public Function GetRandomRS(qry)
		Dim ObjConn
		Dim rs 
		Dim cmd
		Dim arrRandom 
		Dim mtxRandom
		Dim j
		
		Set ObjConn = Server.CreateObject("ADODB.Connection")
		Set rs = Server.CreateObject("ADODB.Recordset")
		Set cmd = Server.CreateObject("ADODB.Command")
		ObjConn.Open strConnect
		cmd.ActiveConnection = ObjConn
		cmd.CommandType = adCmdText
		cmd.CommandText = qry
		rs.CursorType = 3
		rs.Open cmd
		if not rs.EOF then
			arrRandom = rs.GetRows()
			Redim mtxRandom(uBound(arrRandom,2), 1)
			For j = 0 to uBound(arrRandom,2)
				mtxRandom(j,0) = RandomPwd(4, false)
				mtxRandom(j,1) = arrRandom(0,j)
			Next
			arrRandom = mtxRandom
			erase mtxRandom
			arrRandom = OrdenaArreglo(arrRandom)
		else
			arrRandom = ""
		end if
		GetRandomRS = arrRandom
	End Function

End Class

Set ObjRandom = New RandomRS
ds = ObjRandom.GetRandomRS("SELECT notice_id FROM tbl_notice WHERE notice_live=1")
if isArray(ds) then
	For i = 0 to uBound(ds)
		Response.Write(ds(i,0) & " | " & ds(i,1) & "<br>")
	Next
else
	response.Write("no")
end if
%>
Solo incorpore una funcion para ordenar el arreglo mediante el metodo de la burbuja aunque tal vez lo quieran hacer por otro metodo mas eficiente, al final, como te dije, solo necesitas los valores en el indice de matriz(x, 1).
No esta super probado, pero ya pos tu depuralo.

Salu2,
__________________
"El hombre que ha empezado a vivir seriamente por dentro, empieza a vivir más sencillamente por fuera."
-- Ernest Hemingway