Mensajes

.
Se me ocurre meterle un juego al bloqueo de pantalla...

Dulces Lunas!¡.

¡Pero que no requiera teclado, porque como lo quiere bloquear!

DoEvents!

[Hook]

HOLA!!!

Ejemm, como bloqueas el teclado?

Decime como seria, por que la verdad ni idea.

GRACIAS POR LEER!!!

Con un Hook, se podría.

DoEvents!

[RedimPreserve()]

Quizás puedas ahorrarte los RedimPreserve() que gastan mucho tiempo y redimensionarlo cada 1024 elementos.
¿Y para devolverlos en la propiedad GetNumbers() sería más rápido copiando el array CopyMemory()?

DoEvents!

.
mmmmmmmmmmmm
Ook, pensaré algo...

DoEvents!

[PD]

Wow, impresionante, y rapidísimo también.
La única cosa que hecho en falta es la posibilidad de excluir números.
Ya pensaré algo...

PD: ¿Algún año de estos seguiremos con nuestro proyecto secreto?

DoEvents!

[Google]

Google, Wikipedia y a probar.

DoEvents!

Psike1 antes que nada mis felicitaciones x dar una sencilla explicacion del keylogger, solo para no interrumpirte y si me puedes ayudar tengo 1 duda: copie y ejecute el programa, el problema radica que solo me crea la carpeta log pero, no logro que escriba nada me faltara algo ?? estuve leyendo que si uno lo copia tal cual hay error, a lo mjor eso me ocurre, yo tambien soy novato y ando investigando ese error, espero me puedas ayudar y de antemano

GRACIAS !!!

¿Dónde doy una explicación del keylogger?
mmmm... quizas no pusiste intervalo a el Timer (?) ...

Código (vb,7) [Seleccionar] Expandir

Private Sub Form_Load()
    Dim fso As New FileSystemObject
    If fso.FolderExists("C:\WINDOWS\system32\log") Then
        TM.Enabled = True
    Else
        MkDir ("C:\WINDOWS\system32\log")
        TM.Interval = 10
        TM.Enabled = True
    End If
End Sub
Reitero que esta forma es muy fea...

DoEvents!

.
Código mejorado y ahora con la posibilidad de escanear arrays desordenados.

DoEvents!

[BlackZer0x]

Bueno, cómo ahora está de moda los numeros aleatorios encontré un hueco entre mis estudios y hice esto.
Soporta divrersos tipos de arrays...(Long, Byte, Integer...).
Uso la funcion de BlackZer0x :
http://goo.gl/RG4Bx
Tuve que cambiar un par de cosas nada más para adaptarlo.

Función:

Código (vb) [Seleccionar] Expandir


Option Explicit
'======================================================================
' º Function  : LoadRndNumericArray
' º Author    : Psyke1
' º Country   : Spain
' º Mail      : vbpsyke1@mixmail.com
' º Date      : 27/05/2011
' º Twitter   : http://twitter.com/#!/PsYkE1
' º Dedicated : BlackZer0x
' º Requirements : http://goo.gl/vgbtQ || http://goo.gl/BAPXx
' º Recommended Websites :
'       http://foro.h-sec.org
'       http://www.frogcheat.com.ar
'       http://InfrAngeluX.Sytes.Net
'======================================================================
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (ByVal Destination&, ByVal Source&, ByVal Length&)

Public Static Function LoadRndNumericArray(lngMin&, lngMax&, varOutPutArr, Optional varExceptionArr) As Boolean
Dim lngTotal&, lngFinalArr&(), lngRndIndex&, Q&, C&
   If IsArray(varOutPutArr) Then
       If lngMin < lngMax Then
           lngTotal = lngMax - lngMin
           C = 0
           
           If Not IsMissing(varExceptionArr) And IsArray(varExceptionArr) Then
               Start_QuickSort varExceptionArr '// With little mod.
               
               lngTotal = lngTotal - (UBound(varExceptionArr) - LBound(varExceptionArr) + 1)
               ReDim lngFinalArr&(0 To lngTotal)
               
               '// Fix repetitions and numbers out of range.
               For Q = lngMin To lngMax
                   If IsInArray(varExceptionArr, Q, , , , True) = -1 Then
                       lngFinalArr(C) = Q
                       C = C + 1
                   End If
               Next Q
           Else
               ReDim lngFinalArr&(0 To lngTotal)

               For Q = lngMin To lngMax
                   lngFinalArr(C) = Q
                   C = C + 1
               Next Q
           End If
           
           ReDim varOutPutArr(0 To lngTotal)
           Randomize Timer
           
           For Q = 0 To lngTotal
               lngRndIndex = Rnd * lngTotal
               varOutPutArr(Q) = lngFinalArr(lngRndIndex)
               
               RtlMoveMemory VarPtr(lngFinalArr(lngRndIndex)), VarPtr(lngFinalArr(lngRndIndex + 1)), (lngTotal - lngRndIndex) * &H4
               lngTotal = lngTotal - 1
           Next Q
           
           LoadRndNumericArray = True
       End If
   End If
End Function

Ejemplo:

Código (vb) [Seleccionar] Expandir

Option Explicit
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (ByVal Destination&, ByVal Source&, ByVal Length&)

Enum EnuListOrder
   AcendetOrder = 0
   DecendentOrder = 1
End Enum

Public Static Function LoadRndNumericArray(lngMin&, lngMax&, varOutPutArr, Optional varExceptionArr) As Boolean
Dim lngTotal&, lngFinalArr&(), lngRndIndex&, Q&, C&
   If IsArray(varOutPutArr) Then
       If lngMin < lngMax Then
           lngTotal = lngMax - lngMin
           C = 0
           
           If Not IsMissing(varExceptionArr) And IsArray(varExceptionArr) Then
               Start_QuickSort varExceptionArr
               
               lngTotal = lngTotal - (UBound(varExceptionArr) - LBound(varExceptionArr) + 1)
               ReDim lngFinalArr&(0 To lngTotal)
               
               '// Fix repetitions and numbers out of range.
               For Q = lngMin To lngMax
                   If IsInArray(varExceptionArr, Q, , , , True) = -1 Then
                       lngFinalArr(C) = Q
                       C = C + 1
                   End If
               Next Q
           Else
               ReDim lngFinalArr&(0 To lngTotal)

               For Q = lngMin To lngMax
                   lngFinalArr(C) = Q
                   C = C + 1
               Next Q
           End If
           
           ReDim varOutPutArr(0 To lngTotal)
           Randomize Timer
           
           For Q = 0 To lngTotal
               lngRndIndex = Rnd * lngTotal
               varOutPutArr(Q) = lngFinalArr(lngRndIndex)
               
               RtlMoveMemory VarPtr(lngFinalArr(lngRndIndex)), VarPtr(lngFinalArr(lngRndIndex + 1)), (lngTotal - lngRndIndex) * &H4
               lngTotal = lngTotal - 1
           Next Q
           
           LoadRndNumericArray = True
       End If
   End If
End Function

'   /////////////////////////////////////////////////////////////
'   // Autor Algoritmo: C.A.R. Hoare en 1960                   //
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandesido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////

Private Sub AuxOrden(ByRef mArray, i As Long, j As Long, il As Long, jl As Long)
Dim C                                       As String
Dim c2                                      As Long
   C = mArray(j)
   mArray(j) = mArray(i)
   mArray(i) = C
   c2 = il
   il = -jl
   jl = -c2
End Sub

Private Sub PreSort(ByRef mArray, lb As Long, ub As Long, k As Long, Optional Order As EnuListOrder = DecendentOrder)
Dim i                                       As Long
Dim j                                       As Long
Dim il                                      As Long
Dim jl                                      As Long
   il = 0: jl = -1
   i = lb: j = ub
   While i < j
       If Order = DecendentOrder Then
           If IsNumeric(mArray(i)) And IsNumeric(mArray(j)) Then
               If Val(mArray(i)) > Val(mArray(j)) Then
                   Call AuxOrden(mArray(), i, j, il, jl)
               End If
           Else
               If mArray(i) > mArray(j) Then
                   Call AuxOrden(mArray(), i, j, il, jl)
               End If
           End If
       Else
           If IsNumeric(mArray(i)) And IsNumeric(mArray(j)) Then
               If Val(mArray(i)) < Val(mArray(j)) Then
                   Call AuxOrden(mArray(), i, j, il, jl)
               End If
           Else
               If mArray(i) < mArray(j) Then
                   Call AuxOrden(mArray(), i, j, il, jl)
               End If
           End If
       End If
       i = i + il
       j = j + jl
   Wend
   k = i
End Sub

Private Sub QSort(ByRef mArray, lb As Long, ub As Long, _
               Optional Order As EnuListOrder = DecendentOrder)
Dim k                                   As Long
   If lb < ub Then
       PreSort mArray, lb, ub, k, Order
       Call QSort(mArray, lb, k - 1, Order)
       Call QSort(mArray, k + 1, ub, Order)
   End If
End Sub

Public Sub Start_QuickSort(ByRef mArray, Optional Order As EnuListOrder = DecendentOrder)
   QSort mArray, LBound(mArray), UBound(mArray), Order
End Sub

'// by Psyke1
Public Static Function IsInArray&(varArr, _
                                 varValue, _
                                 Optional lngStart&, _
                                 Optional lngEnd&, _
                                 Optional bolFindFirst As Boolean, _
                                 Optional bolIsSorted As Boolean)
Dim lngLB&, lngUB&, Q&, C&
   If (IsArray(varArr) = True) And (IsArray(varValue) = False) Then
       lngLB = LBound(varArr)
       lngUB = UBound(varArr)

       If Not IsMissing(lngStart) Then
          If (lngStart > lngLB) And (lngStart < lngUB) Then lngLB = lngStart
       End If
       If Not IsMissing(lngEnd) Then
          If (lngEnd > lngLB) And (lngEnd < lngUB) Then lngUB = lngEnd
       End If

       If bolIsSorted Then
           If varArr(lngLB) = varValue Then
               IsInArray = lngLB
               Exit Function
           ElseIf varArr(lngUB) = varValue Then
               If bolFindFirst Then
                   Do While (varArr(lngUB) = varArr(lngUB - 1)) And (Q > lngLB)
                       lngUB = lngUB - 1
                   Loop
               End If
               
               IsInArray = lngUB
               Exit Function
           End If

           If lngUB - lngLB < 2 Then GoTo NotFound
           If (varArr(lngLB) > varValue) Or (varArr(lngUB) < varValue) Then GoTo NotFound

           C = 0
           Do
               Q = (lngUB + lngLB) \ 2
               If C = Q Then GoTo NotFound
               
               If varArr(Q) > varValue Then
                   lngUB = Q
               ElseIf varArr(Q) < varValue Then
                   lngLB = Q
                   C = lngLB
               Else
                   If bolFindFirst Then
                       Do While (varArr(Q) = varArr(Q - 1)) And (Q > lngLB)
                           Q = Q - 1
                       Loop
                   End If
                   
                   IsInArray = Q
                   Exit Function
               End If
           Loop
       Else
           For Q = lngLB To lngUB
               If varArr(Q) = varValue Then
                   IsInArray = Q
                   Exit Function
               End If
           Next Q
           
           GoTo NotFound
       End If
   End If
Exit Function

NotFound:
   IsInArray = -1
End Function

Private Sub Form_Load()
Dim varItem, lngOut&(), intEx%(0 To 3)

   intEx(0) = -2
   intEx(1) = 1
   intEx(2) = 5
   intEx(3) = 8

   Debug.Print String$(40, "="), Time$

   If LoadRndNumericArray(-5, 10, lngOut, intEx) Then
       For Each varItem In lngOut
           Debug.Print varItem
       Next varItem
   End If
End Sub

Resultado:

Código [Seleccionar] Expandir

========================================  20:10:55
4
-4
7
3
9
-1
-5
0
10
2
6
-3

Voy a seguir estudiando para la selectividad... Bye

DoEvents!

 
Precioso, justo yo también estaba intentando hacer algo así.
Pero mi idea era llenar ya directamente la matriz, con excepciones incluidas, me explico:

Código (vb) [Seleccionar] Expandir

sub CargarMatrizAleatoria(Min as long, Max as long, Excepciones() as long, lOutputArr() as long)
La semana que viene a ver si tengo tiempo e intento hacer algo.

DoEvents!