'模å------------------------------
Option Explicit
'对è¯æ¡å¥æ
Public hwndMsgBox As Long
'èªå®ä¹ç±»å
Public Type CUSTOM_MSG_PARAMS
hOwnerThread As Long
hOwnerWindow As Long
dwStyle As Long
bUseTimer As Boolean
dwTimerDuration As Long
dwTimerInterval As Long
dwTimerExpireButton As Long
dwTimerCountDown As Long
sTitle As String
sPrompt As String
End Type
Public Cmp As CUSTOM_MSG_PARAMS
'常æ°
Public Const MB_ICONINFORMATION As Long = &H40&
Private Const MB_ABORTRETRYIGNORE As Long = &H2&
Private Const MB_TASKMODAL As Long = &H2000&
Private Const MB_YESNOCANCEL As Long = &H3&
'Windows MessageBox è¿åå¼
Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7
'è¿é¨åæç¨æ·èªå®ä¹å¸¸éï¼æ¥è¡¨ç¤ºæé®çå¨ä½ï¼å¨ç°æçMessageBox常éçåºç¡ä¸
Public Const MB_SELECTBEGINSKIP As Long = MB_YESNOCANCEL
Public Const IDSELECTYES = IDYES
Public Const IDSELECTNO = IDNO
Public Const IDSELECTCANCEL = IDCANCEL
Public Const IDPROMPT = &HFFFF&
'å
¶å®api常æ°
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
'ç¨æ·èªå®ä¹ç±»åå¨hookæ¶ä¼ éæ°æ®ã
Private Type MSGBOX_HOOK_PARAMS
hwndOwner As Long
hHook As Long
End Type
'åé
Private MHP As MSGBOX_HOOK_PARAMS
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
'Public Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
'Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function PutFocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long
Public Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Function MsgBoxHookProc(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'å½messagebox æ¾ç¤ºæ¶ï¼æ们æ¹åæ é¢ï¼æ示信æ¯åæé®caption
If uMsg = HCBT_ACTIVATE Then
'å¨HCBT_ACTIVATEæ¶æ¯ä¸ï¼
'wparamåæ°æ¯messageboxçå¥æï¼å¨timeräºä»¶ä¸éè¦ä½¿ç¨
hwndMsgBox = wParam
'设置messageboxçæé®caption
SetDlgItemText wParam, IDSELECTYES, "æ¯(&Y)"
SetDlgItemText wParam, IDSELECTNO, "å¦(&N)"
SetDlgItemText wParam, IDSELECTCANCEL, "åæ¶"
'è±é©
UnhookWindowsHookEx MHP.hHook
End If
'æ£å¸¸å¤ç继ç»
MsgBoxHookProc = False
End Function
Public Function TimedMessageBoxH(Cmp As CUSTOM_MSG_PARAMS) As Long
Dim hInstance As Long
Dim hThreadId As Long
'æé©
hInstance = GetWindowLong(Cmp.hOwnerThread, GWL_HINSTANCE)
hThreadId = GetCurrentThreadId()
'å¡«å MSGBOX_HOOK_PARAMS ç»æå¼
'å°hook设为å
¶ä¸ä¸ä¸ªåæ°ï¼æ们就è½æªè·æ¶æ¯å¹¶è½æä½å¯¹è¯æ¡ã
With MHP
.hwndOwner = Cmp.hOwnerWindow
.hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, hInstance, hThreadId)
End With
'设置åè®¡æ° 0
Cmp.dwTimerCountDown = 0
'å¦æbUseTimer, é£ä¹å°±enable timer. å 为
'MessageBox API å MsgBox 类似ï¼å¿
é¡»å
³éæè½æ§è¡ä¸ä¸æ¡è¯å¥ã
'对è¯æ¡ä¸æ¾ç¤ºï¼timerçäºä»¶å°±å¨ææ´æ°message boxçæ¾ç¤º
With Form1.Timer1
.Interval = Cmp.dwTimerInterval
.Enabled = Cmp.bUseTimer
End With
'è°ç¨ MessageBox API
TimedMessageBoxH = MessageBox(Cmp.hOwnerWindow, Cmp.sPrompt, Cmp.sTitle, Cmp.dwStyle)
'timerä¸éè¦äº
Form1.Timer1.Enabled = False
End Function
'çªå£-------------------------
'form1ä¸æ·»å text1ï¼command1ï¼timer1
Option Explicit
Private Sub Command1_Click()
'æ¾ç¤ºmessagebox,
'ä¼ é CUSTOM_MSG_PARAMSç»æ
With Cmp
.sTitle = "åè®¡æ¶ MessageBox Hook Demo"
.sPrompt = "è¦é©¬ä¸æ§è¡ï¼éæ©æ¯." & vbCrLf & "æç¹å»å¦." & vbCrLf & vbCrLf & "å°å¨ 10 åèªå¨å
³éï¼" & Space$(20)
.dwStyle = MB_SELECTBEGINSKIP Or MB_ICONINFORMATION
.bUseTimer = True 'å¦ætrueï¼timerä¼æ´æ°æ¾ç¤ºæ¯ dwTimerInterval
.dwTimerDuration = 10 'çå¾
ç§æ°
.dwTimerInterval = 1000 'å计æ¶ç§æ°
.dwTimerExpireButton = IDSELECTNO 'timeoutæ§è¡é»è®¤å¨ä½
.dwTimerCountDown = 0 '
.hOwnerThread = Me.hwnd 'è°ç¨çªå£å¥æ
.hOwnerWindow = Me.hwnd 'å
å«çªå£(me.hwnd or desktop).
End With
Select Case TimedMessageBoxH(Cmp)
Case IDSELECTYES: Text1.Text = "å¨ timeout å æ¯ æé®è¢«æä¸"
Case IDSELECTNO: Text1.Text = "æä¸ å¦ æè
timeout "
Case IDSELECTCANCEL: Text1.Text = " timeout å æä¸ åæ¶"
End Select
End Sub
Private Sub Timer1_Timer()
Dim hWndTargetBtn As Long
If hwndMsgBox <> 0 Then
'计æ°
Cmp.dwTimerCountDown = Cmp.dwTimerCountDown + 1
'æ´æ°æ示计æ¶ä¿¡æ¯
SetDlgItemText hwndMsgBox, IDPROMPT, _
"è¦é©¬ä¸æ§è¡ï¼éæ©æ¯." & vbCrLf & "æç¹å»å¦." & vbCrLf & vbCrLf & "å°å¨ " & CStr(10 - Cmp.dwTimerCountDown) & " ç§åèªå¨å
³éï¼"
'å¦æå计æ¶å®æ¯ï¼è¦æ¨¡æç¹å»
If Cmp.dwTimerCountDown = Cmp.dwTimerDuration Then
'åæ¢timer
Timer1.Enabled = False
'è·åæé®å¥æ
hWndTargetBtn = GetDlgItem(hwndMsgBox, Cmp.dwTimerExpireButton)
If hWndTargetBtn <> 0 Then
'å¨æé®ä¸è®¾ç½®ç¦ç¹
Call PutFocus(hWndTargetBtn)
'ç»PutFocusæ¶é´
DoEvents
'模æç¹å»
Call SendMessage(hWndTargetBtn, WM_LBUTTONDOWN, 0, 0)
Call SendMessage(hWndTargetBtn, WM_LBUTTONUP, 0, 0)
End If
End If
End If
End Sub
追é®ä½ è¿ä¸ªå
¶å®ä¹ä¸ç®æ¯ä¸ä¸ªHOOK APIçä¾åï¼åªæ¯é©ä½æ¶æ¯äºèå·²ï¼å¹¶æ²¡æé©ä½API