sábado, 11 de agosto de 2018

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




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


Saludos Flamer y hasta la próxima 




viernes, 27 de julio de 2018

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


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


Saludos Flamer y hasta la próxima 



domingo, 22 de julio de 2018

Codigo De El Reto 4 y 5 De JavaScript De La Pagina Rogerfm.net

Hola amigos aquí están los códigos del reto 4 y 5 de javascript de la pagina http://rogerfm.net/ , están en vbscript



CÓDIGO RETO 4


option explicit
randomize
dim res,cont,pass,digi,x,shell

Set shell  = CreateObject("wscript.shell")

cont= 2
while not(res=2936)
   x=cint((3 - 1 + 1)*rnd + 1)
   select case x
      case 1
      digi=cint((90-65+1)*rnd+65)
      case 2
         digi=cint((57-48+1)*rnd+48)
   case 3
        digi=cint((122-97+1)*rnd+97)
   end select
   
   res = res + (digi * cont)
   pass = pass & chr(digi)
   cont=cont + 1 
   if res>2936 then
      res=0
   cont=2
   pass=""
   end if
wend
shell.run "cmd /c echo listo la clave es  =        " & pass & "&echo.&echo.&pause"



CÓDIGO DEL RETO 5


option explicit
dim suma,pass,digi,shell,cadena,x,s

Set shell  = CreateObject("wscript.shell")

cadena = "abcdefghijklmnopqrstuvwxyz"
suma= 6030912063
s=""

while suma > 1
   for x=1 to len(cadena)
      digi=mid(cadena,x,1)
      s=cstr((suma - x) / 26)
  
      if instr(s,".")=0 then
      pass=digi & pass
      suma=(suma - x) / 26
         exit for   
      end if
   next
wend  

shell.run "cmd /c echo listo la clave es  =        " & pass  & "&echo.&echo.&pause"




Saludos Flamer y hasta la proxima


domingo, 15 de julio de 2018

Codigos Enviar Mail Con Powershell y VBScript

Hola amigos soy flamer de nuevo aquí les dejare los códigos para enviar un mail por powershell y el código para adaptarlo a vbscript el cual es el único mio los demás los encontré navegando por Internet y los traigo para compartirlo con ustedes.


CODIGO 1

$From = "TU_CORREO@CORREO.com"

$To = "VICTIMA@CORREO.com"

$Subject = "Esto es una prueba fake mail"

$Body = "mensaje de prueba fake mail"

$SMTPServer = "smtp.live.com"

$SMTPClient = New-Object Net.Mail.SmtpClient($SMTPServer,587)

$SMTPClient.EnableSsl = $true

$SMTPClient.Credentials = New-Object System.Net.NetworkCredential("TU_CORREO@hotmail.com","TU_CONTRASEÑA")

$SMTPClient.Send($From,$To,$Subject,$Body)



CODIGO 2

$From = "TU_CORREO@CORREO.com"

$To = "VICTIMA@CORREO.com"

$Cc = "VICTIMA@CORREO.com"

$Attachment = "C:\archivo.txt"

$Subject = "pruebas mail"

$Body = "esto es una prueba mail fake"

$SMTPServer = "smtp.live.com"

$SMTPPort = "587"

Send-MailMessage -From $From -to $To -Cc $Cc -Subject $Subject -Body $Body -SmtpServer $SMTPServer -port $SMTPPort -UseSsl -Credential (Get-Credential) -Attachments $Attachment –DeliveryNotificationOption OnSuccess



CODIGO 3

$EmailTo = "VICTIMA@CORREO.com"

$EmailFrom = "TU_CORREO@CORREO.com"

$Subject = "Pruebas Mail" 

$Body = "Esto es una prueba send mail con powershell" 

$SMTPServer = "smtp.live.com" 

$filenameAndPath = "C:\archivo.txt"

$SMTPMessage = New-Object System.Net.Mail.MailMessage($EmailFrom,$EmailTo,$Subject,$Body)

$attachment = New-Object System.Net.Mail.Attachment($filenameAndPath)

$SMTPMessage.Attachments.Add($attachment)

$SMTPClient = New-Object Net.Mail.SmtpClient($SmtpServer, 587) 

$SMTPClient.EnableSsl = $true 

$SMTPClient.Credentials = New-Object System.Net.NetworkCredential("TU_CORREO@CORREO.com", "TU_CONTRASEÑA")

$SMTPClient.Send($SMTPMessage)




CODIGO MIO

option explicit
dim shell,cmd

set shell=createobject("wscript.shell")

cmd="C:\Windows\System32\WindowsPowerShell\v1.0\powershell.exe -command "

shell.run cmd & "$EmailTo = 'VICTIMA@CORREO.com';$EmailFrom = 'TU_CORREO@CORREO.com';$Subject = 'Pruebas Mail';$Body = 'Esto es una prueba send mail con powershell';$SMTPServer = 'smtp.live.com';$filenameAndPath = 'C:\archivo.txt';$SMTPMessage = New-Object System.Net.Mail.MailMessage($EmailFrom,$EmailTo,$Subject,$Body);$attachment = New-Object System.Net.Mail.Attachment($filenameAndPath);$SMTPMessage.Attachments.Add($attachment);$SMTPClient = New-Object Net.Mail.SmtpClient($SmtpServer, 587);$SMTPClient.EnableSsl = $true;$SMTPClient.Credentials = New-Object System.Net.NetworkCredential('TU_CORREO@CORREO.com', 'TU_CONTRASEÑA');$SMTPClient.Send($SMTPMessage)",0

msgbox "terminamos"



Nota: recuerden poner su correo en donde dice TU_CORREO@CORREO.com y poner su contraseña donde seles pida o donde dise TU_CONTRASEÑA.

Otra cosa yo les puse como servidor smtp.live.com que es de hotmail si usan gmail tendrán que usar el servidor smtp.gmail.com y habilitar lo para aplicaciones desconocidas en https://myaccount.google.com/lesssecureapps



Bueno creo que eso es todo saludos Flamer y hasta la proxima



domingo, 8 de julio de 2018

Código del Crypter.vbs y del Script de X64DBG Del Vídeo [ ==Decifrar Archivo VBScript Ofuscado Usando X64DBG== ]

Hola amigos aquí les dejo el código del crypter que use en el vídeo Descifrar Archivo VBScript Ofuscado Usando X64DBG espero sea de su agrado, así como el script de x64dbg.

En el vídeo no use breakpoint ni puntos de interrupción para que el script de vbs ofuscado se detuviera en la librería kernelbase.dll, tampoco esta configurado solo tengo las configuraciones por defecto.

otra cosa cuando se detiene en la librería kernelbase.dll el código descifrado se muestra en la dirección EAX+358 en hexadecimal y el peso del archivo esta en la direccion EAX+35C en hexadecimal, por ultimo cuando se detiene en dicha librería los registros  EAX y ESP tienen el mismo valor.



===Codigo Del Crypter.vbs===

option explicit
Randomize
dim op,o,s,oARG,oFSO,File
Set oARG=wscript.Arguments
Set oFSO=createObject("Scripting.FileSystemObject")
If oARG.Count=0 Then WScript.Quit
For Each File In oARG
 Set s=oFSO.OpenTextFile(File,1)
 Set o=oFSO.CreateTextFile("Encrypted___" & File,True)
 op=inputbox("Precione un numero del 1 al 3 para el legir el tipo de cifrado","Tipo de cifrado")
 select case op
    case 1
       o.writeline "Execute(" & read(s.readall,1) & ")"
    case 2
       o.writeline "code=" & chr(34) & read(s.readall,2) & chr(34)
    o.writeline "c=split(code," & chr(34)& "==" & chr(34) & ")"
    o.writeline "for x=0 to ubound(c)"
    o.writeline "   command=command & chr(c(x))"
    o.writeline "next"
    o.writeline "Execute command"
    case 3
       o.writeline "code=" & chr(34) & read(s.readall,3) & chr(34)
    o.writeline "for x=1 to len(code) step 2"
    o.writeline "   command=command & chr(cint(" & chr(34) & chr(38) & chr(72) & chr(34) & " & (mid(code,x,2))))"
    o.writeline "next"
    o.writeline "Execute command"
    case else
       msgbox "Adios"
    wscript.quit
 end select
 msgbox "Archivo  " & File & "  encriptado con exito"
Next

o.close
s.close

Function read(x,y)
dim i,e,d
 for i=1 To Len(x)
    select case y
       case 1
          e=e & "chr("& f(asc(mid(x,i,1)))& ") &"
    case 2
             e=e & asc(mid(x,i,1)) & "=="  
          case 3
      d=hex(asc(mid(x,i,1))) 
      if len(d)=1 then
               e=e & "0" & d
            else 
       e=e & d
            end if   
                 
    end select
  
 next
 if y<>3 then
    read=Left(e,Len(e)-2)
 else
    read=e   
 end if
 
End Function

Function f(n)
dim m,t,u
 m=int(rnd*99)+1
 If n mod m=0 Then
  t=(n/m)& "*"& m
 Else
  u=int(rnd*3)
  If u=0 Then t=(n+m)& "-"& m
  If u=1 Then t=(n-m)& "+"& m
  If u=2 Then t=(n*m)& "/"& m
 End If
 f=t
End Function







===Codigo Del Script De X64dbg===


run      // Este comando ejecuta el programa

mov eax,[esp+358]    // Este toma el valor que se encuentra en la dirección esp+358 y lo pasa a EAX

mov ebx,[esp+35c]   // Este toma el valor que se encuentra en la dirección esp+35C y lo pasa a EBX

savedata C:\Users\Flamer\Desktop\dump_script.txt,eax,ebx  

// toma el valor que se encuentra en la dirección EAX y con el tamaño en bytes que posee EBX y genera un archivo en el escritorio llamado dump_script.txt


msg "el Script a sido extraido con exito, saludos"  // muestra un mensaje

ret  // termina el script






Saludos Flamer y hasta la próxima.....

lunes, 2 de julio de 2018

Codigo Del Crackme 2 De Challenge For Newbies




1- Agregamos 2 TextBox uno llamado txtnombre y el otro txtserial

2- Agregamos 4 Button llamados Button1Button2Button3Button4

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 de descarga del crackme y el keygen: Descargar


Saludos Flamer





martes, 29 de mayo de 2018

Codigo Para Copiar o Capturar Pantalla Con Vbscript

Ahora vengo con algo nuevo algo que creía que no se podía y que mucho creo que pensaban lo mismo, pero de tanto buscar y buscar por fin di con el clavo.

Se trata de copiar o capturar la pantalla de nuestro escritorio utilizando vbscript cosa que creía imposible, para después aguardarla en un archivo de word.

Sin mas que decir les dejare el código y al final el link de mi vídeo donde demuestro el uso de el.


option explicit
dim excel,word,doc   'declaramos las variables

set excel=createobject("excel.application")  ' creamos el objecto excel
set word=createobject("word.application")    'creamos el objecto word

excel.Application.SendKeys ("%{1068}") 'se pulsa la tecla para capturar pantalla y se copea al porta papeles
msgbox "pantalla capturada"  ' mensaje de pantalla capturada

Set doc = word.Documents.Add() ' se crea el documento de word
word.Selection.Paste  ' pega lo que se encuentra en el porta papeles
doc.saveas "C:\Users\Flamer\Desktop\img.doc" ' guarda el documento de word creado
word.quit ' cierra el objecto word

Saludos Flamer y creo que vbscript cada día me sorprende mas