Codigo Fuente Del Keygen Del Crackme 3 De Rogerfm.Net By Flamer

Hola amigos aquí les dejo el código fuente del crackme 3 de rogerfm, como siempre esta hecho en vb.net

1- Agregamos 2 TextBox el primero llamado txtnombre y el segundo llamado txtserial

2- Luego agregamos 4 Button llamados

       Button1 con la propiedad text igual a Copiar

       Button2 con la propiedad text igual a Refrech

       Button3 con la propiedad text igual a  Copiar

       Button4 con la propiedad text igual a Generar

3- Después agregamos 2 RadioButton uno llamado op1 y el otro op2

4- Tambien agregamos un Timer llamado timer1

5- Por ultimo agregamos 1 Label llamado msj y con la propiedad text igual a "Keygen Crackme 3 De Challenge For Newbies       By  Flamer  "



Y agregamos un archivo mp3 a los recursos para el sonido del keygen

:::::.....CODIGO.....:::::

Public Class Form1

    Const WM_NCLBUTTONDOWN = &HA1
    Const HTCAPTION = 2
    Private Declare Function ReleaseCapture Lib "user32" () As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As IntPtr, ByVal wParam As IntPtr, lParam As IntPtr) As Long

    Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
    Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Int32, ByVal hwndCallback As Int32) As Long
    Dim tem As String = Environ("temp") & "\musika.mp3"
    Dim tiempo As Integer = 0
    Function cancion(tem)
        Dim mciret As Long

        mciSendString("close all", "", 0, 0)
        mciret = mciSendString("open " & tem & " type MPEGVideo Alias MP3", "", 0, 0)
        mciExecute("Play MP3")
    End Function

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        System.IO.File.WriteAllBytes(tem, My.Resources.Keygen_QuazarFunkyStars)
        cancion(tem)
        Timer1.Start()
        msj.Location = New Point(450, 100)

    End Sub
    Private Sub Form1_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        On Error Resume Next
        mciSendString("close MP3", "", 0, 0)
        Kill(tem)
    End Sub

    Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
        Randomize()
        Dim digi, r, s, suma, largo As Integer
        Dim nom As String = ""

        If tiempo < 3000 Then
            tiempo = tiempo + 1
        Else
            cancion(tem)

            tiempo = 0
        End If


        If op2.Checked Then
            largo = CInt((20 - 4) * Rnd() + 4)

            For x = 1 To largo
                Select Case CInt((2 - 1) * Rnd() + 1)
                    Case 1
                        nom = nom & Chr(CInt((90 - 65) * Rnd() + 65))
                    Case 2
                        nom = nom & Chr(CInt((122 - 97) * Rnd() + 97))
                End Select
            Next

            r = 17

            For x = 1 To Len(nom)
                digi = Asc(Mid(nom, x, 1))
                s = digi + 2159
                suma = suma + (s * r)
                r = r + 1
            Next
            txtnombre.Text = nom
            txtserial.Text = CStr(suma)
            
        End If

        If msj.Location.X > -1000 Then
            msj.Location = New Point(msj.Location.X - 10, 100)
        Else
            msj.Location = New Point(450, 100)
        End If
    End Sub

    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        Clipboard.SetText(txtserial.Text)
        MsgBox("Copiado y Listo Para Pegar", , "Aviso")
    End Sub

    Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
        txtnombre.Text = ""
        txtserial.Text = ""
    End Sub


    Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
        Clipboard.SetText(txtnombre.Text)
        MsgBox("Copiado y Listo Para Pegar", , "Aviso")
    End Sub

    
    Private Sub Form1_MouseDown(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
        Call ReleaseCapture()
        Call SendMessage(Me.Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0)
    End Sub

    Private Sub Button4_Click(sender As System.Object, e As System.EventArgs) Handles Button4.Click
        Dim digi, r, s, suma As Integer

        If op1.Checked Then
            If Len(txtnombre.Text) >= 4 Then
                r = 17
                For x = 1 To Len(txtnombre.Text)
                    digi = Asc(Mid(txtnombre.Text, x, 1))
                    s = digi + 2159
                    suma = suma + (s * r)
                    r = r + 1
                Next
                txtserial.Text = CStr(suma)
            Else
                MsgBox("Error el nombre debe contener mas de 4 digitos", MsgBoxStyle.Information, "Aviso De Error")
            End If
        End If
    End Sub

    Private Sub PictureBox2_Click(sender As System.Object, e As System.EventArgs) Handles PictureBox2.Click
        End
    End Sub

    Private Sub msj_Click(sender As System.Object, e As System.EventArgs) Handles msj.Click

    End Sub
End Class

Link del vídeo donde se resuelve el crackme: https://www.youtube.com/watch?v=D_u0XXn-Uvc

aquí el ejecutable y el crackme por si quieren practicar: Descargar

Saludos Flamer y hasta la próxima