СообЧа > База Знаний > Программирование > Delphi

Вопрос

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

Ответ

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



Copyright © 2000-2004 Сообщество Чайников
Контактная информация