Question

使用VB关闭其他程序

如何使用VB6.0编写的程序关闭另一正在运行的制定程序？请高手指教
另，此处有一示例，但看不懂，请给讲解一下（关闭“计算器”）
' FindWindow函数声明
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As Long
' PostMessage函数声明
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any _
) As Long
'关闭程序需要的常量
Const WM_CLOSE = &H10

Private Sub Command1_Click()
Dim winHwnd As Long
Dim RetVal As Long
winHwnd = FindWindow(vbNullString, "计算器")
Debug.Print winHwnd
If winHwnd <> 0 Then
RetVal = PostMessage(winHwnd, WM_CLOSE, 0&, 0&)
If RetVal = 0 Then
MsgBox "关闭计算器出错！"
End If
Else
MsgBox "计算器没有运行。"
End If
End Sub
我主要是想让大家帮我逐语句加上注释，我主要是看不懂这是什么意思，谢谢

Answer 1

'VB 终止指定进程 ,刷新托盘图标

Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * 1024
End Type

Private Type MODULEENTRY32
dwSize As Long
th32ModuleID As Long
th32ProcessID As Long
GlblcntUsage As Long
ProccntUsage As Long
modBaseAddr As Byte
modBaseSize As Long
hModule As Long
szModule As String * 256
szExePath As String * 1024
End Type

Private Const WM_MOUSEMOVE = &H200

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
OsName As String
End Type

Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function UpdateWindow Lib "user32" Alias "UpdateWindow" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) 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 Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Sub KillExe(EXEName As String)
Dim my As PROCESSENTRY32
Dim hProcessHandle As Long
Dim success As Long
Dim l As Long

l = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If l Then
my.dwSize = 1060
If (Process32First(l, my)) Then
Do
If UCase$(Right$(Left$(my.szExeFile, InStr(1, my.szExeFile, Chr$(0)) - 1), Len(EXEName))) = UCase$(EXEName) Then
hProcessHandle = OpenProcess(&H1F0FFF, True, my.th32ProcessID)
If hProcessHandle <> 0 Then success = TerminateProcess(hProcessHandle, ByVal 0&)
If success = 1 Then CloseHandle (hProcessHandle)
End If
Loop Until (Process32Next(l, my) < 1)
End If
CloseHandle l
End If

End Sub

Private Function GetSysTrayWnd() As Long

Dim Result As Long
Dim Ver As OSVERSIONINFO
Ver.dwOSVersionInfoSize = 148
GetVersionEx Ver

Result = FindWindow("Shell_TrayWnd", vbNullString)
Result = FindWindowEx(Result, 0, "TrayNotifyWnd", vbNullString)
If Ver.dwMajorVersion = 5 And Ver.dwMinorVersion > 0 Then Result = FindWindowEx(Result, 0, "SysPager", vbNullString)
If Ver.dwMajorVersion = 5 Then Result = FindWindowEx(Result, 0, "ToolbarWindow32", vbNullString)
GetSysTrayWnd = Result
End Function

Private Sub RefreshTrayIcon()

Dim hwndTrayToolBar As Long
Dim X, Y As Long
Dim rTrayToolBar As RECT
Dim pos As Long
hwndTrayToolBar = GetSysTrayWnd

GetClientRect hwndTrayToolBar, rTrayToolBar

For X = 1 To rTrayToolBar.Right - 1
For Y = 1 To rTrayToolBar.Bottom - 1
pos = (X And &HFFFF) + (Y And &HFFFF) * &H10000

PostMessage hwndTrayToolBar, WM_MOUSEMOVE, 0, pos

Next Y
Next X
End Sub

Private Sub Command1_Click()
Dim hShellTray As Long
Dim a As String
a = "c:\windows\notepad.exe"'以记事本为例
KillExe a

RefreshTrayIcon'刷新托盘图标
End Sub

Answer 2

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'申明API FindWindow
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'申明API PostMessage
Const WM_CLOSE = &H10 '申明API 常量
'2个API的功能详见百科。
'FindWindow: http://baike.baidu.com/view/373605.htm
'PostMessage: http://baike.baidu.com/view/1080179.htm
Private Sub Command1_Click() '当单击command1的时候
Dim winHwnd As Long '定义winHwnd为长整型，来储存计算器的句柄
Dim RetVal As Long '定义RetVal为长整型
winHwnd = FindWindow(vbNullString, "计算器") '用FindWindow函数返回计算器的句柄到winHwnd
Debug.Print winHwn '这句不是很重要可有可无
If winHwnd <> 0 Then '判断winHwnd是否为0，如果是0就说明计算器没有启动
RetVal = PostMessage(winHwnd, WM_CLOSE, 0&, 0&) '用PostMessage函数寄送WM_CLOSE到计算器并返回值到RetVal
If RetVal = 0 Then '判断RetVal是否为0，如果是0就说明计算器没有成功关闭
MsgBox "关闭计算器出错！"
End If
Else
MsgBox "计算器没有运行。"
End If
End Sub
'个人理解只供参考

Answer 3

我有2种方法，一种是按进程名，还有一种就是你这种。 找到句柄，发送信息。
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Sub KillProcess(ByVal whWnd As Long)
Dim lpdwProcessId As Long
Dim hProcessHandle As Long
GetWindowThreadProcessId whWnd, lpdwProcessId
hProcessHandle = OpenProcess(&H1F0FFF, True, lpdwProcessId)
Dim success As Long
If hProcessHandle <> 0 Then
success = TerminateProcess(hProcessHandle, ByVal 0&)
End If
If success = 1 Then CloseHandle (hProcessHandle)
End Sub

调用方式 KillProcess whWnd‘whWnd为窗口句柄

Answer 4

FindWindow PostMessage是两个API函数，用之前先要声明，然后单击按钮findwindow找到计算器这个窗口名，如果返回值不等于0 就给指定窗口发送关闭窗口的消息，等于0就弹出对话框计算机没有运行，如果postmessage返回值是0弹出对话框关闭出错。。。