Несколько вопросов

[Alfa]

Вопросы:

1) Нажать на машине левую или правую кнопку мыши.(Мышка уже установлена на окне. Требуется только нажать на кнопку)
2) Загрузить программу и узнать ее hwnd.
3) Завершить программу полностью по hwnd.

[vovik221]

По существу первого вопроса: (извени, не проверял передрал слово в слово пример )

Для имитации нажатия на клавишу мыши служит API-функция mouse_event

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

dwFlags - означает, какое событие в данный момент должно происходит
dx,dy - величины, характеризующие перемещение курсора от текущего положения курсора
dx - перемещение по горизонтали (если значение положительное - перемещение идет вправо, если отрицательно - влево)
dy - перемещение по вертикали (если значение положительное - перемещение идет вниз, если отрицательно - вверх).

Пример использования функции: неоходимо переместить курсор из текущей точки нахождения курсора в точку с координатами (851,143) и в этой точке имитировать нажатие левой клавиши мыши

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Dim z As POINTAPI
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Const MOUSEEVENTF_ABSOLUTE = &H8000
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10
Private Sub Form_Load()
GetCursorPos z 'получить текущее значение местоположения курсора
zx = (851 - z.x) / 2 'необходимо разделить полученное значение на 2. С чем это связано, я не знаю. А вы?
zy = (143 - z.y) / 2
mouse_event MOUSEEVENTF_MOVE, zx, zy, 0&, 0& 'перемещение курсора
mouse_event MOUSEEVENTF_LEFTDOWN, 0&, 0&, 0&, 0& 'нажатие на левую клавишу мыши
mouse_event MOUSEEVENTF_LEFTUP, 0&, 0&, 0&, 0& 'отпускание левой клавиши мыши
End Sub

'Примеры использования

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Const MOUSEEVENTF_ABSOLUTE = &H8000
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10

'Имитация клика:
mouse_event MOUSEEVENTF_LEFTDOWN, lpPoint.x, lpPoint.y, 0&, 0&
mouse_event MOUSEEVENTF_LEFTUP, lpPoint.x, lpPoint.y, 0&, 0&

[vovik221]

по поводу вопроса 2 и 3. Речь идет о твоей программе или чужой?

[Alfa]

чужой на этом компьютере

[vovik221]

Источник тот-же.


Запуск программы.

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long

Function startdoc(DocName As String)
Dim Scr_hDC As Long
Scr_hDC = GetDesktopWindow()
startdoc = ShellExecute(Scr_hDC, "Open", DocName, "", "C:\", 1)
End Function

Private Sub Command1_Click()
Dim r As Long
'укажите путь к вашему файлу
r = startdoc("D:\garbage\garik.xls")
End Sub
____________________________________________________________

Нахождение hwnd чужих окон
Я уже не первый раз в своей практике сталкиваюсь с ситуацией, когда мне необходимо найти окно чужой программы. Т.е. узнать - запущено какое то конкретное окно или нет. Или сначала узнать, есть ли окно, а потом закрыть. Да мало ли какие могут быть еще применения.
Подумав, и перепробовав разные законные способы реализации я остановился на следующем:
Исходные данные - имеется программа , окно которой в заголовке содержит какой-то достаточно уникальный набор символов. Задача. Найти и честно закрыть это окно из программы.

Вам понадобится дополнительный модуль.

'код формы

'Функция, которая будет убивать окно. В качестве аргумента требует хэндл окна.
'Причем, не обязательно полное название
Private Sub Command1_Click()
CloseProg "Текстовый документ.txt - Блокнот"
End Sub

'код модуля

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

[vovik221]

.... Или так:



Запустить программу и дождаться завершения его работы
Данный пример запустить приложение Notepad(Блокнот). После закрытия Notepad'а... смотрите сами...
Private 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 Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Public Sub ExecCmd(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
' Инициализируем структуру STARTUPINFO:
start.cb = Len(start)
' Запускаем приложение:
ret& = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
' Ждем завершения запущенного приложения:
ret& = WaitForSingleObject(proc.hProcess, INFINITE)
ret& = CloseHandle(proc.hProcess)
End Sub

Private Sub Form_Load()
ExecCmd ("Notepad")
MsgBox "Работа Блокнота завершена", vbInformation, "Конец."
End Sub

[Alfa]

Нет... Не получается. Нужно запустить программу, узнать ее hwnd. И закрыть функцией.