Results 1 to 28 of 28

Thread: [VB6] - Class for subclassing windows and classes.

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    [VB6] - Class for subclassing windows and classes.



    THE DESCRIPTION IS OUT OF DATE. SEE DESCRIPTION ON GITHUB.

    Hello everyone! Developed a class with which you can work with subclassing. The class has an event WndProc, which is caused when receiving the message window. You can also put on a class subclassing windows. There are methods to pause subclassing and its removal, as well as information on subclassing. Work very convenient, because stop button can stop the project without any consequences. Run better through "Start with full compile", because This will prevent crashes, a failed compilation. I imagine even brought a separate button next to the regular compilation and use it.

    A little bit about working with the class. To install subclassing the window method is called Hook, with a handle of the window. If the method returns True, then subclassing installed. Event processing "WndProc", you can change the behavior of the window. In argument Ret can transfer the return value if you want to call the procedure by default, then you need to pass in the argument DefCall True.
    To install windows subclassing a group (class), you need to call a method HookClass, passing a handle window whose class you need to intercept. On success, the method returns True. Subclassing will operate from next window created in this class, ie, on the parameter passed subclassing will not work. Also by default, this type of subclassing suspended. I did it because of the fact that if you do not process messages create windows properly, then the project will not start with error Out of memory.
    • To remove the need to call a method of subclassing Unhook, Returns True on success.
    • To pause subclassing provides methods and PauseSubclass ResumeSubclass, Returns True on success.
    • HWnd property returns the handle of the window, which is set subclassing (for the installation of windows subclassing a class, returns the passed parameter).
    • IsSubclassed property is designed to determine if it is installed or not subclassing.
    • IsClass property returns True, if mounted on a class subclassing windows.
    • IsPaused property returns True, if subclassing suspended.

    Version 1.1:
    • added method CallDef, allows you to call the previous window procedure for a given message.
    • added property Previous, which returns the address of the previous window procedure.
    • added property Current, which returns the address of the current window procedure.

    Version 2.0:
    • remove the methods that work with the window classes.
    • class works more stable because it uses the other subclassing method (SetWindowSubclass).

    Version 2.1:
    • more stable works. Don't worry about the errors, stop-button, editing code during execution.

    Version 2.2:
    • more stable works. Fix previous bugs.

    For the test I did a small project, which uses subclassing opportunities. Set the timer (SetTimer), replacement for the standard context menu textbox restriction on resizing forms, capturing the "arrival" / "left" mouse over / out of control.

    Version 3.0:
    • more stable works. Fix previous bugs;
    • project is moved to Github.


    Project on GitHub.
    Last edited by The trick; Nov 20th, 2021 at 06:22 PM.

  2. #2

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Class for subclassing windows and classes.

    [not relevant]
    Last edited by The trick; Nov 20th, 2021 at 06:13 PM.

  3. #3

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Class for subclassing windows and classes.

    [not relevant]
    Last edited by The trick; Nov 20th, 2021 at 06:14 PM.

  4. #4

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

    Re: [VB6] - Class for subclassing windows and classes.

    I like that you have it encompassed in a single class, but I hate the fact that it has to use a modified assembly stub to do it.
    Also the Overhead of using COM Events to do the callback makes me cringe, but modern processors probably make that point moot.
    Last edited by DEXWERX; Jun 25th, 2015 at 10:42 AM. Reason: Deleted link to someone elses method

  6. #6

  7. #7
    New Member Dimio's Avatar
    Join Date
    Nov 2015
    Posts
    2

    Re: [VB6] - Class for subclassing windows and classes.

    Your work is very good... anyway I think to have found a little bug.
    1. Create an Usercontrol
    2. Use your class to subclass the main form.
    3. Compile the project
    When you close the program it crashes.
    Attached Files Attached Files

  8. #8

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

    Re: [VB6] - Class for subclassing windows and classes.

    @Trick. Don't know if this applies to the project. But if multiple instances of subclassing is in play and the subclassing is not released in the opposite order, exactly, crashes occur. This has always been an issue with old-school subclassing ... the subclassing chain gets broken. This can occur in a VB project rather easily if VB does not unload the controls in opposite order that the controls first started subclassing. In other words, more times than not, it is likely an issue with the user not the code/thunk. Just my two cents.

    Edited: Ignore my reply, should've taken the couple minutes to download & review the sample project before I replied. Apologize.
    Last edited by LaVolpe; Nov 29th, 2015 at 02:32 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}

  10. #10

  11. #11
    New Member Dimio's Avatar
    Join Date
    Nov 2015
    Posts
    2

    Re: [VB6] - Class for subclassing windows and classes.

    The crash occurs when you try to destroy the heap.
    If you replace:

    Code:
    Private Sub Class_Terminate()
        If hHeap = 0 Then Exit Sub
        UnHook
        If CountHooks = 1 Then
            HeapDestroy hHeap
            hHeap = 0
            SaveCurHeap
        Else
            HeapFree hHeap, HEAP_NO_SERIALIZE, ByVal lpAsm
        End If
    End Sub
    with this:

    Code:
    Private Sub Class_Terminate()
        If hHeap = 0 Then Exit Sub
        UnHook
        HeapFree hHeap, HEAP_NO_SERIALIZE, ByVal lpAsm
        hHeap = 0
    End Sub
    The crash don't occours anymore, although it could cause additional collateral damage.

  12. #12

  13. #13

  14. #14
    Member Dragokas's Avatar
    Join Date
    Aug 2015
    Location
    Ukraine
    Posts
    740

    Re: [VB6] - Class for subclassing windows and classes.

    Anatolii, thank you very much.
    There is no more crashes after closing my application.
    Malware analyst, VirusNet developer, HiJackThis+ author || my CodeBank works

  15. #15
    Member Dragokas's Avatar
    Join Date
    Aug 2015
    Location
    Ukraine
    Posts
    740

    Re: [VB6] - Class for subclassing windows and classes.

    Hi, The Trick !

    Please, remove line:
    Code:
    DefCall = True
    from your project
    Malware analyst, VirusNet developer, HiJackThis+ author || my CodeBank works

  16. #16

  17. #17
    Member Dragokas's Avatar
    Join Date
    Aug 2015
    Location
    Ukraine
    Posts
    740

    Re: [VB6] - Class for subclassing windows and classes.

    Oh, sorry. Now I noticed that you change 'DefCall' calling model on this version. So, I should use DefCall = false on my window message routine for each caught Msgs where I need it.
    I just replaced old 2.0 code to 2.2. without paying attention on new rules of using.
    Malware analyst, VirusNet developer, HiJackThis+ author || my CodeBank works

  18. #18
    New Member
    Join Date
    Aug 2016
    Posts
    5

    Re: [VB6] - Class for subclassing windows and classes.

    Hi,

    There is a little bug

    1. Include a CommandButton -> Command1
    2. Put “End” on “Click” event
    3. Compile the project

    Private Sub Command1_Click()
    End
    End Sub

    When you click on a button (After compiling - Project1.exe) the program it crashes.

    Can you fix it?

  19. #19
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,857

    Re: [VB6] - Class for subclassing windows and classes.

    Never ever use END in your program, this causes an abnormal termination of the application.

  20. #20
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,817

    Re: [VB6] - Class for subclassing windows and classes.

    Yes, without a relatively nasty hack, involving the insertion of machine code in the executable's shutdown procedure, there's no way to fix the damage that an End statement can do.

    Quote from MSDN:
    The End statement stops code execution abruptly, without invoking the Unload, QueryUnload, or Terminate event, or any other Visual Basic code. Code you have placed in the Unload, QueryUnload, and Terminate events of forms and class modules is not executed. Objects created from class modules are destroyed, files opened using the Open statement are closed, and memory used by your program is freed. Object references held by other programs are invalidated.

    The End statement provides a way to force your program to halt. For normal termination of a Visual Basic program, you should unload all forms. Your program closes as soon as there are no other programs holding references to objects created from your public class modules and no code executing.

    (emphasis added)
    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.

  21. #21
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    323

    Re: [VB6] - Class for subclassing windows and classes.

    in one of my project, which is an addin project of msword
    it crash sometimes

  22. #22
    Junior Member
    Join Date
    Sep 2019
    Posts
    22

    Re: [VB6] - Class for subclassing windows and classes.

    @The trick
    You probably shouldn't use HeapLock and HeapUnlock when creating the heap with the HEAP_NO_SERIALIZE flag as stated in the MSDN:
    If the HeapLock and HeapUnlock functions are called on a heap created with the HEAP_NO_SERIALIZE flag, the results are undefined.

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

    Re: [VB6] - Class for subclassing windows and classes.

    Quote Originally Posted by Caine View Post
    @The trick
    You probably shouldn't use HeapLock and HeapUnlock when creating the heap with the HEAP_NO_SERIALIZE flag as stated in the MSDN:
    This quote is so out of context it got me baffled at first. The idea is that only if HeapLock and HeapUnlock are called from multiple threads them using HEAP_NO_SERIALIZE flag will *not* guard the heap against corruption so the results are undefined.

    If you are not using the heap from multiple threads (as is usually the case with every VB6 application) then using HEAP_NO_SERIALIZE allows for a small performance optimization by not using primitives for serialization of these threads when accessing the heap's internal structures.

    "Serialized access" means one after the other, not both threads simultaneously modifying the (same) heap management structure.

    cheers,
    </wqw>

  24. #24
    Junior Member
    Join Date
    Sep 2019
    Posts
    22

    Re: [VB6] - Class for subclassing windows and classes.

    @wqweto
    I understand the part with the performance optimization. I just don't get this part:
    Code:
    Private Function GetFlagPointer() As Long
        Dim he  As PROCESS_HEAP_ENTRY
        HeapLock hHeap
        Do While HeapWalk(hHeap, he)
            If he.wFlags And PROCESS_HEAP_ENTRY_BUSY Then GetFlagPointer = he.lpData: Exit Function
        Loop
        HeapUnlock hHeap
    End Function
    MSDN states that every HeapLock should be balanced with a HeapUnlock. On the other hand, since no other threads will attempt to access the heap that's probably OKish.

    Here's a more complete quote:
    Setting HEAP_NO_SERIALIZE eliminates mutual exclusion on the heap. Without serialization, two or more threads that use the same heap handle might attempt to allocate or free memory simultaneously, which may cause corruption in the heap. Therefore, HEAP_NO_SERIALIZE can safely be used only in the following situations:

    The process has only one thread.
    The process has multiple threads, but only one thread calls the heap functions for a specific heap.
    The process has multiple threads, and the application provides its own mechanism for mutual exclusion to a specific heap.

    If the HeapLock and HeapUnlock functions are called on a heap created with the HEAP_NO_SERIALIZE flag, the results are undefined.
    Since both HeapCreate and HeapAlloc used the HEAP_NO_SERIALIZE flag, the wording here sounds to me like calling HeapLock and HeapUnlock might work or not.

    If I understood you correctly, you're saying that calling HeapLock and HeapUnlock will just work but they won't really protect the heap from corruption with the flag specified? I get that the point is probably moot since this is only called from one thread but I'm trying to understand what's happening here.

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

    Re: [VB6] - Class for subclassing windows and classes.

    Quote Originally Posted by Caine View Post
    If I understood you correctly, you're saying that calling HeapLock and HeapUnlock will just work but they won't really protect the heap from corruption with the flag specified? I get that the point is probably moot since this is only called from one thread but I'm trying to understand what's happening here.
    What I'm saying is that HEAP_NO_SERIALIZE flag is a safe optimization when heap is *not* accessed/locked/performed any modifications of its internal structs by multiple threads simultaneously which is the case in 99% of all VB6 applications (rarely there might be in-process multi-threading implemented).

    cheers,
    </wqw>

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

    Re: [VB6] - Class for subclassing windows and classes.

    Quote Originally Posted by The trick View Post
    The source code of the test:
    Code:
    Option Explicit
     
    ' Тест модуля clsTrickSubclass.cls
    ' В данном модуле с помощью сабклассинга сделаем:
    ' - Ограничение на минимальный и максимальный размер формы
    ' - Вместо стандартного контекстного меню текстбокса вставим свое
    ' - Будем отлавливать сообщение покидания мышью контрола (MouseLeave) и захода (MouseEnter)
    ' - Поставим таймер на окно
     
    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
    Private Type tagTRACKMOUSEEVENT
        cbSize As Long
        dwFlags As Long
        hwndTrack As Long
        dwHoverTime As Long
    End Type
     
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function TrackMouseEvent Lib "user32" (ByRef lpEventTrack As tagTRACKMOUSEEVENT) As Long
    Private Declare Function vbaObjSetAddref Lib "MSVBVM60.DLL" Alias "__vbaObjSetAddref" (dstObject As IUnknown, ByVal srcObjPtr As Long) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) 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 SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
     
    Private Const GWL_USERDATA      As Long = &HFFFFFFEB
    Private Const WM_GETMINMAXINFO  As Long = &H24
    Private Const WM_CONTEXTMENU    As Long = &H7B
    Private Const WM_NCCALCSIZE     As Long = &H83
    Private Const WM_MOUSEMOVE      As Long = &H200
    Private Const WM_MOUSELEAVE     As Long = &H2A3
    Private Const WM_TIMER          As Long = &H113
    Private Const TME_QUERY         As Long = &H40000000
    Private Const TME_LEAVE         As Long = &H2
     
    Dim WithEvents HookForm     As clsTrickSubclass         ' Для сабклассинга формы
    Dim WithEvents HookText     As clsTrickSubclass         ' Для сабклассинга текстбокса
    Dim WithEvents HookClass    As clsTrickSubclass         ' Для сабклассинга всех кнопок
     
    Private Sub cmdButton_Click(Index As Integer)
        If Index = 0 Then
            If HookClass.IsPaused Then
                cmdButton(0).Caption = "Pause"
                HookClass.ResumeSubclass
            Else
                cmdButton(0).Caption = "Run"
                HookClass.PauseSubclass
            End If
        End If
    End Sub
     
    Private Sub Form_Load()
        Dim i As Long
        
        Set HookForm = New clsTrickSubclass
        Set HookText = New clsTrickSubclass
        Set HookClass = New clsTrickSubclass
        HookForm.Hook Me.hwnd                   ' Сабклассируем форму
        HookText.Hook txtTest.hwnd              ' Сабклассируем текстбокс
        HookClass.HookClass cmdButton(0).hwnd   ' Сабклассируем все последующие кнопки
        HookClass.ResumeSubclass                ' Т.к. по умолчанию глобальный сабклассинг приостановлен
        
        ' Все эти кнопки и вообще любые кнопки (CommandButton), которые мы будем добавлять будут отрабатывать в процедуре HookClass_WndProc
        For i = 1 To 5
            Load cmdButton(i)
            SetWindowLong cmdButton(i).hwnd, GWL_USERDATA, ObjPtr(cmdButton(i))
            cmdButton(i).Caption = Array("Global", "subclass", "by", "The trick", "2014")(i - 1)
        Next
        
        SetTimer hwnd, 1, 100, 0
    End Sub
     
    Private Sub Form_Resize()
        Dim cmd As CommandButton
        Dim w   As Long
        Dim h   As Long
        Dim y   As Long
        Dim x   As Long
        
        If WindowState = vbMinimized Then Exit Sub
        
        txtTest.Move 5, 5, ScaleWidth - 10, 200
        
        y = txtTest.Top + txtTest.Height + 5: x = 5
        w = (ScaleWidth - 10) / cmdButton.Count * 2: h = (ScaleHeight - y - 5) / 2
        
        For Each cmd In cmdButton
            cmd.Visible = True: cmd.Move x, y, w - 4, h - 4: x = x + w
            If x > ScaleWidth - w Then x = 5: y = y + h
        Next
    End Sub
     
    ' Процедура обработки сообщений кнопок
    Private Sub HookClass_WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, Ret As Long, DefCall As Boolean)
        Dim cmd As CommandButton
        Select Case Msg
        Case WM_MOUSELEAVE                  ' Мышь вышла за пределы контрола
            vbaObjSetAddref cmd, GetWindowLong(hwnd, GWL_USERDATA)
            cmd.FontUnderline = False
            DefCall = True
        Case WM_MOUSEMOVE
            Dim tme As tagTRACKMOUSEEVENT
            vbaObjSetAddref cmd, GetWindowLong(hwnd, GWL_USERDATA)
            tme.cbSize = Len(tme)
            tme.dwFlags = TME_QUERY
            TrackMouseEvent tme
            If tme.hwndTrack <> hwnd Then
                tme.dwFlags = TME_LEAVE     ' Мышь вошла в контрол
                tme.hwndTrack = hwnd
                TrackMouseEvent tme
                cmd.FontUnderline = True
            End If
            DefCall = True
        Case Else: DefCall = True
        End Select
    End Sub
    ' Процедура обработки сообщений формы
    Private Sub HookForm_WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, Ret As Long, DefCall As Boolean)
        Select Case Msg
        Case WM_TIMER
            If wParam = 1 Then
                Caption = Right(Caption, Len(Caption) - 1) & Left(Caption, 1)
                Exit Sub
            End If
            DefCall = True
        Case WM_GETMINMAXINFO               ' Обрабатываем минимальный и максимальный размер формы
            Dim MinMax As MINMAXINFO
            CopyMemory MinMax, ByVal lParam, Len(MinMax)
            MinMax.ptMaxTrackSize.x = 500   ' Максимальный размер 500х500
            MinMax.ptMaxTrackSize.y = 500
            MinMax.ptMinTrackSize.x = 350   ' Минимальный размер 350х350
            MinMax.ptMinTrackSize.y = 350
            CopyMemory ByVal lParam, MinMax, Len(MinMax)
        Case Else: DefCall = True
        End Select
    End Sub
    ' Процедура обработки сообщений текстбокса
    Private Sub HookText_WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, Ret As Long, DefCall As Boolean)
        Select Case Msg
        Case WM_CONTEXTMENU                 ' Вставляем свое меню
            PopupMenu mnuPopup
        Case Else: DefCall = True
        End Select
    End Sub
    Good luck!

    Attachment 123641
    how to hook for usercontrol?
    I WANT TO GET MOUSE EVENT WM_LBUTTONDOWN ,In the form design mode, the mouse event of the custom control

    how to make SSTab by vb6 usercontrol?-VBForums
    https://www.vbforums.com/showthread....b6-usercontrol
    Last edited by xiaoyao; May 12th, 2021 at 11:32 AM.

  27. #27

  28. #28
    Member Dragokas's Avatar
    Join Date
    Aug 2015
    Location
    Ukraine
    Posts
    740

    Re: [VB6] - Class for subclassing windows and classes.

    Cool! Thanks.
    Malware analyst, VirusNet developer, HiJackThis+ author || my CodeBank works

Tags for this Thread

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