Форум: "Основная";
Текущий архив: 2002.10.10;
Скачать: [xml.tar.bz2];
Внизпроблемы с активизацией приложения Найти похожие ветки
← →
Андрусь (2002-09-24 17:00) [0]Привет всем! Тут вот мучаюсь со следующей проблемой:необх. ограничить число запущенных экземпляров прогр. на одном компьютере до 1-го.Порылся на сайте тут и начал делать так:в проекте создал новый модуль,который в сорсе указал 1-м(будет подгружен 1-м).В нём в секции
initialization
пытаюсь создать мютекс с уник. именем собр. из пути к файлу.Если он уже есть,сл-но один экз. уже запущен.( http://delphi.mastak.ru/articles/limit.html)
Далее я хочу активизировать запущенное ранее приложение. Вот здесь у меня чего-то не отрабатывает.Я делаю так:
(на основании FAQ)
Function FindLastAppl(WndText,ClName:String):hWnd;
Var Wnd : hWnd; buff: Array [0..127] Of Char;WTxt:Boolean;
Begin
Result:=0;
Wnd := GetWindow(Application.Handle, gw_HWndFirst);
While Wnd <> 0 Do
Begin {Не показываем:}
If //(Wnd <> Application.Handle) And {-Собственное окно}
IsWindowVisible(Wnd) And {-Невидимые окна}
(GetWindow(Wnd, gw_Owner) = 0) And {-Дочернии окна}
(GetWindowText(Wnd, buff, sizeof(buff)) <> 0){-без заголовков} Then
Begin
If Pos(WndText, StrPas(buff)) > 0 Then Wtxt:=True
Else Wtxt:=False;
GetClassName(Wnd, buff, sizeof(buff));
If (ClName<>"")Then
If (Pos(ClName, StrPas(buff)) > 0)And Wtxt Then
Begin
Result:=Wnd;
Break;
End;
End;
Wnd := GetWindow(Wnd, gw_hWndNext);
End;
Затем активизируем найденное окно:
//BringWindowToTop(Wnd); тоже как вариант пробовал
ShowWindow(Wnd,SW_ShowNormal);
SetForegroundWindow(Wnd);
Вот. Но почему-то не отрабатывает.Под дебагером смотрел - всё находит,только почему-то не активизируется приложение.
Может кто решал подобную проблему. Может что я делаю не так. Посоветуйте как лучше. Зараннее всем большое спасибо.
← →
Дежавюев (2002-09-24 17:13) [1]Фигня. Используй Mutex-ы. Просто и сердито!
← →
Андрусь (2002-09-24 17:24) [2]>Дежавюев
Для чего? Для ограничения количества запущенных прог. - так использую.Проблема то в другом.
← →
Song (2002-09-24 17:42) [3]В качестве дискриптора на SetForeGroundWindow() надо передавать Application.Handle того приложения, т.е. просто найти его через FindWindow(). Весь этот цикл не нужен.
← →
Андрусь (2002-09-24 18:01) [4]>Song
Это понятно. Но вот у меня ситуация (как и в одном из FAQ),когда нет полного текста окна.Как быть здесь...
← →
Song (2002-09-24 18:07) [5]2Андрусь © (24.09.02 18:01)
По классу окна.
А я, заметьте про окно ничего и не говорил.
Я говорил про Application.Handle.
Дык вот. Если Вы в программе зададите Application.Title можете по этому Title искать через FindWindow()
← →
Андрусь (2002-09-24 18:16) [6]А класс окна у всех TApplication... По крайней мере GetClassName давал мне такие(для моих приложений).
Ну про титл: а если он не постоянен.
← →
handra (2002-09-24 18:29) [7]объяви обработчик сообщения в окне проги и шли его ему:
const
MY_MSG_SHOW = WM_USER + 5563
TForm1=class(TForm)
...
private
procedure FMyMsgShow(var Msg: TMessage); message MY_MSG_SHOW;
...
procedure TForm1.FMyMsgShow(var Msg: TMessage);
begin
//восстанавливаешь здесь свое приложение
end;
В другом приложении SendMessage(НайденныйHWND,MY_MSG_SHOW,0,0);
← →
AL2002 (2002-09-24 18:32) [8]А к hPrevInst ты как относишься?
← →
handra (2002-09-24 18:42) [9]AL2002 ©> в целях совместимости с Win16, M$ не рекомендует использовать
← →
AL2002 (2002-09-24 18:47) [10]Тогда временный файл в памяти создать и хватит.
← →
kerk (2002-09-24 19:05) [11]в RX есть функция ActivatePrevInstance она находится в VCLUtils, она прекрасно работает.
← →
DiamondShark (2002-09-25 11:05) [12]Ваша проблема -- в особенностях SetForegroundWindow под Win2k.
Там она сделана так, что процесс не может установить окно переднего плана для другого процесса.
← →
Андрусь (2002-09-25 12:34) [13]>DiamondShark
Чего-то в этом духе я и подозревал.
Но всё же.Как мне быть.Необх. исключить вызов второй копии программы - с чем прекрасно справляются мютексы, плюс переключится после попытки запуска второй копии приложения на старую. и чтобы корректно отрабатывала во всех Виндах - тут тоже вроде бы всё победил:нашёл handle нужного окна,осталось одно - активизировать его.
Может быть пойти другим путём?..
← →
qube (2002-09-25 12:39) [14]нашёл handle нужного окна,осталось одно - активизировать его.
Может быть пойти другим путём?..
А может, послать ему сообщение?
← →
Song (2002-09-25 12:41) [15]Ну если хэндл нашли, пол дела сделано.
Вот попробуйте хотя бы это: BringWindowToTop()
← →
Андрусь (2002-09-25 13:32) [16]> Мастер Song ©
Хотябы то чудненько отрабатывает,как с другими виндами.
Отрабатывает в приложении,но в секции Initialization - нет. Делаю я по одной статье(упоминалась выше),так вот там мютекс и проверка идут в initialization отд. модуля, который в программе указан перевым.
unit UOneHInst;
interface
uses
Windows,SysUtils,Forms;
................
initialization
If StopLoading then
Begin
ShowErrMsg;
Wnd:=FindLastAppl("Experimentation", "TApplication")
BringWindowToTop(Wnd);
ShowWindow(Wnd,SW_SHOW);
halt;
End;
finalization
if Mutex <> 0 then
CloseHandle(Mutex);}
end.
← →
Song (2002-09-25 13:42) [17]Я бы порекомендовал поместить проверку не в Initialization главного модуля, а в dpr
← →
Андрусь (2002-09-25 14:05) [18]Честно говоря немного не до конца въехал чего вы хотите посоветовать. Скорей всего так я делаю..
program Experimentation;
uses
UOneHInst in "UOneHInst.pas",
Forms,
Unit1 in "Unit1.pas" {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
У меня проверка в Initialization модуля UOneHinst.
Вот и этого. Чего-то там не отрабатывает BringWindowToTop . Хотя внутри приложения работает.
← →
Song (2002-09-25 14:12) [19]Потому что объект TApplication не создан ещё на тот момент, устал Вам объяснять. :(
← →
Андрусь (2002-09-25 15:43) [20]Извините пожалуйста,но чего то не въезжаю - причем здесь Application, который не создан. Я нашёл handle окна,приложения,запущенного раньше. Затем BringWindowToTop-виндозная ф-я.
Простите,мастер,но я не въезжаю - поясните.
← →
Song (2002-09-25 15:45) [21]В Вашем примере что ищет FindLastAppl() ?
← →
Андрусь (2002-09-25 16:12) [22]Я же говорю - она ищет handle окна уже существующего приложения. Там вроде по коду понятно.
Извиняюсь, криво отобразил здесь. Но на самом деле там коментарить не надо - я при поиске проверяю,чтобы был не handle текущего окна - заглавного окна приложения(в модуле я подключаю Forms - там на initialization - InitProc).
← →
Дмитрий Иванов (2002-09-25 16:30) [23]я так делал,в dpr файле когда нашел хендл окна, посылаешь ему сообщение SendMessage(WD,WM_SECONDSTART,0,0); где WD - хендл, а для главной формы пишешь:
const
WM_SECONDSTART = WM_USER + 113;//при повторном запуске проги
...
private
procedure WMSECONDSTART(var Msg: TMessage); message WM_SECONDSTART;
...
//////////////////////////////////////////////////
////////РЕАКЦИЯ НА ПОВТОРНЫЙ ЗАПУСК ПРОГИ/////////
//////////////////////////////////////////////////
procedure TForm1.WMSECONDSTART(var Msg: TMessage);
var H:THandle;
begin
if not Visible then
//достаем из трея
SendMessage(Handle,WM_ICONNOTIFY,100,WM_LBUTTONDBLCLK)
else
begin
//активизация
H:=GetForegroundWindow;
if H<>Handle then AttachThreadInput(GetWindowThreadProcessId(H, nil),
GetWindowThreadProcessId(Handle, nil), True);
if IsIconic(Application.Handle) then
Application.Restore
else
SetForegroundWindow(Handle);
end;
end;
ЗЫ: под ME работает, под другими виндами не пробовал
← →
Zemal (2002-09-25 18:44) [24]program Project1;
uses
Forms,
Windows,
Dialogs,
unMain in "unMain.pas" {fmMain};
{$R *.res}
var
UniqueMapping: THandle;
begin
UniqueMapping := CreateFileMapping($ffffffff,
nil, PAGE_READONLY, 0, 32, "MyMap");
if UniqueMapping = 0 then
begin
ShowMessage("Ошибка выделения памяти!!!");
Halt;
end else
if GetLastError = ERROR_ALREADY_EXISTS then
begin
ShowMessage(
"Можно запустить только один экземпляр приложения!!!");
Halt;
end;
Application.Initialize;
Application.CreateForm(TfmMain, fmMain);
Application.Run;
end.
Вот такой код в файле проекта и все твои проблемы решены :). Работает всегда и везде - проверено много раз и на любых виндах.
← →
Андрусь (2002-09-25 19:10) [25]>Zemal ©
То каким образом определять является ли данный запуск первым я определился - проблема немного в другом - в переключении на работающее приложение. Внимательнее,господа,пожалуйста...
← →
Юрий Зотов (2002-09-25 21:09) [26]Королевство, раздел Hello,World, Примеры работы с WinAPI (самая нижняя ссылка). Там готовые примеры по Вашим вопросам.
← →
Дмитрий Иванов (2002-09-25 22:07) [27]
> Андрусь © (25.09.02 19:10)
> >Zemal ©
> я определился - проблема немного в другом - в переключении
> на работающее приложение. Внимательнее,господа,пожалуйста...
я же тебе написал уже .. будь сам внимателен!
← →
Андрусь (2002-09-26 12:55) [28]>Юрий Зотов
Посмтрел линки,но нет там решения моей проблемы - нужно переключиться на старое приложение.
← →
Дмитрий Иванов (2002-09-26 14:29) [29]program CapBtn;
uses
Windows, Forms, Messages,
main in "main.pas" {Form1};
{$R *.RES}
const AppID="dfggsdfggdrtsdfvvvdr";
var Handle:THandle;h:HWND;
begin
Handle:=CreateFileMapping($FFFFFFFF,nil,PAGE_READONLY,0,1,AppID);
if GetLastError=ERROR_ALREADY_EXISTS then
begin
h:=FindWindow("TForm1","Form1");
SendMessage(h,WM_SECONDSTART,0,0);
end
else
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run
end;
CloseHandle(Handle)
end.
=====================================================
unit Unit1;
interface
uses
Windows, Messages, Forms;
const
WM_SECONDSTART = WM_USER + 113;
type
TForm1 = class(TForm)
private
procedure WMSECONDSTART(var Msg: TMessage); message WM_SECONDSTART;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMSECONDSTART(var Msg: TMessage);
var H:THandle;
begin
H:=GetForegroundWindow;
if H<>Handle then AttachThreadInput(GetWindowThreadProcessId(H, nil), GetWindowThreadProcessId(Handle, nil), True);
if IsIconic(Application.Handle) then
Application.Restore
else
SetForegroundWindow(Handle);
end;
end.
← →
Андрусь (2002-09-30 18:10) [30]>Дмитрий Иванов
Что-то мессага не проходит.
Видимо всё же под Win2k нужно не так
← →
TTCustomDelphiMaster (2002-09-30 18:52) [31]F1 - RegisterWindowMessage
← →
Андрусь (2002-09-30 19:41) [32]Извиняюсь - мессагу ловит,но не поднимается
← →
alena.svt (2002-09-30 20:16) [33]Вам Юрий Зотов писал ссылку и я не поверю что она не работает.
Вот создайте новый проект
И вставте
unit Unit1;
interface
uses Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs;
type TForm1=class(TForm)
procedure FormCreate(Sender:TObject);
private
procedure ActivatePrevInst;
protected
procedure WndProc(var Message:TMessage);override;
end;
var Form1:TForm;
WM_SendDKSFileNameToOpen:Integer;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
CreateSemaphore(nil,0,1,"DelphiKingdomSampleViewSemaphore");
if GetLastError=Error_Already_Exists then
begin
ActivatePrevInst;
Application.Terminate
end
end;
function SeekForMainWindow(Wnd:HWnd;LParam:PInteger):Bool; stdcall;
var Buf:array[Byte] of Char;
ModuleName:string;
begin
if (Wnd<>Form1.Handle) and (Wnd<>Application.Handle) then
begin
GetModuleFileName(GetWindowLong(Wnd,GWL_HInstance),Buf,255);
ModuleName:=Buf;
GetClassName(Wnd,Buf,255);
Result:=(CompareText(ModuleName,ParamStr(0))<>0) or (CompareText(Buf,Form1.ClassName)<>0);
if not Result then
LParam^:=Wnd
end
else
Result:=True
end;
procedure TForm1.ActivatePrevInst;
var MainWnd,AppWnd:HWnd;
I:Integer;
AtomID:TAtom;
begin
AppWnd:=0;
repeat
AppWnd:=FindWindowEx(0,AppWnd,"TApplication",PChar(Application.Title))
until AppWnd<>Application.Handle;
if AppWnd<>0 then
begin
if IsIconic(AppWnd) then
ShowWindow(AppWnd,SW_Restore)
else
SetForegroundWindow(AppWnd);
MainWnd:=0;
EnumWindows(@SeekForMainWindow,Integer(@MainWnd));
if MainWnd<>0 then
for I:=1 to ParamCount do
begin
AtomID:=GlobalAddAtom(PChar(ParamStr(I)));
SendMessage(MainWnd,WM_SendDKSFileNameToOpen,0,AtomID);
GlobalDeleteAtom(AtomID)
end
end
end;
procedure TForm1.WndProc;
var Buf:array[Byte] of Char;
begin
if Message.Msg = WM_SendDKSFileNameToOpen then
begin
GlobalGetAtomName(Message.LParam,Buf,255);
end
else
inherited WndProc(Message)
end;
initialization
WM_SendDKSFileNameToOpen:=RegisterWindowMessage("WM_SendDKSFileNameToOpen");
end.
Только FormCreate в инспекторе не забудьте задать.
И все это у меня прекрасно работает под все Wind"ы и D3,5,6
← →
Андрусь (2002-09-30 20:26) [34]Я не хочу вешать обработчики на криэйт - там приложение новое уже проинициализировано,модули подгружены,память выделена. Нужно пресекать повторный вызов на корню как в http://delphi.mastak.ru/articles/limit.html. Т.е. в сорсе проекта. А оттуда что-то не работает.
← →
alena.svt (2002-09-30 20:33) [35]Но это ж всеравно оптимальный способ да и плюс можете общаться между разными приложениями если их много передавать файлы али еще какие параметры без всякого DDE может все же проще счас снести с dpr"a это чем ломать голову еще три недели(уже неделя).
Но в общем как бы не было желаю вам удачи.
← →
TTCustomDelphiMaster (2002-09-30 20:48) [36]Андрусь
В w2k не любое приложение может сделать себя активным. Но зато активное приложение может активизировать другое. По этому первая копия дожна активизироваться из второй копии.
← →
Андрусь (2002-09-30 20:51) [37]За удачу спасибо. Насчет недели - время вещь относительная.Я не стучусь головой об эту проблему - просто проверяю мысли время от времени,молча делая дело.
← →
Дмитрий Иванов (2002-10-01 02:35) [38]
> Андрусь © (30.09.02 19:41)
> Извиняюсь - мессагу ловит,но не поднимается
все поднимается:)) просто, скорее всего, в тот момент, когда ты запускаешь вторую копию, у тебя существует два окна с заголовком Form1: первое окно в первой копии твоей программы, а второе окно непосредственно в дельфях, и вот в него наверное ты посылаешь сообщение ... попробуй так: откомпилируй, а затем у формы, которая в дельфишном проекте, измени св-во Caption (так чтобы оно не было "Form1"), и запусти откомпилированный ехе"шник
← →
Андрусь (2002-10-01 14:09) [39]>TTCustomDelphiMaster ©
Обидно,а это победить как нить можно.
← →
TTCustomDelphiMaster (2002-10-01 15:43) [40]Андрусь © (01.10.02 14:09)
Читайте MSDN там все написано.
Страницы: 1 2 вся ветка
Форум: "Основная";
Текущий архив: 2002.10.10;
Скачать: [xml.tar.bz2];
Память: 0.56 MB
Время: 0.007 c