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

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

Автор: Xavier Pacheco

unit MultInst;

interface

const
  MI_QUERYWINDOWHANDLE = 1;
  MI_RESPONDWINDOWHANDLE = 2;

  MI_ERROR_NONE = 0;
  MI_ERROR_FAILSUBCLASS = 1;
  MI_ERROR_CREATINGMUTEX = 2;

  // Call this function to determine if error occurred in startup.
  // Value will be one or more of the MI_ERROR_* error flags.
function GetMIError: Integer;

implementation

uses Forms, Windows, SysUtils;

const
  UniqueAppStr = 'DDG.I_am_the_Eggman!';

var
  MessageId: Integer;
  WProc: TFNWndProc;
  MutHandle: THandle;
  MIError: Integer;

function GetMIError: Integer;
begin
  Result := MIError;
end;

function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint):
  Longint; stdcall;
begin
  Result := 0;
  // If this is the registered message...
  if Msg = MessageID then
  begin
    case wParam of
      MI_QUERYWINDOWHANDLE:
        // A new instance is asking for main window handle in order
        // to focus the main window, so normalize app and send back
        // message with main window handle.
        begin
          if IsIconic(Application.Handle) then
          begin
            Application.MainForm.WindowState := wsNormal;
            Application.Restore;
          end;
          PostMessage(HWND(lParam), MessageID, MI_RESPONDWINDOWHANDLE,
            Application.MainForm.Handle);
        end;
      MI_RESPONDWINDOWHANDLE:
        // The running instance has returned its main window handle,
        // so we need to focus it and go away.
        begin
          SetForegroundWindow(HWND(lParam));
          Application.Terminate;
        end;
    end;
  end
    // Otherwise, pass message on to old window proc
  else
    Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;

procedure SubClassApplication;
begin
  // We subclass Application window procedure so that
  // Application.OnMessage remains available for user.
  WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,
    Longint(@NewWndProc)));
  // Set appropriate error flag if error condition occurred
  if WProc = nil then
    MIError := MIError or MI_ERROR_FAILSUBCLASS;
end;

procedure DoFirstInstance;
// This is called only for the first instance of the application
begin
  // Create the mutex with the (hopefully) unique string
  MutHandle := CreateMutex(nil, False, UniqueAppStr);
  if MutHandle = 0 then
    MIError := MIError or MI_ERROR_CREATINGMUTEX;
end;

procedure BroadcastFocusMessage;
// This is called when there is already an instance running.
var
  BSMRecipients: DWORD;
begin
  // Prevent main form from flashing
  Application.ShowMainForm := False;
  // Post message to try to establish a dialogue with previous instance
  BSMRecipients := BSM_APPLICATIONS;
  BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
    @BSMRecipients, MessageID, MI_QUERYWINDOWHANDLE,
    Application.Handle);
end;

procedure InitInstance;
begin
  SubClassApplication; // hook application message loop
  MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
  if MutHandle = 0 then
    // Mutex object has not yet been created, meaning that no previous
    // instance has been created.
    DoFirstInstance
  else
    BroadcastFocusMessage;
end;

initialization
  MessageID := RegisterWindowMessage(UniqueAppStr);
  InitInstance;
finalization
  // Restore old application window procedure
  if WProc <> nil then
    SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(WProc));
  if MutHandle <> 0 then
    CloseHandle(MutHandle); // Free mutex
end.

unit OIMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TMainForm = class(TForm)
    Label1: TLabel;
    CloseBtn: TButton;
    procedure CloseBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses MultInst;

{$R *.DFM}

procedure TMainForm.CloseBtnClick(Sender: TObject);
begin
  Close;
end;

end.

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

1. Единица MultInst определяет несколько констант и переменных:
   • MI_QUERYWINDOWHANDLE и MI_RESPONDWINDOWHANDLE: эти являются обновленными окнами, используемыми для общения между экземплярами.
   • MI_ERROR_NONE, MI_ERROR_FAILSUBCLASS и MI_ERROR_CREATINGMUTEX: эти являются флагами ошибок, которые могут быть установлены, если экземпляр встречает проблему.
   • UniqueAppStr: это уникальная строка, используемая для идентификации приложения в реестре или файловой системе.
2. Функция GetMIError возвращает текущее значение переменной MIError, которая указывает, возникла ли ошибка во время запуска.
3. Функция NewWndProc является процедурой окна, обрабатывающей сообщения для основного формата. Она проверяет, связано ли сообщение с экземпляром приложения (например, запросом или ответом) и отвечает соответствующим образом.
4. Процедура SubClassApplication подклассирует процедуру окна приложения, позволяя функции NewWndProc обрабатывать сообщения.
5. Если возникает ошибка во время подклассирования, переменная MIError устанавливается для указания проблемы.
6. Процедура DoFirstInstance создает мьютекс с уникальным именем и устанавливает его как первый экземпляр приложения.
7. Процедура BroadcastFocusMessage отправляет сообщение, пытаясь установить диалог с существующим экземпляром, когда новый экземпляр запускается.

Теперь давайте посмотрим, как эти компоненты используются в единице OIMain:

1. Класс TMainForm определяется как простой формат с меткой и кнопкой.
2. В процедуре InitInstance единицы MultInst, процедура окна приложения подклассируется с помощью SubClassApplication, а мьютекс открывается или создается.
3. Если это первый экземпляр, процедура DoFirstInstance создает мьютекс с уникальным именем. В противном случае она отправляет сообщение фокуса существующему экземпляру.
4. Переменная MainForm объявляется как экземпляр класса TMainForm.
5. В обработчике события CloseBtnClick для кнопки форма просто закрывается.

Для предотвращения одновременного запуска нескольких экземпляров приложения код использует комбинацию техник:

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

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

Как не допустить запуска второй копии программы, используя метод сжатия и субклассификации в Windows.

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

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

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