Запуск приложения

← →
Ольга (2002-02-28 17:11) [0]

Я понимаю, что вопросы по поводу проверки того, запущено приложение или нет, задавались и не раз, я облазила все, кучу всего посмотрела и перепробовала, но не получается, запускается следующая копия и все. Може надо в параметрах формы что-то задавать? Серьезно - очень много перепробовала, то что раньше в форумах было...

← →
Sasha9 (2002-02-28 17:23) [1]

загляни в MS SDK про Mutex

← →
Виктор Щербаков (2002-02-28 17:29) [2]

Читала?

http://delphi.mastak.ru/articles/limit.html

← →
Ольга (2002-02-28 17:30) [3]

Спасибо попробую...
Но что-то подобное уже было...

← →
I/O (2002-02-28 20:26) [4]

program Project1;

uses
Forms,
Windows, // Обязательно!!!
Unit1 in "Unit1.pas" {Form1};

{$R *.res}

Var
MemHnd : HWND;
begin
MemHnd := CreateFileMapping(HWND($FFFFFFFF),nil,PAGE_READWRITE,0,1024,"one_file");
if GetLastError<>ERROR_ALREADY_EXISTS then
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end;
CloseHandle(MemHnd);
end.

← →
wdr (2002-03-01 05:52) [5]

uses Forms, Windows;
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;
...
...

← →
sniknik (2002-03-02 08:37) [6]

Модуль для этих целей, главное должен быть прописан первым в списке модулей.
Примерно так.

program Convert;

uses
LimHinst in "LimHinst.pas",
Forms,
MainUnit in "MainUnit.pas";

{$R *.res}

begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

и сам модуль спасибо автору.

unit LimHinst;
//****************************************************************************
//
// Author: ©2001 Vladimir G. Yudin aka y-soft
// e-mail: y-soft@mail.ru
//
// Description: Ограничение количества одновременно работающих экземпляров
// приложения.
//
// Отличие от существующих реализаций:
//
// 1. С целью исключения преждевременных инициализаций проверка
// производится в самом начале загрузки приложения, до загрузки всех модулей
// 2. Исключен возможный конфликт имен, т.к. в качестве уникального имени
// используется полный путь к исполняемому модулю
// 3. Изменением значения HinstLim можно установить любое разрешенное количество
// одновременно запущенных экземпляров приложения
// 4. Изменением WaitPause можно регулировать время ожидания
// (если установить INFINITE, то получится своеобразный вариант горячего
// резервирования)
//
// Тестировалось в WinME и WinNT 4 SP6A. Ошибки не обнаружены
//
// Usage: модуль необходимо указать ПЕРВЫМ в списке uses файла .DPR проекта
// и установить необходимые значения констант HinstLimit и WaitPause.
//
// Возможные расширения:
//
// 1. Значения HinstLimit и WaitPause хранить в INI-файле или в реестре
// 2. Значение HinstLimit менять динамически в зависимости от условий
//
// Thanks: Спасибо Юрию Зотову за указание на существование проблемы
//
// Disclaimer: Используйте совершенно свободно на свой страх и риск.
// Автор убедительно просит сообщать ему о найденных ошибках и
// внесенных усовершенствованиях.
// Всякие совпадения идей, наименований функций, процедур, переменных и
// констант считать случайными :)
//
//****************************************************************************
interface

const
//Установите необходимые значения!!!
HinstLimit = 1;
WaitPause = 50;

implementation
uses
Windows;
var
Semaphore : THandle;
SemaphoreName : array[0..255] of Char;
IncCnt : integer;

function StopLoading : boolean;
var
L,I : integer;
begin
// В качестве уникального имени семафора используем полный путь
// к исполняемому файлу приложения (по определению уникален!!!)
L := GetModuleFileName(MainInstance,SemaphoreName,SizeOf(SemaphoreName));
// В имени семафора нельзя использовать обратные слэши, поэтому
// заменяем их на прямые (или еще на что-нибудь кроме #0)
for I := 0 to L - 1 do
if SemaphoreName[I] = "\" then
SemaphoreName[I] := "/";

Semaphore := CreateSemaphore(nil,HinstLimit,HinstLimit,SemaphoreName);

Result := (Semaphore = 0) or // Если семафор не удалось создать
(WaitForSingleObject(Semaphore,WaitPause) <> WAIT_OBJECT_0); // Если семафор занят
end;

procedure ShowErrMsg;
const
PROGRAM_ALREADY_RUN = "Не дпускается повторных вызовов программы!";
begin
// Главное окно программы еще не существует, поэтому выводим MessageBox
// без владельца
MessageBox(0, PROGRAM_ALREADY_RUN, SemaphoreName, MB_ICONSTOP or MB_OK);
end;

initialization
IncCnt := 0;
if StopLoading then
begin
ShowErrMsg;
// Так как никаких инициализаций еще не производилось, то
// спокойно используем для завершения программы Halt -
// finalization все равно выполнится
halt;
end
else
IncCnt := 1;
finalization
if Semaphore <> 0 then
begin
// Обязательно явно освобождаем семафор, т.к.
// автоматически его счетчик ссылок не переустанавливается
ReleaseSemaphore(Semaphore, IncCnt, nil);
// Напоследок во избежание неожиданностей освобождаем дескриптор семафора
// (так предписывает MSDN)
CloseHandle(Semaphore);
end;
end.

← →
Kettle of delphi (2002-03-02 14:49) [7]

Вот этот код точно работает (жирным выделено то, что нужно добавить в файл проекта):

program Project1; uses Forms, Windows, Unit1 in "Unit1.pas" {Form1}; {$R *.res} var HM: THandle; function Check: boolean; begin HM:=OpenMutex(MUTEX_ALL_ACCESS, false, "MyOwnMutex"); Result:=(HM<>0); if HM=0 then HM:=CreateMutex(nil, false, "MyOwnMutex"); end; begin //Проверяем, запущено ли уже приложение: if Check then Exit; Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end.

← →
I/O (2002-03-03 01:00) [8]

Ольга, есть и такой вариант:

procedure TForm1.FormCreate(Sender: TObject);
VAR
Wnd : hWnd;
buff: ARRAY [0..127] OF Char;
d:string;
begin
Application.ShowMainForm:=false;
Wnd := GetWindow(Handle, gw_HWndFirst);
WHILE Wnd <> 0 DO BEGIN
IF IsWindowVisible(Wnd) AND
(GetWindow(Wnd, gw_Owner) = 0) AND
(GetWindowText(Wnd, buff, sizeof(buff)) <> 0)
THEN BEGIN
GetWindowText(Wnd, buff, sizeof(buff));
d:=(StrPas(buff));
if d=application.Title then
if Application.MessageBox("эта программа уже запущена"+#13+ "запустить еще одну", "предупреждение",MB_YESNO) = IDNO then
Application.Terminate;

END;
Wnd := GetWindow(Wnd, gw_hWndNext);
END;
application.ShowMainForm:=True;
end;

Запуск приложения Найти похожие ветки