PostMessage в служебных приложениях

Есть проблема, которую я не могу решить. Я создал два служебных приложения в Delphi и попытался отправлять в них сообщения. Конечно, в таких приложениях нет окон, и PostMessage требуется параметр дескриптора окна для отправки сообщения.

Поэтому я создал дескриптор окна с помощью функции AllocateHWnd (MyMethod: TWndMethod) и передал в качестве параметра MyMethod процедуру, которую я хочу вызывать при получении сообщения. Если бы это было оконное приложение, PostMessage (), вызванный с использованием дескриптора, возвращенного методом AllocateHWnd, непременно отправил бы сообщение, которое затем было бы получено процедурой MyMethod.

Однако в моих сервисных приложениях ситуация иная. Я не понимаю почему, но в одном из них отправка сообщений таким образом работает нормально, а во втором - нет (сообщения вообще не принимаются). Только когда служба останавливается, я замечаю, что MyMethod получает два сообщения: WM_DESTROY и WM_NCDESTROY. Сообщения, которые я отправляю с помощью PostMessage, никогда не принимаются этой процедурой. С другой стороны, первая служба всегда получает все отправляемые мной сообщения.

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

Спасибо за любой совет. Мариуш.

Ответов (8)

Решение

Без дополнительной информации будет сложно помочь вам отладить это, особенно почему это работает в одном сервисе, а не в другом. Тем не мение:

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

Изменить: я пытаюсь ответить на все ваши ответы сразу.

Во-первых, если вы хотите упростить себе жизнь, вам действительно стоит попробовать OmniThreadLibrary от gabr . Я не знаю, работает ли это в служебном приложении Windows, я даже не знаю, пробовали ли это еще. Вы можете спросить на форуме. Однако у него много замечательных функций, и на него стоит обратить внимание хотя бы ради обучающего эффекта.

Но, конечно, вы также можете запрограммировать это для себя, и вам придется это сделать для версий Delphi до Delphi 2007. Я просто добавлю несколько фрагментов из нашей внутренней библиотеки, которая развивалась с годами и работает в нескольких десятках программ. Я не утверждаю, что в нем нет ошибок. Вы можете сравнить это со своим кодом, и, если что-то выпадет, не стесняйтесь спрашивать, и я постараюсь уточнить.

Это упрощенный метод Execute () базового класса рабочего потока:

procedure TCustomTestThread.Execute;
var
  Msg: TMsg;
begin
  try
    while not Terminated do begin
      if (integer(GetMessage(Msg, HWND(0), 0, 0)) = -1) or Terminated then
        break;
      TranslateMessage(Msg);
      DispatchMessage(Msg);

      if Msg.Message = WM_USER then begin
        // handle differently according to wParam and lParam
        // ...
      end;
    end;
  except
    on E: Exception do begin
      ...
    end;
  end;
end;

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

Существует специальный метод для инициирования завершения работы потока, поскольку поток необходимо разбудить, когда он находится внутри GetMessage () :

procedure TCustomTestThread.Shutdown;
begin
  Terminate;
  Cancel; // internal method dealing with worker objects used in thread
  DoSendMessage(WM_QUIT);
end;

procedure TCustomTestThread.DoSendMessage(AMessage: Cardinal;
  AWParam: integer = 0; ALParam: integer = 0);
begin
  PostThreadMessage(ThreadID, AMessage, AWParam, ALParam);
end;

Публикация WM_QUIT вызовет выход из цикла сообщений. Однако существует проблема, заключающаяся в том, что код в классах-потомках может полагаться на правильную обработку сообщений Windows во время выключения потока, особенно при использовании интерфейсов COM. Вот почему вместо простого WaitFor () используется следующий код для освобождения всех запущенных потоков:

procedure TCustomTestController.BeforeDestruction;
var
  i: integer;
  ThreadHandle: THandle;
  WaitRes: LongWord;
  Msg: TMsg;
begin
  inherited;
  for i := Low(fPositionThreads) to High(fPositionThreads) do begin
    if fPositionThreads[i] <> nil then try
      ThreadHandle := fPositionThreads[i].Handle;
      fPositionThreads[i].Shutdown;
      while TRUE do begin
        WaitRes := MsgWaitForMultipleObjects(1, ThreadHandle, FALSE, 30000,
          QS_POSTMESSAGE or QS_SENDMESSAGE);
        if WaitRes = WAIT_OBJECT_0 then begin
          FreeAndNil(fPositionThreads[i]);
          break;
        end;
        if WaitRes = WAIT_TIMEOUT then
          break;

        while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do begin
          TranslateMessage(Msg);
          DispatchMessage(Msg);
        end;
      end;
    except
      on E: Exception do
        // ...
    end;
    fPositionThreads[i] := nil;
  end;
end;

Это в переопределенном методе BeforeDestruction (), потому что все потоки должны быть освобождены до того, как деструктор дочернего класса контроллера начнет освобождать любые объекты, которые потоки могут использовать.

Вот что я бы попробовал:

  • Проверьте возвращаемое значение и GetLastError PostMessage
  • Это машина Vista / 2008? Если да, проверьте, есть ли у отправляющего приложения достаточные права для отправки сообщения.

Мне нужно больше информации, чтобы помочь вам в дальнейшем.

Я предлагаю вам рассмотреть возможность использования именованных каналов для IPC. Вот для чего они предназначены:

Ищете альтернативу сообщениям Windows, используемым для межпроцессного взаимодействия

Есть одна хитрость в зацикливании сообщений в потоках. Windows не создает очередь сообщений для потока немедленно, поэтому будет некоторое время, когда публикация сообщений в потоке не удастся. Подробности здесь . В моем потоке цикла сообщений я использую технику, которую предлагает MS:

constructor TMsgLoopThread.Create;
begin
  inherited Create(True);
  FEvMsgQueueReady := CreateEvent(nil, True, False, nil);
  if FEvMsgQueueReady = 0 then
    Error('CreateEvent: '+LastErrMsg);
end;

procedure TMsgLoopThread.Execute;
var
  MsgRec: TMsg;
begin
  // Call fake PeekMessage for OS to create message queue for the thread.
  // When it finishes, signal the event. In the main app execution will wait
  // for this event.
  PeekMessage(MsgRec, 0, WM_USER, WM_USER, PM_NOREMOVE);
  SetEvent(FEvMsgQueueReady);

  ...
end;

// Start the thread with waitinig for it to get ready
function TMsgLoopThread.Start(WaitInterval: DWORD): DWORD;
begin
  inherited Start;
  Result := WaitForSingleObject(FEvMsgQueueReady, WaitInterval);
end;

Но в вашем случае я настоятельно рекомендую использовать другие средства IPC.

Как упоминал Мги, вам нужен цикл обработки сообщений. Вот почему PeekMessage возвращает сообщения правильно. Дело не в том, что сообщений нет, дело в том, что вы их не обрабатываете. В стандартном приложении Delphi создает класс TApplication и вызывает Application.Run. Это цикл обработки сообщений для обычного приложения. В основном он состоит из:

  repeat
    try
      HandleMessage;
    except
      HandleException(Self);
    end;
  until Terminated;

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

Там пример использования услуги и обработку PostThreadMessage депеши здесь . Имейте в виду, как упоминал Мик, вы не можете использовать обработку сообщений между приложениями с разными контекстами безопасности (особенно в Vista). Вы должны использовать именованные каналы или аналогичные. Microsoft обсуждает это здесь .

Редактировать:

Судя по опубликованному вами фрагменту кода, возможно, вы просто боретесь с проблемой потоковой передачи. AllocHWnd не является потокобезопасным. См. Здесь действительно подробное объяснение проблемы и версию, которая правильно работает в потоках.

Конечно, это все еще возвращает нас к тому, почему вы не используете вместо этого PostThreadMessage. Поскольку ваш образец кода структурирован, было бы тривиально сделать обработку сообщения функцией потока, а затем передать ее в класс для утилизации.

Спасибо за все ваши ответы. Думаю, о проблеме можно забыть. Я создал новое приложение-службу и провел быстрые тесты сообщений. Сообщения были доставлены правильно, поэтому я надеюсь, что теперь могу заявить, что обычно все работает нормально и что-то не так только с этой одной службой, которую я описал. Я знаю, что это глупо, но я просто попробую скопировать один фрагмент кода за другим из «плохого» сервиса в новый. Возможно, это поможет мне найти причину проблемы.

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

Что касается привилегий, Microsoft говорит: «UAC использует WIM, чтобы блокировать отправку сообщений Windows между процессами с разными уровнями привилегий». В моей Vista UAC отключен, и я не устанавливал никаких привилегий для тех служб, которые я описал. Кроме того, я не отправляю сообщения между разными процессами. Сообщения отправляются в рамках одного процесса.

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

uses ...;

type
  TMyThread = class;
  TMyClass = class
  private
    FThread: TMyThread;
    procedure ReadMessage(var Msg: TMessage);
  public
    FHandle: HWND;
    constructor Create;
    destructor Destroy; override;
  end;

  TMyThread = class(TThread)
  private
    FMyClass: TMyClass;
  protected
    procedure Execute; override;
    constructor Create(MyClass: TMyClass); reintroduce;
  end;

implementation

{ TMyClass }

constructor TMyClass.Create;
begin
  inherited Create;
  FHandle := AllocateHWnd(ReadMessage);
  FThread := TMyThread.Create(Self);
end;

destructor TMyClass.Destroy;
begin
  FThread.Terminate;
  FThread.WaitFor;
  FThread.Free;
  DeallocateHWnd(FHandle);
  inherited Destroy;
end;

procedure TMyClass.ReadMessage(var Msg: TMessage);
begin
  Log.Log('message read: ' + IntToStr(Msg.Msg));
end;

{ TMyThread }

constructor TMyThread.Create(MyClass: TMyClass);
begin
  inherited Create(True);
  FMyClass := MyClass;
  Resume;
end;

procedure TMyThread.Execute;
begin
  while not Terminated do
  begin
    //do some work and
    //send a message when finished
    if PostMessage(FMyClass.FHandle, WM_USER, 0, 0) then
      Log.Log('message sent')
    else
      Log.Log('message not sent: ' + SysErrorMessage(GetLastError));
    //do something else...
    Sleep(1000);
  end;
end;

Это всего лишь пример, но функционирование моего реального кода основано на той же идее. Когда вы создаете объект этого класса, он создаст поток, который начнет отправлять сообщения этому классу. Log.Log () сохраняет данные в текстовый файл. Когда я использую этот код в новом сервисном приложении, все работает нормально. Когда я помещаю его в «сломанный» сервис, этого не происходит. Обратите внимание, что я не использую цикл ожидания сообщения для получения сообщений. Я создал новую службу и просто поместил в нее приведенный выше код, а затем создал объект класса. Это все.

Если я узнаю, почему это не работает в "битом" сервисе, я напишу об этом.

Спасибо за время, которое вы мне уделили.

Мариуш.

Я провел долгие часы, пытаясь найти причину, по которой сообщения не получаются. Как я показал в своем фрагменте кода, конструктор класса создает дескриптор окна, на который я отправлял сообщения. Пока класс был создан основным потоком, все работало нормально, поскольку дескриптор окна (если я правильно понимаю) существовал в контексте основного потока, который по умолчанию ожидает сообщений. В «сломанной» службе, как я назвал ее по ошибке, мой класс был создан другим потоком, поэтому дескриптор должен существовать в контексте этого потока. Поэтому, когда я отправлял сообщения, используя этот дескриптор окна, они были получены этим потоком, а не основным. Из-за того, что в этом потоке не было цикла ожидания сообщений, мои сообщения вообще не были получены. Я просто не знал, что так работает.

Спасибо за ваше время и всю информацию, которую вы мне предоставили.

Мги, я думаю, ты абсолютно прав. Я реализовал цикл ожидания сообщения следующим образом:

procedure TAsyncSerialPort.Execute;
var
  Msg: tagMSG;
begin
  while GetMessage(Msg, 0, 0, 0) do
  begin
    {thread message}
    if Msg.hwnd = 0 then
    begin
      case Msg.message of
        WM_DATA_READ: Log.Log('data read');
        WM_READ_TIMEOUT: Log.Log('read timeout');
        WM_DATA_WRITTEN: Log.Log('data written');
        WM_COMM_ERROR: Log.Log('comm error');
      else
        DispatchMessage(Msg);
      end;
    end
    else
      DispatchMessage(Msg);
  end;
end;

Я делаю это впервые, пожалуйста, не могли бы вы проверить правильность кода? Фактически, это фрагмент кода моего реального класса (журналы будут заменены реальным кодом). Он обрабатывает перекрывающийся порт связи. Есть два потока, которые отправляют сообщения потока в поток выше, информируя его о том, что они написали или получили некоторые данные из порта связи и т. Д. Когда поток получает такое сообщение, он выполняет действие - он получает полученные данные из очереди, где потоки сначала помещают его, а затем вызывают внешний метод, который, скажем, анализирует полученные данные. Не хочу вдаваться в подробности, это неважно :). Я отправляю сообщения потока, подобные этому: PostThreadMessage (MyThreadId, WM_DATA_READ, 0, 0).

Этот код работает правильно, как я проверял, но я хотел бы убедиться, что все правильно, поэтому я спрашиваю вас об этом. Буду признателен, если вы ответите.

Чтобы освободить поток, я делаю следующее:

destructor TAsyncSerialPort.Destroy;
begin
  {send a quit message to the thread so that GetMessage returns false and the loop ends}
  PostThreadMessage(ThreadID, WM_QUIT, 0, 0);

  {terminate the thread but wait until it finishes before the following objects 
  (critical sections) are destroyed for the thread might use them before it quits}
  Terminate;
  if Suspended then
    Resume;
  WaitFor;

  FreeAndNil(FLock);
  FreeAndNil(FCallMethodsLock);
  inherited Destroy;
end;

Я надеюсь, что это правильный способ завершить цикл сообщений.

Большое спасибо за Вашу помощь.

Кстати, я надеюсь, что мой английский язык понятен, не так ли? :) Извините, если вы меня не понимаете.