Ловим сообщения программы

← →
cruiser © (2008-09-30 17:06) [0]

Здравствуйте уважаемые Мастера! Вопрос:
Как можно реализовать на Delphi отлов сообщений некоторой программы, которые она выдает в окно командной строки после её запуска из командной строки? Например, в окне cmd пишется: удаление произведено. А как мне отловить это сообщение и например поместить в showmessage моей программы?

← →
Vlad Oshin © (2008-09-30 17:07) [1]

http://yandex.ru/yandsearch?rpt=rad&text=%D0%BF%D0%B5%D1%80%D0%B5%D1%85%D0%B2%D0%B0%D1%82%20%D0%B2%D1%8B%D0%B2%D0%BE%D0%B4%D0%B0%20%D0%B2%20%D0%BA%D0%BE%D0%BD%D1%81%D0%BE%D0%BB%D1%8C%20delphi

← →
cruiser © (2008-09-30 17:08) [2]

Спасибо. Я просто не такую фразу вбивал в поисковике :)

← →
cruiser © (2008-09-30 20:50) [3]

Спасибо за подсказку. Стал использовать вот такой код:
procedure RunDosInMemo(CmdLine: string; AMemo: TMemo); const ReadBuffer = 2400; begin with Security do begin nlength := SizeOf(TSecurityAttributes); binherithandle := true; lpsecuritydescriptor := nil; end; if Createpipe(ReadPipe, WritePipe, @Security, 0) then begin Buffer := AllocMem(ReadBuffer + 1); FillChar(Start, Sizeof(Start), #0); start.cb := SizeOf(start); start.hStdOutput := WritePipe; start.hStdInput := ReadPipe; start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW; start.wShowWindow := SW_HIDE; if CreateProcess(nil, PChar(CmdLine), @Security, @Security, true, NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then begin repeat Apprunning := WaitForSingleObject (ProcessInfo.hProcess, 10); ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil); Buffer[BytesRead] := #0; OemToAnsi(Buffer, Buffer); AMemo.Text := AMemo.text + string(Buffer); Application.ProcessMessages; until (Apprunning <> WAIT_TIMEOUT); end; FreeMem(Buffer); CloseHandle(ProcessInfo.hProcess); CloseHandle(ProcessInfo.hThread); CloseHandle(ReadPipe); CloseHandle(WritePipe); end; end; procedure TForm1.Button1Click(Sender: TObject); begin Memo1.Clear; RunDosInMemo("ping 127.0.0.1 -t", Memo1); end; procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin FreeMem(Buffer); CloseHandle(ProcessInfo.hProcess); CloseHandle(ProcessInfo.hThread); end; end.

Возник вопрос:
Как сделать, что бы по нажатию на кнопку, например button2 или в процедуре FormCloseQuery выполнить принудительное завершение процесса, запущенного из программы? (в данном случае ping...)

Спасибо!

← →
Юрий Зотов © (2008-09-30 20:55) [4]

TerminateProcess.

http://msdn.microsoft.com/en-us/library/ms686714(VS.85).aspx

← →
cruiser © (2008-09-30 21:14) [5]

Спасибо!

Добавил это windows.TerminateProcess(ProcessInfo.hProcess,WAIT_OBJECT_0), но ничего не срабатывает. Процесс так и висит. STILL_ACTIVE этот тоже пробовал не подходит. Подскажите, что не так?

← →
Юрий Зотов © (2008-09-30 21:43) [6]

Куда добавили? Показывайте код. И WAIT_OBJECT_0 тут ни при чем.

← →
cruiser © (2008-09-30 21:47) [7]

Извиняюсь...

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin FreeMem(Buffer); CloseHandle(ProcessInfo.hProcess); CloseHandle(ProcessInfo.hThread); windows.TerminateProcess(ProcessInfo.hProcess,process_terminate); windows.TerminateThread(ProcessInfo.hThread,1) end;

← →
Юрий Зотов © (2008-09-30 22:22) [8]

> cruiser © (30.09.08 21:47) [7]

Пара наводящих вопросов:

1. Какой смысл имеет хэндл процесса (или потока) ПОСЛЕ того, как ЭТОТ хэндл УЖЕ был закрыт?

2. Какой смысл имеет прерывание потока (TerminateThread) ПОСЛЕ того, как был прерван ВЕСЬ процесс ЭТОГО потока (TerminateProcess)?

← →
cruiser © (2008-09-30 22:35) [9]

Спасибо большое. До этого я не догадался. Все было так просто. Убрал CloseHandle(ProcessInfo.hProcess); CloseHandle(ProcessInfo.hThread); и всё заработало :)

← →
Riply © (2008-09-30 23:06) [10]

> [9] cruiser © (30.09.08 22:35)
> Спасибо большое. До этого я не догадался. Все было так просто.
> Убрал CloseHandle(ProcessInfo.hProcess); CloseHandle(ProcessInfo.hThread); и всё заработало :)

А я бы их не убирала

← →
Юрий Зотов © (2008-09-30 23:07) [11]

> cruiser © (30.09.08 22:35) [9]

> Убрал CloseHandle(ProcessInfo.hProcess); CloseHandle(ProcessInfo.hThread);

Я бы их оставил, но CloseHandle(ProcessInfo.hThread) вызвал сразу после CreateProcess (на фига держать ненужный хэндл?), а CloseHandle(ProcessInfo.hProcess) - сразу после TerminateProcess (хотя тоже не уверен, что в этом есть смысл - но на всякий случай).

А вот TerminateThread - убрал бы. При прерывании процесса его поток прервется сам.

← →
cruiser © (2008-09-30 23:12) [12]

спасибо. попробую.
еще вопрос. при запуске любого приложения, вместо "ping 127.0.0.1 -t" приложение приходит в ступор, а запущенное таким образом приложение ничего не делает . в чем ошибка?

← →
cruiser © (2008-09-30 23:13) [13]

т.е. и родитель и потомок (приложения) не работают в таком случае и приходится их убивать из диспетчера задач

← →
Юрий Зотов © (2008-09-30 23:38) [14]

> cruiser © (30.09.08 23:12) [12]

> приложение приходит в ступор, а запущенное таким образом приложение
> ничего не делает.

Имеется в виду любое консольное или GUI приложение? С консольным все должно работать, а GUI ждет действий юзера. Наше приложение при этом тоже ждет - пока кто-то не запишет в stdout (а писать туда некому).

← →
cruiser © (2008-09-30 23:41) [15]

В том то и дело что консольное. Т.е. это самое консольное приложение не просит никаких нажатий, а просто делает свою работу :( Куда копать?

← →
cruiser © (2008-09-30 23:45) [16]

есть предположение, что консольная прога выводит свои данные в окно консоли каким-то другим способом, отличным от того что мы пытаемся перехватить...

← →
Юрий Зотов © (2008-09-30 23:51) [17]

Обратил внимание на название процедуры - там есть слово DOS. Если это DOS-программа (а не консольная Windows-программа), то она может выводить не в stdout, а напрямую в видеобуфер ($B800).

← →
cruiser © (2008-09-30 23:55) [18]

Это exe файл, который при запуске с опр. параметрами пишет отчет совей работы в окно консоли. Может в это проблема?

← →
Юрий Зотов © (2008-09-30 23:57) [19]

> cruiser © (30.09.08 23:55) [18]

Запустите ее под DOSом. Если не обругается - то это DOS-программа.

← →
cruiser © (2008-10-01 00:01) [20]

Написано в описании проги: this program cannot be run in dos mode

← →
turbouser © (2008-10-01 00:12) [21]

> cruiser © (30.09.08 23:12) [12]
>
> спасибо. попробую.
> еще вопрос. при запуске любого приложения, вместо "ping
> 127.0.0.1 -t" приложение приходит в ступор

Естесственно. Ключик -t это "Отправка пакетов на указанный узел до команды прерывания. Для вывода статистики и продолжения нажмите <Ctrl>+<Break>, для прекращения - <Ctrl>+<C>."

← →
cruiser © (2008-10-01 00:17) [22]

> Естесственно. Ключик -t это "Отправка пакетов на указанный
> узел до команды прерывания. Для вывода статистики и продолжения
> нажмите <Ctrl>+<Break>, для прекращения - <Ctrl>+<C>."

Это то здесь причем?

> Запустите ее под DOSом. Если не обругается - то это DOS-
> программа.

Не знаю что и делать. Запускаемая программа ругается в лог файле на неправильную конфигурацию программы. Странно. Может какая-то защита стоит или недоработка, что программу нельзя запускать как дочерний процесс?

← →
Германн © (2008-10-01 00:33) [23]

> if CreateProcess(nil,
> PChar(CmdLine),
> @Security,
> @Security,
> true,
> NORMAL_PRIORITY_CLASS,
> nil,
> nil,
> start,
> ProcessInfo) then
>

Тут нет очепяток?

← →
cruiser © (2008-10-01 00:44) [24]

Подскажите, на что обратить внимание? Где очепяток?

← →
Германн © (2008-10-01 00:54) [25]

> Подскажите, на что обратить внимание?

Нет это я ошибся в арифметике. :(

← →
cruiser © (2008-10-01 00:57) [26]

Опытным путем определил что висяку способствует параметр start.dwFlags. Если его закоментить, то дочерняя прога запускается и отрабатывает, правда наша программа не видит момента закрытия консольного приложения и тупо висит. + в этом случае так же не идет перехват того, что программа выдает в консоль.

← →
Сергей М. © (2008-10-01 09:06) [27]

> cruiser © (01.10.08 00:57) [26]

Чему у тебя равен параметр CmdLine при вызове процедуры ?

← →
cruiser © (2008-10-01 09:42) [28]

В листинге наверху видно что, например, "ping 127.0.0.1 -t"
Заметил еще вот что. При запуске дочернего процесса с параметром sw_hide, то она не отрабатывает свою функциональность. А вот если с параметром sw_normal, то окно консоли видно, но в нём ничего не пишется (я так понимаю и должно быть). Но при этом код не отрабатывает запись в memo1.
Пробовал вот сюда:
repeat Apprunning := WaitForSingleObject (ProcessInfo.hProcess, 10); ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil); Buffer[BytesRead] := #0; OemToAnsi(Buffer, Buffer); AMemo.Text := AMemo.text + string(Buffer); Application.ProcessMessages; until (Apprunning <> WAIT_TIMEOUT);
вместо AMemo.Text := AMemo.text + string(Buffer) ставить showmessage string(buffer) и думал что сообщение будет выдаваться при каждом новом выводи консольной программы. А ннееет - выдается только в конце по завршению процесса консольной проги и несколько раз, пока всё не покажет... Странно как-то. Сегодня буду пробовать другой код, найденный на просторах инета...

> окно консоли видно, но в нём ничего не пишется

Видно его или не видно, но писаться в нем ничего и не должно, потому что станд.вывод консоли тобой перехвачен.

Вот этот чуть подкорректированный код чудесно работает и в точности выполняет поставленную тобой задачу:

var Security: TSecurityAttributes; ReadPipe, WritePipe: THandle; Start: TStartupInfo; ProcessInfo: TProcessInformation; Buffer: PChar; Apprunning: Cardinal; BytesRead: Cardinal; procedure RunDosInMemo(CmdLine: string; AMemo: TMemo); const ReadBuffer = 2400; begin with Security do begin nlength := SizeOf(TSecurityAttributes); binherithandle := true; lpsecuritydescriptor := nil; end; if Createpipe(ReadPipe, WritePipe, @Security, 0) then begin Buffer := AllocMem(ReadBuffer + 1); FillChar(Start, Sizeof(Start), #0); start.cb := SizeOf(start); start.hStdOutput := WritePipe; start.hStdInput := ReadPipe; start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW; start.wShowWindow := SW_HIDE; if CreateProcess(nil, PChar(CmdLine), @Security, @Security, true, NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then begin CloseHandle(ProcessInfo.hThread); while not Application.Terminated do begin Apprunning := WaitForSingleObject (ProcessInfo.hProcess, 10); if Apprunning <> WAIT_TIMEOUT then Break; ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil); Buffer[BytesRead] := #0; OemToAnsi(Buffer, Buffer); AMemo.Text := AMemo.text + string(Buffer); Application.ProcessMessages; end; end; FreeMem(Buffer); if Apprunning = WAIT_TIMEOUT then TerminateProcess(ProcessInfo.hProcess, 0); CloseHandle(ProcessInfo.hProcess); CloseHandle(ReadPipe); CloseHandle(WritePipe); end; end; procedure TForm1.Button3Click(Sender: TObject); begin RunDosInMemo("ping 127.0.0.1 -t", Memo); end;

Никаких обработчиков OnCloseQuery не требуется - завершение приложения ведет к автоматическому уничтожению порожденного процесса cmd.exe, если на этот момент он еще активен.

Спасибо. Дома попробую этот код.

> Никаких обработчиков OnCloseQuery не требуется - завершение
> приложения ведет к автоматическому уничтожению порожденного
> процесса cmd.exe, если на этот момент он еще активен.

А мне нужно что бы моё приложение не закрывалось, а по нажатию на кнопку стоп в любой момент прибивался бы дочерний процесс.

> мне нужно что бы моё приложение не закрывалось, а по нажатию
> на кнопку стоп в любой момент прибивался бы дочерний процесс

И что тебе мешает реализовать такую логику ?

Реализовал уже :) Я просто отвечал вот на это:

> завершение
> > приложения ведет к автоматическому уничтожению порожденного
>
> > процесса cmd.exe, если на этот момент он еще активен.

а closequery, так, попало в цитату :) Сегодня вечером проверю предложенный Вами код.

> в любой момент прибивался бы дочерний процесс

Это, мягко говоря, не есть гуд.
Если процесс жив и нормально реагирует на ожидаемые события ввода, "прибивать" его не только нехорошо, но и в отдельных случаях чревато опасными последствиями.

А как же тогда будет верно остановить его (дочернего процесса) работу и выкинуть из памяти, если это очень нужно?

при работе кода приложение повисло наглухо(

этоя про:
> код чудесно работает

( хотелось бы заценить рабочий...

> brother © (01.10.08 13:57) [36]

> ( хотелось бы заценить рабочий...

Он, во-ще, рабочий, но хромает.

Сделай ReadBuffer = 240

--
Regards, LVT.

Сергей М., а работает именно ping... или какое-то другое приложение? Я спрашиваю, потому что как раз ping это не показатель. С ping у меня и мой первый код работал.
За "Консольному процессу, очевидно, следует посылать CTRL_C_EVENT
" спасибо, попробую реализовать.

Ловим сообщения программы Найти похожие ветки