Как корректно получить сообщение от SendMessage

Андрей Игоревич
Дата: 27.06.2019 11:33:50
Не програмистъ. Сильно прошу не бить (если только чуть).
Кратко:
Не могу разобраться как получить сообщение от SendMessage;
Код почти полная копипаста:

Отправитель:

procedure TForm1.Button1Click(Sender: TObject);
var
  CDS: TCopyDataStruct;
  str:string;
begin
  str := 'message1';

  CDS.dwData := 1;

  CDS.cbData := Length(str) + 1;

  GetMem(CDS.lpData, CDS.cbData);

  StrPCopy(CDS.lpData, AnsiString(str));

  SendMessage(FindWindow(nil, 'Receiver'),
                  WM_COPYDATA, Handle, Integer(@CDS));

  FreeMem(CDS.lpData, CDS.cbData);

 end;


Получатель:

procedure TForm1.WMCopyData(var MessageData: TWMCopyData);
var
  s:string;
begin
  if MessageData.CopyDataStruct.dwData = 1 then
  begin
    s := PAnsiChar((MessageData.CopyDataStruct.lpData));
    Label1.Caption:=s;
 //   ShowMessage(S);
    MessageData.Result := 123;
  end
  else
    MessageData.Result := -321;
end;


И получатель никак не реагирует, ничего не меняет, вообще не входит в данную процедуру.
FindWindow(nil, 'Receiver')

Работает корректно и находит нужное окно.
Например команды
    SendMessage(receiverHandle, WM_LBUTTONDOWN, 300,300);
    SendMessage(receiverHandle, WM_LBUTTONup, 300,300);
    SetWindowPos(receiverHandle, HWND_BOTTOM, 1, 1, 20, 20, swp_nosize);

Вполне себе успешно перемещают нужное окно получателя или кликают по нему.

Если чуть подробнее, может подскажите более корректное решение:
Есть программа (оболочка), которая запускает множество расчетных одинаковых подпрограмм (~100), но так сразу 100 положит любой компьютер, запускать надо по "N" штук, потому надо отслеживать сколько программ работает в текущий момент и запускать новые по мере закрытия старых, потому завершившие работы программы посылают сообщение с идентификатором (который получили при запуске) о окончании работы и закрываются.
С передачей сообщений никогда ранее дела не имел, потому - темный лес.
Можно, конечно, отслеживать количество запущенных программ, но это неудобно в случае если запустить расчетную программу вручную (что тоже бывает).
Мимопроходящий
Дата: 27.06.2019 11:35:46

почему не потоки а процессы?

Posted via ActualForum NNTP Server 1.5

goldmi45
Дата: 27.06.2019 11:43:58
Андрей Игоревич,

procedure WMCopyData(var MessageData: TWMCopyData); message WM_COPYDATA; //это есть?
Андрей Игоревич
Дата: 27.06.2019 12:35:06
Мимопроходящий
почему не потоки а процессы?

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

goldmi45
Андрей Игоревич,

procedure WMCopyData(var MessageData: TWMCopyData); message WM_COPYDATA; //это есть?

Ааа...ааа... 3 часа сидел и тупил, вот как я мог прозевать, ведь вроде проверял, всё смотрел....
Всё, работает спасибо. Вот блин тупняк...
Василий 2
Дата: 27.06.2019 14:34:23
SendMessage излишнее тут (и негибкое), если надо сообщать просто об окончании. Запускай процессы через CreateProcess, проверяй код завершения
var si: TStartupInfo;
    pi: TProcessInformation;
    ExitCode: DWORD;
begin
  Result := True;
  // запускаем проверку архива
  si := Default(TStartupInfo);
  if not CreateProcess(nil, PChar(string(AppPath)),
                       nil, nil, False, CREATE_NO_WINDOW, nil, nil, si, pi) then
    raise Err('Не удалось запустить');
  // и ждем, пока процесс отработает
  try
    repeat
      if WaitForSingleObject(pi.hProcess, 5*MSecsPerSec) = WAIT_TIMEOUT then
        begin TerminateProcess(pi.hProcess, 0); raise Err('Превышен срок ожидания'); end;
      if not GetExitCodeProcess(pi.hProcess, ExitCode) then Break;
    until ExitCode <> STILL_ACTIVE;
  finally
    CloseHandle(pi.hProcess); CloseHandle(pi.hThread);
  end;
  // проверяем код завершения проги. 0 - ОК, иначе - ошибка
  Result := (ExitCode = 0);


Выдрано из рабочей функции, но могут быть артефакты вырезания лишнего
Андрей Игоревич
Дата: 27.06.2019 23:18:21
Василий 2
SendMessage излишнее тут (и негибкое), если надо сообщать просто об окончании. Запускай процессы через CreateProcess, проверяй код завершения
var si: TStartupInfo;
    pi: TProcessInformation;
    ExitCode: DWORD;
begin
  Result := True;
  // запускаем проверку архива
  si := Default(TStartupInfo);
  if not CreateProcess(nil, PChar(string(AppPath)),
                       nil, nil, False, CREATE_NO_WINDOW, nil, nil, si, pi) then
    raise Err('Не удалось запустить');
  // и ждем, пока процесс отработает
  try
    repeat
      if WaitForSingleObject(pi.hProcess, 5*MSecsPerSec) = WAIT_TIMEOUT then
        begin TerminateProcess(pi.hProcess, 0); raise Err('Превышен срок ожидания'); end;
      if not GetExitCodeProcess(pi.hProcess, ExitCode) then Break;
    until ExitCode <> STILL_ACTIVE;
  finally
    CloseHandle(pi.hProcess); CloseHandle(pi.hThread);
  end;
  // проверяем код завершения проги. 0 - ОК, иначе - ошибка
  Result := (ExitCode = 0);


Выдрано из рабочей функции, но могут быть артефакты вырезания лишнего

Однако не очень простая функция :). Но интересная.
Раз уж первый вопрос решился столь банально, не подскажете, как можно принудительно закрыть программы запущенные исключительно данной родительской программой (ну допустим запущенно две программы одновременно или вручную запущенна расчетная программа) у CreateProcess параметров какое-то безумное количество,способна ли она на такое?
Смысл - сделать кнопку в родительской программе "Остановить расчет": процесс запуска новых модулей остановить легко, но вот сами модули закрыть сложнее (не закрыв лишнего), стоит понимать, что средний расчет в одном расчетном модуле идет 4-6 часов (а весть расчет может идти около недели). Впихивать в расчетные модули что-то для прерывания крайне не хочется, к этому модулю достаточно суровые требования по коду и разрабатывается он не мной, обработкой параметров при запуске и сообщением при окончании хотелось бы ограничится.
Василий 2
Дата: 28.06.2019 10:19:09
Конечно, посмотри внимательнее, у меня есть закрытие процесса по таймеру
alekcvp
Дата: 28.06.2019 10:26:57
Андрей Игоревич
Раз уж первый вопрос решился столь банально, не подскажете, как можно принудительно закрыть программы запущенные исключительно данной родительской программой (ну допустим запущенно две программы одновременно или вручную запущенна расчетная программа) у CreateProcess параметров какое-то безумное количество,способна ли она на такое?
Смысл - сделать кнопку в родительской программе "Остановить расчет": процесс запуска новых модулей остановить легко, но вот сами модули закрыть сложнее (не закрыв лишнего), стоит понимать, что средний расчет в одном расчетном модуле идет 4-6 часов (а весть расчет может идти около недели). Впихивать в расчетные модули что-то для прерывания крайне не хочется, к этому модулю достаточно суровые требования по коду и разрабатывается он не мной, обработкой параметров при запуске и сообщением при окончании хотелось бы ограничится.

TerminateProcess() должен помочь. Хэндл процесса у вас уже есть из кода выше, разве что с правами могут возникнуть трудности, но, по-идее, не должны.
alekcvp
Дата: 28.06.2019 10:28:05
Василий 2
Конечно, посмотри внимательнее, у меня есть закрытие процесса по таймеру

if WaitForSingleObject(pi.hProcess, 5*MSecsPerSec) = WAIT_TIMEOUT then
        begin TerminateProcess(pi.hProcess, 0); raise Err('Превышен срок ожидания'); end;

Это вот жесть, с точки зрения читаемости кода, ИМХО.
Андрей Игоревич
Дата: 28.06.2019 14:41:30
Василий 2
Конечно, посмотри внимательнее, у меня есть закрытие процесса по таймеру

Ага, спасибо. Всё отлично работает, открывает, закрывает, на удивление...

Из любопытства, понимаю что не про Делфи, но вдруг знаете чисто теоретически может ли Handle у программ повторятся? Ну например запомнил я все Handle всех запущенных программ, пользователь позакрывал часть руками, потом понаоткрывал новых всяких разных, а затем нажал "остановить расчет" - который убивает все процессы с запомненными Handle и дополнительно убил и ни в чем не повинные процессы? Надо ли такое отслеживать или шанс подобного пренебрежительно мал?

alekcvp
TerminateProcess() должен помочь. Хэндл процесса у вас уже есть из кода выше, разве что с правами могут возникнуть трудности, но, по-идее, не должны.

Отлично работает, спасибо. Про права, если у пользователя нет прав админа будет ли работать?