VPF::Обработка сообщений. - Форум программистов

Демо

Дата 9.3.2006, 22:17 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 6
Всего: 50

Да вот простейший пример:

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  FMsg: TMsg;
  ThrId: THandle;

implementation

{$R *.dfm}

procedure ThrProc(p: Pointer);
begin
    PeekMessage(FMsg,0,0,0,PM_NOREMOVE);
    while GetMessage(FMsg,0,0,0) do
    begin
      case FMsg.message of
        WM_USER+1:
          begin
            MessageBox(0,'WM_USER+1','Message',MB_OK);
          end;
        WM_QUIT:
          begin
            Exit;
          end;
      end;
    end;

end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  PostThreadMessage(ThrId,WM_USER+1,0,0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BeginThread(nil,0,@ThrProc,nil,0,ThrId);
end;

end.

--------------------

Romero

Дата 12.3.2006, 09:25 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 129
Регистрация: 17.6.2005

Репутация: 1
Всего: 1

Огромное спасибо! Работает. Только я разбил пример на 2 проги: одна отправляет, другая принимает.

Цитата(Romikgy @ 9.3.2006, 17:49

)

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

Нужно ли делать обработку других сообщений, кроме WM_USER+1, WM_QUIT?

Как мне организовать передачу ThrId от запущенной второй проги, если она зпускается из первой? При создании потока отправлять родителю сообщение тем же способом? Тогда как узнать хэндл родителя?

И еще такой ньюанс:
Моя программа, которая должна реагировать на отправленные ей сообщения, состоит из 2 форм. На второй форме выполняется некая процедура, которая может вызвать зависание всей проги (собственно, это я и хочу отлавливать). Так вот, если сделать отдельный поток, то при зависании он ведь наверняка сможет среагировать на сообщение, а мне это не нужно.
Может, все-таки стоит мне сделать на одной из форм бесконечный цикл с проверкой? Тогда и с хэндлом будет проще - буду брать хэндл запускаемого приложения.

Romikgy

Дата 13.3.2006, 10:08 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 13
Всего: 146

Цитата(Romero @ 12.3.2006, 08:25

)

Нужно ли делать обработку других сообщений, кроме WM_USER+1, WM_QUIT?

Нужно обрабатывать , только которые те нужны, ну чтоб можно было с прогой работать (типа выключить прогу)

Цитата(Romero @ 12.3.2006, 08:25

)

передачу ThrId

что это?

Цитата(Romero @ 12.3.2006, 08:25

)

При создании потока отправлять родителю сообщение тем же способом? Тогда как узнать хэндл родителя?

ни ля ля не понял smile

Цитата(Romero @ 12.3.2006, 08:25

)

Моя программа, которая должна реагировать на отправленные ей сообщения, состоит из 2 форм. На второй форме выполняется некая процедура, которая может вызвать зависание всей проги (собственно, это я и хочу отлавливать). Так вот, если сделать отдельный поток, то при зависании он ведь наверняка сможет среагировать на сообщение, а мне это не нужно.
Может, все-таки стоит мне сделать на одной из форм бесконечный цикл с проверкой? Тогда и с хэндлом будет проще - буду брать хэндл запускаемого приложения.

ты мож сказать конкретно че нужно то ?

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

Romero

Дата 15.3.2006, 07:15 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 129
Регистрация: 17.6.2005

Репутация: 1
Всего: 1

Цитата(Romikgy @ 13.3.2006, 10:08

)

что это?

Как сообщить родителю ThrId из BeginThread, я имел ввиду.

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

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

Это сообщение отредактировал(а) Romero - 15.3.2006, 07:16

Демо

Дата 15.3.2006, 07:50 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 6
Всего: 50

Цитата(Romero @ 15.3.2006, 07:15

)

Но нужно учесть, что при зависании первой проги ответ прийти не должен

Да не ответ придти не должен, а определить нужно, что программа повисла. Не так ли?

Дополнительный поток получает сообщение, проверяет доступность основного потока и отвечает в запросившую программу код состояния программы.

Так как первая программа дочерняя по отношению ко второй и запусается из нее, то какие проблемы определить идентификатор потока?

Известен дочерний процесс. Через него и получи ид доп. потока.

--------------------

Romero

Дата 15.3.2006, 08:36 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 129
Регистрация: 17.6.2005

Репутация: 1
Всего: 1

Цитата(Демо @ 15.3.2006, 07:50

)

Дополнительный поток получает сообщение, проверяет доступность основного потока и отвечает в запросившую программу код состояния программы.

Да.

Цитата(Демо @ 15.3.2006, 07:50

)

Так как первая программа дочерняя по отношению ко второй и запусается из нее, то какие проблемы определить идентификатор потока?

Пример, плиззз.

Демо

Дата 15.3.2006, 13:35 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 6
Всего: 50

Цитата(Romero @ 15.3.2006, 08:36

)

Пример, плиззз.

Пожалуйста -

Приложение1:

Код


unit ufMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

const
  UM_GetTHrId=WM_USER+1;

type
  TAppThread=class(TThread)
  private
    FReady: Boolean;
  protected
    procedure Execute; override;
  public
    constructor Create;
    property Ready: Boolean read FReady;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
  end;

var
  Form1: TForm1;
  Thr: TAppThread;

implementation

{$R *.dfm}

{ TForm1 }
procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  if Msg.message = UM_GetTHrId then
  begin
    if Assigned(Thr) then
    begin
      while not thr.Ready do Sleep(10);
      ShowMessage('Process Query ThreadId');
      PostThreadMessage(Msg.WParam,UM_GETTHrId,Thr.ThreadID,0);
    end;
    Handled := True;
  end;
end;

{ TAppThread }

constructor TAppThread.Create;
begin
  inherited Create(True);
  FReady := False;
  FreeOnTerminate := True;
  Resume;
end;

procedure TAppThread.Execute;
var
  M: TMsg;
begin
  PeekMessage(M,0,0,0,PM_NOREMOVE);
  FReady := True;
  while GetMessage(M,0,0,0) do
  begin
    if M.wParam=0 then MessageBox(0,'Message from Prog2!','Warning',MB_OK);
    if M.wParam=1 then TerminateProcess(GetCurrentProcess,0);
    if M.message=WM_CLOSE then Exit;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
  Thr := TAppThread.Create;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
//Имитация завсиания

  Sleep(100000);
end;

end.

Приложение2:

Код


unit ufMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

const
  UM_GetThrId=WM_USER+1;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  H: THandle;
  ThrId: THandle;

implementation

{$R *.dfm}

function ExecCmd(const aCommand: String): THandle;
var
  pi:PROCESS_INFORMATION;
  si:STARTUPINFO;
  cmdLine,Path: String;
begin
  Result := 0;
  ZeroMemory(@si,sizeof(si));
  si.cb:=SizeOf(si);
  si.dwFlags := STARTF_FORCEONFEEDBACK+STARTF_USESHOWWINDOW;
  si.wShowWindow := SW_SHOWNORMAL;
  Path := ExtractFilePath(aCommand);
  cmdLine := aCommand;

  if CreateProcess( nil,             // No module name (use command line).
                        PChar(cmdLine),  // Command line.
                        nil,             // Process handle not inheritable.
                        nil,             // Thread handle not inheritable.
                        False,           // Set handle inheritance to FALSE.
                        0,               // No creation flags.
                        nil,             // Use parent's environment block.
                        PChar(Path),     // Use parent's starting directory.
                        si,              // Pointer to STARTUPINFO structure.
                        pi )             // Pointer to PROCESS_INFORMATION structure.

    then
    begin
      Result := pi.dwThreadId;
      WaitForInputIdle(pi.hProcess,5000);
      CloseHandle(pi.hThread);
      CloseHandle(pi.hProcess);
    end;
end;


procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  if Msg.message = UM_GetThrId then
  begin
    ShowMessage('Handle ThreadId From App1: '+IntToStr(Msg.wParam));
    ThrId := Msg.wParam;
    PostThreadMessage(Msg.wParam,UM_GetTHrId,0,0);
    Handled := True;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  H := ExecCmd('..\prog1\prog1.exe');
  PostThreadMessage(H,UM_GetTHrId,GetCurrentThreadId,0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//Убиваем первое приложение
  PostThreadMessage(ThrId,UM_GetTHrId,1,0);
end;

end.

Это сообщение отредактировал(а) Демо - 15.3.2006, 13:40

--------------------

Romero

Дата 19.3.2006, 11:41 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 129
Регистрация: 17.6.2005

Репутация: 1
Всего: 1

Спасибо!

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »