|
| Для зарегистрированных пользователей |
|
Нахождение hwnd чужих окон
Я уже не первый раз в своей практике сталкиваюсь с ситуацией, когда мне необходимо найти окно чужой программы. Т.е. узнать - запущено какое то конкретное окно или нет. Или сначала узнать, есть ли окно, а потом закрыть. Да мало ли какие могут быть еще применения.
Подумав, и перепробовав разные законные способы реализации я остановился на следующем:
Исходные данные - имеется программа , окно которой в заголовке содержит какой-то достаточно уникальный набор символов. ЗАдача. Найти и честно закрыть это окно из программы.
Итак, размещаем в модуле:
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 EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public 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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long
Public Const WM_CLOSE = &H10
Dim strCaptions() As String ' Здесь будут лежать заголовки всех найденных окон
Dim lngHandle() As Long ' А здесь все хэндлы этих окон
Public Function CloseProg(strCaption As String) As Boolean Dim iCount As Integer Dim i As Integer Dim Pos As Integer Dim lngEnum As Long ReDim strCaptions(0)
' Обнуляем массив от возможных прошлых результатов
ReDim lngHandle(0) ' то же чистим
lngEnum = EnumWindows(AddressOf Callback1_EnumWindows, 0) ' вот эта функция будет циклически вызвана столько раз,
' сколько будет найдено окон ' т.е. после ее выполнения оба массива будут наполнены
For i = 0 To UBound(strCaptions) ' перебираем эти массивы
Pos = InStr(1, strCaptions(i), strCaption, vbTextCompare) ' ищем строку, которая должна характеризовать
' искомое окно
If Pos > 0 Then
SendMessage lngHandle(i), WM_CLOSE, 0, 0 ' Это команда окну честно закрыться. ' Заметьте будут закрыты все окна с таким заголовком
iCount = iCount + 1
End If Next
If iCount >= 1 Then CloseProg = True ' работа выпонена
Else CloseProg = False 'такое окно не найдено
End If End Function
Public Function Callback1_EnumWindows(ByVal hwnd As Long, _ ByVal lpData As Long) As Long
Dim cnt As Long Dim rttitle As String * 256
cnt = GetWindowText(hwnd, rttitle, 255) ' ищем следующее окно If cnt > 0 Then ' нашли, тогда добавляем элемент в массивы ReDim Preserve lngHandle(UBound(strCaptions) +1) ReDim Preserve strCaptions(UBound(strCaptions) + 1) strCaptions(UBound(strCaptions)) = Left$(rttitle, cnt) lngHandle(UBound(lngHandle)) = hwnd End If Callback1_EnumWindows = 1 ' продолжаем перебирать
End Function
Работает это все так:
CloseProg "Netscape"
Если такое окно (к примеру "Boris Hompage - Netscape") будет найдено - то оно будет закрыто.
Заметьте еще одну тонкость. Если вы закрываете окно с несохраненным документом - последует приглашение его сохранить.
Иногда отдельные окна не желают закрываться по посланному сообщению
В этом случае можно поробовать применить функцию
DestroyWindow или CloseHandle
Обе принимают в качестве единственного аргумента хэндл закрываемого окна.
И последнее - информация к размышлению - многие контролы, например кнопки - тоже полноценные окна и их тоже можно "закрыть"
Ну и этот примерчик не ограничивается только закрытием окна, можно передать ему фокус, поставить его поверх других окон, и тд...
Дополнение к статье. Еще один способ закрыть приложения, если оно упорно игнорирует все вышеперечистленные способы, и закрываться не желает. Этот способ првавда напоминает нежный удар по голове приложения ломом. Но результат обычно достигаетсч правильный
Итак, в вышеуказанный модуль добавьте :
Public Const PROCESS_TERMINATE = &H1
Public Const WM_QUERYENDSESSION = &H11
Public Const WM_ENDSESSION = &H16
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, _
lpdwProcessId As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, _
ByVal uExitCode As Long) As Long
'И функция, которая будет убивать окно. В качестве аргумента требцует хэндл окна.
Public Sub KillProcess(ByVal hwnd As Long)
Dim pID As Long,
Dim hProc As Long
GetWindowThreadProcessId hwnd, pID
hProc = OpenProcess(PROCESS_TERMINATE, False, pID)
Call SendMessage(hwnd, WM_QUERYENDSESSION, 0, 1)
Call SendMessage(hwnd, WM_ENDSESSION, -1, 1)
TerminateProcess hProc, 0
CloseHandle hProc
End Sub
|
