Форум программистов [Powered by Invision Power Board]

Код

unit Not2Run;

interface

uses
    Windows
  , SysUtils
  , Forms
  ;

procedure CheckOneInstance(const ApplicationName: String);
 // Проверяет что программа с идентификатором ApplicationName уже запущена.
 // Если это так, то предыдущий экземпляр "выталкивается" на поверхность и
 // выполняется Halt(1)

type
{ WIN32 Helper Classes }

{ tHandledObject }

  tHandledObject = class(tObject)
  protected
    fName  : String;
    fHandle: tHandle;
    fCreated: Boolean;
    procedure SetHandle(const aName :String; aHandle: tHandle);
    procedure ErrorCreate;
  public
    destructor Destroy; override;
    property Name: string read fName;
    property Handle: tHandle read fHandle;
    property Created: Boolean read fCreated;
  end;

{ tSharedMem }

  tSharedMem = class(tHandledObject)
  private
    fSize: Integer;
    fDataPtr: Pointer;
  public
    constructor Create(const aName: string; aSize: Integer);
    destructor Destroy; override;
    property Size: Integer read fSize;
    property DataPtr: Pointer read fDataPtr;
  end;

type
  eSharedResources = class(Exception);

implementation

{ tHandledObject }

destructor tHandledObject.Destroy;
begin
  if fHandle <> 0 then CloseHandle(fHandle);
end;

procedure tHandledObject.ErrorCreate;
begin
  raise eSharedResources.Create(Format('Ошибка создания %s(%s):'^M^J'%s',[ClassName,fName,SysErrorMessage(GetLastError)]));
end;

procedure tHandledObject.SetHandle(const aName :String; aHandle: tHandle);
begin
  fName:= aName;
  if aHandle = 0 then ErrorCreate;
  fHandle:= aHandle;
  fCreated:= GetLastError = 0;
end;

{ tSharedMem }

constructor tSharedMem.Create(const aName: string; aSize: Integer);
begin
  fSize:= aSize;
  SetHandle(aName,CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, aSize, PChar(aName)));
  fDataPtr := MapViewOfFile(fHandle, FILE_MAP_WRITE, 0, 0, aSize);
  if fDataPtr = nil then ErrorCreate;
end;

destructor TSharedMem.Destroy;
begin
  if fDataPtr <> nil then UnmapViewOfFile(fDataPtr);
  inherited Destroy;
end;

var
  FirstInstance :tSharedMem;

procedure CheckOneInstance(const ApplicationName: String);
 // Проверяет что программа с идентификатором ApplicationName уже запущена.
 // Если это так, то предыдущий экземпляр "выталкивается" на поверхность и
 // выполняется Halt(1)
var HPtr: pHandle;
begin
  FirstInstance:= tSharedMem.Create('Alex&Co_FirstInstace_'
       +AnsiUpperCase(StringReplace(ApplicationName,'\','/',[rfReplaceAll])),
                                         SizeOf(Application.Handle));
  HPtr:= pHandle(FirstInstance.DataPtr);
  if HPtr^ = 0  then  // это первый экземпляр программы в памяти?
    HPtr^:= Application.Handle  //да
  else begin  // нет, не первый. Вытащим первый на поверхность
    if IsIconic(HPtr^) then ShowWindow(HPtr^, SW_RESTORE);
    SetForegroundWindow(HPtr^);
    Halt(1); // и отваливаем
  end;
end;

initialization

finalization
  if FirstInstance <> nil then FirstInstance.Free;
end.




program Project1;

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

{$R *.res}

begin
  // Запущена или нет уже программа
  CheckOneInstance('Name_Program');
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.







function TForm1.ApplicationMessage(var Message: TMessage): Boolean;
var
  hWnd, hCurWnd, dwThreadID, dwCurThreadID: THandle;
  OldTimeOut: Cardinal;
  AResult: Boolean;
begin
   Result := False;
   if Message.Msg = RestoreOldInstance then
   begin
     Application.Restore;
     hWnd := Application.Handle;
     SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @OldTimeOut, 0);
     SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, Pointer(0), 0);
     SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
     hCurWnd := GetForegroundWindow;
     AResult := False;
     while not AResult do
     begin
        dwThreadID := GetCurrentThreadId;
        dwCurThreadID := GetWindowThreadProcessId(hCurWnd);
        AttachThreadInput(dwThreadID, dwCurThreadID, True);
        AResult := SetForegroundWindow(hWnd);
        AttachThreadInput(dwThreadID, dwCurThreadID, False);
     end;
     SetWindowPos(hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
     SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, Pointer(OldTimeOut), 0);
   end;
   inherited;
end;