![]() |
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Вторая копия программы ! [D7, NT4, Win2k, WinXP]
Конопелька © (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] "недостаточен для правильного восстановления приложения".