VB Shell HOOK 代码

最新推荐文章于 2025-07-07 12:46:38 发布

原创最新推荐文章于 2025-07-07 12:46:38 发布 · 3k 阅读

0 ·

本内容遵循CC 4.0 BY-SA版权协议

标签

#hook #shell #vb #string #function

VB老皇历专栏收录该内容

35 篇文章

订阅专栏

本文介绍了一个使用Visual Basic编写的注册Shell钩子的示例程序，通过此程序可以监听并记录系统级窗口的创建与销毁等事件。文章详细展示了如何通过API函数实现窗口过程的拦截，并将相关信息记录到不同的控件中。

Attribute VB_Name = " Module1 "

Option Explicit

Private Declare Function RegisterShellHook Lib "Shell32" Alias "#181" (ByVal hwnd As Long, ByVal nAction As Long) As Long 'use in 98

Private Declare Function RegisterShellHookWindow Lib "user32" (ByVal hwnd As Long) As Long 'use in NT5

Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (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 GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch 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 RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long

'Powered by barenx

'Private Const HSHELL_WINDOWCREATED = 1 ' 系统级的窗体被创建

'Private Const HSHELL_WINDOWDESTROYED = 2 ' 系统级的窗体即将被关闭

'Private Const HSHELL_ACTIVATESHELLWINDOW = 3 ' SHELL 的主窗体将被激活（本例未用）

'Private Const HSHELL_WINDOWACTIVATED = 4 ' 系统级的窗体被激活

'Private Const HSHELL_GETMINRECT = 5 ' 窗体被最大化或最小化（本例未用）

'Private Const HSHELL_REDRAW = 6 ' Windows 任务栏被刷新（本例未用）

'Private Const HSHELL_TASKMAN = 7 ' 任务列表的内容被选中（本例未用）

'Private Const HSHELL_LANGUAGE = 8 ' 中英文切换或输入法切换（本例未用）

'MSDN

'wParam lParam

'HSHELL_GETMINRECT A pointer to a SHELLHOOKINFO structure.

'HSHELL_WINDOWACTIVATEED The HWND handle of the activated window.

'HSHELL_RUDEAPPACTIVATEED The HWND handle of the activated window.

'HSHELL_WINDOWREPLACING The HWND handle of the window replacing the top-level window.

'HSHELL_WINDOWREPLACED The HWND handle of the window being replaced.

'HSHELL_WINDOWCREATED The HWND handle of the window being created.

'HSHELL_WINDOWDESTROYED The HWND handle of the top-level window being destroyed.

'HSHELL_ACTIVATESHELLWINDOW Not used.

'HSHELL_TASKMAN Can be ignored.

'HSHELL_REDRAW The HWND handle of the window that needs to be redrawn.

'HSHELL_FLASH The HWND handle of the window that needs to be flashed.

'HSHELL_ENDTASK The HWND handle of the window that should be forced to exit.

'HSHELL_APPCOMMAND The APPCOMMAND which has been unhandled by the application or other hooks. See WM_APPCOMMAND and use the message cracker GET_APPCOMMAND_LPARAM(lParam) to crack this parameter.

Private Const HSHELL_WINDOWCREATED = 1

Private Const HSHELL_WINDOWDESTROYED = 2

Private Const HSHELL_ACTIVATESHELLWINDOW = 3

Private Const HSHELL_WINDOWACTIVATED = 4

Private Const HSHELL_GETMINRECT = 5

Private Const HSHELL_REDRAW = 6

Private Const HSHELL_TASKMAN = 7

Private Const HSHELL_LANGUAGE = 8

Private Const HSHELL_SYSMENU = 9

Private Const HSHELL_ENDTASK = 10

Private Const HSHELL_ACCESSIBILITYSTATE = 11

Private Const HSHELL_APPCOMMAND = 12

Private Const HSHELL_WINDOWREPLACED = 13

Private Const HSHELL_WINDOWREPLACING = 14

Private Const HSHELL_HIGHBIT = &H8000

Private Const HSHELL_FLASH = (HSHELL_REDRAW Or HSHELL_HIGHBIT)

Private Const HSHELL_RUDEAPPACTIVATED = (HSHELL_WINDOWACTIVATED Or HSHELL_HIGHBIT)

Private Const GWL_WNDPROC = -4 ' 该索引用来创建窗口类的子类

Private Shell_Hook_Msg_ID As Long

Private LogWinOldProc As Long

Private LogControl As Control

Public Enum mLogControlType

tListBox

tTextBox

tForm

tPictureBox

tLabel

End Enum

Private LogControlType As mLogControlType

' ******************************************************************************

' Routine: RegLogWindow

' Description:

' Created by: barenx

' Machine: asc

' Date-Time: 2006-12-7上午 10:58:48

' Last modification: last_modification_info_here

' ******************************************************************************

Public Function RegLogWindow(ByVal hwnd As Long, ByVal mLogControl As Control, ByVal tLogControlType As mLogControlType) As Boolean

On Error Resume Next

LogControlType = tLogControlType

Dim tmp As Long

Shell_Hook_Msg_ID = RegisterWindowMessage("SHELLHOOK")

RegLogWindow = Shell_Hook_Msg_ID

RegLogWindow = RegLogWindow And (RegisterShellHook(hwnd, 1) Or RegisterShellHookWindow(hwnd)) ' 调用未公开的函数（进行注册）

LogWinOldProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc) ' 实施拦截：在存储了原入口地址的同时，将新地址指向自定义的函数WindowProc

'LogControl = mLogControl

Set LogControl = mLogControl

End Function

' ******************************************************************************

' Routine: UnRegLogWindow

' Description:

' Created by: barenx

' Machine: asc

' Date-Time: 2006-12-7上午 11:08:00

' Last modification: last_modification_info_here

' ******************************************************************************

Public Function UnRegLogWindow(hwnd As Long)

Call RegisterShellHook(hwnd, 0)

Call SetWindowLong(hwnd, GWL_WNDPROC, LogWinOldProc)

End Function

' ******************************************************************************

' Routine: WindowProc

' Description:

' Created by: barenx

' Machine: asc

' Date-Time: 2006-12-7上午 11:08:00

' Last modification: last_modification_info_here

' ******************************************************************************

Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long ' 回调函数

Dim i As Long

Dim m_Out_String As String

Dim recTime As String

Dim recParam As String

If uMsg = Shell_Hook_Msg_ID Then

recTime = Format$(Now(), "YY-MM-DD:HH-NN-SS ") & vbTab & " 0x" & _

Hex$(wParam) & vbTab & " 0x" & _

Hex$(lParam) & vbTab & " "

Select Case wParam

Case HSHELL_WINDOWCREATED

m_Out_String = String$(260, vbNullChar)

i = GetWindowText(lParam, m_Out_String, 260) ' 取窗体的标题

If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed"

m_Out_String = recTime & "HSHELL_WINDOWCREATED" & vbTab & " " & m_Out_String

Case HSHELL_WINDOWDESTROYED

m_Out_String = String$(260, vbNullChar)

i = GetWindowText(lParam, m_Out_String, 260) ' 取窗体的标题

If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed"

m_Out_String = recTime & "HSHELL_WINDOWDESTROYED" & vbTab & " " & m_Out_String

Case HSHELL_ACTIVATESHELLWINDOW

m_Out_String = recTime & "HSHELL_ACTIVATESHELLWINDOW"

Case HSHELL_WINDOWACTIVATED

m_Out_String = String$(260, vbNullChar)

i = GetWindowText(lParam, m_Out_String, 260) ' 取窗体的标题

If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed"

m_Out_String = recTime & "HSHELL_WINDOWACTIVATEED" & vbTab & " " & m_Out_String

Case HSHELL_GETMINRECT

m_Out_String = recTime & "HSHELL_GETMINRECT"

Case HSHELL_REDRAW

m_Out_String = String$(260, vbNullChar)

i = GetWindowText(lParam, m_Out_String, 260) ' 取窗体的标题

If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed"

m_Out_String = recTime & "HSHELL_REDRAW" & vbTab & " " & m_Out_String

Case HSHELL_TASKMAN

m_Out_String = recTime & "HSHELL_TASKMAN"

Case HSHELL_LANGUAGE

m_Out_String = recTime & "HSHELL_LANGUAGE"

Case HSHELL_SYSMENU

m_Out_String = recTime & "HSHELL_SYSMENU"

Case HSHELL_ENDTASK

m_Out_String = String$(260, vbNullChar)

i = GetWindowText(lParam, m_Out_String, 260) ' 取窗体的标题

If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed"

m_Out_String = recTime & "HSHELL_ENDTASK" & vbTab & " " & m_Out_String

Case HSHELL_ACCESSIBILITYSTATE

m_Out_String = recTime & "HSHELL_ACCESSIBILITYSTATE"

Case HSHELL_APPCOMMAND

m_Out_String = recTime & "HSHELL_APPCOMMAND"

Case HSHELL_WINDOWREPLACED

m_Out_String = String$(260, vbNullChar)

i = GetWindowText(lParam, m_Out_String, 260) ' 取窗体的标题

If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed"

m_Out_String = recTime & "HSHELL_WINDOWREPLACED" & vbTab & " " & m_Out_String

Case HSHELL_WINDOWREPLACING

m_Out_String = String$(260, vbNullChar)

i = GetWindowText(lParam, m_Out_String, 260) ' 取窗体的标题

If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed"

m_Out_String = recTime & "HSHELL_WINDOWREPLACING" & vbTab & " " & m_Out_String

Case HSHELL_FLASH

m_Out_String = String$(260, vbNullChar)

i = GetWindowText(lParam, m_Out_String, 260) ' 取窗体的标题

If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed"

m_Out_String = recTime & "HSHELL_FLASH" & vbTab & " " & m_Out_String

Case HSHELL_RUDEAPPACTIVATED

m_Out_String = String$(260, vbNullChar)

i = GetWindowText(lParam, m_Out_String, 260) ' 取窗体的标题

If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed"

m_Out_String = recTime & "HSHELL_RUDEAPPACTIVATEED" & vbTab & " " & m_Out_String

End Select

If Len(m_Out_String) Then Call m_WriteToControl(m_Out_String)

Else

WindowProc = CallWindowProc(LogWinOldProc, hwnd, uMsg, wParam, lParam)

End If

End Function

' ******************************************************************************

' Routine: m_WriteToControl

' Description:

' Created by: barenx

' Machine: asc

' Date-Time: 2006-12-7上午 11:08:00

' Last modification: last_modification_info_here

' ******************************************************************************

Private Function m_WriteToControl(t_str As String)

Select Case LogControlType

Case tListBox

LogControl.AddItem t_str

Case tTextBox

LogControl.Text = LogControl.Text & vbCrLf & t_str

Case tForm, tPictureBox

LogControl.Print t_str

Case tLabel

LogControl.Caption = t_str

End Select

End Function