Hola a todos, os dejo el siguiente aporte:


Se trata de una función para añadir a cualquier proyecto que requiera generar un ID único. Muy útil si estamos creando un crypter, troyano o cualquier otro malware. A veces necesitamos que el usuario introduzca una llave (key) para generar de forma única una cifrado resistente.

Pues bien, con éste ejemplo podrás incluir una "reja" de pixels, al pasar el mouse por encima se generará un patrón ÚNICO calculado a partir de:

• AppID único definido por el programador
• Longitud de tu HashKey
• Patrón capturado por el ratón/mouse

El source se puede mejorar, así como la función de generación del Hash único, pero bueno, he hecho pruebas y es prácticamente imposible generar 2 HashKey iguales, recomiendo que cada uno utilice una firma propia (cualquier texto es válido), cuanto mayor sea la longitud del Hash generado, más complicado será encontrar una colisión (coincidencia).

https://www.mediafire.com/?fh74usgez3fvf7n

El algoritmo es propio, no es demasiado complejo:

Const Signature As String = "Put_Here_Your_AppID"       'Write here your unique Application ID
Const Lenght As Integer = 20                            'Lenght of your final hash
 
Dim Hash As Long
Dim SignatureHash As String
 
Private Sub Form_Load()
    p(0).BackColor = vbWhite
    x = 100
    Y = 200
    For i = 1 To 300
        Load p(i)
        p(i).Top = Y
        p(i).Left = x
        p(i).Visible = True
        p(i).Tag = 0
        x = x + p(i).Width
        If i Mod 25 = 0 Then
            Y = Y + p(i).Height
            x = 100
        End If
    Next
    For i = 1 To Len(Signature)
        M = M & CStr(Asc(Mid(Signature, i, 1)) Xor i)
    Next
    SignatureHash = M
End Sub
 
Private Sub p_DblClick(Index As Integer)
    For i = 1 To 300
        p(i).Tag = 0
        p(i).BackColor = vbWhite
    Next
    Text1.Text = ""
End Sub
 
Private Sub p_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
    Select Case p(Index).BackColor
        Case vbWhite
            p(Index).BackColor = RGB(25, 25, 25)
            p(Index).Tag = 2
        Case RGB(25, 25, 25)
            p(Index).BackColor = RGB(75, 75, 75)
            p(Index).Tag = 4
        Case RGB(75, 75, 75)
            p(Index).BackColor = RGB(150, 150, 150)
            p(Index).Tag = 8
        Case RGB(150, 150, 150)
            p(Index).BackColor = RGB(210, 210, 210)
            p(Index).Tag = 16
        Case RGB(210, 210, 210)
            p(Index).BackColor = vbWhite
            p(Index).Tag = 32
    End Select
    Hash = 0
    For i = 1 To 300
        Hash = Hash + p(i).Tag * i
    Next
    For i = 1 To Len(SignatureHash)
        If Hash Mod 3 = 0 Then
            M = LCase(M) & Hex(Mid(SignatureHash, i, 1) & Int(Hash / i))
        Else
            M = UCase(M) & Hex(Mid(SignatureHash, i, 1) & Int(Hash / i))
        End If
    Next
    Text1.Text = Left(M, Lenght)
End Sub
 

Editas las constantes, la primera es una string que deberás inventarte, eso te garantiza ID's únicos para tu aplicación. La segunda constante es la longitud del hash generado, por ejemplo 20.

Cada vez que pasamos el mouse por un pixel, cambia su color y asignamos un nuevo valor para su propiedad TAG (2, 4, 8, 16 o 32). Al finalizar, un bucle suma todos los TAG y los multiplica por el contador actual (de 1 hasta 300). Dicho resultado se finaliza con un segundo bucle en primenumber=3 que genera un Hash de tipo hexadecimal utilizando un XOR con la Signature String constante del inicio.

Un saludo