1.已知可执行程序的名字a.exe,如何判断程序是否已经在运行?怎么杀死它?
2.已知对话框的窗口标题“**”,怎么判断对话框已经弹出(以下程序代码不知道为什么没有举出所有窗口),并用代码关掉该窗口?
Private Sub Command1_Click()
Dim co As Variant
List1.Clear
Call EnumWindows(AddressOf EnumWindowsProc, 0&)
For Each co In coll
If Mid(co, 1, 3) = "-!@" Then
co = "Class Name:" + Mid(co, 4)
End If
List1.AddItem co
Next
End Sub
'hWnd是Window传给我们的Window handle,而lParam是我们呼叫EnumWindows()时的第
'二个叁数值,在这个例子中,我们传0进来,所以lParam一直是0
Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim S As String, pid As Long
If GetParent(hwnd) = 0 Then
'读取 hWnd 的视窗标题
S = String(80, 0)
Call GetWindowText(hwnd, S, 80)
S = Left(S, InStr(S, Chr(0)) - 1)
Call GetWindowThreadProcessId(hwnd, pid)
'当没有标题的hWnd之pid被加入Coll的Collection时,若pid重覆会有错,我们不管它
On Error Resume Next
If Len(S) = 0 Then
'没有标题,则记录Class Name
S = String(255, 0)
Call GetClassName(hwnd, S, 255)
S = Left(S, InStr(S, Chr(0)) - 1)
coll.Add "-!@" + S, Str(pid) 'key 为Pid
Else
'如果相同的pid记录两次,便会产生err, 而去执行errh的程序
On Error GoTo errh
If IsWindowVisible(hwnd) Then
coll.Add S, Str(pid)
End If
End If
End If
EnumWindowsProc = True ' 表示继续列举 hWnd
Exit Function
errh:
'如果先前coll 记录key=pid的 那个Item记录的是ClassName,则Item以Window
'的Title来取代
If Mid(coll.Item(Str(pid)), 1, 3) = "-!@" Then '表示先前以ClassName记录
coll.Remove (Str(pid))
coll.Add S, Str(pid)
End If
EnumWindowsProc = True ' 表示继续列举 hWnd
End Function
2.已知对话框的窗口标题“**”,怎么判断对话框已经弹出(以下程序代码不知道为什么没有举出所有窗口),并用代码关掉该窗口?
Private Sub Command1_Click()
Dim co As Variant
List1.Clear
Call EnumWindows(AddressOf EnumWindowsProc, 0&)
For Each co In coll
If Mid(co, 1, 3) = "-!@" Then
co = "Class Name:" + Mid(co, 4)
End If
List1.AddItem co
Next
End Sub
'hWnd是Window传给我们的Window handle,而lParam是我们呼叫EnumWindows()时的第
'二个叁数值,在这个例子中,我们传0进来,所以lParam一直是0
Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim S As String, pid As Long
If GetParent(hwnd) = 0 Then
'读取 hWnd 的视窗标题
S = String(80, 0)
Call GetWindowText(hwnd, S, 80)
S = Left(S, InStr(S, Chr(0)) - 1)
Call GetWindowThreadProcessId(hwnd, pid)
'当没有标题的hWnd之pid被加入Coll的Collection时,若pid重覆会有错,我们不管它
On Error Resume Next
If Len(S) = 0 Then
'没有标题,则记录Class Name
S = String(255, 0)
Call GetClassName(hwnd, S, 255)
S = Left(S, InStr(S, Chr(0)) - 1)
coll.Add "-!@" + S, Str(pid) 'key 为Pid
Else
'如果相同的pid记录两次,便会产生err, 而去执行errh的程序
On Error GoTo errh
If IsWindowVisible(hwnd) Then
coll.Add S, Str(pid)
End If
End If
End If
EnumWindowsProc = True ' 表示继续列举 hWnd
Exit Function
errh:
'如果先前coll 记录key=pid的 那个Item记录的是ClassName,则Item以Window
'的Title来取代
If Mid(coll.Item(Str(pid)), 1, 3) = "-!@" Then '表示先前以ClassName记录
coll.Remove (Str(pid))
coll.Add S, Str(pid)
End If
EnumWindowsProc = True ' 表示继续列举 hWnd
End Function
Option Explicit
Private Sub cmdkill_Click()
Dim winHwnd As Long
Dim RetVal As Long
winHwnd = FindWindow(vbNullString, "Calculator")
MsgBox winHwnd
If winHwnd <> 0 Then
RetVal = PostMessage(winHwnd, WM_CLOSE, 0&, 0&)
If RetVal = 0 Then
MsgBox "置入消息错误!"
End If
Else
MsgBox "Calculator没有打开!"
End If
End Sub
'模块中
Option ExplicitDeclare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongDeclare Function PostMessage Lib "user32" Alias _
"PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As LongPublic Const WM_CLOSE = &H10'ok
'把以下代码放入模块中 调用FindTitle函数(你可以修改该函数符合你的要求)
'我想应该没问题,因为我刚做过一个“广告杀手”的小程序(我感觉还可以,你要的话我可以发给你!!)Public Const GW_HWNDFIRST = 0 '子窗口的第一兄弟窗口,其第一个顶层窗口
Public Const GW_HWNDLAST = 1 '子窗口的最后一个兄弟窗口,或最后一个顶层窗口
Public Const GW_HWNDNEXT = 2 '后继窗口
Public Const GW_HWNDPREV = 3 '先前窗口
Public Const GW_OWNER = 4 '窗口拥有者Public Const SC_CLOSE = &HF060&
Public Const WM_SYSCOMMAND = &H112Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal HWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetWindow Lib "user32" (ByVal HWnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal HWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal HWnd As Long) As Long
Sub FindTitle()
'查找桌面上的所有窗口标题
On Error GoTo ErrHandle:
Dim currwnd As Double
Dim ListItem As StringDim buf As String
Dim buflen As Long
Dim child_hwnd As Long
Dim ret As Longcurrwnd = GetWindow(HWnd, GW_HWNDFIRST)While currwnd <> 0
Length = GetWindowTextLength(currwnd)
ListItem$ = Space$(Length + 1)
Length = GetWindowText(currwnd, ListItem$, Length + 1)'在这里判断ListItem$是否是你准备杀了的窗口的标题
' if instr(ListItem$,你的程序窗口的标题)<>0 then
' 如果是调用下面的关闭函数
' ret = SendMessage(HWnd, WM_SYSCOMMAND, SC_CLOSE, 0)
' end if currwnd = GetWindow(currwnd, GW_HWNDNEXT)
WendErrHandle:
Exit Sub
End Sub