Javin007
asked on
How do you "Hold Down" a key using Keybd_Events API, or SendInput API?
The obvious answer here would be simply, "Don't Send a KeyUp event, and the key will be held down." However, that's not what happens.
Using the Keybd_Event and SendInput APIs (they both do the exact same thing) sending a keypress of say, a shift key down, then the "a" key down and up, then the shiftkey up would emulate the pressing of [Shift] + [A] ("A"). That works without a problem.
However, sending the KeyDown event for the "a" key, waiting for three seconds, and then sending the KeyUp event does NOT result in "aaaaaaaaaaaaaaaaaaa..."
I also don't want to set up some kind of timer that just emulates x number of KeyDown/KeyUps for the key pressed.
This is for a macro recording/playback application, specifically for use in getting playbacks of certain things within video games. Thus, if a person presses the left arrow key, they should continue turning left until the key is released. During playback, this doesn't happen. Plus, if I were to emulate "tapping" the arrow key as opposed to holding it down, then we'd not only have to hope that my app "taps" the key faster than the game checks the buffer, but also that I by some miracle "tap" it the precise number of times necessary to emulate the holding down of the key. Which is impossible.
Is there a way within windows to REALLY emulate the "holding down" of a key?
Using the Keybd_Event and SendInput APIs (they both do the exact same thing) sending a keypress of say, a shift key down, then the "a" key down and up, then the shiftkey up would emulate the pressing of [Shift] + [A] ("A"). That works without a problem.
However, sending the KeyDown event for the "a" key, waiting for three seconds, and then sending the KeyUp event does NOT result in "aaaaaaaaaaaaaaaaaaa..."
I also don't want to set up some kind of timer that just emulates x number of KeyDown/KeyUps for the key pressed.
This is for a macro recording/playback application, specifically for use in getting playbacks of certain things within video games. Thus, if a person presses the left arrow key, they should continue turning left until the key is released. During playback, this doesn't happen. Plus, if I were to emulate "tapping" the arrow key as opposed to holding it down, then we'd not only have to hope that my app "taps" the key faster than the game checks the buffer, but also that I by some miracle "tap" it the precise number of times necessary to emulate the holding down of the key. Which is impossible.
Is there a way within windows to REALLY emulate the "holding down" of a key?
ASKER
The keyboard activity is recorded by a tight loop that constantly checks the keyboard state. Any keystate change noted is timestamped (number of milliseconds since record start) and recorded. To be honest, I haven't even tried SetKeyboardState yet, and don't know why it didn't dawn on me to do so. Lemme give that a shot.
-Javin
-Javin
ASKER
Edit: I use GetKeyState, not GetKeyboardState. I'll see if building the keyboard array for SetKeyboardState will give me the results I'm looking for.
-Javin
-Javin
You can also try WH_JOURNALRECORD/WH_JOURNA LPLAYBACK hooks. I used WH_JOURNALRECORD hook in my global keyboard/mouse hook sample ( http://www.freevbcode.com/ShowCode.Asp?ID=1610 ).
ASKER
Yes, but I should've mentioned I'm specifically avoiding keyboard hooks, since some antivirus/protection applications go nuts if they see them. Last thing I need is my macro program flipping people out when their antivirus apps go off.
-Javin
-Javin
ASKER
I tried the following direct from ALLAPI.Net, but absolutely nothing is happening. SetKeyboardState isn't looking like a workable option now.
Const VK_CAPITAL = &H14
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const VK_USED = VK_SCROLL
Private Type KeyboardBytes
kbByte(0 To 255) As Byte
End Type
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long
Private Declare Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
Private Declare Function SetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim kbArray As KeyboardBytes, CapsLock As Boolean, kbOld As KeyboardBytes
Private Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
'Get the current keyboardstate
GetKeyboardState kbOld
'Hide the form
Me.Hide
MsgBox "Keep your eyes on the little num-, shift- and scrolllock lights on the keyboard."
TurnOff VK_CAPITAL
TurnOff VK_NUMLOCK
TurnOff VK_SCROLL
Sleep 1000
TurnOn VK_NUMLOCK
Sleep 100
TurnOn VK_CAPITAL
Sleep 100
TurnOn VK_SCROLL
Sleep 300
TurnOff VK_NUMLOCK
Sleep 100
TurnOff VK_CAPITAL
Sleep 100
TurnOff VK_SCROLL
Sleep 500
TurnOn VK_NUMLOCK
TurnOn VK_SCROLL
Sleep 200
TurnOff VK_NUMLOCK
TurnOff VK_SCROLL
Sleep 200
TurnOn VK_NUMLOCK
TurnOn VK_SCROLL
Sleep 200
TurnOff VK_NUMLOCK
TurnOff VK_SCROLL
Sleep 200
TurnOn VK_CAPITAL
Sleep 200
TurnOff VK_CAPITAL
Sleep 200
TurnOn VK_CAPITAL
Sleep 200
TurnOff VK_CAPITAL
Sleep 200
TurnOn VK_NUMLOCK
TurnOn VK_SCROLL
Sleep 200
TurnOff VK_NUMLOCK
TurnOff VK_SCROLL
Sleep 200
TurnOn VK_NUMLOCK
TurnOn VK_SCROLL
Sleep 200
TurnOff VK_NUMLOCK
TurnOff VK_SCROLL
Sleep 200
TurnOn VK_CAPITAL
Sleep 400
TurnOff VK_CAPITAL
Sleep 200
TurnOn VK_NUMLOCK
Sleep 100
TurnOn VK_CAPITAL
Sleep 100
TurnOn VK_SCROLL
Sleep 300
TurnOff VK_SCROLL
Sleep 100
TurnOff VK_CAPITAL
Sleep 100
TurnOff VK_NUMLOCK
Sleep 1000
Unload Me
End Sub
Private Sub TurnOn(vkKey As Long)
'Get the keyboard state
GetKeyboardState kbArray
'Change a key
kbArray.kbByte(vkKey) = 1
'Set the keyboard state
SetKeyboardState kbArray
End Sub
Private Sub TurnOff(vkKey As Long)
'Get the keyboard state
GetKeyboardState kbArray
'change a key
kbArray.kbByte(vkKey) = 0
'set the keyboard state
SetKeyboardState kbArray
End Sub
Private Sub Form_Unload(Cancel As Integer)
'restore the old keyboard state
SetKeyboardState kbOld
End Sub
Const VK_CAPITAL = &H14
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const VK_USED = VK_SCROLL
Private Type KeyboardBytes
kbByte(0 To 255) As Byte
End Type
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long
Private Declare Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
Private Declare Function SetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim kbArray As KeyboardBytes, CapsLock As Boolean, kbOld As KeyboardBytes
Private Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
'Get the current keyboardstate
GetKeyboardState kbOld
'Hide the form
Me.Hide
MsgBox "Keep your eyes on the little num-, shift- and scrolllock lights on the keyboard."
TurnOff VK_CAPITAL
TurnOff VK_NUMLOCK
TurnOff VK_SCROLL
Sleep 1000
TurnOn VK_NUMLOCK
Sleep 100
TurnOn VK_CAPITAL
Sleep 100
TurnOn VK_SCROLL
Sleep 300
TurnOff VK_NUMLOCK
Sleep 100
TurnOff VK_CAPITAL
Sleep 100
TurnOff VK_SCROLL
Sleep 500
TurnOn VK_NUMLOCK
TurnOn VK_SCROLL
Sleep 200
TurnOff VK_NUMLOCK
TurnOff VK_SCROLL
Sleep 200
TurnOn VK_NUMLOCK
TurnOn VK_SCROLL
Sleep 200
TurnOff VK_NUMLOCK
TurnOff VK_SCROLL
Sleep 200
TurnOn VK_CAPITAL
Sleep 200
TurnOff VK_CAPITAL
Sleep 200
TurnOn VK_CAPITAL
Sleep 200
TurnOff VK_CAPITAL
Sleep 200
TurnOn VK_NUMLOCK
TurnOn VK_SCROLL
Sleep 200
TurnOff VK_NUMLOCK
TurnOff VK_SCROLL
Sleep 200
TurnOn VK_NUMLOCK
TurnOn VK_SCROLL
Sleep 200
TurnOff VK_NUMLOCK
TurnOff VK_SCROLL
Sleep 200
TurnOn VK_CAPITAL
Sleep 400
TurnOff VK_CAPITAL
Sleep 200
TurnOn VK_NUMLOCK
Sleep 100
TurnOn VK_CAPITAL
Sleep 100
TurnOn VK_SCROLL
Sleep 300
TurnOff VK_SCROLL
Sleep 100
TurnOff VK_CAPITAL
Sleep 100
TurnOff VK_NUMLOCK
Sleep 1000
Unload Me
End Sub
Private Sub TurnOn(vkKey As Long)
'Get the keyboard state
GetKeyboardState kbArray
'Change a key
kbArray.kbByte(vkKey) = 1
'Set the keyboard state
SetKeyboardState kbArray
End Sub
Private Sub TurnOff(vkKey As Long)
'Get the keyboard state
GetKeyboardState kbArray
'change a key
kbArray.kbByte(vkKey) = 0
'set the keyboard state
SetKeyboardState kbArray
End Sub
Private Sub Form_Unload(Cancel As Integer)
'restore the old keyboard state
SetKeyboardState kbOld
End Sub
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Oops, missing your posts while wrote mine :). Just a brief replay antiviruses..
WH_JOURNALXXXXX hooks are thread-specific hooks, not system wide, though they can record/playback ALL windows events over system. This means they are "safety" hooks and I think antivirus programs won't react on theese hooks.
WH_JOURNALXXXXX hooks are thread-specific hooks, not system wide, though they can record/playback ALL windows events over system. This means they are "safety" hooks and I think antivirus programs won't react on theese hooks.
ASKER
Right, but by being thread specific hooks, then if the person starts the macro recorder, then goes into his video game (a different thread) and plays for a bit, then comes back out, the recording would have nothing in it, correct?
-Javin
-Javin
Now I know that you're under NT OS :)
MSDN says :"Because the SetKeyboardState function alters the input state of the calling thread and not the global input state of the system, an application cannot use SetKeyboardState to set the NUM LOCK, CAPS LOCK, or SCROLL LOCK indicator lights on the keyboard. " But they lie as usually :) w9x system DOES react on these indicators.
NT is a different beast entirely and is not affected. SetKeyboardState works as documented (doesn't affect status indicators).
MSDN says :"Because the SetKeyboardState function alters the input state of the calling thread and not the global input state of the system, an application cannot use SetKeyboardState to set the NUM LOCK, CAPS LOCK, or SCROLL LOCK indicator lights on the keyboard. " But they lie as usually :) w9x system DOES react on these indicators.
NT is a different beast entirely and is not affected. SetKeyboardState works as documented (doesn't affect status indicators).
No, as I stated before, these hooks record ALL windows events irrespectivly which tread is active (this is why I used them in my Global Keyboard Hook sample - you can try sample from freevbcode and see it records all keyboard/mouse events). These hooks are different than other hooks - they aren't REAL hooks. All other hooks INTERCEPT windows messages BEFORE they achive system and can affect all system work. This is why all other hooks should live in dll, while these two hooks just recorded messages ALREADY PROCESSED by system and remowed from system queue, so they can live in application (hence can be using from VB).
ASKER
Hrm. I'm checking out the PDF at the moment, but thus far, nothing I've tried has worked. Tried changing to the SetKeyboardState API, but that has absolutely NO effect, and no keypresses trigger at all there.
As for the hooks, this would require a complete rewrite of my system, so I'm not sure that I'm ready to jump into that when everything else I've tried has the same effect (presses the button but doesn't emulate a key being held down.)
Do you have any snippets that SHOW a key-hold working in VB 6?
-Javin
As for the hooks, this would require a complete rewrite of my system, so I'm not sure that I'm ready to jump into that when everything else I've tried has the same effect (presses the button but doesn't emulate a key being held down.)
Do you have any snippets that SHOW a key-hold working in VB 6?
-Javin
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
>> so it's likely playbacks won't work as well if you transport them to a different system.
Given a quick thought, you could include the repeat speeds in your saved playback file (if any?) so it'll be the same as it was for you. If you try the demo, you'll notice is almost exactly the same as if you were to hold it down. I quickly came up with it so you'll need to implement better methods (registry functions, loop/api timers, keyboard/sendmessage api).
Given a quick thought, you could include the repeat speeds in your saved playback file (if any?) so it'll be the same as it was for you. If you try the demo, you'll notice is almost exactly the same as if you were to hold it down. I quickly came up with it so you'll need to implement better methods (registry functions, loop/api timers, keyboard/sendmessage api).
you could subclass the game window and store the key presses that are received by that. with this you know exactly how many key down / key up events where sent to the game while the key was pressed. then if you send the same number of key down / up events back to it you should get the same effect. (unless the game doesn't operate on a per key press basis, if so then you will need to remember the interval between each and play it back at the same speed).
Hi
I've made a sample app, but it's still buggy/not error proff, so I didn't post it to FreeVBCode (My favorite site). Here is code:
'===============mHook.bas= ========== =====
Public Enum JOURNAL_CODES
HC_ACTION = 0
HC_GETNEXT = 1
HC_SKIP = 2
HC_NOREMOVE = 3
HC_SYSMODALON = 4
HC_SYSMODALOFF = 5
End Enum
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type EVENTMSG
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Public hJournalRec As Long
Public hJournalPlay As Long
Private Recorder As cRecords
Public StartTime As Long
Private Const WH_JOURNALRECORD = 0
Private Const WH_JOURNALPLAYBACK = 1
Public Function JournalRecordProc(ByVal nCode As JOURNAL_CODES, ByVal wParam As Long, lParam As EVENTMSG) As Long
Static bModallOn As Boolean
If nCode = HC_SYSMODALON Then bModallOn = True
If nCode = HC_SYSMODALOFF Then bModallOn = False
If (nCode < 0) Or bModallOn Then GoTo ProcessMessage
If nCode = HC_ACTION Then
Recorder.Add lParam.pt.x, lParam.pt.y, lParam.time - StartTime, lParam.lParam, lParam.wParam, lParam.message, lParam.hwnd
End If
ProcessMessage:
JournalRecordProc = CallNextHookEx(hJournalRec , nCode, wParam, ByVal VarPtr(lParam))
End Function
Public Function JournalPlayBackProc(ByVal nCode As JOURNAL_CODES, ByVal wParam As Long, lParam As EVENTMSG) As Long
Static bModallOn As Boolean
Dim delta As Long
If nCode = HC_SYSMODALON Then bModallOn = True
If nCode = HC_SYSMODALOFF Then bModallOn = False
If (nCode < 0) Or bModallOn Then Exit Function 'GoTo ProcessMessage
Form1.Caption = Recorder.Count
If nCode = HC_SKIP Then
Recorder.Remove 1
If Recorder.Count = 1 Then StopPlayBack
Exit Function
ElseIf nCode = HC_GETNEXT Then
lParam.hwnd = Recorder.Item(1).hwnd
lParam.lParam = Recorder.Item(1).lParam
lParam.message = Recorder.Item(1).message
lParam.pt.x = Recorder.Item(1).ptX
lParam.pt.y = Recorder.Item(1).ptY
lParam.time = StartTime + Recorder.Item(1).time
lParam.wParam = Recorder.Item(1).wParam
delta = lParam.time - GetTickCount
If delta > 0 Then
JournalPlayBackProc = delta
Else
JournalPlayBackProc = 0
End If
Exit Function
End If
ProcessMessage:
JournalPlayBackProc = CallNextHookEx(hJournalPla y, nCode, wParam, ByVal VarPtr(lParam))
End Function
Public Sub StartRecording()
StopPlayBack
Set Recorder = New cRecords
StartTime = GetTickCount
hJournalRec = SetWindowsHookEx(WH_JOURNA LRECORD, AddressOf JournalRecordProc, App.hInstance, 0)
End Sub
Public Sub PauseRecording()
If hJournalRec Then UnhookWindowsHookEx hJournalRec
End Sub
Public Sub ResumeRecording()
StartTime = GetTickCount
hJournalRec = SetWindowsHookEx(WH_JOURNA LRECORD, AddressOf JournalRecordProc, App.hInstance, 0)
End Sub
Public Sub StopRecording()
If hJournalRec Then
UnhookWindowsHookEx hJournalRec
hJournalRec = 0
End If
End Sub
Public Sub StartPlayBack()
StopRecording
StartTime = GetTickCount
hJournalPlay = SetWindowsHookEx(WH_JOURNA LPLAYBACK, AddressOf JournalPlayBackProc, App.hInstance, 0)
End Sub
Public Sub PausePlayBack()
If hJournalPlay Then UnhookWindowsHookEx hJournalPlay
End Sub
Public Sub ResumePlayBack()
StartTime = GetTickCount
hJournalPlay = SetWindowsHookEx(WH_JOURNA LPLAYBACK, AddressOf JournalPlayBackProc, App.hInstance, 0)
End Sub
Public Sub StopPlayBack()
If hJournalPlay Then UnhookWindowsHookEx hJournalPlay
hJournalPlay = 0
End Sub
Public Sub StopAll()
StopRecording
StopPlayBack
Set Recorder = Nothing
End Sub
'=====================cEve nt.cls==== =========
Public hwnd As Long
Public message As Long
Public wParam As Long
Public lParam As Long
Public time As Long
Public ptX As Long
Public ptY As Long
'==============cRecords.cl s========= ========== ===
'simple collection class builded with class builder based on cEvents.cls
'vb classes don't allow passing UDT, so pt.Y and pt.Y transformed to ptX and ptY
Private mCol As Collection
Public Function Add(ptX As Long, ptY As Long, time As Long, lParam As Long, wParam As Long, message As Long, hwnd As Long, Optional sKey As String) As cEvent
'create a new object
Dim objNewMember As cEvent
Set objNewMember = New cEvent
objNewMember.ptX = ptX
objNewMember.ptY = ptY
objNewMember.time = time
objNewMember.lParam = lParam
objNewMember.wParam = wParam
objNewMember.message = message
objNewMember.hwnd = hwnd
If Len(sKey) = 0 Then
mCol.Add objNewMember
Else
mCol.Add objNewMember, sKey
End If
Set Add = objNewMember
Set objNewMember = Nothing
End Function
Public Property Get Item(vntIndexKey As Variant) As cEvent
Set Item = mCol(vntIndexKey)
End Property
Public Property Get Count() As Long
Count = mCol.Count
End Property
Public Sub Remove(vntIndexKey As Variant)
mCol.Remove vntIndexKey
End Sub
Public Property Get NewEnum() As IUnknown
Set NewEnum = mCol.[_NewEnum]
End Property
Private Sub Class_Initialize()
Set mCol = New Collection
End Sub
Private Sub Class_Terminate()
Set mCol = Nothing
End Sub
'=========Form1.frm======= ========== ===
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Form1"
ClientHeight = 3360
ClientLeft = 45
ClientTop = 435
ClientWidth = 7380
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3360
ScaleWidth = 7380
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdStop
Caption = "<"
BeginProperty Font
Name = "Webdings"
Size = 15.75
Charset = 2
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6720
TabIndex = 4
Top = 2880
Width = 495
End
Begin VB.CommandButton cmdPause
Caption = ";"
BeginProperty Font
Name = "Webdings"
Size = 15.75
Charset = 2
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6240
TabIndex = 3
Top = 2880
Width = 495
End
Begin VB.CommandButton cmdRecord
Caption = "n"
BeginProperty Font
Name = "Webdings"
Size = 8.25
Charset = 2
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5760
TabIndex = 2
ToolTipText = "Record"
Top = 2880
Width = 495
End
Begin VB.CommandButton cmdPlay
Caption = "4"
BeginProperty Font
Name = "Webdings"
Size = 15.75
Charset = 2
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5280
TabIndex = 1
ToolTipText = "Play"
Top = 2880
Width = 495
End
Begin VB.TextBox Text1
Height = 2655
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 120
Width = 7095
End
Begin VB.Label lblStatus
BorderStyle = 1 'Fixed Single
Caption = "Label1"
Height = 375
Left = 120
TabIndex = 5
Top = 2880
Width = 4575
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim bPausing As Boolean
Private Sub cmdPause_Click()
EnableButtons 1, 1, 0, 0
If lblStatus.Caption = "Playing..." Then PausePlayBack
If lblStatus.Caption = "Recording..." Then PauseRecording
lblStatus = "Pausing..."
End Sub
Private Sub cmdPlay_Click()
EnableButtons 0, 0, 1, 1
If lblStatus = "Pausing..." Then
ResumePlayBack
Else
StartPlayBack
End If
lblStatus = "Playing..."
End Sub
Private Sub cmdRecord_Click()
EnableButtons 0, 0, 1, 1
If lblStatus = "Pausing..." Then
ResumeRecording
Else
StartRecording
End If
lblStatus = "Recording..."
End Sub
Private Sub cmdStop_Click()
If lblStatus.Caption = "Playing..." Then
StopPlayBack
EnableButtons 0, 1, 0, 0
End If
If lblStatus.Caption = "Recording..." Then
StopRecording
EnableButtons 1, 0, 0, 0
End If
End Sub
Private Sub Form_Load()
Text1 = ""
Caption = "Win events recorder"
lblStatus = "Idle"
EnableButtons 0, 1, 0, 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
If hJournalRec Then StopRecording
If hJournalPlay Then StopPlayBack
End Sub
Private Sub EnableButtons(ByVal bPlay As Boolean, ByVal bRecord As Boolean, ByVal bPause As Boolean, ByVal bStop As Boolean)
cmdPlay.Enabled = bPlay
cmdPause.Enabled = bPause
cmdStop.Enabled = bStop
cmdRecord.Enabled = bRecord
End Sub
Regards
Ark
I've made a sample app, but it's still buggy/not error proff, so I didn't post it to FreeVBCode (My favorite site). Here is code:
'===============mHook.bas=
Public Enum JOURNAL_CODES
HC_ACTION = 0
HC_GETNEXT = 1
HC_SKIP = 2
HC_NOREMOVE = 3
HC_SYSMODALON = 4
HC_SYSMODALOFF = 5
End Enum
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type EVENTMSG
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Public hJournalRec As Long
Public hJournalPlay As Long
Private Recorder As cRecords
Public StartTime As Long
Private Const WH_JOURNALRECORD = 0
Private Const WH_JOURNALPLAYBACK = 1
Public Function JournalRecordProc(ByVal nCode As JOURNAL_CODES, ByVal wParam As Long, lParam As EVENTMSG) As Long
Static bModallOn As Boolean
If nCode = HC_SYSMODALON Then bModallOn = True
If nCode = HC_SYSMODALOFF Then bModallOn = False
If (nCode < 0) Or bModallOn Then GoTo ProcessMessage
If nCode = HC_ACTION Then
Recorder.Add lParam.pt.x, lParam.pt.y, lParam.time - StartTime, lParam.lParam, lParam.wParam, lParam.message, lParam.hwnd
End If
ProcessMessage:
JournalRecordProc = CallNextHookEx(hJournalRec
End Function
Public Function JournalPlayBackProc(ByVal nCode As JOURNAL_CODES, ByVal wParam As Long, lParam As EVENTMSG) As Long
Static bModallOn As Boolean
Dim delta As Long
If nCode = HC_SYSMODALON Then bModallOn = True
If nCode = HC_SYSMODALOFF Then bModallOn = False
If (nCode < 0) Or bModallOn Then Exit Function 'GoTo ProcessMessage
Form1.Caption = Recorder.Count
If nCode = HC_SKIP Then
Recorder.Remove 1
If Recorder.Count = 1 Then StopPlayBack
Exit Function
ElseIf nCode = HC_GETNEXT Then
lParam.hwnd = Recorder.Item(1).hwnd
lParam.lParam = Recorder.Item(1).lParam
lParam.message = Recorder.Item(1).message
lParam.pt.x = Recorder.Item(1).ptX
lParam.pt.y = Recorder.Item(1).ptY
lParam.time = StartTime + Recorder.Item(1).time
lParam.wParam = Recorder.Item(1).wParam
delta = lParam.time - GetTickCount
If delta > 0 Then
JournalPlayBackProc = delta
Else
JournalPlayBackProc = 0
End If
Exit Function
End If
ProcessMessage:
JournalPlayBackProc = CallNextHookEx(hJournalPla
End Function
Public Sub StartRecording()
StopPlayBack
Set Recorder = New cRecords
StartTime = GetTickCount
hJournalRec = SetWindowsHookEx(WH_JOURNA
End Sub
Public Sub PauseRecording()
If hJournalRec Then UnhookWindowsHookEx hJournalRec
End Sub
Public Sub ResumeRecording()
StartTime = GetTickCount
hJournalRec = SetWindowsHookEx(WH_JOURNA
End Sub
Public Sub StopRecording()
If hJournalRec Then
UnhookWindowsHookEx hJournalRec
hJournalRec = 0
End If
End Sub
Public Sub StartPlayBack()
StopRecording
StartTime = GetTickCount
hJournalPlay = SetWindowsHookEx(WH_JOURNA
End Sub
Public Sub PausePlayBack()
If hJournalPlay Then UnhookWindowsHookEx hJournalPlay
End Sub
Public Sub ResumePlayBack()
StartTime = GetTickCount
hJournalPlay = SetWindowsHookEx(WH_JOURNA
End Sub
Public Sub StopPlayBack()
If hJournalPlay Then UnhookWindowsHookEx hJournalPlay
hJournalPlay = 0
End Sub
Public Sub StopAll()
StopRecording
StopPlayBack
Set Recorder = Nothing
End Sub
'=====================cEve
Public hwnd As Long
Public message As Long
Public wParam As Long
Public lParam As Long
Public time As Long
Public ptX As Long
Public ptY As Long
'==============cRecords.cl
'simple collection class builded with class builder based on cEvents.cls
'vb classes don't allow passing UDT, so pt.Y and pt.Y transformed to ptX and ptY
Private mCol As Collection
Public Function Add(ptX As Long, ptY As Long, time As Long, lParam As Long, wParam As Long, message As Long, hwnd As Long, Optional sKey As String) As cEvent
'create a new object
Dim objNewMember As cEvent
Set objNewMember = New cEvent
objNewMember.ptX = ptX
objNewMember.ptY = ptY
objNewMember.time = time
objNewMember.lParam = lParam
objNewMember.wParam = wParam
objNewMember.message = message
objNewMember.hwnd = hwnd
If Len(sKey) = 0 Then
mCol.Add objNewMember
Else
mCol.Add objNewMember, sKey
End If
Set Add = objNewMember
Set objNewMember = Nothing
End Function
Public Property Get Item(vntIndexKey As Variant) As cEvent
Set Item = mCol(vntIndexKey)
End Property
Public Property Get Count() As Long
Count = mCol.Count
End Property
Public Sub Remove(vntIndexKey As Variant)
mCol.Remove vntIndexKey
End Sub
Public Property Get NewEnum() As IUnknown
Set NewEnum = mCol.[_NewEnum]
End Property
Private Sub Class_Initialize()
Set mCol = New Collection
End Sub
Private Sub Class_Terminate()
Set mCol = Nothing
End Sub
'=========Form1.frm=======
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Form1"
ClientHeight = 3360
ClientLeft = 45
ClientTop = 435
ClientWidth = 7380
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3360
ScaleWidth = 7380
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdStop
Caption = "<"
BeginProperty Font
Name = "Webdings"
Size = 15.75
Charset = 2
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6720
TabIndex = 4
Top = 2880
Width = 495
End
Begin VB.CommandButton cmdPause
Caption = ";"
BeginProperty Font
Name = "Webdings"
Size = 15.75
Charset = 2
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6240
TabIndex = 3
Top = 2880
Width = 495
End
Begin VB.CommandButton cmdRecord
Caption = "n"
BeginProperty Font
Name = "Webdings"
Size = 8.25
Charset = 2
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5760
TabIndex = 2
ToolTipText = "Record"
Top = 2880
Width = 495
End
Begin VB.CommandButton cmdPlay
Caption = "4"
BeginProperty Font
Name = "Webdings"
Size = 15.75
Charset = 2
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5280
TabIndex = 1
ToolTipText = "Play"
Top = 2880
Width = 495
End
Begin VB.TextBox Text1
Height = 2655
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 120
Width = 7095
End
Begin VB.Label lblStatus
BorderStyle = 1 'Fixed Single
Caption = "Label1"
Height = 375
Left = 120
TabIndex = 5
Top = 2880
Width = 4575
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim bPausing As Boolean
Private Sub cmdPause_Click()
EnableButtons 1, 1, 0, 0
If lblStatus.Caption = "Playing..." Then PausePlayBack
If lblStatus.Caption = "Recording..." Then PauseRecording
lblStatus = "Pausing..."
End Sub
Private Sub cmdPlay_Click()
EnableButtons 0, 0, 1, 1
If lblStatus = "Pausing..." Then
ResumePlayBack
Else
StartPlayBack
End If
lblStatus = "Playing..."
End Sub
Private Sub cmdRecord_Click()
EnableButtons 0, 0, 1, 1
If lblStatus = "Pausing..." Then
ResumeRecording
Else
StartRecording
End If
lblStatus = "Recording..."
End Sub
Private Sub cmdStop_Click()
If lblStatus.Caption = "Playing..." Then
StopPlayBack
EnableButtons 0, 1, 0, 0
End If
If lblStatus.Caption = "Recording..." Then
StopRecording
EnableButtons 1, 0, 0, 0
End If
End Sub
Private Sub Form_Load()
Text1 = ""
Caption = "Win events recorder"
lblStatus = "Idle"
EnableButtons 0, 1, 0, 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
If hJournalRec Then StopRecording
If hJournalPlay Then StopPlayBack
End Sub
Private Sub EnableButtons(ByVal bPlay As Boolean, ByVal bRecord As Boolean, ByVal bPause As Boolean, ByVal bStop As Boolean)
cmdPlay.Enabled = bPlay
cmdPause.Enabled = bPause
cmdStop.Enabled = bStop
cmdRecord.Enabled = bRecord
End Sub
Regards
Ark
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Hrm. So I suppose the answer to the question: How do you "Hold Down" a key using Keybd_Events API, or SendInput API?
is: You don't.
I'll divvy up the points between ya for your effort, 300 for Art since he's been trying since before christmas, and 100 to you other two. Thanks for the attempt!
-Javin
is: You don't.
I'll divvy up the points between ya for your effort, 300 for Art since he's been trying since before christmas, and 100 to you other two. Thanks for the attempt!
-Javin
How do you record keyboard activity? IMHO you can use GetKeyboardState/SetKeyboa
Regards
Ark