比如我在 VB程序中用 shell c:\winrar\winrar.exe a data.zip c:\*.wav
将WINRAR文件打开,那它将显示,并在任务管理器里也有一进程对应
我若是经常性去执行该段代码,那进程里将会有数不尽的WINRAR。
如何将该打开的程序,通过代码关闭呢?请大家积极参与回答,重分酬谢 :)
将WINRAR文件打开,那它将显示,并在任务管理器里也有一进程对应
我若是经常性去执行该段代码,那进程里将会有数不尽的WINRAR。
如何将该打开的程序,通过代码关闭呢?请大家积极参与回答,重分酬谢 :)
1.要查找到该窗口.
2.向该窗口发送一个WIMCLOSE消息.
这是我程序中的一个模块,懒得整理了..全给你吧. Option ExplicitPublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount 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 IsIconic Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd 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
Public 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
'
Private Const SW_RESTORE = 9
Public Const WM_CLOSE = &H10
Public Const WM_QUIT = &H12
Private m_hWnd As Long
Private m_Method As FindWindowPartialTypes
Private m_CaseSens As Boolean
Private m_Visible As Boolean
Private m_AppTitle As StringPublic Enum FindWindowPartialTypes
FwpStartsWith = 0
FwpContains = 1
FwpMatches = 2
End EnumPublic Function AppActivatePartial(AppTitle As String, Optional Method As FindWindowPartialTypes = FwpStartsWith, Optional CaseSensitive As Boolean = False) As Long
Dim hWndApp As Long
hWndApp = FindWindowPartial(AppTitle, Method, CaseSensitive, True)
If hWndApp Then
If IsIconic(hWndApp) Then
Call ShowWindow(hWndApp, SW_RESTORE)
End If
Call SetForegroundWindow(hWndApp)
AppActivatePartial = hWndApp
End If
End FunctionPublic Function FindWindowPartial(AppTitle As String, _
Optional Method As FindWindowPartialTypes = FwpStartsWith, _
Optional CaseSensitive As Boolean = False, _
Optional MustBeVisible As Boolean = False) As Long
m_hWnd = 0
m_Method = Method
m_CaseSens = CaseSensitive
m_AppTitle = AppTitle
If m_CaseSens = False Then
m_AppTitle = UCase$(m_AppTitle)
End If
Call EnumWindows(AddressOf EnumWindowsProc, MustBeVisible)
FindWindowPartial = m_hWnd
End Function''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
Static WindowText As String
Static nRet As Long
If lParam Then 'window must be visible
If IsWindowVisible(hWnd) = False Then
EnumWindowsProc = True
End If
End If
WindowText = Space$(256)
nRet = GetWindowText(hWnd, WindowText, Len(WindowText))
If nRet Then
WindowText = Left$(WindowText, nRet)
If m_CaseSens = False Then
WindowText = UCase$(WindowText)
End If
Select Case m_Method
Case FwpStartsWith
If InStr(WindowText, m_AppTitle) = 1 Then
m_hWnd = hWnd
End If
Case FwpContains
If InStr(WindowText, m_AppTitle) <> 0 Then
m_hWnd = hWnd
End If
Case FwpMatches
If WindowText = m_AppTitle Then
m_hWnd = hWnd
End If
End Select
End If
EnumWindowsProc = (m_hWnd = 0)
End Function
'------------------------------------------------Public Function ActivateWin(WinLab As String, frmMethod As Integer, chCase As Boolean) As Long
'winlab 窗口标题
'frmmethod 0 开始有 1包含 2匹配
'chcase 区分在小写
'返回值:窗口的句柄
Dim nRet As Long
Dim Title As String
nRet = AppActivatePartial(Trim(WinLab), _
Val(frmMethod), chCase)
If nRet Then
ActivateWin = nRet
Else
ActivateWin = 0
End If
End Function
'关闭窗口.
Public Function CloseWin(hWnd As Long)
If hWnd > 0 Then
PostMessage hWnd, WM_QUIT, 0, 0 '发送窗口关闭
End If
End Function
Private Const INFINITE = &HFFFF
Private Const NORMAL_PRIORITY_CLASS = &H20
Private Const SYNCHRONIZE = &H100000
Private Const REALTIME_PRIORITY_CLASS = &H100'/结构体
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End TypePrivate Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End TypePrivate Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type'/关闭以前打开的进程.
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 LongPrivate Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" _
(ByVal lpApplicationname As String, _
ByVal lpCommandLine As String, _
ByVal lpProcessAttributes As Long, _
ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
lpEnvironment As Any, _
ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long'
'启动EXE文件
'函数:OpenExe
'参数:FileName EXE文件名,WorkPath 工作目录.
'返回值:该EXE的进程句柄
Public Function OpenExe(ByVal Filename As String, _
Optional WorkPath As String = "") As Long
Dim Proc As PROCESS_INFORMATION
Dim Start As STARTUPINFO
Dim Rc As Long
Dim Mdriv As String
Dim A As String
Dim B As String
Dim ExeName As String
On Error Resume Next
ExeName = FileNameExp(Filename)
WorkPath = FilePath(Filename)
ChDrive Left$(WorkPath, 2)
ChDir WorkPath
Rc = CreateProcess(ExeName, WorkPath, _
ByVal 0, ByVal 0, 1, _
NORMAL_PRIORITY_CLASS, _
ByVal 0, vbNullString, _
Start, Proc)
OpenExe = Proc.hProcess
End Function'
'关闭一个EXE文件
'函数:CloseExe
'参数:ProID 该EXE的进程句柄
'返回值:无
Public Function CloseExe(ProID As Long)
Dim Rc As Long
'/中断一个进程
Call TerminateProcess(ProID, 0)
'/关闭该进程
Call CloseHandle(ProID)
End Function
打开应用:
Private Sub Command1_Click()
Shell "Calc.exe", vbNormalFocus
End Sub
关闭应用:
Private Sub Command2_Click()
Dim lpClassName As String
Dim lpCaption As String
Dim Handle As LongConst NILL = 0&
Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060&lpClassName = "SciCalc"
lpCaption = "Calculator"
'* Determine the handle to the Calculator window.
Handle = FindWindow(lpClassName$, lpCaption$)
'* Post a message to Calc to end its existence.
Handle = SendMessage(Handle, WM_SYSCOMMAND, SC_CLOSE, NILL)
End Sub