1- Agregamos 2 TextBox uno llamado txtnombre y el otro txtserial
2- Agregamos 4 Button llamados Button1, Button2, Button3 y Button4
3- Agregamos 2 RadioButton el primero llamado op1 y el segundo op2
4- Agregamos una imagen para cerrar el programa llamada PictureBox2
5- Agreguen un archivo MP3 como recurso
6- Por ultimo agregamos un Timer con la propiedad interval = 100
Código
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.musika)
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 x, d, s, mul, r, rd As Integer
Dim nom As String = ""
If tiempo < 1950 Then
tiempo = tiempo + 1
Else
cancion(tem)
tiempo = 0
End If
If op2.Checked Then
mul = 45
s = 0
r = Int((12 - 4 + 1) * Rnd() + 4)
For x = 1 To r
rd = Int((3 - 1 + 1) * Rnd() + 1)
Select Case rd
Case 1
d = Int((57 - 48 + 1) * Rnd() + 48)
nom = nom & Chr(d)
Case 2
d = Int((90 - 65 + 1) * Rnd() + 65)
nom = nom & Chr(d)
Case 3
d = Int((122 - 97 + 1) * Rnd() + 97)
nom = nom & Chr(d)
End Select
Next
For x = 1 To Len(nom)
d = Asc(Mid(nom, x, 1))
s = s + (d * mul)
mul = mul + 1
Next
txtnombre.Text = nom
txtserial.Text = CStr(s)
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)
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)
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 x, d, s, mul As Integer
If op1.Checked Then
mul = 45
s = 0
If Len(txtnombre.Text) > 3 Then
For x = 1 To Len(txtnombre.Text)
d = Asc(Mid(txtnombre.Text, x, 1))
s = s + (d * mul)
mul = mul + 1
Next
txtserial.Text = CStr(s)
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
End Class
Link del vídeo donde se resuelve el crackme: Ver
Link de descarga del crackme y el keygen: Descargar
Saludos Flamer