Codigo Fuente Del Keygen Para El Crackme1 De Dyablo By Flamer

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



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

2- Luego agregamos 5 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
       Button5 con la propiedad text igual a Parchar Boton

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 1 De Dyablo      By  Flamer "



También se me olvidaba tienen que agregar 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 largo, s1, s2, x 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 - 5) * Rnd() + 5)

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

s1 = ((30 * largo) + 15) * 3
s2 = (125 * largo) + Len(CStr(s1)) + 3
txtnombre.Text = nom
txtserial.Text = CStr(s2) & "-" & CStr(s1) & UCase(Mid(txtnombre.Text, 3, 2))
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 s1, s2, largo As Integer

If op1.Checked Then
If Len(txtnombre.Text) >= 4 Then
largo = Len(txtnombre.Text)
s1 = ((30 * largo) + 15) * 3
s2 = (125 * largo) + Len(CStr(s1)) + 3

txtserial.Text = CStr(s2) & "-" & CStr(s1) & UCase(Mid(txtnombre.Text, 3, 2))
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 Button5_Click(sender As System.Object, e As System.EventArgs) Handles Button5.Click
Dim cd As New OpenFileDialog
Dim file As String = ""
Dim code As String = ""

With cd
.Title = "Selecciona El Crackme De Dyablo"
.Filter = "File Exe|*.exe"
.ShowDialog()
file = .FileName
End With

If file <> "" Then
code = Space(FileLen(file))
FileOpen(1, file, OpenMode.Binary)
FileGet(1, code)
FileClose(1)

If Mid(code, 5265, 13) = "NO REGISTRADO" Then
FileOpen(2, file, OpenMode.Binary)
Seek(2, 11304)
FilePut(2, Chr(1))
FileClose(2)
MsgBox("Boton Del Crackme Habilitado...", , "Parchado")
Else
MsgBox("No Seleccionastes El Crackme De Dyablo", MsgBoxStyle.Critical, "Error")
End If
Else

MsgBox("No Seleccionastes Nada", MsgBoxStyle.Critical, "Error")
End If




End Sub
End Class


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

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


Saludos Flamer y hasta la próxima