Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Запрет запуска второго экземпляра приложения [XP]


Страницы:   1 2

Германн ©   (2010-10-30 01:39:00) 

с переключением на первый экземпляр.
Обнаружил что старый добрый SetForegroundWindow нынче не работает. Пошерстил в поисковиках, нашел кучу вариантов. Но в самых свежих сообщениях, которые я нашел, все эти варианты называются "хаками" и не дающими гарантии. Насколько смог уразуметь сейчас самым прямым путем является использование функции AllowSetForegroundWindow. Вот сейчас сижу и пытаюсь найти наиболее красивое решение. Этой функции нужен ProcessID. Искать его перебором как-то не красиво. Процесс то мой собственный. Кроме того функции SetForegroundWindow нужен Handle окна того процесса. Опять искать?
А что если использовать для данной задачи CreateFileMapping? И в этом файле передавать и PID и Handle?
P.S. Давно уже так близко кWinAPI не подходил. Дрожат коленки. :(
P.P.S. Пока сам попробовать не могу. Вчерашние эксперименты привели к необходимости переустановки Д2007.


Leonid Troyanovsky   (2010-10-31 11:44:00) [1]


> DVM ©   (31.10.10 02:15) [16]

>          PInstanceDesc(p)^.App := Application.Handle;
>          PInstanceDesc(p)^.MainWin := AWnd;

Первое хранить необязательно, бо можно найти GWL_HWNDPARENT.
А вот будет ли валиден AWnd - это еще вопрос.
Наверное, нужно хранить ThreadId, затем делать EnumThreadWindows,
убедиться, что это искомое приложение и установить на поток хук,
чтобы не пропустить WM_QUIT. А может потребуется и OpenThread,
чтобы не пропустить Terminate*.

--
Regards, LVT.


Leonid Troyanovsky   (2010-10-31 11:32:00) [2]


> 0x00FF00 ©   (31.10.10 06:30) [22]

> WM_NULL с ненулевым WParam — то оно отсылает окну-отправителю
> WM_RESPOND (после чего отправитель закрывается), и само
> выводит себя на передний план.

Сам себя foreground  процесс сделать не может.
See SetForeGroundWindow restrictions.

--
Regards, LVT.


Leonid Troyanovsky   (2010-10-31 11:25:00) [3]


> Германн ©   (31.10.10 02:33) [20]

> Здесь четко указано какой процесс имеет право поднять своё
> окно "наверх".

Если юзер пускает процесс из проводника, комстроки или ярлыком,
то запускаемый процесс может стать foreground получая юзеровский
ввод либо как запускаемый foreground процессом.

Т.е., если специально не мешать ходу процесса, то ничего
осбенного (в т.ч. AllowSetForegroundWindow) для назначения
foreground предыдущей копии делать не надо.
Во всяком случае для XP, w2k3 было так.

--
Regards, LVT.


Leonid Troyanovsky   (2010-10-31 11:13:00) [4]


> Германн ©   (31.10.10 02:08) [15]

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

Например, из проводника
http://groups.google.com/group/fido7.ru.delphi.chainik/msg/278f89887ab26b31

--
Regards, LVT.


DVM   (2010-10-31 10:19:00) [5]


> Германн ©   (31.10.10 02:54) [21]


> MSDN ничего не говорит о том, что делать если вызов сей
> функции был "неудачен".

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


0x00FF00   (2010-10-31 06:31:00) [6]

Ой.
WM_RESPOND здесь вообще зря.
Можно обойтись обычным WM_CLOSE, чтобы не плодить сообщения.


0x00FF00   (2010-10-31 06:30:00) [7]

Придумал ещё один способ.

Он не включает в себя создание расшаренных файлов или сегментов.
Основан он на посылке обычного Broadcast-сообщения WM_NULL, которое все окна в системе обычно игнорируют.
Все, кроме нашего.

Ключевыми являются обработчики сообщений WM_NULL (который для всех окон задан по умолчанию) и WM_RESPOND.

При создании нового экземпляра приложения, WM_NULL посылается широковещательно всем окнам системы. Откликнется же на нулевое сообщение только наше окно. Если оно видит, что ему пришло WM_NULL с ненулевым WParam — то оно отсылает окну-отправителю WM_RESPOND (после чего отправитель закрывается), и само выводит себя на передний план.

Впрочем, если считаете, что использовать WM_NULL "не по назначению" — дурной тон, то вполне можно применить RegisterWindowMessage для создания спецсообщения (увы, без предварительной регистрации Broadcast не сработает).

Вот минимальный рабочий пример:

program Test;

uses
 Windows, Messages;

const
 WM_RESPOND = WM_USER + 1000;
 BSF_ALLOWSFW = $80;
 CN = 'TEST_WND';
 WN = 'Test';
 WW = 400;
 WH = 300;

var
 M : MSG;
 W : HWND;
 WC : WNDCLASS;

function WindowProc(hWnd: HWND; Msg, WParam, LParam: LongInt): LongInt; stdcall;
begin
 Result:=0;
 case Msg of
   WM_CREATE: BroadcastSystemMessage(BSF_ALLOWSFW or BSF_NOTIMEOUTIFNOTHUNG, nil, WM_NULL, hWnd, 0);

   WM_NULL:
     if (WParam<>0)and(WParam<>hWnd) then begin
       SetForegroundWindow(hWnd);
       SendMessage(WParam, WM_RESPOND, 0, 0);
     end;

   WM_RESPOND: SendMessage(hWnd, WM_CLOSE, 0, 0);

   WM_CLOSE: DestroyWindow(hWnd);

   WM_DESTROY: PostQuitMessage(0);
   
   else Result:=DefWindowProc(hWnd, Msg, WParam, LParam);
 end;
end;

begin
 fillChar(WC, SIZEOF(WNDCLASS), 0);
 with WC do begin
   Style:=CS_HREDRAW or CS_VREDRAW;
   lpfnWndProc:=@WindowProc;
   hInstance:=SysInit.HInstance;
   hCursor:=LoadCursor(0, IDC_ARROW);
   hbrBackground:=GetSysColorBrush(COLOR_BTNFACE);
   lpszClassName:=CN;
 end;
 RegisterClass(WC);
 W := CreateWindowEx(0, CN, WN, WS_VISIBLE or WS_SYSMENU,
 round((GetSystemMetrics(SM_CXSCREEN)-WW)/2),
 round((GetSystemMetrics(SM_CYSCREEN)-WH)/2),
 WW, WH, 0, 0, HInstance, nil);
 ShowWindow(W, SW_SHOWNORMAL);
 UpdateWindow(W);

 while GetMessage(M, 0, 0, 0) do begin
   TranslateMessage(M);
   DispatchMessage(M);
 end;
 
 UnregisterClass(CN, HInstance);
 Halt(M.wParam);
end.


P.S. Звиняюсь, если слишком назойлив :-[


Германн   (2010-10-31 02:54:00) [8]

Подниму наверх свой вопрос Германн ©   (31.10.10 01:31) [10]
Как грамотно использовать функцию GetWindowThreadProcessId?
Эта функция возвращает два значения.
1. identifier of the thread that created the window.
2. lpdwProcessId
[out]Pointer to a variable that receives the process identifier. If this parameter is not NULL, GetWindowThreadProcessId copies the identifier of the process to the variable

MSDN ничего не говорит о том, что делать если вызов сей функции был "неудачен".


Германн   (2010-10-31 02:33:00) [9]

В любом случае всё упирается в http://msdn.microsoft.com/en-us/library/ms633539%28VS.85%29.aspx
Здесь четко указано какой процесс имеет право поднять своё окно "наверх".


Германн   (2010-10-31 02:22:00) [10]


> DVM ©   (31.10.10 02:15) [16]
>
>
> > Германн ©   (31.10.10 02:08) [15]
>
> Я вот так делаю, проблем вроде нет:
>
>

И этот юнит ты помещаешь в начало списка uses.
Это тоже уже описано.


DVM   (2010-10-31 02:21:00) [11]

ну еще

var
SingleRun: TSingleRun;

можно защитить, обернув в функцию и убрать с глаз долой в implementation

но это уже неважно


DVM   (2010-10-31 02:18:00) [12]

в dpr файле в самом начале вставить:

 if SingleRun.ActivatePrevInstance then exit;


в OnCreate главной формы

SingleRun.RegisterInstance(Handle);


DVM   (2010-10-31 02:15:00) [13]


> Германн ©   (31.10.10 02:08) [15]

Я вот так делаю, проблем вроде нет:


unit uSingleRun;

interface

uses
 Windows, Messages, SysUtils, Forms;

type

 TInstanceDesc = record
   App: HWND;
   MainWin: HWND;
 end;
 PInstanceDesc = ^TInstanceDesc;

 TSingleRun = class
 private
   FInstanceHandle: THandle;
   FInstanceName: string;
   FRegistered: boolean;
 public
   constructor Create(const AInstanceName: string);
   destructor Destroy; override;
   function ActivatePrevInstance: Boolean;
   procedure RegisterInstance(AWnd: HWND);
   procedure UnregisterInstance;
 end;

var
 SingleRun: TSingleRun;

implementation

//------------------------------------------------------------------------------

constructor TSingleRun.Create(const AInstanceName: String);
begin
 inherited Create;
 FInstanceName := AInstanceName;
end;

//------------------------------------------------------------------------------

destructor TSingleRun.Destroy;
begin
 UnregisterInstance;
 inherited Destroy;
end;

//------------------------------------------------------------------------------

function TSingleRun.ActivatePrevInstance: boolean;
var
 p: Pointer;
 h: THandle;
 hApp: HWND;
 hMainWin: HWND;
begin
 result := False;
 h := OpenFileMapping(FILE_MAP_READ, False, PChar(FInstanceName));
 if h <> 0 then
   begin
     p := MapViewOfFile(h, FILE_MAP_READ, 0, 0, 0);
     if Assigned(p) then
       begin
         hApp := PInstanceDesc(p)^.App;
         hMainWin := PInstanceDesc(p)^.MainWin;
         if IsWindow(hApp) and IsWindow(hMainWin) then
           begin
             if IsIconic(hApp) then
               ShowWindow(hApp, SW_SHOW);
             if IsIconic(hMainWin) then
               ShowWindow(hMainWin, SW_SHOW);
             BringWindowToTop(hMainWin);
             SetForegroundWindow(hMainWin);
             result := True;
           end;
         UnmapViewOfFile(p);
       end;
     CloseHandle(h);
   end;
end;

//------------------------------------------------------------------------------

procedure TSingleRun.RegisterInstance(AWnd: HWND);
var
 p: Pointer;
begin
 if FRegistered then
   Exit;
 FInstanceHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
                                  SizeOf(TInstanceDesc), PChar(FInstanceName));
 if FInstanceHandle <> 0 then
   begin
     p := MapViewOfFile(FInstanceHandle, FILE_MAP_WRITE, 0, 0, 0);
     if Assigned(p) then
       begin
         PInstanceDesc(p)^.App := Application.Handle;
         PInstanceDesc(p)^.MainWin := AWnd;
         UnmapViewOfFile(p);
         FRegistered := True;
       end
     else
       UnregisterInstance;
   end;
end;

//------------------------------------------------------------------------------

procedure TSingleRun.UnregisterInstance;
begin
 if FInstanceHandle <> 0 then
   begin
     CloseHandle(FInstanceHandle);
     FInstanceHandle := 0;
     FRegistered  := False;
   end;
end;

//------------------------------------------------------------------------------

initialization

 SingleRun := TSingleRun.Create(ExtractFileName(ParamStr(0)));

finalization

 SingleRun.Free;
 
end.


Германн   (2010-10-31 02:08:00) [14]


> DVM ©   (31.10.10 01:51) [14]
>
>
> > Германн ©
>
> а ты вообще уверен, что тебе нужно именно Foreground окно?
>  Т.е с фокусом ввода? Просто вылезти наверх недостаточно?
>
>

Достаточно. Но я тебя не совсем понимаю. Есть другой способ при попытке запустить программу из меню Пуск, из ярлыка на рабочем столе и т.д. не запускать вторую копию, а "показать пользователю окно уже работающего экземпляра программы"?


DVM   (2010-10-31 01:51:00) [15]


> Германн ©

а ты вообще уверен, что тебе нужно именно Foreground окно? Т.е с фокусом ввода? Просто вылезти наверх недостаточно?


DVM   (2010-10-31 01:49:00) [16]

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


Германн   (2010-10-31 01:44:00) [17]


>  А чего в нем кривого?

1. AttachThreadInput
 Используя эту функцию в данном примере мы пытаемся обмануть ОС говоря, что это нам очень нужно. Обманув мы возвращаем всё в исходное состояние.
2. SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT...
 Ради личной цели меняем общие настройки ОС.


Германн   (2010-10-31 01:33:00) [18]


> DVM ©   (31.10.10 01:30) [9]
>
>
> > Германн ©   (31.10.10 01:25) [8]
>
> А чего в нем кривого? Все честно законно, документировано.
>
>

Приведу еще одну ссылку
http://blogs.msdn.com/b/oldnewthing/archive/2009/02/20/9435239.aspx


Германн   (2010-10-31 01:31:00) [19]

Пробую написать своё решение с использованием функции AllowSetForegroundWindow. И возник вопрос:
Как грамотно использовать функцию GetWindowThreadProcessId?
Ни в SDK, ни в msdn не сказано что делать в случае какой-либо ошибки.
Такое впечатление, что эту функцию писала "другая группа" (с) DVM ©
:)


DVM   (2010-10-31 01:30:00) [20]


> Германн ©   (31.10.10 01:25) [8]

А чего в нем кривого? Все честно законно, документировано.

И оно будет работать по всей видимости всегда. Есть причины.

Как бы там ни было, у MS всегда должна быть в загашнике функция для переключения окон таскбаром, пока есть таскбар.


Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо