procedure ..(var msg:TMessage); message MY_MSG; отрабатывает 1 раз!?

[Человек_Борща]

Доброго времени!

Имеется собственное оконное сообщение(регистрируется в конструкторе формы), и на него стоит хук.

Конструктор формы:

procedure TMainForm.FormCreate(Sender: TObject);
var
  d: PInteger;
  aInt: Integer;
begin
  ...
  if IsAlreadyRunning(aInt) then //Если копия ПО существует, то в aInt пишется дескриптор гл. окна
  begin
    PostMessage(aInt, MY_MSG, 0, 0); //Оправляется сообщение с целью "Юзер забыл что ты есть, покажи себя!"
    Application.Terminate; //Убить 2-ю копию. 
  end;

  //Если это первый экземпляр ПО
  hMMF := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, 4096,
    PChar(MMFName));
  RegisterWindowMessage('MY_MSG'); 
  d := MapViewOfFile(hMMF, FILE_MAP_WRITE, 0, 0, 0);
  try
    d^ := Handle;
  finally
    UnmapViewOfFile(d);
  end;

Хук на сообщение:

procedure TMainForm.MMFHandler(var MSG: TMessage);
begin
  if MSG.MSG = MY_MSG then
  begin
    TrayHideShowBtn.Caption := DM.GetTranslatableConst(TC_TRAY_HIDECAPTION);
    TrayHideShowBtn.ImageIndex := 6;

    Application.MainForm.Show;
    Application.ShowMainForm := true;
    FlashWindow(Application.MainFormHandle, true);
  end;
end;

Хук отрабатывает только 1 раз, почему?
Во второй и 3-й раз, в него даже не заходит отладчик.

[Пепел Феникса]

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

[Человек_Борща]

inherited

Нужен только для оконных сообщений.

Даже если бы это было не так, все равно сообщение доходило бы до меня, но дальше не шло. Однако, этого не происходит вообще. Хук срабатывает 1 раз, за 1 запуск ПО и больше не отрабатывает.

[Кольша]

может wm_copydata?и mutex? отлично срабатывает всегда...

[xoodoo]

в aInt пишется дескриптор гл. окна

Главное окно VCL-приложения и окно главной формы VCL-приложения - не одно и тоже, это совершенно разные окна.

PostMessage(aInt, MY_MSG, 0, 0);

Логично было бы предположить что ниже следует вызов функции

MY_MSG := RegisterWindowMessage('MY_MSG');

А его-то как раз и нет, код зарегистрированного сообщения благополучно похерен, так что непонятно как это вообще работате хотя бы 1 раз.

Application.Terminate; //Убить 2-ю копию.

Terminate ничего не "убивает", всего лишь выставляется флаг завершения, так что выполнение программы боагополучненько продолжается со строчки следующей сразу за комментарием
//Если это первый экземпляр ПО

[Человек_Борща]

Главное окно VCL-приложения и окно главной формы VCL-приложения - не одно и тоже, это совершенно разные окна.

Тогда как правильно сделать? Нужно поставить именно главное окно. Хотя этот код можно и в OnShow поставить.

Далее как правильно регистрировать свое сообщение?
Точнее у меня есть переменная vMY_MSG:THandle в неё я регистрирую RegisterWindowMessage('MY_MSG')

КАк второму приложению узнать, какую команду послать?

[xoodoo]

vMY_MSG:THandle в неё я регистрирую RegisterWindowMessage('MY_MSG')

В упор не вижу этого в твоем коде.

[Человек_Борща]

Кто-нибудь направит на путь истинный?
Есть сабж с RegisterWindowMessage:

procedure TMainForm.WndProc(var MSG: TMessage);
begin
inherited;
if MSG.MSG = MY_MSG then
begin
TrayHideShowBtn.Caption := DM.GetTranslatableConst(TC_TRAY_HID ECAPTION);
TrayHideShowBtn.ImageIndex := 6;

Application.MainForm.Show;
Application.ShowMainForm := true;
FlashWindow(Application.MainFormHan dle, true);
end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
d: PInteger;
aInt: Integer;
begin
LoadLangSettings;
MY_MSG := RegisterWindowMessage('MY_MSG ');
if IsAlreadyRunning(aInt) then
begin
PostMessage(aInt, MY_MSG , 0, 0);
Application.Terminate;
end;

hMMF := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, 4096,
PChar(MMFName));

d := MapViewOfFile(hMMF, FILE_MAP_WRITE, 0, 0, 0);
try
d^ := Application.Handle;
finally
UnmapViewOfFile(d);
end;

Нифига не работает -(

[Человек_Борща]

Такс, отказался от RegisterWindowMessage.
Просто задал константу WM_USER + какое-то число;

Создал пустую форму, в конструкторе которой:

var
  EmptyForm: TEmptyForm;

implementation

uses MainFormUnit,uConsts;

{$R *.dfm}

procedure TEmptyForm.FormCreate(Sender: TObject);
var
  d: PInteger;
  aInt: Integer;
begin
  if IsAlreadyRunning(aInt) then
  begin
    PostMessage(aInt, MY_MSG, 0, 0);
    Application.Terminate;
  end;

  hMMF := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, 4096,
    PChar(MMFName));

  d := MapViewOfFile(hMMF, FILE_MAP_WRITE, 0, 0, 0);
  try
    d^ := MainForm.Handle;
  finally
    UnmapViewOfFile(d);
  end;
end;

procedure TEmptyForm.FormDestroy(Sender: TObject);
begin
  CloseHandle(hMMF);
end;

Фукнкция:

var
  myDir: string;
  hMMF: Thandle; // Идентификатор MMF

function IsAlreadyRunning(out aResult: Integer): Boolean;

implementation


function IsAlreadyRunning(out aResult: Integer): Boolean;
var
  hmMMF: Thandle;
  pReadInt: PInteger;
begin
  aResult := -1;
  hmMMF := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MMFName));
  try
    Result := (hmMMF <> 0);
    if Result then // if true...
    begin
      pReadInt := MapViewOfFile(hmMMF, FILE_MAP_ALL_ACCESS, 0, 0, 0);
      try
        if (pReadInt <> nil) then
          aResult := pReadInt^; //<<- ПРОБЛЕМА! 
      finally
        UnmapViewOfFile(pReadInt);
      end;
    end;
  finally
    CloseHandle(hmMMF);
  end;
end;

Суть в том, что код работает только 1 раз.
В IsAlreadyIsRunning в aResult каждый раз новые числа лезут, а должно быть одно и тоже.
Может я не правильно читаю оттуда?

[Кольша]

Чем вас mutex'ы не устраивают?Я их предложил уже давненько..