Re[4]: TService, TServiceThread, DLL
От: Danchik Украина  
Дата: 23.05.05 18:23
Оценка: 2 (1)
Здравствуйте, Strannic, Вы писали:

S>Проблема щас в другом, точнее не проблема а непонятнка. Стартует поток Thread.Execute; но как только Execute выполнилось поток тут же вызывает DoTerminate. В итоге я не сильно соображаю, каким образом не завершать работу потока пока ему явно не придет на это команды??? Ну не делать же в Execute Repeat Until Terminated; — так же все ресурсы можно посадить!


Тут тебе необходимо в потоке организовать очередь сообщений.
Можно сделать ее самым банальным способом — создать в потоке окно и посылать к нему сообщения с помощью функций SendMessage (дождаться результата) и PostMessage (поставить сообщение в очередь и продолдать работать)

Создать окно AllocateHWnd и уничтожить DeallocateHWnd (юнит Forms.pas)

Твой поток будет выглядеть так:


const
  MY_MESSAGE_BASE = CM_BASE + 1000;
  MY_MESSAGE1 = MY_MESSAGE_BASE + 1; // sample message 1
  MY_MESSAGE2 = MY_MESSAGE_BASE + 2; // sample message 2

type
  TPluginThread = class (TThread)
  private
    FWndHandle: HWND;
  protected
    procedure WndProc(var Message: TMessage); virtual;
    procedure Execute; override;
    procedure Idle;
    function ProcessMessage(var Msg: TMsg): Boolean;
    procedure ProcessMessages;
  private
    procedure MyMessage1(var Message: TMessage); message MY_MESSAGE1;
    procedure MyMessage2(var Message: TMessage); message MY_MESSAGE2;
  public
    property WndHandle: HWND read FWndHandle;
  end;


implementation

procedure TPluginThread.Execute;
begin
  try
    FWndHandle := AllocateHWND (WndProc);
    try
      ProcessMessages;
    finally
      DeallocateHWnd (FWndHandle);
    end;
  except
   // kill any exceptions
  end;
end;

procedure TPluginThread.ProcessMessages;
var
  Msg: TMsg;
begin
  while not Terminated and ProcessMessage (Msg) do {loop};
end;

function TPluginThread.ProcessMessage(var Msg: TMsg): Boolean;
begin
  Result := False;

  if PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE) then
  begin
    if GetMessage (Msg, 0, 0, 0) then begin
      Result := True;
      if Msg.Message <> WM_QUIT then begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end else
        Terminate;
    end;
  end else
    WaitMessage;

  Idle;

end;

procedure TPluginThread.Idle;
begin
  { do something if you want}
end;


procedure TPluginThread.WndProc(var Message: TMessage);
begin
  try
    Dispatch(Message);
  except
    // kill exceptions;
  end;
end;

procedure TPluginThread.MyMessage1(var Message: TMessage);
begin
  // do something
end;

procedure TPluginThread.MyMessage2(var Message: TMessage);
begin
  // do something
end;


Пример посылки сообщения:
 SendMessage (MyThread.WndHandle, MY_MESSAGE1, 0, 0)
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.