Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.10.10;
Скачать: [xml.tar.bz2];

Вниз

проблемы с активизацией приложения   Найти похожие ветки 

 
Андрусь   (2002-09-24 17:00) [0]

Привет всем! Тут вот мучаюсь со следующей проблемой:необх. ограничить число запущенных экземпляров прогр. на одном компьютере до 1-го.Порылся на сайте тут и начал делать так:в проекте создал новый модуль,который в сорсе указал 1-м(будет подгружен 1-м).В нём в секции initialization
пытаюсь создать мютекс с уник. именем собр. из пути к файлу.Если он уже есть,сл-но один экз. уже запущен.( http://delphi.mastak.ru/articles/limit.html)
Далее я хочу активизировать запущенное ранее приложение. Вот здесь у меня чего-то не отрабатывает.Я делаю так:

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;
(на основании FAQ)
Затем активизируем найденное окно:

//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.71 MB
Время: 0.06 c
3-31664
Ditrix
2002-09-20 12:45
2002.10.10
удаление поля в dBase таблице SQL запросом в runtim-е


1-31685
Cobalt
2002-09-27 18:55
2002.10.10
Как выйти из оператора case?


3-31615
Behemoth
2002-09-19 11:17
2002.10.10
А как это делать правильнее и быстрее? (SQL)


1-31700
ksan
2002-09-30 20:07
2002.10.10
контекстное меню


4-32095
PaRL
2002-08-27 19:58
2002.10.10
Текст





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский