A valuable subclass of source code

Article Title: a valuable subclass of source code. Linux is a technology channel of the IT lab in China. Includes basic categories such as desktop applications, Linux system management, kernel research, embedded systems, and open source.
Create an ActiveX DLL project named SmartSubClassLib
　　
'Put the following code in the standard module. The module name is mSmartSubClass.
　　
'----------------------------------------------------
'Module mSmartSubClass
'
'Version... 1.0
'Date... 24 then l 2001
'
'Copyright (C) 2001 android? Andres@vbsmart.com (Pons)
'----------------------------------------------------
　　
'Api declarations:
Option Explicit
　　
Public Const SSC_OLDPROC = "SSC_OLDPROC"
Public Const SSC_OBJADDR = "SSC_OBJADDR"
　　
Private Declare Function GetProp Lib "user32" Alias "GetPropA "(_
ByVal hWnd As Long ,_
ByVal lpString As String) As Long
　　
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory "(_
Destination As Any ,_
Source As Any ,_
ByVal Length As Long)
　　
'Function StartSubclassWindowProc ()
'
'This is the first windowproc that contains es messages
'For all subclassed windows.
'The aim of this function is to just collect The message
'And deliver it to the right SmartSubClass instance.
'
Public Function SmartSubClassWindowProc (_
ByVal hWnd As Long ,_
ByVal uMsg As Long ,_
ByVal wParam As Long ,_
ByVal lParam As Long) As Long
　　
Dim lRet As Long
Dim oSmartSubClass As SmartSubClass
　　
'Get the memory address of the class instance...
LRet = GetProp (hWnd, SSC_OBJADDR)
　　　　
If lRet <> 0 Then
'Osmartsubclass will point to the class instance
'Without incrementing the class reference counter...
CopyMemory oSmartSubClass, lRet, 4
　　　　　　
'Send the message to the class instance...
SmartSubClassWindowProc = oSmartSubClass. WindowProc (hWnd ,_
UMsg, wParam, lParam)
　　
'Remove the address from memory...
CopyMemory oSmartSubClass, 0 &, 4
End If
　　　　
End Function
　　
'Put the following code in the class module. The module name is SmartSubClass.
　　
'----------------------------------------------------
'Class SmartSubClass
'
'Version... 1.0
'Date... 24 then l 2001
'----------------------------------------------------
　　
Option Explicit
　　
'Public event:
Public Event NewMessage (_
ByVal hWnd As Long ,_
ByRef uMsg As Long ,_
ByRef wParam As Long ,_
ByRef lParam As Long ,_
ByRef Cancel As Boolean)
　　
'Private variables:
Private m_hWnds () As Long
　　
'Api declarations:
Private Const GWL_WNDPROC = (-4)
　　
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 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 Declare Function GetProp Lib "user32" Alias "GetPropA "(_
ByVal hWnd As Long ,_
ByVal lpString As String) As Long
　　　　
Private Declare Function SetProp Lib "user32" Alias "SetPropA "(_
ByVal hWnd As Long ,_
ByVal lpString As String ,_
ByVal hData As Long) As Long
　　
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA "(_
ByVal hWnd As Long ,_
ByVal lpString As String) As Long
　　
Private Declare Function IsWindow Lib "user32 "(_
ByVal hWnd As Long) As Long
　　
'
'Function SubClassHwnd
'
'This is the core function in This class.
'You can use it to both subclass and unsubclass a window.
'Once a window is subclassed the event NewMessage will
'Be raised every time a message is sent to the window.
'
Public Function SubClassHwnd (ByVal hWnd As Long ,_
ByVal bSubClass As Boolean) As Boolean
　　
Dim lRet As Long
　　　　
LRet = 0
　　　　
'Make sure that hWnd is a valid window handler...
If IsWindow (hWnd) Then
　　　　
If bSubClass Then
'We are subclassing a window...
　　　　　　　　
'Make sure that the window wasn' t already subclassed...
If GetProp (hWnd, SSC_OLDPROC) = 0 Then
　　　　　　　　
'Now we subclass the window by changing its windowproc
LRet = SetWindowLong (hWnd, GWL_WNDPROC ,_
AddressOf SmartSubClassWindowProc)
　　　　　　　　　　
'Check if we 've managed to subclass...
If lRet <> 0 Then
'Store the old windowproc and the memory
'Address of this class...
SetProp hWnd, SSC_OLDPROC, lRet
SetProp hWnd, SSC_OBJADDR, ObjPtr (Me)
　　　　　　　　　　　　
'Add the window to an internal list
'Subclassed windows...
PAddHwndToList hWnd
End If
End If
Else
'We are unsubclassing a window...
　　　　　　
'Get the old windowproc...
LRet = GetProp (hWnd, SSC_OLDPROC)
　　　　　　　　
If lRet <> 0 Then
'Unsubclass the window...
LRet = SetWindowLong (hWnd, GWL_WNDPROC, lRet)
End If
　　　　　　　　
'Remove any extra information...
RemoveProp hWnd, SSC_OLDPROC
RemoveProp hWnd, SSC_OBJADDR
　　　　　　　　
'Remove the window from the internal list...
PRemoveHwndFromList hWnd
End If
Else
'If hWnd is not a valid window,
'Make sure that there isn' t stored garbage...
RemoveProp hWnd, SSC_OLDPROC
RemoveProp hWnd, SSC_OBJADDR
　　　　　　
PRemoveHwndFromList hWnd
End If
　　　　　
SubClassHwnd = (lRet <> 0)
　　　　
End Function
　　
'
'Function WindowProc
'
'This is the link between the windowproc and the class instance.
'Every time SmartSubClassWindowProc generated es a window message,
'It will post it to the right class instance.
'
Friend Function WindowProc (_
ByVal hWnd As Long ,_
ByVal uMsg As Long ,_
ByVal wParam As Long ,_
ByVal lParam As Long) As Long
　　
Dim lRet As Long
Dim bCancel As Boolean
　　　　
BCancel = False
　　　　
WindowProc = 0
　　　　
'Raise the event NewMessage...
'This will tell the owner of the class variable that
'New message is ready to be processed.
'The owner will be able to cancel The message by setting
'The variable bCancel to True.
RaiseEvent NewMessage (hWnd, uMsg, wParam, lParam, bCancel)
　　　　
'If the event hasn' t been canceled by the owner
'We need to send it to the original windowproc
If Not bCa