Управление однопоточным запуском приложений на Delphi: гарантия уникальности экземпляра

Delphi , Синтаксис , Справочник по API-функциям

Вопрос однопоточного запуска приложений на Delphi является актуальным для разработчиков, которым необходимо обеспечить, что пользователь может запустить только один экземпляр программы. Это может быть необходимо для различных причин, например, для предотвращения конфликтов данных или обеспечения согласованности работы приложения.

Проблема

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

Исходный код

Вот исходный код, который пытается закрыть дополнительные экземпляры приложения:

function killDuplicates: integer;
var
    ContinueLoop, FSnapshotHandle: THandle;
    FProcessEntry32: TProcessEntry32;
    pna: string;
begin
    Result := 0;
    FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
    ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
    while Integer(ContinueLoop) <> 0 do
    begin
        pna := LowerCase(ExtractFileName(FProcessEntry32.szExeFile));
        if pna = 'myapp.exe' then
            Result := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE, FALSE, FProcessEntry32.th32ProcessID), 0));
        ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
    end;
    CloseHandle(FSnapshotHandle);
end;

Недостатки текущего подхода

Основная проблема кроется в том, что код не проверяет, является ли текущий процесс экземпляром, который нужно закрыть. Вместо этого, он просто закрывает все найденные экземпляры, включая текущий.

Альтернативный ответ и подход с использованием мьютекса

В альтернативном ответе пользователя обсуждается использование мьютекса для управления однопоточным запуском приложения. Это более надежный и безопасный способ, так как позволяет текущему экземпляру приложения контролировать попытки запуска новых экземпляров.

Подтвержденный ответ

Для решения проблемы необходимо в коде проверять, является ли процесс, найденный в цикле, текущим процессом. Для этого можно использовать функцию GetCurrentProcessId и сравнивать полученный идентификатор с идентификатором процесса из цикла.

function IsAnotherInstanceRunning: Boolean;
var
    FSnapshotHandle, ProcessID: THandle;
    FProcessEntry32: TProcessEntry32;
begin
    Result := False;
    FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
    Process32First(FSnapshotHandle, FProcessEntry32);
    while Process32Next(FSnapshotHandle, FProcessEntry32) <> 0 do
    begin
        if LowerCase(ExtractFileName(FProcessEntry32.szExeFile)) = 'myapp.exe' then
        begin
            ProcessID := FProcessEntry32.th32ProcessID;
            if ProcessID <> GetCurrentProcessId then
            begin
                // Это другой экземпляр приложения
                Result := True;
                if Application.IsTerminateOtherInstance(ProcessID) then
                    TerminateProcess(OpenProcess(PROCESS_TERMINATE, FALSE, ProcessID), 0);
            end;
        end;
    end;
    CloseHandle(FSnapshotHandle);
end;

В этом примере предполагается, что существует функция Application.IsTerminateOtherInstance, которая определяет, нужно ли завершать другой экземпляр (например, если это не текущий пользовательский сеанс завершения, это может быть реализовано как уведомление):

function Application.IsTerminateOtherInstance(const ProcessID: Cardinal): Boolean;
begin
    // Здесь может быть логика, определяющая, нужно ли завершать процесс
    // Например, можно уведомить процесс и позволить ему корректно завершиться
    Result := False; // Завершение в этом примере отключено
end;

Использование мьютекса для контроля за запуском приложения

Вместо перебора и завершения других экземпляров можно использовать мьютекс для блокировки запуска второго экземпляра, что является более безопасным и рекомендуемым решением:

var
    InstanceMutex: THandle;
begin
    InstanceMutex := CreateMutex(nil, TRUE, 'MyAppInstanceMutex');
    if InstanceMutex = 0 then
    begin
        // Не удалось создать мьютекс, возможно, уже запущен экземпляр
        // Можно здесь уведомить пользователя о запущенном экземпляре
        Exit;
    end;
    if GetLastError = ERROR_ALREADY_EXISTS then
    begin
        // Уже запущен экземпляр приложения
        // Можно здесь привести текущий экземпляр в фокус, если это необходимо
        CloseHandle(InstanceMutex);
        Exit;
    end;
    // Приложение успешно запущено как единственный экземпляр
end;

Выводы

Для обеспечения однопоточного запуска приложения на Delphi следует использовать механизмы блокировки, такие как мьютексы, которые позволяют контролировать доступ к ресурсу (в данном случае — к запущенному приложению). Это обеспечивает согласованное поведение и предотвращает конфликты при одновременном запуске нескольких экземпляров программы.

Создано по материалам из источника по ссылке.

Необходимо управлять однопоточным запуском приложений на Delphi, предотвращая запуск более одного экземпляра программы и обеспечивая уникальность запущенного приложения.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Справочник по API-функциям ::