
25/03/2005, 11:40
|
 | 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 |