Menú

Mostrar Mensajes

Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.

Mostrar Mensajes Menú

Mensajes - Dessa

#91
Yo olvidé de agregar un If a mi code, luego pruebo como dice  BlackZeroX , por ahora serà así



Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
Private Declare Sub RtlMoveMemory Lib "Kernel32" (ByVal Destination As Any, ByVal Source As Any, ByVal length As Long)
Private Declare Function GetTickCount Lib "Kernel32" () As Long

Private Sub Form_Load()
   Dim x As Long
   Dim s As String
   Dim t1 As Long
   Dim t2 As Long

   If App.LogMode = 0 Then End
   Me.AutoRedraw = True

   'Dessa
   Me.Print "Dessa"
   t1 = GetTickCount
   For x = 5000 To 7000
       If IsLucky(x) Then
           s = s & x & " "
       End If
   Next
   t2 = GetTickCount
   Me.Print t2 - t1 & vbNewLine

   MsgBox s
   s = ""

   '*PsYkE1*
   Me.Print "PsYkE1"
   t1 = GetTickCount
   For x = 5000 To 7000
       If Check_Lucky_Number3(x) Then
           s = s & x & " "
       End If
   Next
   t2 = GetTickCount
   Me.Print t2 - t1 & vbNewLine
   MsgBox s

   'LeandroA
   Me.Print "LeandroA"
   t1 = GetTickCount
   For x = 5000 To 7000
       If IsLuckyNumber(x) Then
           s = s & x & " "
       End If
   Next
   t2 = GetTickCount
   Me.Print t2 - t1
   MsgBox s
End Sub

'Dessa
Function IsLucky(lngNum As Long) As Boolean

Dim x As Long, cont As Long, contStep As Long, Indice As Long, numLuck() As Long

If lngNum < 1 Then Exit Function
If lngNum Mod 2 = 0 Then Exit Function
If lngNum = 1 Or lngNum = 3 Then IsLucky = True: Exit Function
If lngNum = 5 Then Exit Function


For x = 1 To lngNum Step 2
     ReDim Preserve numLuck(contStep)
     numLuck(contStep) = x
     contStep = contStep + 1
Next

contStep = 0: cont = 0: Indice = 1

While numLuck(Indice) <= UBound(numLuck)
     If numLuck(UBound(numLuck)) <> lngNum Then Exit Function
     x = -1
     While x < UBound(numLuck)
         x = x + 1
         If cont = numLuck(Indice) - 1 Then
             cont = 0
         Else
           numLuck(contStep) = numLuck(x)
           cont = cont + 1
           contStep = contStep + 1
         End If
   Wend

   If contStep = numLuck(Indice + 1) Then
       ReDim Preserve numLuck(contStep - 2)
   Else
       ReDim Preserve numLuck(contStep - 1)
   End If
   cont = 0
   contStep = 0
   Indice = Indice + 1
Wend

For x = 0 To UBound(numLuck)
   If numLuck(x) = lngNum Then
     IsLucky = True
     Exit For
   End If
Next

End Function




'-PsYkE1
Public Function Check_Lucky_Number3(ByVal lNumber As Long) As Boolean
   Dim lTempArray()            As Long
   Dim NextElim                As Long
   Dim lArrayUBound            As Long
   Dim m                       As Long
   Dim x                       As Long

   If lNumber = 1 Or lNumber = 3 Then
       GoTo IsLucky
   ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then
       m = 1
       For x = 1 To lNumber Step 2
           ReDim Preserve lTempArray(m)
           lTempArray(m) = x
           m = m + 1
       Next
       NextElim = 3: m = 2
       Do
           x = NextElim
           Do While x <= UBound(lTempArray)
               lArrayUBound = UBound(lTempArray)
               If Not x = lArrayUBound Then
                   RtlMoveMemory VarPtr(lTempArray(x)), VarPtr(lTempArray(x + 1)), (lArrayUBound - x) * 4
                   ReDim Preserve lTempArray(lArrayUBound - 1)
               Else
                   Exit Function
               End If
               x = x + (NextElim - 1)
           Loop
           m = m + 1
           NextElim = lTempArray(m)
       Loop While Not NextElim > lArrayUBound
IsLucky: Check_Lucky_Number3 = True
   End If
End Function

'LeandroA
Private Function IsLuckyNumber(ByVal Num As Long) As Boolean

   Dim lCount As Long, lPos As Long, i As Long
   Dim Arr() As Long

   If Num < 1 Then Exit Function
   If Num Mod 2 = 0 Then Exit Function

   ReDim Preserve Arr(CLng(Num / 2) + (Num Mod 2))

   For lPos = 1 To Num Step 2
        i = i + 1
        Arr(i) = lPos
   Next


   lCount = 1

   Do While UBound(Arr) > lCount

       lCount = lCount + 1
       lPos = Arr(lCount)

       Do
           If lPos > UBound(Arr) Then Exit Do
           If lPos < UBound(Arr) Then CopyMemory Arr(lPos), Arr(lPos + 1), 4 * (UBound(Arr) - lPos)
           ReDim Preserve Arr(UBound(Arr) - 1)
           lPos = lPos + Arr(lCount) - 1
       Loop

       If Arr(UBound(Arr)) <> Num Then Exit Function
   Loop

   IsLuckyNumber = True

End Function





#92
Pude mejorar en parte a mi primera version, bueno, algo es algo...

Tambien me queda pendiente la sugerencia de Psyke.




Option Explicit
Private Declare Function GetTickCount Lib "Kernel32" () As Long

Private Sub Form_Load()
 
 If App.LogMode = 0 Then
   MsgBox "Ejecutar Compilado"
   End ' perdon por el end
 End If
 
   Dim t1 As Long
   Dim t2 As Long
 
   Me.AutoRedraw = True
   
   t1 = GetTickCount
   Me.Print IsLucky(45235) & "  IsLucky"
   t2 = GetTickCount
   Me.Print t2 - t1

End Sub
Function IsLucky(lngNum As Long) As Boolean

Dim x As Long, cont As Long, contStep As Long, Indice As Long, numLuck() As Long

If lngNum < 1 Then Exit Function
If lngNum Mod 2 = 0 Then Exit Function
If lngNum = 1 Or lngNum = 3 Then IsLucky = True: Exit Function
If lngNum = 5 Then Exit Function


For x = 1 To lngNum Step 2
     ReDim Preserve numLuck(contStep)
     numLuck(contStep) = x
     contStep = contStep + 1
Next

contStep = 0: cont = 0: Indice = 1

While numLuck(Indice) <= UBound(numLuck)
     If numLuck(UBound(numLuck)) <> lngNum Then Exit Function
     x = -1
     While x < UBound(numLuck)
         x = x + 1
         If cont = numLuck(Indice) - 1 Then
             cont = 0
         Else
           numLuck(contStep) = numLuck(x)
           cont = cont + 1
           contStep = contStep + 1
         End If
   Wend

   If contStep = numLuck(Indice + 1) Then
       ReDim Preserve numLuck(contStep - 2)
   Else
       ReDim Preserve numLuck(contStep - 1)
   End If
   cont = 0
   contStep = 0
   Indice = Indice + 1
Wend

For x = 0 To UBound(numLuck)
   If numLuck(x) = lngNum Then
     IsLucky = True
     Exit For
   End If
Next

End Function






#93
Si Pyske1   , te entendí pero probé 45235 (compilado), con gettickcount y las dos van parejas... por supuesto que tendría que ser mas rapida con tu sugerencia (sin el último For). intentaré mejorar con RtlMoveMemory  :D



Cita de: Tokes en 13 Agosto 2010, 22:22 PM
En fín, si alguien quiere hacerme el favor de revisarlo  para números arriba del 37 se los agradeceré.

Tokes, el 45 lo da como true y no lo es, tambien entre 1 y 200 hay 8 numeros mas que no son Lucky, saludos







   
#94
Leandro, probando como dice Karcrack (que devuelva un Boolean ingresando un numero Long) es un "Misil", muy buena, no era que las matematicas no eran tu fuerte ?



PsYkE1, si en teoria tenes razon, pero probando no cambia en mucho, después pruebo mejor, me quedó la cabeza "quemada"  :xD








#95
Bueno, como se dijo, no me impota el tiempo, me conformo con que funcione... espero ...porque la verdad es que me costó un huevo (el izquierdo). :xD ,  lo dicho con que funcione está bien para mí.



Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub Form_Load()
 
   
    Dim t1 As Long
    Dim t2 As Long
    t1 = GetTickCount
 
    Me.AutoRedraw = True
   
    Me.Print IsLucky(45235)
   
    t2 = GetTickCount
   
    Me.Print t2 - t1
   
   
   
End Sub

Function IsLucky(lngNum As Long) As Boolean

Dim x As Long, cont As Long, contStep As Long, Indice As Long, numLuck() As String

If lngNum < 1 Then Exit Function
If lngNum Mod 2 = 0 Then Exit Function
If lngNum = 1 Or lngNum = 3 Then IsLucky = True: Exit Function
If lngNum = 5 Then Exit Function


For x = 1 To lngNum Step 2
      ReDim Preserve numLuck(contStep)
      numLuck(contStep) = x
      contStep = contStep + 1
Next

contStep = 0: cont = 0: Indice = 1

While numLuck(Indice) <= UBound(numLuck)
  For x = 0 To UBound(numLuck)
      If cont = numLuck(Indice) - 1 Then
        cont = 0
      Else
        numLuck(contStep) = numLuck(x)
        cont = cont + 1
        contStep = contStep + 1
      End If
  Next
  If contStep = numLuck(Indice + 1) Then
    ReDim Preserve numLuck(contStep - 2)
  Else
    ReDim Preserve numLuck(contStep - 1)
  End If
  cont = 0
  contStep = 0
  Indice = Indice + 1
Wend

For x = 0 To UBound(numLuck)
If numLuck(x) = lngNum Then
   IsLucky = True
   Exit For
End If
Next

End Function





#96
Cita de: Dreamaker en 10 Agosto 2010, 05:29 AM

Bueno paso a aclararle las dudas a los que les interesó, es formar un una contraseña sabiendo que es un número de 4 dígitos formado por las cifras del año 2010 por lo cual queda sobreentendido que como bien dijeron algunos no podrá empezar con "0012" o "0021" o similares sino con "1 o 2" para que tenga 4 dígitos, ya que a "01" se considera su parte entera como "1"


Si, lo aclaró nuevamente, pero para el caso es lo mismo,  un ejercicio para determinar un passwod tendria que tener un resultado solo , no ?

#97
Para mi hay 2 resultados



Private Sub Form_Load()

Dim x As Variant
Dim m As Double
Dim i As Byte
Dim suma As Byte


For x = 1000 To 2000
 If InStr(1, x, "0") > 0 Or InStr(1, x, "1") > 0 Or InStr(1, x, "2") > 0 Then
   m = x Mod 11
   If m = 0 Then
     suma = 0
     For i = 1 To Len(x)
       suma = suma + Mid(x, i, 1)
     Next
     If suma = 2 Then MsgBox x
  End If
 End If
Next

End Sub





#98
Para el caso seria lo mismo, eso elevaria las posibilidades a 4 números (corrijanme si me equivoco), los 4 son divisibles por 11, tambien los 4 numeros son de 4 cifras  y tambien la suma de las cifras de esos 4 números es 2, por lo tanto, Dreamaker, la forma de averiguar el password de ese usuario es el "ophcrack"  :D







#99
No sé, en mi criterio en la pregunta dice un número de 4 cifras, no contariá los ceros por delante, esa es mi duda, sino seria un strng con 4 numeros.

#100
Cita de: rob1104 en  9 Agosto 2010, 20:28 PM
la unica cifra que cumple con esas caracteristicas es 1001

tengo una duda, 1100 no ?