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

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

Вторая копия программы ! [D7, NT4, Win2k, WinXP]


Страницы:   1 2 3 4

Конопелька ©   (2005-12-07 00:12:00) 

Здравтвуйте !
Подскажите пожалуйста исключение варианта запуска второй копии программы !! и что б при повторном запуске программы открывалось уже запущеное мое приложение ! у меня есть несколько примеров но они не совсем меня устраивают ! И подскажите обязательно ли для этого нужно знать название программы !и если его изменить получиться ли исключить запуск второй копии !
И тут же еще один вопрос к этой теме ! есть два приложение - первое простое с двумя кнопками (к примеру ) а второе имеет две формы ! и вот нужно что б по нажатию той или иной кнопки открывалось то или иное окно второй программы (уже запущеной) !
Заранее огромное спасибо за помощь ! ))


Игорь Шевченко   (2005-12-07 18:27:00) [41]

А вот народу нифига непонятно, почему, собстна нельзя просто вызвать SetForegroundWindow ?


Leonid Troyanovsky   (2005-12-07 18:12:00) [42]


> gdaujk ©   (07.12.05 18:02) [29]


Xavi, конечно, уважаемый guy, но этот код очень далек от совершенства.
Особенно мне не нравятся всякие бродкасты.

--
Regards, LVT.


Leonid Troyanovsky   (2005-12-07 18:07:00) [43]


> Rouse_ ©   (07.12.05 17:53) [28]
> Хм, код который привел > Alexander Panov ©   (07.12.05 15:
> 14) [18] вполне документирован в MSDN. Не вижу тут никаких
> "хакерских штучек" :)


Хакерские штучки - это разнообразные варианты ForceForeground.
Хотя, фокусы SystemParametersInfo ничем не лучше.

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

И еще рефрен: чего все привязались к мьютексам, семафор -то
гораздо полезней, он хоть 4 байтовое число хранить может.

--
Regards, LVT.


gdaujk   (2005-12-07 18:02:00) [44]

Leonid Troyanovsky ©   (07.12.05 17:01) [27]

А всем этим хакерским штучкам

Почему хакерским? По-моему, вопрос возникает из-за того, что автор, как и многие другие разработчики, считает, что в ситуации, когда пользователь запускает вторую копию, а должна быть только одна, логично было бы показать ему первый экземпляр, ведь пользователь, в общем-то, этого и хочет. А  политики MS, как и пути господни, неисповедима :-)))

Обещанный код

Основан на материалах книги: "Delphi 5: руководство разработчика" Стива Тейксейра и Ксавье Пачеко.

Просто присоедините нижеописанный модуль к программе. Больше ничего делать не надо :-)

unit gdaMultInst;

interface

implementation

uses Forms, Windows;

var
 WProc: TFNWndProc;
 hMutex: THandle;
 MIError: Integer;
 UniqueMes: Integer;

const
 MI_ERROR_NONE = 0;
 MI_ERROR_FAILSUBCLASS = 1;
 MI_ERROR_CREATINGMUTEX = 2;
 UNIQUE_APP_STR = 'MyCoolProject';

procedure ForceForegroundWindow(MainWnd: HWND);
var
  fPID, cPID: DWORD;
begin
  fPID := GetWindowThreadProcessId(GetForegroundWindow, nil);
  cPID := GetWindowThreadProcessId(MainWnd, nil);
  AttachThreadInput(fPID, cPID, True);
  ShowWindow(MainWnd, SW_SHOWNORMAL);
  SetForegroundWindow(MainWnd);
  AttachThreadInput(fPID, cPID, False);
end;

function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; stdcall;
begin
 Result := 0;
 if Msg = UniqueMes
 then ForceForegroundWindow(Application.Handle)
 else
   Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;

procedure SubClassAplication;
begin
 WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc)));
 if WProc = nil
   then MIError := MIError or MI_ERROR_FAILSUBCLASS;
end;

procedure DoFirstInstance();
begin
 hMutex := CreateMutex(nil, False, UNIQUE_APP_STR);
 if hMutex = 0
   then MIError := MIError or MI_ERROR_CREATINGMUTEX;
end;

procedure BroadcastFocusMessage();
var
 BSMRecipients: DWORD;
begin
 Application.ShowMainForm := False;
 BSMRecipients := BSM_APPLICATIONS;
 BroadcastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
                        @BSMRecipients,
                        UniqueMes,
                        0, 0);
end;

procedure InitInstance;
begin
 SubClassAplication;
 hMutex := CreateMutex(nil, False, UNIQUE_APP_STR);
 if GetLastError = ERROR_ALREADY_EXISTS then
   begin
     BroadcastFocusMessage;
     Application.Terminate;
   end;
end;

initialization
 UniqueMes := RegisterWindowMessage(UNIQUE_APP_STR);
 InitInstance;

finalization
 if WProc <> nil
   then SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(WProc));
 if hMutex <> 0 then CloseHandle(hMutex);

end.


PS: писал второпях, так что скорее всего есть ошибки...


Rouse_   (2005-12-07 17:53:00) [45]

Хм, код который привел > Alexander Panov ©   (07.12.05 15:14) [18]вполне документирован в MSDN. Не вижу тут никаких "хакерских штучек" :)

на всякий случай приведу полный вариант примера:

DPR:
program Project1;

uses
 Windows,
 Forms,
 Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

var
 RestoreOldInstance: Cardinal;
begin
 CreateMutex(nil, True, '{C68C1DD9-2CB0-4B2F-9A6A-29F4ADE5707D}');
 if GetLastError = ERROR_ALREADY_EXISTS then
 begin
   if MessageBox(0,
     'Запуск второй копии приложения запрещен, активизировать предыдущую копию?',
     'Ошибка', MB_YESNO + MB_ICONERROR + MB_DEFBUTTON1) = ID_YES then
   begin
     RestoreOldInstance :=
       RegisterWindowMessage('{FC9D27F6-D173-4CF6-8A9A-3A2197C72390}');
     PostMessage(HWND_BROADCAST, RestoreOldInstance, 0, 0); // y-soft
   end;
   Exit;
 end;
 Application.Initialize;
 Application.CreateForm(TForm1, Form1);
 Application.Run;
end.


Форма:
unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   procedure FormCreate(Sender: TObject);
 private
   RestoreOldInstance: Cardinal;
   function ApplicationMessage(var Message: TMessage): Boolean;
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.ApplicationMessage(var Message: TMessage): Boolean;
var
 hWnd, hCurWnd, dwThreadID, dwCurThreadID: THandle;
 OldTimeOut: Cardinal;
 AResult: Boolean;
begin
 Result := False;
 if Message.Msg = RestoreOldInstance then
 begin
   Application.Restore; // y-soft
   hWnd := Application.Handle;
   SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @OldTimeOut, 0);
   SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, Pointer(0), 0);
   SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
   hCurWnd := GetForegroundWindow;
   AResult := False;
   while not AResult do
   begin
     dwThreadID := GetCurrentThreadId;
     dwCurThreadID := GetWindowThreadProcessId(hCurWnd);
     AttachThreadInput(dwThreadID, dwCurThreadID, True);
     AResult := SetForegroundWindow(hWnd);
     AttachThreadInput(dwThreadID, dwCurThreadID, False);
   end;
   SetWindowPos(hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
   SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, Pointer(OldTimeOut), 0);
 end;
 inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 RestoreOldInstance :=
   RegisterWindowMessage('{FC9D27F6-D173-4CF6-8A9A-3A2197C72390}');
 Application.HookMainWindow(ApplicationMessage);
end;

end.


Leonid Troyanovsky   (2005-12-07 17:01:00) [46]


> gdaujk ©   (07.12.05 16:49) [26]

> Интересный довод :-). Ващ код в ДОС тоже робить не будет
> :-))) Приведите конкретный пример...


Нет смысла приводить какой-либо пример, бо вместо того, чтобы
неактивный процесс вытаскивал себя в foreground в нарушение
политики MS, можно было законно сделать  SetForegroundWindow
из своего foreground приложения.

А всем этим хакерским штучкам судьба жить до очередного SP.
Причем, чем более разрекламированный способ, тем меньше ему жить.

Т.е., если я знаю, как обойти оное ограничение, я ни с кем не поделюсь,
бо (1) нефик идти поперек MS, (2) вдруг мне самому приcпичит поперек.

--
Regards, LVT.


gdaujk   (2005-12-07 16:49:00) [47]

Конопелька   (07.12.05 16:04) [21]

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

Alexander Panov ©   (07.12.05 16:12) [23]

Интересный довод :-). Ващ код в ДОС тоже робить не будет :-))) Приведите конкретный пример...

По топику пробежался глазами... Но SystemParametersInfo - только для Win98/ME.

PS: автор, вы предполагаете работу вашей программы под Win98/ME?


Alexander Panov   (2005-12-07 16:13:00) [48]

gdaujk ©   (07.12.05 15:24) [20]

Кстати, топик по ссылке прочитал? Там есть замечания и некоторые ссылки на материалы.


Alexander Panov   (2005-12-07 16:13:00) [49]

gdaujk ©   (07.12.05 15:24) [20]
Может пришлёте код неработающего приложения?

Откуда я его возьму?


Alexander Panov   (2005-12-07 16:12:00) [50]

gdaujk ©   (07.12.05 15:24) [20]
А у меня, на XP, работает. С чего бы это? Может пришлёте код неработающего приложения?


С того, что если работает у тебя в конкретной ситуации, еще не значит, что работать будет везде.


Virgo_Style   (2005-12-07 16:08:00) [51]

offtop: ну зачем же столько "!" ?


Конопелька   (2005-12-07 16:04:00) [52]

Я конечно извиняюсь !! Но я немного непонял наверно ! Вот я сделал так вроде работает ! Но вот в чем проблема ! Один раз он восстанавливает программу ! Но когда второй раз повторно запускаешь программу то он неможет ее закрыть и обработчики событий OnCloseQuery тож неработает и на панели задач она не появляеться !
Вот код программы:

program server;

uses
 Forms,Windows,ShellAPI,
 mainform in 'mainform.pas' {mainform1};

{$R *.res}

procedure ForceForegroundWindow(MainWnd: HWND);
var
  fPID, cPID: DWORD;
begin
  fPID := GetWindowThreadProcessId(GetForegroundWindow, nil);
  cPID := GetWindowThreadProcessId(MainWnd, nil);
  AttachThreadInput(fPID, cPID, True);
  ShowWindow(MainWnd, SW_SHOW);
  SetForegroundWindow(MainWnd);
  AttachThreadInput(fPID, cPID, False);
end;

var Handle:longint;

begin
Handle:=FindWindow('Tmainform1',nil);
if handle=0 then
 begin
 Application.Initialize;
 Application.CreateForm(Tmainform1, mainform1);
 Application.Run;
 end
   else
 begin
 ForceForegroundWindow(handle);
 end;

end.


Что я сделал неправильно ! ??


gdaujk   (2005-12-07 15:24:00) [53]

>Alexander Panov ©   (07.12.05 15:14) [18]

>Именно.

А у меня, на XP, работает. С чего бы это? Может пришлёте код неработающего приложения?

>Alexander Panov ©   (07.12.05 15:15) [19]

В W98 ... как раз нет проблем с этим.


А как тогда объяснить gdaujk ©   (07.12.05 15:12) [17]?


Alexander Panov   (2005-12-07 15:15:00) [54]

gdaujk ©   (07.12.05 15:12) [17]

В W98 и WindowsNT как раз нет проблем с этим.
В ME не знаю  - не использовал.


Alexander Panov   (2005-12-07 15:14:00) [55]

gdaujk ©   (07.12.05 15:09) [16]
То есть вы хотите сказать, что при выполнении кода [8] окно на передний план не выходит?


Именно.

Вот код:

class procedure TDummy.RestoreApp(Sender: TObject);
var
 hWnd, hCurWnd, dwThreadID, dwCurThreadID: THandle;
 OldTimeOut: Cardinal;
 AResult: Boolean;
begin
   hWnd := Application.Handle;
   SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @OldTimeOut, 0);
   SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, Pointer(0), 0);
   SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
   hCurWnd := GetForegroundWindow;
   AResult := False;
   while not AResult do
   begin
     dwThreadID := GetCurrentThreadId;
     dwCurThreadID := GetWindowThreadProcessId(hCurWnd);
     AttachThreadInput(dwThreadID, dwCurThreadID, True);
     AResult := SetForegroundWindow(hWnd);
     AttachThreadInput(dwThreadID, dwCurThreadID, False);
   end;
   SetWindowPos(hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
   SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, Pointer(OldTimeOut), 0);
 Application.Restore;
end;


(c) Rouse_ & y-soft


gdaujk   (2005-12-07 15:12:00) [56]

>В MSDN ведь написано ясно:

However, on Microsoft Windows 98and Windows Millennium Edition(Windows Me), if a nonforeground thread calls SetForegroundWindow and passes the handle of a window that was not created by the calling thread, the window is not flashed on the taskbar. To have SetForegroundWindow behave the same as it did on Windows 95 and Microsoft Windows NT 4.0, change the foreground lock timeout value when the application is installed. This can be done from the setup or installation application with the following function call:

SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, (LPVOID)0, SPIF_SENDWININICHANGE | SPIF_UPDATEINIFILE);


gdaujk   (2005-12-07 15:09:00) [57]

Alexander Panov ©   (07.12.05 15:01) [14]

окно же на передний план не появляется


То есть вы хотите сказать, что при выполнении кода [8] окно на передний план не выходит?

PS: код [8] направлен именно на перенесение окна на передний план, а не на мигание...


Alexander Panov   (2005-12-07 15:02:00) [58]

gdaujk ©   (07.12.05 14:58) [13]
Почитал и понял, что основные ограничения SetForegroundWindow накладываются в Win98/Me


В W2000 и XP ситуация намного хуже.


Alexander Panov   (2005-12-07 15:01:00) [59]

gdaujk ©   (07.12.05 14:58) [13]
PS: приведите хоть один пример (ситуацию), в котором при повторном запуске приложения в NT4, Win2k, WinXP вариант [8] "недостаточен для правильного восстановления приложения".


В MSDN ведь написано ясно:

В случае, если пользователь работает с другим приложением, окно не будет выдвинуто на передний план.
Для этого нужно воспользоваться
SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, (LPVOID)0, SPIF_SENDWININICHANGE | SPIF_UPDATEINIFILE);

И т.д.

В W2000 и XP именно так и ведет себя функция SetForegroundWindow и иже с ней - прочто начинает мигать кнопка на панели задач, окно же на передний план не появляется.


gdaujk   (2005-12-07 14:58:00) [60]

>Alexander Panov ©   (07.12.05 13:46) [12]

>Прочитай внимательно...

Почитал и понял, что основные ограничения SetForegroundWindow накладываются в Win98/Me, и избавится от оных предлагается SystemParametersInfo. Но я чтитал внимательно и сабж, в котором автором тёмно-серым по светло-серому указаны: NT4, Win2k, WinXP. Вопрос почему-то не "отпадает сам собой". Может я недостаточно внимательно читал???

>В следующий раз выбирай выражения

И какое, по вашему, выражение в контексте фразы: "Желательно аргументировать свою точку зрения, иначе можно прослыть ..." - нужно было употребить?

PS: приведите хоть один пример (ситуацию), в котором при повторном запуске приложения в NT4, Win2k, WinXP вариант [8] "недостаточен для правильного восстановления приложения".


Страницы:   1 2 3 4

Наверх

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