| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
проблемы с активизацией приложения [D6, Win2k]
Андрусь © (2002-09-24 17:00:00)Привет всем! Тут вот мучаюсь со следующей проблемой:необх. ограничить число запущенных экземпляров прогр. на одном компьютере до 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);
Вот. Но почему-то не отрабатывает.Под дебагером смотрел - всё находит,только почему-то не активизируется приложение.
Может кто решал подобную проблему. Может что я делаю не так. Посоветуйте как лучше. Зараннее всем большое спасибо.
TTCustomDelphiMaster (2002-10-01 15:43:00) [1]Андрусь © (01.10.02 14:09)
Читайте MSDN там все написано.
Андрусь (2002-10-01 14:09:00) [2]>TTCustomDelphiMaster ©
Обидно,а это победить как нить можно.
Дмитрий Иванов (2002-10-01 02:35:00) [3]
> Андрусь © (30.09.02 19:41)
> Извиняюсь - мессагу ловит,но не поднимается
все поднимается:)) просто, скорее всего, в тот момент, когда ты запускаешь вторую копию, у тебя существует два окна с заголовком Form1: первое окно в первой копии твоей программы, а второе окно непосредственно в дельфях, и вот в него наверное ты посылаешь сообщение ... попробуй так: откомпилируй, а затем у формы, которая в дельфишном проекте, измени св-во Caption (так чтобы оно не было "Form1"), и запусти откомпилированный ехе"шник
Андрусь (2002-09-30 20:51:00) [4]За удачу спасибо. Насчет недели - время вещь относительная.Я не стучусь головой об эту проблему - просто проверяю мысли время от времени,молча делая дело.
TTCustomDelphiMaster (2002-09-30 20:48:00) [5]Андрусь
В w2k не любое приложение может сделать себя активным. Но зато активное приложение может активизировать другое. По этому первая копия дожна активизироваться из второй копии.
alena.svt (2002-09-30 20:33:00) [6]Но это ж всеравно оптимальный способ да и плюс можете общаться между разными приложениями если их много передавать файлы али еще какие параметры без всякого DDE может все же проще счас снести с dpr"a это чем ломать голову еще три недели(уже неделя).
Но в общем как бы не было желаю вам удачи.
Андрусь (2002-09-30 20:26:00) [7]Я не хочу вешать обработчики на криэйт - там приложение новое уже проинициализировано,модули подгружены,память выделена. Нужно пресекать повторный вызов на корню как в http://delphi.mastak.ru/articles/limit.html.Т.е. в сорсе проекта. А оттуда что-то не работает.
alena.svt (2002-09-30 20:16:00) [8]Вам Юрий Зотов писал ссылку и я не поверю что она не работает.
Вот создайте новый проект
И вставте
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 19:41:00) [9]Извиняюсь - мессагу ловит,но не поднимается
TTCustomDelphiMaster (2002-09-30 18:52:00) [10]F1 - RegisterWindowMessage
Андрусь (2002-09-30 18:10:00) [11]>Дмитрий Иванов
Что-то мессага не проходит.
Видимо всё же под Win2k нужно не так
Дмитрий Иванов (2002-09-26 14:29:00) [12]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-26 12:55:00) [13]>Юрий Зотов
Посмтрел линки,но нет там решения моей проблемы - нужно переключиться на старое приложение.
Дмитрий Иванов (2002-09-25 22:07:00) [14]
> Андрусь © (25.09.02 19:10)
> >Zemal ©
> я определился - проблема немного в другом - в переключении
> на работающее приложение. Внимательнее,господа,пожалуйста...
я же тебе написал уже .. будь сам внимателен!
Юрий Зотов (2002-09-25 21:09:00) [15]Королевство, раздел Hello,World, Примеры работы с WinAPI (самая нижняя ссылка). Там готовые примеры по Вашим вопросам.
Андрусь (2002-09-25 19:10:00) [16]>Zemal ©
То каким образом определять является ли данный запуск первым я определился - проблема немного в другом - в переключении на работающее приложение. Внимательнее,господа,пожалуйста...
Zemal (2002-09-25 18:44:00) [17]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 16:30:00) [18]я так делал,в 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 работает, под другими виндами не пробовал
Андрусь (2002-09-25 16:12:00) [19]Я же говорю - она ищет handle окна уже существующего приложения. Там вроде по коду понятно.
Извиняюсь, криво отобразил здесь. Но на самом деле там коментарить не надо - я при поиске проверяю,чтобы был не handle текущего окна - заглавного окна приложения(в модуле я подключаю Forms - там на initialization - InitProc).
Song (2002-09-25 15:45:00) [20]В Вашем примере что ищет FindLastAppl() ?
| |
Страницы: 