Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 286
  • Last Modified:

Interrupt a code

Hi, I got in my program a very long code running, and it takes some time to finish executing. But sometimes I want to stop it, but I can't. Is there any way of doing this? Something using timers and the GetAsyncKeyState funcion maybe... Like this:

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

Private Sub Timer1_Timer()
If (GetAsyncKeyState(vbKeyEnd)) Then 'WHEN END IS PRESSED

'STOP THE CODE

End Sub

Understand? I hope you do, and thanks!
0
HyMaX_2003
Asked:
HyMaX_2003
  • 6
  • 4
  • 3
  • +4
1 Solution
 
nichiaCommented:
If your program is in a long loop, then placing a DoEvents statement in the loop will allow events to fire (like the keypress event).  You can code a loop exit based on a certain keypress, etc.

Hope it helps!
0
 
gillgatesCommented:
Exit Sub

That will exit the function.  It won't pause it.
0
 
Ryan ChongCommented:
>>But sometimes I want to stop it, but I can't. Is there any way of doing this?
You may try use the Sleep API, which suspends the execution of the current thread for a specified interval, example:

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

Private Sub Timer1_Timer()
If (GetAsyncKeyState(vbKeyEnd)) Then 'WHEN END IS PRESSED

'STOP THE CODE
DoEvents
Sleep 1000 'Pause 1 second

End Sub
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
Ryan ChongCommented:
but try not put your code above inside a Timer Event, as the Timer control already got Interval Property, which can be set to determine the looping interval.

regards
0
 
Mike TomlinsonMiddle School Assistant TeacherCommented:
Here is a simple example of a process being interrupted by a "Cancel" button.

Create a new project and add two commandbuttons and two labels:

Option Explicit

Private cancelProcess As Boolean

Private Sub Form_Load()
    Command1.Caption = "Start"
    Command2.Caption = "Cancel"
End Sub

Private Sub Command1_Click()
    Command1.Enabled = False
   
    Dim i As Double
    Dim j As Double
   
    cancelProcess = False
    For i = 1 To 50000
        If cancelProcess Then
            MsgBox "Cancelled!"
            Exit For
        End If
           
        Label1.Caption = i
        j = i / 3
        Label2.Caption = j
           
        DoEvents ' keep the app responsive so the user can click the cancel button
    Next i
       
    If Not cancelProcess Then
        MsgBox "Done!"
    End If
    Command1.Enabled = True
End Sub

Private Sub Command2_Click()
    cancelProcess = True
End Sub
0
 
JR2003Commented:

In your long running code place some lines something like this that will run frequently.

Option Explicit
Private bCancelled As Boolean
Private Function SomeLongRunningFunction()
    bCancelled = False
    Do
        DoEvents
        If bCancelled Then Exit Function
    Loop
End Function

Private Sub Command1_Click()
    SomeLongRunningFunction
End Sub

Private Sub Command2_Click()
    bCancelled = True
End Sub
0
 
RejojohnyCommented:
do u want to stop in the debug mode or in an exe .. if in debug mode, then presing CTRL+Pause Break will break into the code and let u debug from the current statement which is been run ...
0
 
HyMaX_2003Author Commented:
Sorry but nothing worked... my program executes a series of mouse clicks, and it doesn't stop until it's finished... I want to stop THAT! I'll post the code here:

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _
        ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, _
        ByVal dwExtraInfo As Long)
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, _
        ByVal y As Long) As Long
       
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4

Public Sub mouseclick(x As Long, y As Long)
SetCursorPos x, y
mouse_event MOUSEEVENTF_LEFTDOWN, x, y, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, x, y, 0, 0
End Sub

Private Sub Command1_Click()
mouseclick 10, 20
mouseclick 10, 30
mouseclick 10, 40
mouseclick 10, 50
mouseclick 10, 60
mouseclick 10, 70
mouseclick 10, 80
mouseclick 10, 90
...
End Sub
0
 
nichiaCommented:
The problem here is once the mouse_event clicks off your form, you lose keyboard focus and you have no easy way to get user input to cancel the operation.

The only solution I can suggest is to register a hotkey for your application so that you can get notified even without keyboard focus.

There are several good examples on the web and at EE for using a hotkey in VB.

Good Luck!
0
 
nichiaCommented:
Actually, your initial idea using GetAsyncKeyState is a good one.  I got it to work in the code below.  I also used th Sleep function to put a one second pause in between each mouse event for testing.  The code uses a form level variable (bEscape) to control the termination of the For loop.  The Doevents in the loop allows the timer event code to execute while in the loop.

Option Explicit

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

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _
        ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, _
        ByVal dwExtraInfo As Long)
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, _
        ByVal y As Long) As Long
       
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4

Private bEscape As Boolean 'Escape key flag

Public Sub mouseclick(x As Long, y As Long)
    SetCursorPos x, y
    mouse_event MOUSEEVENTF_LEFTDOWN, x, y, 0, 0
    mouse_event MOUSEEVENTF_LEFTUP, x, y, 0, 0
End Sub

Private Sub Command1_Click()

    Dim i As Long
   
    Command1.Enabled = False 'Prevents reentry during Doevents
    bEscape = False 'Reset our escape flag
   
    For i = 20 To 90 Step 10
        mouseclick 10, i
        Call Sleep(1000)
        DoEvents
        If (bEscape) Then Exit For
    Next
    Beep
    Command1.Enabled = True
   
End Sub


Private Sub Timer1_Timer()
    If (GetAsyncKeyState(vbKeyEnd)) Then bEscape = True
End Sub
0
 
HyMaX_2003Author Commented:
nichia, your idea is very good, but it only worked in the simple version of the code. In the complex version of the code I couldn't make it work. I'll be posting it here, and I'll tell you how it works:



Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _
ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, _
ByVal dwExtraInfo As Long)
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, _
ByVal y As Long) As Long
Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const VK_CONTROL = &H11
Private Const KEYEVENTF_KEYUP = &H2
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private tmpData As String
Dim timestorun As String
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Public Sub MouseClick(x As Long, y As Long)
SetCursorPos x, y
keybd_event VK_CONTROL, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTDOWN, x, y, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, x, y, 0, 0
keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
End Sub

Private Sub Command1_Click()
MsgBox "You can edit at runtime the MouseClicks and wait commands. By pressing the Home key in your keyboard, the program will run the codes typed inside the Text Box. The problem is, it can't be stopped. I want to stop the code by pressing the End key.", vbInformation + vbOKOnly, "How it works"
End Sub

Private Sub events_Timer()
If (GetAsyncKeyState(vbKeyHome)) Then

'REPEAT-------------------
timestorun = 0
Do
timestorun = timestorun + 1

'EVENTS-------------------
Dim tmpData As String
Dim cmds As New Collection
Dim arrTmp() As String, i As Long, arrVal() As String
   
tmpData = LCase(Trim(Text1.Text))
If tmpData <> "" Then
arrTmp = Split(tmpData, vbNewLine)
For i = 0 To UBound(arrTmp)
If arrTmp(i) <> "" Then
arrVal = Split(arrTmp(i), " ")

Select Case arrVal(0)

Case "mouseclick"
If UBound(arrVal) = 2 Then
MouseClick CLng(Left$(arrVal(1), Len(arrVal(1)) - 1)), CLng(arrVal(2))
Else
MsgBox arrTmp(i), vbCritical, "Incorrect Format"
End If
                       
Case "wait"
If UBound(arrVal) = 1 Then
Sleep CLng(arrVal(1))
Else
MsgBox arrTmp(i), vbCritical, "Incorrect Format"
End If
               
Case Else
MsgBox arrTmp(i), vbCritical, "Unknown Command"
                       
End Select
End If
Next i
End If
'EVENTS-------------------

If timestorun = Text2.Text Then Exit Do
Loop
'REPEAT-------------------

End If
End Sub


Add two textboxes to the form (one of them with multiline and scrollbar) and also a timer (interval: 400, name: events)

Well the program works like that: There is a TEXTBOX, where you can type in each line a command like 'MouseClick 100, 100" and 'Wait 1000'. So, by pressing the Home key these commands will be executed a number of times you specify. But the problem is that it doesn't stop until it's finished. That's what I want to know, how to make it stop by pressing the End key.

This way, you can edit the places to click and the interval between them at runtime.

I'll be increasing the points value, because I see it's harder than I thought.
0
 
HyMaX_2003Author Commented:
Oh and just a note: when you put the MouseClick event in the textbox, you must put a comma, like the example below:

MouseClick 100, 100

Thanks!
0
 
Mike TomlinsonMiddle School Assistant TeacherCommented:
Add a Module to your project and paste the "Module1" code into it.  Change your form code to the area labeled "Form1" below.

The code registers ALT_END as a hotkey for your app.  Just press ALT_END during a running sequence and it will be cancelled.

Since we have to subclass the form to receive hotkey messages, DO NOT press the Stop button in the IDE.  Always close your app by pressing the X on your main form.  This will unsubclass the form and allow your app to exit gracefully.

If you press the Stop button, the IDE will crash and you will lose any unsaved changes.

Regards,

Idle_Mind

' --------------------------------------------------------------------------------------
' Module1
' --------------------------------------------------------------------------------------
Option Explicit

Public Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, _
    ByVal ID As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
   
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, _
    ByVal ID As Long) As Long

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

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

Public Const WM_HOTKEY = &H312
Public Const GWL_WNDPROC = -4

Public Const MOD_CTRL = &H2
Public Const MOD_SHFT = &H4
Public Const MOD_ALT = &H1

Public Const VK_END = &H23

Public glWinRet As Long
Public cancelled As Boolean

Public Function CallbackMsgs(ByVal wHwnd As Long, ByVal wmsg As Long, ByVal wp_id As Long, ByVal lp_id As Long) As Long
    If wmsg = WM_HOTKEY Then
        If wp_id = 0 Then
            cancelled = True
        End If
        CallbackMsgs = 1
        Exit Function
    End If
    CallbackMsgs = CallWindowProc(glWinRet, wHwnd, wmsg, wp_id, lp_id)
End Function

' --------------------------------------------------------------------------------------
' Form1
' --------------------------------------------------------------------------------------
Option Explicit

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

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _
    ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, _
    ByVal dwExtraInfo As Long)
   
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, _
    ByVal y As Long) As Long
   
Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, _
    ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
   
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) _
    As Integer

Private Const VK_CONTROL = &H11
Private Const KEYEVENTF_KEYUP = &H2
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private tmpData As String
Private timestorun As String

Private hotKeySet As Boolean ' true if ALT_END key was successfully registered

Private Sub Form_Load()
    ' attempt to register the ALT_END key as a hotkey for this app
    hotKeySet = RegisterHotKey(Me.hwnd, 0, MOD_ALT, VK_END)
    If hotKeySet Then
        ' Subclass the form to get the Hotkey message
        glWinRet = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf CallbackMsgs)
    Else
        MsgBox "Unable to register END key", vbCritical, "Hotkey already taken"
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If hotKeySet Then
        ' Unsubclass the form
        SetWindowLong Me.hwnd, GWL_WNDPROC, glWinRet
        ' Unregister the hotkey
        UnregisterHotKey Me.hwnd, 0
    End If
End Sub

Public Sub MouseClick(x As Long, y As Long)
    SetCursorPos x, y
    keybd_event VK_CONTROL, 0, 0, 0
    mouse_event MOUSEEVENTF_LEFTDOWN, x, y, 0, 0
    mouse_event MOUSEEVENTF_LEFTUP, x, y, 0, 0
    keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
End Sub

Private Sub events_Timer()
    Dim tmpData As String
    Dim arrTmp() As String, i As Long, arrVal() As String
   
    If (GetAsyncKeyState(vbKeyHome)) Then
        cancelled = False
        'REPEAT-------------------
        timestorun = 0
        Do
            timestorun = timestorun + 1

            'EVENTS-------------------
            tmpData = LCase(Trim(Text1.Text))
            If tmpData <> "" Then
                arrTmp = Split(tmpData, vbNewLine)
                For i = 0 To UBound(arrTmp)
                    DoEvents ' allow the system to process a possible hotkey message
                    If cancelled Then
                        MsgBox "Sequence Cancelled", vbInformation, "ALT_END pressed"
                        Exit Sub
                    End If
                    If arrTmp(i) <> "" Then
                        arrVal = Split(arrTmp(i), " ")
                       
                        Select Case arrVal(0)

                            Case "mouseclick"
                                If UBound(arrVal) = 2 Then
                                    MouseClick CLng(Left$(arrVal(1), Len(arrVal(1)) - 1)), CLng(arrVal(2))
                                Else
                                    MsgBox arrTmp(i), vbCritical, "Incorrect Format"
                                End If
                       
                            Case "wait"
                                If UBound(arrVal) = 1 Then
                                    Sleep CLng(arrVal(1))
                                Else
                                    MsgBox arrTmp(i), vbCritical, "Incorrect Format"
                                End If
               
                            Case Else
                                MsgBox arrTmp(i), vbCritical, "Unknown Command"
                       
                        End Select
                    End If
                Next i
            End If
            'EVENTS-------------------

            If timestorun = Text2.Text Then Exit Do
        Loop
        'REPEAT-------------------

    End If
End Sub
0
 
HyMaX_2003Author Commented:
Sorry but I can't make it work. I press End and nothing happens, it continues clicking and clicking.
0
 
Mike TomlinsonMiddle School Assistant TeacherCommented:
>> The code registers ALT_END as a hotkey for your app.

You need to press Alt-End to stop the sequence.  I didn't use end because I didn't want it change the default behaviour associated with just End by itself.

Idle_Mind
0
 
HyMaX_2003Author Commented:
WOW! Sorry about that, my mistake! IT'S SIMPLY PERFECT! THANKS SO MUCH, ONCE MORE!
0
 
Mike TomlinsonMiddle School Assistant TeacherCommented:
As a side note...the use of the timer is kinda ugly.  I see you are using it to trap the Home key, but the sequencing code probably shouldn't be in there at all.

Personally, I would register ALT_HOME as another hotkey and then get rid of the timer altogether.  

Let me know if you want to see how the code would look.  I won't be able to get to it today as I must get ready for my daugthers birthday party/sleepover.

Not really looking forward to a bunch of six year olds girls taking over the house for an evening....lol.

=)
Idle_Mind
0
 
HyMaX_2003Author Commented:
lol Happy birthday to your daughter! But I prefer to use the timers, because I understand them... Thx!
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 6
  • 4
  • 3
  • +4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now