Понадобилось мне тут сделать проверку того, запущена ли уже одна копия моей
программы или нет. Как же это сделать на Delphi? Логика решения задачи проста:
найти процесс с таким же именем как наш, сравнить PID (Process IDentifier)
текущего процесса и найденного и если они разные, то смело выходим из программы.
Если же одинаковые, то мы нашли наш текущий процесс и убивать его не стоит (:. А
теперь реализация...
Для решения поставленной задачи необхоимо:
1. узнать имя текущего процесса и его PID
2. перебрать существующие в памяти процессы и сравнить данные
3. корректно завершить или продолжить работу приложения
Первое реализуется весьма просто: имя текущего процесса
хранится в переменной в глобальном обьекте Application с названием
ExeName, а PID узнаётся с помощью WinAPI-функции GetCurrentProcessId
без параметров.
Пункт номер два требует подключения библиотеки TlHelp32,
которая даёт доступ к функциям ToolHelp32. Нам потребуются функции
CreateToolhelp32Snapshot (снепшот состояния операционной системы в данный
момент времени), Process32First (получение информации о первом процессе в
списке) и Process32Next (получение информации о каждом следующем процессе
в списке). Их подробное описание можно найти в справочнике WinAPI, которые
поставляется вместе со средой Delphi.
Пункт с номером три тоже не вызывает никакх сложностей -
всего лишь необходимо вмешаться в работу главного .dpr файла Вашего проекта
(изначально project1.dpr) и изменить порядок производимых действий. О том как
именно изменить, будет рассказано ниже. А теперь напишем функцию для проверки
существования схожего процесса. У меня данная функция вынесена в модуль под
названием startup. Ниже приведён код модуля с комментариями.
unit startup;
interface
// Наша функция возвращает PID найденного процесса
// или 0, если процесс не найден.
function AnotherProcessExists: cardinal;
implementation
// Подключаем модули с системными функциями
Uses Forms, SysUtils, Windows, TlHelp32;
function AnotherProcessExists: cardinal;
var h: Cardinal;
p: tagPROCESSENTRY32;
fnd: boolean;
my_name, pr_name: string;
my_pid: Cardinal;
begin
result := 0;
// Узнаём свой PID
my_pid := GetCurrentProcessId;
// Узнаём имя своего процесса. Обьект Application
// должен быть заранее инициализирован.
my_name := StrRScan(PChar(Application.ExeName), '');
delete(my_name, 1, 1);
// Делаем снепшот системы.
h := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
p.dwSize := SizeOf(tagPROCESSENTRY32);
// Находим первый процесс.
fnd := Process32First(h, p);
// Цикл перебора всех процессов в системе.
while fnd do
begin
// Узнаём имя найденного процесса.
pr_name := StrRScan(p.szExeFile, '');
if pr_name='' then
pr_name := p.szExeFile else
delete(pr_name, 1, 1);
// Проверяем имя найденного процесса и сверяем его PID
// с PID-ом нашего процесса.
if(pr_name = my_name)and(my_pidp.th32ProcessID)then
begin
// Вторая копия нашей программы уже существует,
// заканчиваем цикл и выходим.
fnd := false;
result := p.th32ProcessID;
end else
// Сходий процесс не найден, продолжаем перебор
fnd := Process32Next(h, p);
end;
// Закрываем наш снепшот.
CloseHandle(h);
end;
end.
Теперь изменим свой проект (project1.dpr) для корректного
завершения нашей программы в случае нахождения ещё одной копии:
program Project1;
uses
// Подключаем наш модуль.
Forms, startup, Windows,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
// Инициализируем обьект Application для корректной работы.
Application.Initialize;
// Проверяем процессы, если наша программа уже запущена,
// то выводим сообщение и выходим.
if AnotherProcessExists>0 then
begin
MessageBox(0, 'Another Copy Already Running!', 'Error', 0);
Application.Terminate;
end else
// Копии программы нет в памяти - нормальный запуск.
begin
Application.CreateForm(TForm1, Form1);
Application.Run;
end
end.
Как можно видеть, простенькая функция и минимальные изменения
оригинального кода программы позволяют достичь желаемого результата.
Единственный минус данной функции AnotherProcessExists заключается в том,
что если Вы назовёте свою программу как какую-нибудь уже существующую и та
существующая будет запущена на компьютере пользователя, то Ваша уже не
запуститься. Это обходится либо проверкой пути, либо какой-нибудь схожей
проверкой. Однако в большинстве случаев программы не конфликтуют друг с другом
(я такого ещё не замечал), поэтому дополнительные проверки оставим на усмотрение
читателя.
by Фрук
