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

Delphi , Программа и Интерфейс , Приложение своё

Автор: Тихонов Михаил

Он основан на объекте ядра FileMapping. Такой способ уже был приведен ранее, но в отличие от приведенного, в нем использован оригинальный метод получения дескриптора первого запущенного приложения. Хэндл дескриптора первого запу- щенного приложения (Application.Handle) как раз и сохраняется в области дан- ных объекта FileMapping. Используется только одна функция FirstHinstanceRunning. Она имеет один параметр RunMode, Значения которого должны быть определены следующим образом:

• если RunMode = 0 то недопущение повторного запуска того-же самого EXE файла с учетом пути
• если RunMode = 1 то недопущение повторного запуска того-же самого EXE файла без учета пути
• иначе повторный запуск разрешен

Ниже приводится текст функции:

unit FirstHinstanceRunning;

interface

uses
  Windows,
  Forms,
  StrUtils,
  SysUtils;

function FirstHinstanceRunning(RunMode: Integer = 0): boolean;

implementation

function FirstHinstanceRunning(RunMode: Integer = 0): boolean;
const
  MemFileSize = 127;

var
  MemHnd: HWND;
  MemFileName: string;
  lpBaseAddress: ^HWND;
  FirstAppHandle: HWND;

begin
  Result := False;
  MemFileName := Application.ExeName;
  case RunMode of
    0:
      MemFileName := AnsiReplaceText(MemFileName, '\', '/');
    1:
      MemFileName := ExtractFileName(MemFileName);
  else
    Exit;
  end;
  //если FileMapping есть - то происходит OpenFileMapping
  MemHnd := CreateFileMapping(HWND($FFFFFFFF), nil,
    PAGE_READWRITE, 0, MemFileSize, PChar(MemFileName));
  if GetLastError <> ERROR_ALREADY_EXISTS then
  begin
    if MemHnd <> 0 then
    begin
      lpBaseAddress := MapViewOfFile(MemHnd, FILE_MAP_WRITE, 0, 0, 0);
      if lpBaseAddress <> nil then
        lpBaseAddress^ := Application.Handle;
    end;
  end
  else
  begin
    //    MemFileHnd := OpenFileMapping(FILE_MAP_READ, False, PChar(MemFileName));
    Result := True;
    if MemHnd <> 0 then
    begin
      lpBaseAddress := MapViewOfFile(MemHnd, FILE_MAP_READ, 0, 0, 0);
      if lpBaseAddress <> nil then
      begin
        FirstAppHandle := lpBaseAddress^;
        ShowWindow(FirstAppHandle, SW_restore);
        SetForegroundWindow(FirstAppHandle);
      end;
    end;
  end;
  if lpBaseAddress <> nil then
    UnMapViewOfFile(lpBaseAddress);
end;

В тексте проекта * .dpr вызов функции выглядит приблизительно следующим образом

program OneHinstance;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  FirstHinstanceRunning in '..\..\FirstHinstanceRunning.pas';

{$R *.res}

begin
  Application.Initialize;

  if FirstHinstanceRunning(0) then
    Exit;

  Application.CreateForm(TForm1, Form1);
  Application.Run;

  //  CloseHandle(MemHnd);      //надо ли ???
end.

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

А вдруг Вы забыли вызвать CloseHandle - будет ли утечка памяти? И да, и нет. Утечка ресурсов (тех же объектов ядра) вполне вероятна, пока процесс еще исполняется. Однако по завершении процесса операционная система гарантированно освобождает все ресурсы, принадлежавшие этому процессу, и в случае объектов ядра действует так: в момент завершения процесса просматривает его таблицу описателей и закрывает любые открытые описатели.

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

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

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

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

:: Главная :: Приложение своё ::