unit _SingleInstance;

interface

uses
  SysUtils,
  Winapi.Windows, VCL.Forms,
  Classes;

type
  TSingleInstance = class(TComponent)
  private
    FOnSecondRun: TNotifyEvent;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property OnSecondRun: TNotifyEvent read FOnSecondRun write FOnSecondRun;
  end;

implementation

var InstanceName: String;
    PIName: PChar;
    MsgHandle: HWND;
    AppWndProc: Pointer;
    RunTime: Boolean;
    Iam: TSingleInstance;


function MyWindowProc(WindowHandle : hWnd; TheMessage : LongInt; ParamW : LongInt; ParamL : LongInt) : LongInt stdcall;
begin
  if TheMessage = MsgHandle then begin
    if Assigned(Iam.FOnSecondRun) then Iam.FOnSecondRun(Iam)
                                  else begin
      if Application.MainForm <> nil then
      begin
        Application.MainForm.Show;
        Application.MainForm.WindowState := wsNormal;
        Application.BringToFront;
      end;
    end;
    Result := 0;
    Exit;
  end;
  Result := CallWindowProc(AppWndProc, WindowHandle, TheMessage, ParamW, ParamL);
end;

constructor TSingleInstance.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if RunTime then begin
    MsgHandle := RegisterWindowMessage(PIName);
    AppWndProc := Pointer(SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(@MyWindowProc)));
  end;
  Iam := Self;
end;

destructor TSingleInstance.Destroy;
begin
  if RunTime then SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(AppWndProc));
  inherited Destroy;
end;

initialization
  RunTime := Application.MainForm = nil;
  if RunTime then begin
    InstanceName := ExtractFileName(Paramstr(0));
    PIName := PChar(InstanceName);
    CreateMutex(nil, false, PIName);
    if GetLastError = ERROR_ALREADY_EXISTS then begin
      SendMessage(HWND_BROADCAST, RegisterWindowMessage(PIName), 0, 0);
      Halt(0);
    end;
  end;

finalization
end.
