freepascal.ru

Необходимо следить за запуском следующих копий программы под windows ce и, если таковые обнаружены, разворачивать главное окно первой копии, которая запущена раньше всех, а дубль прибивать. Я использовал для этого стандартную схему с мютексами, а для того, чтобы развернуть окно первой запущенной копии, посылаю специальное сообщение, которое обрабатываю в заранее подмененной оконной процедуре. В итоге получился следующий код:

Код: Выделить всё

unit AppExistSpy;
interface

uses
  Windows;

function SpyEnable(Handle: THandle): Boolean;

implementation

const
  WM_EXISTS = 1024 + 1;

var
  Mutex: THandle;
  OldWndProc: WndProc;

function NewWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall;
begin
  if msg = WM_EXISTS then
  begin
    ShowWindow(hWnd, SW_RESTORE);
    SetActiveWindow(HWND);
  end
  else
    result := CallWindowProc(OldWndProc, hWnd, Msg, wParam, lParam);
end;

function SpyEnable(Handle: THandle): boolean;
begin
  result := false;
  Mutex := CreateMutex(nil, false, 'MyMutex');
  if GetLastError = ERROR_ALREADY_EXISTS then SendMessage(Handle, WM_EXISTS, 0, 0)
  else
  begin
    OldWndProc := WndProc(SetWindowLong(Handle, GWL_WNDPROC, LongInt(@NewWndProc)));
    result := true;
  end;
end;

end.

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

А чем SetForegroundWindow не подходит?

А без особой разницы какая функция вызsвается для оперирования окном. Туда управление просто никогда не передаётся. И я кажется теперь понял почему: сообщение WM_EXISTS я отправляю не первому окну, а самому себе. Походу надо читать в хелпе про широковещательную рассылку, или вообще забивать на сообщения и использовать что-то другое

Так сообщение надо отсылать по-идее до создания собственного окна

FedeX
Своего я всё-таки добился. Пришлось регистрировать глобальное сообщение и использовать BroadcastSystemMessage. Вот поправленный код модуля:

Код: Выделить всё

unit AppExistSpy;

interface

uses
  Windows;

function SpyEnable(Handle: THandle): Boolean;

implementation

Const
  Msg_Name = 'Msg_copy_exsists';

var
  Mutex: THandle;
  OldWndProc: WndProc;
  MsgNum: Cardinal;

function NewWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall;
begin
  if msg = MsgNum then
  begin
    ShowWindow(hWnd, SW_SHOWNORMAL);
    SetForegroundWindow(hWnd);
  end
  else
    result := CallWindowProc(OldWndProc, hWnd, Msg, wParam, lParam);
end;

function SpyEnable(Handle: THandle): boolean;
var
  Recipients: DWORD;
begin
  result := false;
  MsgNum := RegisterWindowMessage(Msg_Name);
  Mutex := CreateMutex(nil, false, 'MyMutex');
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
    Recipients := BSM_APPLICATIONS;
    BroadcastSystemMessage(BSF_POSTMESSAGE, @Recipients, MsgNum, 0, 0);
  end
  else
  begin
    OldWndProc := WndProc(SetWindowLong(Handle, GWL_WNDPROC, LongInt(@NewWndProc)));
    result := true;
  end;
end;

end.