⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 msub.bas

📁 提供进程监视[包括启动参数] 进程检测[包括启动参数] 网络连接检测 SSDT检测 BHO检测 IE插件检测 自启动项检测 -------程序部分[使用彩字显示] 包
💻 BAS
字号:
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


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -