Results 1 to 28 of 28

Thread: [RESOLVED] Detecting when IDE Stop button has been clicked

  1. #1

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Resolved [RESOLVED] Detecting when IDE Stop button has been clicked

    Ok, I've been adapting all my code to use the "new" (ok, not so new) comctl32.dll method of subclassing. If done with care, I've found that I can actually make my subclassing IDE Stop button safe. That was quite amazing to me, and I'd encourage you to read through my other Subclassing thread for more details on this.

    However, my question of the day has to do with detecting when the IDE Stop button has been presses, as opposed to a form just naturally closing. If we're in a compiled program, I won't really care. I'm specifically talking about running programs in the IDE.

    Here's a short (BAS) module to illustrate what I'd like to do:

    Code:
    
    Option Explicit
    '
    Private Const WM_DESTROY = &H2&
    '
    Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
    Private Declare Function GetWindowSubclass Lib "comctl32.dll" Alias "#411" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, pdwRefData As Long) As Long
    Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
    Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    '
    '
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
    Private Type POINTAPI
        x As Long
        y As Long
    End Type
    Private Type MINMAXINFO
        ptReserved As POINTAPI
        ptMaxSize As POINTAPI
        ptMaxPosition As POINTAPI
        ptMinTrackSize As POINTAPI
        ptMaxTrackSize As POINTAPI
    End Type
    '
    
    Public Function IdeStopButton() As Boolean
    
        ' What might I put here to figure out whether the IDE "Stop"
        ' button was pressed, as opposed to just the form naturally closing.
    
    End Function
    
    
    Public Sub SubclassFormFixedWidth(frm As VB.Form)
        Call SetWindowSubclass(frm.hWnd, AddressOf FixedWidth_Proc, frm.hWnd, CLng(frm.Width \ Screen.TwipsPerPixelX))
    End Sub
    
    Private Function FixedWidth_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
        If uMsg = WM_DESTROY Then
            Call RemoveWindowSubclass(hWnd, AddressOf_FixedWidth_Proc, hWnd)
            FixedWidth_Proc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
    
    
            Debug.Print IdeStopButton
    
    
            Exit Function
        End If
        '
        Dim PelWidth As Long
        Dim MMI As MINMAXINFO
        Const WM_GETMINMAXINFO As Long = &H24&
        '
        ' And now we force our width to not change.
        If uMsg = WM_GETMINMAXINFO Then
            ' Force the form to stay at initial size.
            PelWidth = dwRefData
            CopyMemory MMI, ByVal lParam, LenB(MMI)
            MMI.ptMinTrackSize.x = PelWidth
            MMI.ptMaxTrackSize.x = PelWidth
            CopyMemory ByVal lParam, MMI, LenB(MMI)
            Exit Function ' If we process the message, we must return 0 and not let more hook code execute.
        End If
        '
        ' Give control to other hooks, if they exist.
        FixedWidth_Proc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
    End Function
    
    Private Function AddressOf_FixedWidth_Proc() As Long
        AddressOf_FixedWidth_Proc = ProcedureAddress(AddressOf FixedWidth_Proc)
    End Function
    
    Private Function ProcedureAddress(AddressOf_TheProc As Long)
        ' A private "helper" function for writing the AddressOf_... functions.
        ProcedureAddress = AddressOf_TheProc
    End Function
    
    To use it, just throw it into a BAS module and then throw the following into the default Form1's code:

    Code:
    
    Option Explicit
    
    Private Sub Form_Load()
        SubclassFormFixedWidth Me
    End Sub
    
    
    It's that IdeStopButton function that I'd like to get working if anyone can figure it out. Even though, when the Stop button is pressed, all COM objects are un-instantiated and all dynamic arrays are erased, that still doesn't give me a way to do it.

    Here's one thing I tried, but it didn't work:

    Code:
    
    Public Function IdeStopButton() As Boolean
        On Error GoTo Stopping
        Dim bb() As Byte
        ReDim bb(0)
        Exit Function
    Stopping:
        IdeStopButton = True
    End Function
    
    I also tried this, but no cigar:

    Code:
    
    Public Function IdeStopButton() As Boolean
        On Error GoTo Stopping
        Dim coll As Collection
        Set coll = New Collection
        coll.Add "asdf", "asdf"
        Exit Function
    Stopping:
        IdeStopButton = True
    End Function
    
    
    Any idea are much appreciated.

    Also, I'd like to work this out without any machine-code insertion, but I suppose I'm willing to consider it if nothing else can be worked out.

    Elroy
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  2. #2
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: Detecting when IDE Stop button has been clicked

    Not sure but you can check the value from `EbMode` when on Stopping debug session outside tear-down code reaches your callback routine in the IDE.
    Code:
    Private Declare Function EbMode Lib "vba6" () As Long
    Probably also check if `vb6.dll` is loaded before calling it (not to fail when run compiled outside the IDE).

    Edit: Now I see this is what The trick proposed in the previous thread.

    cheers,
    </wqw>

  3. #3

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Detecting when IDE Stop button has been clicked

    Hmmm, ok, I'm still stuck. Wqweto, good ideas, but no cigar.

    The EbMode returns 1 in both cases (whether we clicked "X" to close form, or whether we hit the IDE Stop button).

    I also threw in the following module, and the exact same set of dependencies is listed in both cases. I listed them inside of the IdeStopButton function that I'm trying to write.

    Code:
    
    Option Explicit
    '
    Private Const MAX_PATH = 260
    Private Type MODULEENTRY32
        dwSize As Long
        th32ModuleID As Long
        th32ProcessID As Long
        GlblcntUsage As Long
        ProccntUsage As Long
        modBaseAddr As Long
        modBaseSize As Long
        hModule As Long
        szModule As String * 256
        szExePath As String * MAX_PATH
    End Type
    '
    Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
    Private Declare Function Module32First Lib "kernel32" (ByVal hSnapShot As Long, lpMe32 As MODULEENTRY32) As Long
    Private Declare Function Module32Next Lib "kernel32" (ByVal hSnapShot As Long, lpMe32 As MODULEENTRY32) As Long
    Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
    Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
    '
    
    Private Sub Command1_Click()
        Dim Deps() As String
        Dim i As Long
        '
        Deps = GetMyProcessModules
        If IsDimmedStr(Deps) Then
            For i = LBound(Deps) To UBound(Deps)
                Debug.Print Deps(i)
            Next i
        End If
    End Sub
    
    Private Sub Command2_Click()
        MsgBox ImUsingThisModule("mscomctl.ocx")
    End Sub
    
    Public Function ImUsingThisModule(ByVal sModuleName As String) As Boolean
        ' Do NOT include a path.
        Dim Deps() As String
        Dim i As Long
        '
        ' Add a back-slash to keep from matching any partial names.
        sModuleName = "\" & UCase$(sModuleName)
        '
        Deps = GetMyProcessModules
        If IsDimmedStr(Deps) Then
            For i = LBound(Deps) To UBound(Deps)
                If UCase$(Right$(Deps(i), Len(sModuleName))) = sModuleName Then
                    ImUsingThisModule = True
                    Exit Function
                End If
            Next i
        End If
        ' If we fall out, it wasn't found.
    End Function
    
    Public Function GetMyProcessModules() As String()
        ' This function retrieves all dependencies of the program that calls it.
        ' It returns the complete path, so it can be used to determine which dependencies are
        ' side-by-side versus ones pulled from the registry.
        '
        Dim Me32 As MODULEENTRY32
        Dim lRet As Long
        Dim lhSnapShot As Long
        Dim pID As Long
        Dim iLen As Integer
        Dim sModule As String
        Dim DependencyList() As String
        Dim iCount As Long
        Const TH32CS_SNAPMODULE = &H8
        '
        pID = GetCurrentProcessId ' Get our process ID.
        '
        ' Snapshot tool will be used to get complete list of dependencies being used.
        lhSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, pID)
        If lhSnapShot = 0 Then Exit Function
        '
        ' Get the dependencies.
        ReDim DependencyList(1 To 100)
        Me32.dwSize = LenB(Me32)                ' Set up the Module Entry structure.
        lRet = Module32First(lhSnapShot, Me32)  ' Call the "First" function to start the loop.
        Do While lRet
            If Me32.th32ProcessID = pID Then
                '
                ' If the dependency belongs to us, add it to the list.
                iCount = iCount + 1
                If iCount > UBound(DependencyList) Then ReDim Preserve DependencyList(1 To UBound(DependencyList) + 100)
                DependencyList(iCount) = RTrimNull(Me32.szExePath)
            End If
            ' Get next dependency and loop.
            lRet = Module32Next(lhSnapShot, Me32)
        Loop
        '
        ' All done, clean up and get out.
        If iCount Then
            ReDim Preserve DependencyList(1 To iCount)
        Else
            Erase DependencyList
        End If
        CloseHandle lhSnapShot
        GetMyProcessModules = DependencyList
    End Function
    
    Public Function RTrimNull(s As String) As String
        Dim i As Integer
        i = InStr(s, vbNullChar)
        If i Then
            RTrimNull = Left$(s, i - 1)
        Else
            RTrimNull = s
        End If
    End Function
    
    Public Function IsDimmedStr(TheArray() As String) As Boolean
        ' This won't fail on one of the (0 to -1) arrays.
        On Error Resume Next
            IsDimmedStr = (LBound(TheArray) = LBound(TheArray)) ' Will error (leaving IsDimmedStr = False) if not dimensioned.
        On Error GoTo 0
    End Function
    
    
    So ... it's still back to the drawing board. Any/all ideas are excitedly welcomed.

    Elroy

    EDIT1: Anyone can play around with the above module by just putting two buttons on a form, and then throwing that code into the form.

    EDIT2: A bit more info: The above list of dependencies is the same when unloading a window, regardless of whether it's the last window being unloaded in the program. In other words, if I hit the Stop button VERSUS unloading a form (with other forms still showing), the list of dependencies is still identical.
    Last edited by Elroy; Apr 21st, 2017 at 11:25 AM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  4. #4
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: Detecting when IDE Stop button has been clicked

    Try that:
    Code:
    Option Explicit
    
    Private Declare Function FindWindow Lib "user32" _
                             Alias "FindWindowA" ( _
                             ByVal lpClassName As String, _
                             ByVal lpWindowName As String) As Long
    Private Declare Function SetWindowLong Lib "user32" _
                             Alias "SetWindowLongA" ( _
                             ByVal hWnd As Long, _
                             ByVal nIndex As Long, _
                             ByVal dwNewLong As Long) As Long
    Private 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
    
    Private Const GWL_WNDPROC   As Long = (-4)
    
    Private pfnPrevProc     As Long
    Private hWndIDE         As Long
    
    Public Function HijackStopButton() As Boolean
    
        hWndIDE = FindWindow("wndclass_desked_gsk", vbNullString)
        If hWndIDE = 0 Then Exit Function
        
        pfnPrevProc = SetWindowLong(hWndIDE, GWL_WNDPROC, AddressOf WndProc)
        
        HijackStopButton = pfnPrevProc
        
    End Function
    
    Public Sub RestoreStopButtonBehavior()
        
        If pfnPrevProc = 0 Or hWndIDE = 0 Then Exit Sub
        
        SetWindowLong hWndIDE, GWL_WNDPROC, pfnPrevProc
        
    End Sub
    
    Private Function WndProc( _
                     ByVal hWnd As Long, _
                     ByVal lMsg As Long, _
                     ByVal wParam As Long, _
                     ByVal lParam As Long) As Long
                         
        If lMsg = &H1044 And wParam = &H33 Then
        
            MsgBox "Stop button was pressed", vbInformation
            RestoreStopButtonBehavior
            
        Else
        
            WndProc = CallWindowProc(pfnPrevProc, hWnd, lMsg, wParam, lParam)
            
        End If
     
    End Function
    When you press "Stop" it'll show message and you can handle the needed things. The second pressing ends execution. I don't test it, i just see throught Spy+ windows messages and see that when you select commands on panel or menu it calls 0x1044 message with different second parameter. 0x33 - Stop button.

  5. #5
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,224

    Re: Detecting when IDE Stop button has been clicked

    couldn't you just use the IAT hook you posted from Krool's CCRP.

    @the Trick the method you posted works in VBA also. (different window class and message though)
    Last edited by DEXWERX; Apr 21st, 2017 at 11:48 AM.

  6. #6

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: Detecting when IDE Stop button has been clicked

    I actually got it. It was WAY easier than I thought it'd be. It turns out, when you hit Stop, all global/module variables are reset (in addition to all COMs being un-instantiated and all dynamic arrays erased). And that all happens BEFORE the static subclassing gets executed to allow you to un-subclass.

    Therefore, all I had to do was set a boolean when I subclassed, and check it whenever I want.

    Here's the code that shows it. It reports "False" when clicking the form's "X", and it reports "True" when the Stop button was clicked.

    Code:
    
    Option Explicit
    '
    Private Const WM_DESTROY = &H2&
    '
    Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
    Private Declare Function GetWindowSubclass Lib "comctl32.dll" Alias "#411" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, pdwRefData As Long) As Long
    Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
    Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    '
    '
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
    Private Type POINTAPI
        x As Long
        y As Long
    End Type
    Private Type MINMAXINFO
        ptReserved As POINTAPI
        ptMaxSize As POINTAPI
        ptMaxPosition As POINTAPI
        ptMinTrackSize As POINTAPI
        ptMaxTrackSize As POINTAPI
    End Type
    '
    Dim bSetWhenSubclassing_UsedByIdeStop As Boolean
    '
    
    Public Function IdeStopButton() As Boolean
        IdeStopButton = Not bSetWhenSubclassing_UsedByIdeStop
    End Function
    
    
    Public Sub SubclassFormFixedWidth(frm As VB.Form)
        Call SetWindowSubclass(frm.hWnd, AddressOf FixedWidth_Proc, frm.hWnd, CLng(frm.Width \ Screen.TwipsPerPixelX))
        ReDim bbStopCheck(0)
        bSetWhenSubclassing_UsedByIdeStop = True
    End Sub
    
    Private Function FixedWidth_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
        If uMsg = WM_DESTROY Then
            Call RemoveWindowSubclass(hWnd, AddressOf_FixedWidth_Proc, hWnd)
            FixedWidth_Proc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
    
    
    
            Debug.Print IdeStopButton
    
    
    
    
            Exit Function
        End If
        '
        Dim PelWidth As Long
        Dim MMI As MINMAXINFO
        Const WM_GETMINMAXINFO As Long = &H24&
        '
        ' And now we force our width to not change.
        If uMsg = WM_GETMINMAXINFO Then
            ' Force the form to stay at initial size.
            PelWidth = dwRefData
            CopyMemory MMI, ByVal lParam, LenB(MMI)
            MMI.ptMinTrackSize.x = PelWidth
            MMI.ptMaxTrackSize.x = PelWidth
            CopyMemory ByVal lParam, MMI, LenB(MMI)
            Exit Function ' If we process the message, we must return 0 and not let more hook code execute.
        End If
        '
        ' Give control to other hooks, if they exist.
        FixedWidth_Proc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
    End Function
    
    Private Function AddressOf_FixedWidth_Proc() As Long
        AddressOf_FixedWidth_Proc = ProcedureAddress(AddressOf FixedWidth_Proc)
    End Function
    
    Private Function ProcedureAddress(AddressOf_TheProc As Long)
        ' A private "helper" function for writing the AddressOf_... functions.
        ProcedureAddress = AddressOf_TheProc
    End Function
    
    

    And again, to play, just throw the above in a BAS module, and throw the following into a Form1.

    Code:
    
    Option Explicit
    
    Private Sub Form_Load()
        SubclassFormFixedWidth Me
    End Sub
    
    
    Say Trick, I'll be sure and look at your code, as I'm always fascinated with what you come up with.

    Thanks to ALL,
    Elroy

    EDIT1: With this last piece, I truly believe I'm going to be able to make my subclassing about as IDE safe as is possible.

    EDIT2: Wow, I feel like I'm living on the edge, but this has allowed me to get "On Error" totally out of all my subclassing procedures. And, truth be told, when I'm actually specifically debugging a subclassing procedure, I'd rather that it crash so that I can fix it, even if it does crash the IDE in the process. Hopefully, once I've debugged it, it'll all be IDE safe again. I doubt many say this about subclassing, but this stuff is COOL!
    Last edited by Elroy; Apr 21st, 2017 at 12:31 PM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  7. #7
    PowerPoster
    Join Date
    Feb 2017
    Posts
    4,996

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    What about when getting an error and clicking terminate?
    What about when you change a declaration statement and VB prompts that the project need to be restarted?
    And Shift+F5...
    It's not just the stop button.

    Why don't you put the subclassing in a dll?

  8. #8

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    Ok, just for posterity, here's how I used it all. I deleted long comments at the top to get it to fit in the post, but this is my model for writing totally IDE safe subclassing:

    Code:
    
    Option Explicit
    '
    Private Const WM_DESTROY = &H2&
    '
    Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
    Private Declare Function GetWindowSubclass Lib "comctl32.dll" Alias "#411" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, pdwRefData As Long) As Long
    Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
    Private Declare Function NextSubclassProcOnChain Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    'Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    '
    Dim bSetWhenSubclassing_UsedByIdeStop As Boolean ' Never goes false once set by first subclassing, unless IDE Stop button is clicked.
    '
    '**************************************************************************************
    ' The following MODULE level stuff is specific to individual subclassing needs.
    '**************************************************************************************
    '
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
    '
    Private Type POINTAPI
        x As Long
        y As Long
    End Type
    Private Type MINMAXINFO
        ptReserved As POINTAPI
        ptMaxSize As POINTAPI
        ptMaxPosition As POINTAPI
        ptMinTrackSize As POINTAPI
        ptMaxTrackSize As POINTAPI
    End Type
    '
    
    '**************************************************************************************
    '**************************************************************************************
    '**************************************************************************************
    '
    ' Generic subclassing procedures (used in many of the specific subclassing).
    '
    '**************************************************************************************
    '**************************************************************************************
    '**************************************************************************************
    
    Private Sub SubclassSomeWindow(hWnd As Long, AddressOf_ProcToHook As Long, Optional dwRefData As Long)
        ' This just always uses hWnd for uIdSubclass, as we never have a need to subclass the same window to the same proc.
        ' The uniqueness is pfnSubclass and uIdSubclass (second and third argument below).
        '
        ' This can be called AFTER the initial subclassing to update dwRefData.
        '
        bSetWhenSubclassing_UsedByIdeStop = True
        Call SetWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd, dwRefData)
    End Sub
    
    Private Function GetSubclassRefData(hWnd As Long, AddressOf_ProcToHook As Long) As Long
        ' This one is used only to fetch the optional dwRefData you may have specified when calling SubclassSomeWindow.
        ' Typically this would only be used by the hooked procedure, but it is available to anyone.
        Call GetWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd, GetSubclassRefData)
    End Function
    
    Private Function IsSubclassed(hWnd As Long, AddressOf_ProcToHook As Long) As Boolean
        ' This just tells us we're already subclassed.
        Dim dwRefData As Long
        IsSubclassed = GetWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd, dwRefData) = 1&
    End Function
    
    Private Sub UnSubclassSomeWindow(hWnd As Long, AddressOf_ProcToHook As Long)
        ' Only needed if we specifically want to un-subclass before we're closing the form (or control),
        ' otherwise, it's automatically taken care of when the window closes.
        '
        ' Be careful, some subclassing may require additional cleanup that's not done here.
        Call RemoveWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd)
    End Sub
    
    Private Function ProcedureAddress(AddressOf_TheProc As Long)
        ' A private "helper" function for writing the AddressOf_... functions (see above notes).
        ProcedureAddress = AddressOf_TheProc
    End Function
    
    Private Function DummyProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
        ' This could be used to just use comctl32.dll to store data for us in the dwRefData.
        ' However, we'd do better to create specific "Dummy" procedure, and use the same hWnd.
        ' That way, there'd be no chance of a collision on hWnd.
        '
        ' Give control to other hooks, if they exist.
        DummyProc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
    End Function
    
    Private Function IdeStopButtonClicked() As Boolean
        IdeStopButtonClicked = Not bSetWhenSubclassing_UsedByIdeStop
    End Function
    
    '**************************************************************************************
    '**************************************************************************************
    '**************************************************************************************
    '
    ' The following are our functions to be hooked, along with their AddressOf_... function.
    ' All of the following should be Private to make sure we don't accidentally call it,
    ' except for the first procedure that's actually used to initiate the subclassing.
    '
    '**************************************************************************************
    '**************************************************************************************
    '**************************************************************************************
    
    Public Sub SubclassFormFixedWidth(frm As VB.Form)
        SubclassSomeWindow frm.hWnd, AddressOf FixedWidth_Proc, CLng(frm.Width \ Screen.TwipsPerPixelX)
    End Sub
    
    Private Function FixedWidth_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
        If uMsg = WM_DESTROY Then
            UnSubclassSomeWindow hWnd, AddressOf_FixedWidth_Proc
            FixedWidth_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
    
            If Not IdeStopButtonClicked Then
    
                ' You could do other clean-up here if you have any.
    
            End If
    
            Exit Function
        End If
        If IdeStopButtonClicked Then ' Protect the IDE.  Don't execute any specific stuff if we're stopping.  We may run into COM objects or other problems.
            FixedWidth_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
            Exit Function
        End If
        '
        ' THE ABOVE TWO CHECKS SHOULD BE IN ANY NEW SUBCLASSING PROCEDURES TO PROTECT THE IDE.
        '
        Dim PelWidth As Long
        Dim MMI As MINMAXINFO
        Const WM_GETMINMAXINFO As Long = &H24&
        '
        ' And now we force our width to not change.
        If uMsg = WM_GETMINMAXINFO Then
            ' Force the form to stay at initial width.
            PelWidth = dwRefData
            '
            CopyMemory MMI, ByVal lParam, LenB(MMI)
            '
            MMI.ptMinTrackSize.x = PelWidth
            MMI.ptMaxTrackSize.x = PelWidth
            '
            CopyMemory ByVal lParam, MMI, LenB(MMI)
            Exit Function ' If we process the message, we must return 0 and not let more hook code execute.
        End If
        '
        ' Give control to other hooks, if they exist.
        FixedWidth_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
    End Function
    
    Private Function AddressOf_FixedWidth_Proc() As Long
        AddressOf_FixedWidth_Proc = ProcedureAddress(AddressOf FixedWidth_Proc)
    End Function
    
    
    And still ...

    Code:
    
    Option Explicit
    
    Private Sub Form_Load()
        SubclassFormFixedWidth Me
    End Sub
    
    ... to see it in action.

    Also, as DexWerx pointed out, once you know your module name, you can do further cleanup with "AddressOf ModuleName.ThisProc".

    Enjoy,
    Elroy
    Last edited by Elroy; Apr 21st, 2017 at 12:53 PM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  9. #9
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    Quote Originally Posted by Elroy View Post
    ... this is my model for writing totally IDE safe subclassing
    Not quite so fast sparky. Both scenarios I gave you in your other thread still crash on my system & that's using your latest tweaks above. System: Win10
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  10. #10

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    Hahaha, I love being called "sparky". I've got a dog named Sparky, and he's something else.

    And, ok ok. I did see your post, but I didn't take a close look. I'll do that now.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  11. #11

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    Drat, ok, I must agree that LaVolpe is correct. Let me outline the two scenarios here ...

    1) Use the example above (post #8). Put a command button on Form1, and then put this code in it ...

    Code:
    
    Private Sub Command1_Click()
        Error 1234
    End Sub
    
    Execute the project, click the command button (causing a runtime error), and then click "End" on the error reporting form that comes up. Bam ... IDE crash.


    2) Use the example above (post #8). Add a second form (Form2). On the first form (Form1), add a command button, and then put this code in it ...

    Code:
    
    Private Sub Command1_Click()
        Form2.Show vbModal
    End Sub
    
    Execute the project, click the command button (which will modally load Form2), and then click the IDE "Stop" button. Bam ... IDE crash.

    ---------------------------

    Interestingly, in the first scenario, even if I click "Debug", I'm losing my "Run To Cursor" and "Set Next Statement" options, which I frequently use. I'm not at all sure what that's about. I can still edit the code "on the fly" (pause mode), but that's not so good.

    Hmmm ... ok, it's not perfect. I still think I'll try it and see how things go. At this point, I'm too committed. Also, I like that ComCtl32.dll keeps track of what's subclassed rather than me having to do it, as evidenced by no hWndOrig() arrays (or collections) in my subclassing module.

    Sighs,
    Elroy

    EDIT1: Just a further FYI. I tested both of the above scenarios, and the subclassed procedure is NOT getting called with WM_DESTROY, which is what's causing the crash. It's like they're both more similar to executing an END statement than normal execution.
    Last edited by Elroy; Apr 21st, 2017 at 02:04 PM.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  12. #12
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    Interestingly, in the first scenario, even if I click "Debug", I'm losing my "Run To Cursor" and "Set Next Statement" options, which I frequently use. I'm not at all sure what that's about. I can still edit the code "on the fly", but that's not so good.
    If you see the yellow highlighting, you can click and drag (from the IDE window's left border) the yellow arrow and move it to the next line or wherever else in the routine you need to go.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  13. #13
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    Elroy, don't spend too much time looking for the perfect fix if wanting to stay with the common controls subclassing APIs.

    If you are using subclassing, you'll know not to hit end. You'll know you can move from the offending line to get out of the routine and stave off a crash until you can shut down normally.

    If you are posting a project where subclassing is in use, simply warn any potential onlookers what End/Stop can do. You can optionally turn off subclassing while in IDE but demand it when compiled. A simple routine looks something like this. Debug statements are not compiled:

    Code:
    Private Function pvIsNotCompiled(Value As Long) As Boolean
        Value = 1 ' set to any non-zero value that means something to your calling routine
        pvIsNotCompiled = True
    End Function
    
    >> now in your routines where you may want to skip subclassing for IDE (temporarily or semi-permanently...
    
        Dim lValue As Long   ' within routine that initiates subclassing
        ....
        Debug.Assert pvIsNotCompiled(lValue)  ' rem out this line to allow subclassing in IDE
        If lValue Then Exit Sub/Function
        ...
    edited: didn't use the same function name, but here is a copy & paste from one of my projects informing users of the risk
    Code:
    ....
        Debug.Assert pvIsUncompiled(lValue) ' don't subclass in IDE; rem this line out if you wish, just don't hit STOP
        If lValue = 1& Then
            If MsgBox("Subclassing will begin to restrict form sizing." & vbCrLf & _
                "Click YES to allow subclassing and never press the END button." & vbCrLf & _
                "Click NO to prevent subclassing." & vbCrLf & vbCrLf & _
                "Note: This is not displayed when compiled." & vbCrLf & "You can stop displaying this by " & _
                "commenting out the Debug.Assert line in modWork.SetSizeRestrictions, allowing subclassing in IDE.", vbYesNo + vbInformation, "Confirmation") = vbNo Then Exit Function
        End If
    ...
    Last edited by LaVolpe; Apr 21st, 2017 at 02:33 PM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  14. #14

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    Hi LaVolpe,

    Yeah, I was previously doing most of that before I changed over to comctl32.dll. And yeah, I virtually never hit "End" on the runtime-error window because I've probably got databases and all kinds of other things open that I'd like to shut down normally.

    Regarding doing an InIDE() check, I'm not so keen on that one. I'd rather run as "close as possible" to a compiled program while in the IDE. That way, I can catch any/all bugs that users may bump into.

    Also, I didn't say it earlier, but I very seldom use modal forms. For all my "involved" forms, they're virtually never modal. There is one spot that's an exception to that, and you've just explained why that spot crashed when I hit the "Stop" button. And, truth be told, I quite seldom hit the "Stop" button either. However, at times, it's nice to have that option. It's also nice to have a good understanding of this stuff.

    All The Best,
    Elroy
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  15. #15
    PowerPoster
    Join Date
    Feb 2017
    Posts
    4,996

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    What about Shift+F9?

    One of the worse things that I have when the subclasser is in the same program is the inability to check the stack calls, to trace from where the program got there.
    If I hit Shift+F9(*) to see it, I cannot go back to the code any more, I need to close VB6 from the task manager.

    (*) Edit: I meant Ctrl+L, but also hitting Shift+F9 to check a variable value has the same effect.
    Last edited by Eduardo-; Apr 22nd, 2017 at 04:07 PM.

  16. #16

  17. #17
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    And if you really want safe IDE subclassing, as mentioned earlier, Thunks work extremely well without relying on an activex dll or another 3rd party dll. I personally am quite comfortable with subclassing gotchas and don't feel the need for a class like "the trick" offers, but it would offer a nearly 100% IDE-safe environment for subclassing. If he's offering it, you don't need to learn ASM to roll your own. Its not gonna fix that CopyMemory call to an invalid pointer but that's a different topic.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  18. #18

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    Wait ... CopyMemory to an invalid pointer?

    Code:
    
            CopyMemory MMI, ByVal lParam, LenB(MMI)
            '
            MMI.ptMinTrackSize.x = PelWidth
            MMI.ptMaxTrackSize.x = PelWidth
            '
            CopyMemory ByVal lParam, MMI, LenB(MMI)
    
    Somewhere in there? That's really old code (admittedly cut down somewhat for the example), but it seems to work.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  19. #19

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    Also, if I'm going to insert some machine-code, I've got to keep track of what's been subclassed. I actually thought about this.

    Is there some way to get comctl32.dll to enumerate what's been subclassed? That would be fantastic.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  20. #20
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: Detecting when IDE Stop button has been clicked

    Quote Originally Posted by The trick View Post
    Try that:
    Code:
    Option Explicit
    
    Private Declare Function FindWindow Lib "user32" _
                             Alias "FindWindowA" ( _
                             ByVal lpClassName As String, _
                             ByVal lpWindowName As String) As Long
    Private Declare Function SetWindowLong Lib "user32" _
                             Alias "SetWindowLongA" ( _
                             ByVal hWnd As Long, _
                             ByVal nIndex As Long, _
                             ByVal dwNewLong As Long) As Long
    Private 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
    
    Private Const GWL_WNDPROC   As Long = (-4)
    
    Private pfnPrevProc     As Long
    Private hWndIDE         As Long
    
    Public Function HijackStopButton() As Boolean
    
        hWndIDE = FindWindow("wndclass_desked_gsk", vbNullString)
        If hWndIDE = 0 Then Exit Function
        
        pfnPrevProc = SetWindowLong(hWndIDE, GWL_WNDPROC, AddressOf WndProc)
        
        HijackStopButton = pfnPrevProc
        
    End Function
    
    Public Sub RestoreStopButtonBehavior()
        
        If pfnPrevProc = 0 Or hWndIDE = 0 Then Exit Sub
        
        SetWindowLong hWndIDE, GWL_WNDPROC, pfnPrevProc
        
    End Sub
    
    Private Function WndProc( _
                     ByVal hWnd As Long, _
                     ByVal lMsg As Long, _
                     ByVal wParam As Long, _
                     ByVal lParam As Long) As Long
                         
        If lMsg = &H1044 And wParam = &H33 Then
        
            MsgBox "Stop button was pressed", vbInformation
            RestoreStopButtonBehavior
            
        Else
        
            WndProc = CallWindowProc(pfnPrevProc, hWnd, lMsg, wParam, lParam)
            
        End If
     
    End Function
    When you press "Stop" it'll show message and you can handle the needed things. The second pressing ends execution. I don't test it, i just see throught Spy+ windows messages and see that when you select commands on panel or menu it calls 0x1044 message with different second parameter. 0x33 - Stop button.
    what about vb6 ide pauseed message id?not stop id/events for ide?

  21. #21
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    It may not be difficult to check whether you have pressed the "pause or stop key" on the toolbar of the VB6 IDE. How to detect that the state of the IDE has changed?
    1. I loaded subclass subclassing and a settimer timer callback before FORM1 was displayed.
    Code:
    2. Add a button to execute: MSGBOX 33/0
    At this time, the VB6 IDE did not crash. First, an error dialog box popped up, and the settimer callback was still running (Is there any way to detect the error message with an internal method? Here you can stop subclassing, SetWindowLong hwnd1, GWL_WNDPROC, pfnPrevProc)
    3. Manually click the "Debug" button in the error dialog box, and the timer will stop running.
    The pause button (small icon) in the IDE turns gray (how to get this status?)

    (If you don't stop the subclassing, you can't modify the code in the IDE or skip this line, click continue or stop the IDE, and the VB6 ide will crash.
    Last edited by xiaoyao; Jun 18th, 2023 at 08:10 PM.

  22. #22
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    > Is there any way to detect the error message with an internal method?

    Yes, there is but at this time you cannot execute/interpret any VB6 code so it's like the chicken and egg problem i.e. there is no way using VB6 code to detect that IDE/interpreter cannot execute VB6 code anymore.

    You cannot protect the IDE from tripping over executing/interpreting VB6 code in an exceptional state (error shown, Help->About modal dialog shown, end button pressed, run-time to design-time transition, project tear-down) by using any VB6 code to implement this IDE protection.

    cheers,
    </wqw>

  23. #23
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    Quote Originally Posted by wqweto View Post
    > Is there any way to detect the error message with an internal method?

    Yes, there is but at this time you cannot execute/interpret any VB6 code so it's like the chicken and egg problem i.e. there is no way using VB6 code to detect that IDE/interpreter cannot execute VB6 code anymore.

    You cannot protect the IDE from tripping over executing/interpreting VB6 code in an exceptional state (error shown, Help->About modal dialog shown, end button pressed, run-time to design-time transition, project tear-down) by using any VB6 code to implement this IDE protection.

    cheers,
    </wqw>
    when error happend ,if it's show a msgbox message window,now settimer is running,this time to unload subclass,it's maybe successfull

    Forcibly ended manually, this event is easy to handle, just add an on error goto to the subclassing callback process.

    Now the main problem is that when the divisor is 0 and other abnormal situations, you can’t skip this line of code even if you click debug. If you don’t click the card, it will get stuck and cannot run. The only way in this case is to make another timer that can continue to run to automatically detect this error window. Then turn off the subclassing callback.

    Are there any other situations where the exception might be raised?
    Last edited by xiaoyao; Jun 19th, 2023 at 08:06 AM.

  24. #24
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    Quote Originally Posted by xiaoyao View Post
    when error happend ,if it's show a msgbox message window,now settimer is running,this time to unload subclass,it's maybe successfull

    Forcibly ended manually, this event is easy to handle, just add an on error goto to the subclassing callback process.

    Now the main problem is that when the divisor is 0 and other abnormal situations, you can’t skip this line of code even if you click debug. If you don’t click the card, it will get stuck and cannot run. The only way in this case is to make another timer that can continue to run to automatically detect this error window. Then turn off the subclassing callback.

    Are there any other situations where the exception might be raised?
    It looks like you have it all figured out already then, but if you think slapping OERN fixes anything about IDE protection it does not.

    cheers,
    </wqw>

  25. #25

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    Yeah, I do occasionally use OERN in subclassing, but not for IDE protection.

    I'll occasionally have a subclass procedure that makes a call back into a Public procedure in a form. And I always surround that callback with OERN ... OEG0, just to protect in case I forget to put the procedure in my form that's subclassed. Because, if I don't do that, it'll crash the IDE when it errors.

    And yeah, I agree that OERN isn't helping to protect the IDE at all.

    -----------

    Added: In a sense, I guess the scenario I outlined is IDE protection, but probably not the kind that people might think (i.e., it's not protection for forgetting to unsubclass).
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  26. #26
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    Quote Originally Posted by Elroy View Post
    Yeah, I do occasionally use OERN in subclassing, but not for IDE protection.

    I'll occasionally have a subclass procedure that makes a call back into a Public procedure in a form. And I always surround that callback with OERN ... OEG0, just to protect in case I forget to put the procedure in my form that's subclassed. Because, if I don't do that, it'll crash the IDE when it errors.

    And yeah, I agree that OERN isn't helping to protect the IDE at all.

    -----------

    Added: In a sense, I guess the scenario I outlined is IDE protection, but probably not the kind that people might think (i.e., it's not protection for forgetting to unsubclass).
    The main reason for this is that if you accidentally click the pause or stop button, or trigger an ordinary error prompt, it is still possible to handle it perfectly and prevent a crash.
    But for some other possible unexpected crashes, there is still no way to solve it. I tried adding veh, seh and other error handling APIs, but there was no response.
    Running multithreading in the VB6 IDE, I heard that a Chinese person has solved this problem perfectly. To prevent the point from pausing, stopping, or accidentally adding a breakpoint, the multi-threaded operation will get stuck here, and the point will continue to run and it will really crash.
    Now there is a way to HOOK the click event of VB6 IDE (click pause, stop) to call the API first, stop subclassing or stop multi-threading.
    This prevents 90%-99% of crash situations.

    For example thread pools are used for heavy computations. For example, if 10 threads download 10,000 web pages, it will take about 2 minutes to complete.
    Let's say it might take 100-500 milliseconds for one thread to download a web page.
    Then clicking the stop button in the VB6 IDE will prevent the stop. And wait for 10 threads to finish processing the current task before exiting, and it is estimated that all threads will end in 300 milliseconds. In this way, it only stops 300 milliseconds slower, and in most cases it may only increase the time by 5-10 milliseconds. But it can guarantee almost no collapse.

  27. #27
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    Can be used for IDE protection in an additional SetTimer timer that fires every 300 ms. Or install a VB6 IDE plug-in to detect the EBmode value to determine whether the IDE is stopped, paused or running.
    Or write a code in assembly to detect and unload subclassing or close, suspend multithreading.
    Ordinary VB classes are subclassed, and an assembly code is added to each class instance to detect whether the IDE is interrupted or stopped.
    If 20 subclassed objects are running in VB6, for example, the full set of VB6 controls replaces the self-developed control UI.
    If each control is subclassed, the operation may be slower or there may be conflicts.
    If you can protect the IDE, just write an assembly call, and you don't need to add assembly subclassing to each class or control.
    20 controls are just the restoration that needs to process 20 message callbacks. The handle + the original message processing address actually only needs to occupy 20*2*4=80 bytes to save these two values.

    If you accidentally click stop, all variable values ????disappear. For example, in my simple module timer, there are 3 forms and 2 classes that need to return messages.
    public objectList as Collection
    objectList.add form1, objptr(form1)
    objectList.add form2, objptr(form2)
    objectList.add class1, objptr(class1)
    The collection data holding these objects is also lost. Fortunately, you can use SetPropA to save additional data, and this function is still valid when all variable objects disappear.
    For other methods, such as memory mapping and other methods, the class intends to access data by string name, as long as the process does not crash, it can still be read in the VB6 IDE.

    Can subclassing remove certain messages, probably not? Like the control message, the mouse movement generates the most
    WM_MOUSEMOVE
    If you can make a control respond to only a small number of events, the crashes can be greatly reduced.
    For example, VB6 global hotkeys and shortcut keys, unfortunately, he also has to process all messages, but can add code to judge when the registered hotkey is pressed.
    So there is also a lot of capacity to cause crashes. Counting the commonly used callbacks, the safest one is settimer. Because it is set to trigger once per second, it will never be possible to generate hundreds of message events per second.
    Last edited by xiaoyao; Jun 19th, 2023 at 04:32 PM.

  28. #28
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: [RESOLVED] Detecting when IDE Stop button has been clicked

    Quote Originally Posted by xiaoyao View Post
    ...if 10 threads download 10,000 web pages, it will take about 2 minutes to complete.
    I wonder, what kind of Application needs something like that...

    Olaf

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width