Как заблокировать запуск 2х копий программы?

← →
Виктор8 (2006-02-21 23:31) [0]

← →
Grief © (2006-02-21 23:34) [1]

if FindWindow("TForm1", "здесь_заголовок_твоего_окна") <> 0 then завершиться;
это если совсем просто.
Можно через mutex"ы - смотреть соответствующий раздел msnd

← →
Ученик чародея © (2006-02-22 05:12) [2]

program XXX; uses oneruned in "oneruned.pas", ...

unit oneruned; interface implementation uses Windows; var Mutex : THandle; MutexName : array[0..1024] of Char; function StopLoading : boolean; var L,I : integer; begin // В качестве уникального имени мьютекса используем полный путь // к исполняемому файлу приложения L := GetModuleFileName(MainInstance,MutexName,SizeOf(MutexName)); // В имени мьютекса нельзя использовать обратные слэши, поэтому // заменяем их на прямые for I := 0 to L - 1 do if MutexName[I] = "\" then begin MutexName[I] := "/"; end; Mutex := CreateMutex(nil,false,MutexName); Result := (Mutex = 0) or // Если мьютекс не удалось создать (GetLastError = ERROR_ALREADY_EXISTS); // Если мьютекс уже существует end; initialization if StopLoading then halt; finalization if Mutex <> 0 then CloseHandle(Mutex); end.

← →
Ormada © (2006-02-22 07:31) [3]

на самом деле тебе не только надо не допустить запуска второй копии тебе надо ещё и перевести фокус на существующий экземляр если он есть.....
program MyToDo;

uses
..
begin
MTDMainConsts.WM_APP_ACTIVATE := RegisterWindowMessage(MTDMainConsts.APPLICATION_NAME);
CreateMutex(nil, False, MTDMainConsts.APPLICATION_NAME);

if GetLastError = ERROR_ALREADY_EXISTS then
begin
PostMessage(HWND_BROADCAST, MTDMainConsts.WM_APP_ACTIVATE, 0, 0);
Halt(0);
end;

Application.Initialize;
Application.CreateForm(TMTDMainForm, MTDMainForm);
Application.Run;
end.

а в маин форм
где нить в крейте или конструкторе
Application.OnMessage := AppMessage;

procedure AppMessage(var Msg: TMsg; var Handled: Boolean);

procedure TMTDMainForm.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
if Msg.message = MTDMainConsts.WM_APP_ACTIVATE then
begin
// the message will be received by several windows - handle it only once
if Msg.hwnd = Application.Handle then
begin
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_RESTORE, 0);
SetForegroundWindow(Application.Handle);
Handled := True;
end;
end
else
inherited;
end;

Unit MTDMainConsts;
var
WM_APP_ACTIVATE : DWORD;
-----------------------------------------------------------------------
создрано с исхдников клиента для этого форума

← →
Leonid Troyanovsky © (2006-02-22 09:01) [4]

> Ormada © (22.02.06 07:31) [3]

> PostMessage(HWND_BROADCAST, MTDMainConsts.WM_APP_ACTIVATE,
> 0, 0);

Из своего foreground process сделать таковым искомый можно.
А нективному сделать себя foreground нельзя.

Да и, вообще, HWND_BROADCAST - MD.

--
Regards, LVT.

← →
Ormada © (2006-02-22 10:01) [5]

тады только перебор окон и посылка нужному

← →
BiN © (2006-02-22 10:37) [6]

> Ormada © (22.02.06 10:01) [5]
>
> тады только перебор окон и посылка нужному

Зачем это?

Пример использования MMF для определения наличия копии процесса и уведомления с передачей первого параметра (ParamStr(1)):

program Project1; uses windows, SysUtils, Forms, Unit1 in "Unit1.pas" {Form1}; {$R *.res} var InstExists: Boolean; begin NewInstMessageValue:=RegisterWindowMessage(Pchar(UniqueName+"msg")); if NewInstMessageValue=0 then RaiseLastOSError; hSection:=CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, DATA_SIZE, Pchar(UniqueName+"map")); if hSection=0 then RaiseLastOSError(); InstExists:=GetLastError=ERROR_ALREADY_EXISTS; try lpCustomData:=MapViewOfFile(hSection, FILE_MAP_ALL_ACCESS, 0, 0, DATA_SIZE); if lpCustomData=nil then RaiseLastOSError; if InstExists then begin if (ParamCount>0) and (Length(ParamStr(1))>0) then CopyMemory(@(lpCustomData^.Buffer), @Paramstr(1)[1], Length(Paramstr(1))); SendMessage(lpCustomData^.ClientHandle, NewInstMessageValue, GetCurrentProcessId, GetCurrentThreadId); end else begin Application.Initialize; Application.CreateForm(TForm1, Form1); ZeroMemory(lpCustomData, DATA_SIZE); lpCustomData.ClientHandle:= Form1.Handle; Application.Run; end; finally if lpCustomData<>nil then UnmapViewOfFile(lpCustomData); CloseHandle(hSection); end; end. unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) protected procedure WndProc(var Message: TMessage); override; private { Private declarations } public { Public declarations } end; const DATA_SIZE = 1024; type TCustomData = packed record ClientHandle: THandle; Buffer: array [0..DATA_SIZE-SizeOf(THandle)-1] of char; end; PCustomData = ^TCustomData; const UniqueName = "AppNotificationNameSpace"; var Form1: TForm1; hSection: DWORD; NewInstMessageValue: DWORD; lpCustomData: PCustomData; implementation {$R *.dfm} { TForm1 } procedure TForm1.WndProc(var Message: TMessage); begin inherited; if Message.Msg=NewInstMessageValue then begin ShowMessage(Format("New instance running: PID: %d, TID: %d, Param: %s", [Message.WParam, Message.LParam, Pchar(@(lpCustomData.Buffer))])); ZeroMemory(@(lpCustomData^.Buffer), SizeOf(lpCustomData^.Buffer)); end; end; end.

← →
Fay © (2006-02-22 13:14) [7]

2 BiN © (22.02.06 10:37) [6]
Для 9x надо бы добавить PAGE_WRITECOPY. Или не использовать FILE_MAP_ALL_ACCESS.

← →
BiN © (2006-02-22 15:02) [8]

> Fay © (22.02.06 13:14) [7]
>
> 2 BiN © (22.02.06 10:37) [6]
> Для 9x надо бы добавить PAGE_WRITECOPY. Или не использовать
> FILE_MAP_ALL_ACCESS.

Почему?
Пример работает и под 9x. А вот если использовать флаг PAGE_WRITECOPY, то он точно работать не будет.

← →
Fay © (2006-02-22 15:08) [9]

2 BiN © (22.02.06 15:02) [8]
М.б. я как-то не очень правильно перевёл это :

Windows 95/98/Me: You must pass PAGE_WRITECOPY to CreateFileMapping; otherwise, an error will be returned.

← →
BiN © (2006-02-22 15:41) [10]

> Fay © (22.02.06 15:08) [9]
>
> 2 BiN © (22.02.06 15:02) [8]
> М.б. я как-то не очень правильно перевёл это :
>
> Windows 95/98/Me: You must pass PAGE_WRITECOPY to CreateFileMapping;
> otherwise, an error will be returned.

Эта ремарка относится к флагу FILE_MAP_COPY, который в моем примере не используется.

← →
Fay © (2006-02-22 15:55) [11]

2 BiN © (22.02.06 15:41) [10]

SECTION_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED or SECTION_QUERY or
SECTION_MAP_WRITE or SECTION_MAP_READ or SECTION_MAP_EXECUTE or SECTION_EXTEND_SIZE);

FILE_MAP_COPY = SECTION_QUERY;
FILE_MAP_ALL_ACCESS = SECTION_ALL_ACCESS;

← →
Дмитрий Белькевич © (2006-02-22 16:05) [12]

А можно еще компоненты сетевые воткнуть и порт на локалхосте расшарить, да отзываться как-нибудь.
Вот такой я извращенец ;)

← →
Fay © (2006-02-22 16:12) [13]

2 Дмитрий Белькевич © (22.02.06 16:05) [12]
Ага, например порт 3050...

← →
BiN © (2006-02-22 16:17) [14]

> Fay © (22.02.06 15:55) [11]
>
> SECTION_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED or SECTION_QUERY
> or
> SECTION_MAP_WRITE or SECTION_MAP_READ or SECTION_MAP_EXECUTE
> or SECTION_EXTEND_SIZE);
>
> FILE_MAP_COPY = SECTION_QUERY;
> FILE_MAP_ALL_ACCESS = SECTION_ALL_ACCESS;
>

Считаю полемику на данную тему неуместной. Т.к.:
a) MSDN не оговаривает особых случаев использования флага FILE_MAP_ALL_ACCESS, который как известно Same as FILE_MAP_WRITE
б) MS был волен реализовать механизмы контроля доступа как ему угодно, логично это или нет, с нашей точки зрения.
в) Пример не противоречит официальной документации и был протестирован в том числе и на 9х
г) уже надоедает, честное слово

← →
Fay © (2006-02-22 16:25) [15]

2 BiN © (22.02.06 16:17) [14]

> Считаю полемику на данную тему неуместной
В [1] был буквальный ответ на "Эта ремарка относится к флагу FILE_MAP_COPY, который в моем примере не используется"

> уже надоедает, честное слово
Это бывает. Пройдёт.

> В [1] был буквальный ответ
В [11], конечно.

> Ага, например порт 3050...

Нет, 3050 не надо. 3050 - это святое ;)

> Дмитрий Белькевич © (22.02.06 23:06) [17]
>
>
> > Ага, например порт 3050...
>
>
> Нет, 3050 не надо. 3050 - это святое ;)

Так ведь в настройках можно номер порта и поменять, в принципе :))

var h:Thandle;
err:longint;
begin
h:=CreateMutex(nil,false,"your-some-unique-guid");
err:=GetLastError();
if (err<>ERROR_SUCCESS)
then begin
MessageBox(0,"обнаружена уже работающая копия программы","сообщение",MB_OK or MB_ICONWARNING);
ExitProcess(0);
end;
end;
// CloseHandle(h); - где-то на выходе из программы, хотя и не обязательно.

C мьютексами (как объектами ядра) будет понадежнее и попроще. Правда, это всё равно не спасёт от запуска второй копии в другой пользовательской сессии.

Как заблокировать запуск 2х копий программы? Найти похожие ветки