Без дополнительной информации вам будет трудно помочь отладить это, особенно почему это работает в одном сервисе, но не в другом. Тем не менее:
Вместо того, чтобы пытаться исправить проблему в вашем коде, вы можете удалить окна полностью и использовать 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 () , потому что все потоки должны быть освобождены, прежде чем деструктор класса контроллера-потомка начнет освобождать любые объекты, которые потоки могут использовать.