Solved

Interrupt a code

Posted on 2004-08-25
18
252 Views
Last Modified: 2010-05-02
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
Comment
Question by:HyMaX_2003
  • 6
  • 4
  • 3
  • +4
18 Comments
 
LVL 3

Expert Comment

by:nichia
ID: 11898793
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
 
LVL 3

Expert Comment

by:gillgates
ID: 11899221
Exit Sub

That will exit the function.  It won't pause it.
0
 
LVL 49

Expert Comment

by:Ryan Chong
ID: 11899363
>>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
 
LVL 49

Expert Comment

by:Ryan Chong
ID: 11899368
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
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 11899581
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
 
LVL 18

Expert Comment

by:JR2003
ID: 11901217

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
 
LVL 26

Expert Comment

by:Rejojohny
ID: 11901992
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
 
LVL 1

Author Comment

by:HyMaX_2003
ID: 11918692
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
 
LVL 3

Expert Comment

by:nichia
ID: 11918860
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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 3

Expert Comment

by:nichia
ID: 11918920
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
 
LVL 1

Author Comment

by:HyMaX_2003
ID: 11921115
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
 
LVL 1

Author Comment

by:HyMaX_2003
ID: 11921117
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
 
LVL 85

Accepted Solution

by:
Mike Tomlinson earned 100 total points
ID: 11921388
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
 
LVL 1

Author Comment

by:HyMaX_2003
ID: 11922883
Sorry but I can't make it work. I press End and nothing happens, it continues clicking and clicking.
0
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 11923299
>> 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
 
LVL 1

Author Comment

by:HyMaX_2003
ID: 11923390
WOW! Sorry about that, my mistake! IT'S SIMPLY PERFECT! THANKS SO MUCH, ONCE MORE!
0
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 11923400
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
 
LVL 1

Author Comment

by:HyMaX_2003
ID: 11926061
lol Happy birthday to your daughter! But I prefer to use the timers, because I understand them... Thx!
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now