定时关闭MSGBOX问题,我记得在某一期的<程序员>杂志中"专家门诊"中看到过解决办法,好像是调用一个脚本实现的,但我忘记了,不知道有没有人还

Question

定时关闭MSGBOX问题,我记得在某一期的<程序员>杂志中"专家门诊"中看到过解决办法,好像是调用一个脚本实现的,但我忘记了,不知道有没有人还记得?,这个脚本没有调用API函数,仅是脚本调用的方式,有人记得吗?

Answer 1

API'关Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 'Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long '
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const BM_CLICK = &HF5
const ts="提示框名"
const an ="按钮名"Private Sub Timer1_Timer()
    pk = FindWindow(vbNullString, ts)
    pp = FindWindowEx(pk, ByVal 0&, "Button", an)
    SendMessage pp, BM_CLICK, 0, 0
End Sub

Answer 2

'在表单的声明区中加入以下的声明Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As LongPrivate Const WM_CLOSE = &H10
Private Const MsgTitle As String = "Test Message"'在表单中加入一个 CommandButton 及一个 Timer 控制项，加入以下程序码：Private Sub Command1_Click()
Dim nRet As Long
Timer1.Interval = 3000
Timer1.Enabled = True
nRet = MsgBox("若您不回应的话，3 秒后此 MsgBox 会自动关闭", 64, MsgTitle)
Timer1.Enabled = False
End SubPrivate Sub Timer1_Timer()
Dim hWnd As Long
hWnd = FindWindow(vbNullString, MsgTitle)
Call SendMessage(hWnd, WM_CLOSE, 0, ByVal 0&)
End Sub此方法的限制说明：1、当常数设定为 VbAbortRetryIgnore 或 VbYesNo 时，无效！
2、在 Design Time 时，无效，必须 Make EXE 之后才有效！

Answer 3

用API函数,我知道怎样调用,可是,我记得在<程序员>杂志"专家门诊"中有一期有解决问题,方法是调用好像是引用WSH脚本的,是可以解决定时关闭的,但我忘记了怎样调用,有谁记得吗?排除API函数调用这种方法.

Answer 4

可以简单，用WH_CBT钩子监视即将创建或激活的窗口，可以得到那个窗口的Hwnd,以及它上面的按钮的hwnd,得到这些，想关闭，那就很容易了~~~~~~~~~~~~~~~~~~

Answer 5

http://community.csdn.net/Expert/topic/4067/4067593.xml?temp=.8975794
可以参考一下.

Answer 6

用API我知道怎样做,但是我要求是调用脚本式的,这绝对可以实现,而且可以定时关闭,有哪位大虾还记得?

Answer 7

' *********************************************************************
'  Copyright ?998 Karl E. Peterson, All Rights Reserved
'  http://www.mvps.org/vb
' *********************************************************************
'  Warning: This computer program is protected by copyright law and
'  international treaties. Unauthorized reproduction or distribution
'  of this program, or any portion of it, may result in severe civil
'  and criminal penalties, and will be prosecuted to the maximum
'  extent possible under the law.
' *********************************************************************
Option ExplicitPrivate Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Const WM_CLOSE = &H10Private Const MsgTitle As String = "Test Message"Private Sub cmdTest_Click()
   Dim msg As String
   Dim nRet As Long
   '
   ' Adjust timeout to match user's spec.
   '
   With Timer1
      .Interval = HScroll1.Value * 1000
      .Enabled = True
   End With
   '
   ' Message should reflect whether compiled.
   '
   If Compiled Then
      msg = "I should disappear in " & HScroll1.Value & " seconds."
   Else
      msg = "I whould disappear in " & HScroll1.Value & _
            " seconds," & vbCrLf & "if this demo were compiled."
   End If
   '
   ' Return value, after a timeout, is the same as if
   ' the user had pressed the Close (X) button.
   '
   nRet = MsgBox(msg, Combo1.ItemData(Combo1.ListIndex), MsgTitle)
   Select Case nRet
      Case vbOK:       msg = "vbOK ["
      Case vbCancel:   msg = "vbCancel ["
      Case vbAbort:    msg = "vbAbort ["
      Case vbRetry:    msg = "vbRetry ["
      Case vbIgnore:   msg = "vbIgnore ["
      Case vbYes:      msg = "vbYes ["
      Case vbNo:       msg = "vbNo ["
      Case Else:       msg = "Unknown ["
   End Select
   txtReturn.Text = msg & nRet & "]"
   Timer1.Enabled = False
End SubPrivate Sub Form_Load()
   With Combo1
      .AddItem "vbAbortRetryIgnore"
      .ItemData(.NewIndex) = 2
      .AddItem "vbOKCancel"
      .ItemData(.NewIndex) = 1
      .AddItem "vbOKOnly"
      .ItemData(.NewIndex) = 0
      .AddItem "vbRetryCancel"
      .ItemData(.NewIndex) = 5
      .AddItem "vbYesNo"
      .ItemData(.NewIndex) = 4
      .AddItem "vbYesNoCancel"
      .ItemData(.NewIndex) = 3
      .ListIndex = .NewIndex
   End With
   txtReturn.Text = ""
   Set Me.Icon = Nothing
End SubPrivate Sub HScroll1_Change()
   cmdTest.Caption = "Test " & HScroll1.Value & _
      " Second MsgBox"
End SubPrivate Sub Timer1_Timer()
   Dim hWnd As Long
   '
   ' The following works for all *except*
   ' vbAbortRetryIgnore, which any responsible
   ' programmer must let the user answer.
   '
   hWnd = FindWindow(vbNullString, MsgTitle)
   Call SendMessage(hWnd, WM_CLOSE, 0, ByVal 0&)
End SubPrivate Function Compiled() As Boolean
   On Error GoTo NotCompiled
   Debug.Print 1 / 0
   Compiled = True
NotCompiled:
End Function

Answer 8

我的问题是不用API函数,而是调用脚本来解决啊...........

Answer 9

Private Sub Command1_Click()
    Set WsShell = CreateObject("Wscript.Shell")
    WsShell.Popup "你TMD怎么还不睡？！", 1, "PowerBASIC温馨提示"
End Sub
'在IDE环境下可能不正常，编译为exe文件就没问题了。