Подписаться на RSS рассылку
Главная » Статьи по Delphi » Программа и интерфейс » Предотвратить запуск второй копии программы

Предотвратить запуск второй копии программы

Автор: Борисов Сергей

Для того чтобы не дать программе запуститься, если её копия уже работает выполните следующие дейтвия: выберите Project -> View Source. Появится окно редактора кода с открытым файлом Project.dpr (по умолчанию). Далее добавьте в список модулей модуль Windows. А между Begin и End напишите:

CreateFileMapping(HWND($FFFFFFFF), nil, PAGE_READWRITE, 0, 1024,
'Programm Name');
if GetLastError <> ERROR_ALREADY_EXISTS then
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end
else
begin

Application.MessageBox('Программа уже выполняется!', 'Внимание');
halt;
end;

Теперь при попытке запустить вторую копию программы программа выдаст соответствующее сообщения и завершит работу.

Функция GetLastError - Выдаёт код ошибки последнего неудачного Windows API вызова;

Функция CreateFileMapping создает или открывает именованный или безымянный объект отображенного в памяти (проецируемого) файла для заданного файла.

В итоге получится следующее:

program Project1;
uses
  Forms,
  Windows,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  CreateFileMapping(HWND($FFFFFFFF), nil, PAGE_READWRITE, 0, 1024,
'Programm Name');
  if GetLastError <> ERROR_ALREADY_EXISTS then
  begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
  end
  else
  begin

  Application.MessageBox('Программа уже выполняется!', 'Внимание');
  halt;
  end;

end.

Просмотров: 6720

Обсудить на форуме

0   Спам
(27.05.2011)
1. Гриша
Паша, какие например?
Может мьютексы, разве что...

function CheckMutexMy: Boolean;
const
NAME_MUTEX_SETUP = 'MyMutexCheck';
begin
HandleMutexCheck := OpenMutex(MUTEX_ALL_ACCESS, false, NAME_MUTEX_SETUP);
Result := (HandleMutexCheck <> 0);
if HandleMutexCheck = 0 then
HandleMutexCheck := CreateMutex(nil, false, MyMutexCheck);
end;

Думаю ясно, что код создает мьютек если его ещё нет (т.е. когда функция вызывается первый раз в первой копии программы) и возвращает True. При её вызове второй раз, или из другой копии программы - будет False, т.к. мьютекс уже существует.
"HandleMutexCheck" здесь глобальная переменная, что бы уничтожить мьютекс при выходе из программы:
CloseHandle(HandleMutexCheck);

Всем удачной проверки запуска второй копии программы


Имя *:
Email:


Код *:

Copyright © 2008-2016 Программирование на Delphi для начинающих и не только

Полнота авторских прав на все материалы, опубликованные на сервере DelphiDevelop.ru принадлежит их авторам

Перепечатка материалов разрешается с указанием авторства и гиперссылки на первоисточник информации

Хостинг от uCoz

Автор проекта: Борисов Сергей

e-mail: save-x@yandex.ru

Связь с администрацией сайта