msub.bas

来自「提供进程监视[包括启动参数] 进程检测[包括启动参数] 网络连接检测 」· BAS 代码 · 共 66 行

Attribute VB_Name = "mSub"
Option Explicit

Private Const WM_NCDESTROY = &H82
Private Const GWL_WNDPROC = (-4)
Private Const OLDWNDPROC = "OldWndProc"

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 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 uMsg As Long, _
        ByVal wParam As Long, ByVal lParam As Long) As Long

'Public Function SubClass(hWnd As Long) As Boolean
'    Dim lpfnOld As Long
'    Dim fSuccess As Boolean
'
'    If (GetProp(hWnd, OLDWNDPROC) = 0) Then
'        lpfnOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
'        If lpfnOld Then
'            fSuccess = SetProp(hWnd, OLDWNDPROC, lpfnOld)
'        End If
'    End If
'
'    If fSuccess Then
'        SubClass = True
'    Else
'        If lpfnOld Then Call UnSubClass(hWnd)
'        MsgBox "Unable to successfully subclass &H" & Hex(hWnd), vbCritical
'    End If
'End Function

'Public Function UnSubClass(hWnd As Long) As Boolean
'    Dim lpfnOld As Long
'
'    lpfnOld = GetProp(hWnd, OLDWNDPROC)
'    If lpfnOld Then
'        If RemoveProp(hWnd, OLDWNDPROC) Then
'            UnSubClass = SetWindowLong(hWnd, GWL_WNDPROC, lpfnOld)
'        End If
'    End If
'End Function

'Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As _
'        Long, ByVal lParam As Long) As Long
'    Select Case uMsg
'        Case WM_SHNOTIFY        '处理系统消息通告函数
'            Call Form1.NotificationReceipt(wParam, lParam)
'        Case WM_NCDESTROY
'            Call UnSubClass(hWnd)
'            MsgBox "Unubclassed &H" & Hex(hWnd), vbCritical, "WndProc Error"
'    End Select
'
'    WndProc = CallWindowProc(GetProp(hWnd, OLDWNDPROC), hWnd, uMsg, wParam, lParam)
'End Function