Недавно столкнулся со схожей проблеммой, когда пытался узнать как закрыть внешнее приложение из программы, вот что нарыл (это модуль который закрывает нужный процесс по хендлу): 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 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 '' Это команда окну честно закрыться. ' SendMessage lngHandle(i), WM_ENDSESSION, 0, 0 '' Это команда окну честно закрыться. SendMessage lngHandle(i), WM_QUERYENDSESSION, 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 ' 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 конечно тут лишнего половина, но ты небось разберешься , там по-моему есть нужный тебе кусок. Удачи!
Ответить
|