Как избежать повторного запуска моего приложения

Как избежать повторного запуска моего приложения

=== Вариант N 1 ===

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure WMCopyData(var msg: TMessage); message WM_COPYDATA;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  checkinst;

procedure TForm1.FormCreate(Sender: TObject);
var
  h : HWND;
begin
  h := SetUniqueUID(Handle, 123456); // назначаем уникальный идентификатор
  if h <> Handle then
    begin
      SendString(h, GetCommandLineStr, Handle, 0);
      ActivatePrevInstance(h);
      Halt;
    end;
end;

procedure TForm1.WMCopyData;
begin
   Memo1.Lines.CommaText := PChar(PCopyDataStruct(msg.LParam).lpData);
end;

--------------------------checkinst.pas-------------------------
unit checkinst;

interface

uses
  Windows,
  Messages,
  Sysutils;

function SetUniqueUID(ahwnd: HWND; uid: DWord): HWND;
procedure ActivatePrevInstance(ahwnd: HWND);
procedure SendString(ahwnd:HWND; const s: String; aWParam: WParam;
dwData:DWord);
function GetCommandLineStr: String;

implementation

function SetUniqueUID(ahwnd: HWND; uid: DWord): HWND;
var
  ClassName: array [0..255] of Char;
begin
  GetClassName(ahwnd, ClassName, SizeOf(classname));
  Result := FindWindowEx(0, 0, ClassName, nil);
  while (Result <> 0) do
    if GetProp(Result, 'UID') = uid then
      Exit
    else
      Result := FindWindowEx(0, Result, ClassName, nil);
  SetProp(ahwnd, 'UID', uid);
  Result := ahwnd;
end;

procedure ActivatePrevInstance(ahwnd: HWND);
var
  h : HWND;
begin
  h := GetWindowLong(ahwnd, GWL_HWNDPARENT);
  if IsIconic(h) then
     ShowWindow(h, SW_RESTORE);
  SetForegroundWindow(h);
end;

procedure SendString(ahwnd:HWND; const s: String; aWParam: WParam;
dwData:DWord);
var
  cds: TCopyDataStruct;
begin
  cds.cbData := Length(s)+1;
  cds.lpData := Pointer(s);
  cds.dwData := dwData;
  SendMessage(ahwnd, WM_COPYDATA, aWParam, LParam(@cds));
end;

function GetCommandLineStr: String;
var
  i : Integer;
begin
  for i := 0 to ParamCount do
    Result := Result + ' ' + AnsiQuotedStr(ParamStr(i), '"');
end;
-------------------------EOF checkinst.pas---------------------

Leonid Troyanovsky 

++++++++++++++++++++++++++++++++++++

=== Вариант с Мьютексом ===

В файле проекта (.dpr) прямо можешь написать нечто вроде:
uses windows,...
var
  H: THandle;
begin
  H := CreateMutex(nil, True, 'уникальное_имя_для_твоей_проги');
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
    H := FindWindow(nil, 'название заголовка окна программы');
    SetForegroundWindow(H);
    Exit;
  end;
  Application.Initialize;
  Application.Title := 'название заголовка окна программы';
  Application.CreateForm(TAppData, AppData);
  Application.CreateForm(TMain, Main);
  Application.Run;
  CloseHandle(H);
end;

********************************************************

Мой способ.

CheckEvent: TEvent;
...
procedure TForm1.FormCreate(Sender: TObject);
begin
CheckEvent:= TEvent.Create( nil, false, true, 'MYPROJECT_CHECKEXIST' );
If CheckEvent.WaitFor(10)<>wrSignaled then
begin
ShowMessage('Сколько можно запускать одну и ту же программу ?');
Halt;
end else
...

Эта запись была добавлена в Воскресенье, 11 мая, 2008 - 14:16 В разделы Win API, Запуск программ. Вы можете подписаться на получение новых комментариев RSS 2.0 feed. Both comments and pings are currently closed.