Предотвратить запуск второй копии программы
Автор: 
Для того чтобы не дать программе запуститься, если её копия уже работает выполните следующие дейтвия: выберите 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.
Просмотров: 7220
|
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); Всем удачной проверки запуска второй копии программы |
Copyright © 2008 - 2018 Программирование на Delphi для начинающих и не только.
Полнота авторских прав на все материалы, опубликованные на сервере DelphiDevelop.ru принадлежит их авторам.
Перепечатка материалов разрешается с указанием авторства и гиперссылки на первоисточник информации.