Передача строки в уже запущенный экземпляр приложения

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

Project1.dpr

program Project1;

uses
  ...
  AppInstanceControl in 'AppInstanceControl.pas';

  if not AppInstanceControl.RestoreIfRunning(Application.Handle) then
  begin
    Application.Initialize;
    Application.MainFormOnTaskbar := True;
    Application.CreateForm(TFormMain, FormMain);
    Application.Run;
  end;

end.

AppInstanceControl.pas

{На основе кода Зарко Гайича, который можно найти по адресу http://delphi.about.com/library/code/ncaa100703a.htm}

unit AppInstanceControl;

interface

uses
  Windows,
  SysUtils;

function RestoreIfRunning(const AAppHandle: THandle; const AMaxInstances: integer = 1): boolean;

implementation

uses
  Messages;

type
  PInstanceInfo = ^TInstanceInfo;
  TInstanceInfo = packed record
    PreviousHandle: THandle;
    RunCounter: integer;
  end;

var
  UMappingHandle: THandle;
  UInstanceInfo: PInstanceInfo;
  UMappingName: string;

  URemoveMe: boolean = True;

function RestoreIfRunning(const AAppHandle: THandle; const AMaxInstances: integer = 1): boolean;
var
  LCopyDataStruct : TCopyDataStruct;
begin
  Result := True;

  UMappingName := StringReplace(
                   ParamStr(0),
                   '\',
                   '',
                   [rfReplaceAll, rfIgnoreCase]);

  UMappingHandle := CreateFileMapping($FFFFFFFF,
                                     nil,
                                     PAGE_READWRITE,
                                     0,
                                     SizeOf(TInstanceInfo),
                                     PChar(UMappingName));

  if UMappingHandle = 0 then
    RaiseLastOSError
  else
  begin
    if GetLastError <> ERROR_ALREADY_EXISTS then
    begin
      UInstanceInfo := MapViewOfFile(UMappingHandle,
                                    FILE_MAP_ALL_ACCESS,
                                    0,
                                    0,
                                    SizeOf(TInstanceInfo));

      UInstanceInfo^.PreviousHandle := AAppHandle;
      UInstanceInfo^.RunCounter := 1;

      Result := False;
    end
    else //already runing
    begin
      UMappingHandle := OpenFileMapping(
                                FILE_MAP_ALL_ACCESS, 
                                False, 
                                PChar(UMappingName));
      if UMappingHandle <> 0 then
      begin
        UInstanceInfo := MapViewOfFile(UMappingHandle,
                                      FILE_MAP_ALL_ACCESS,
                                      0,
                                      0,
                                      SizeOf(TInstanceInfo));

        if UInstanceInfo^.RunCounter >= AMaxInstances then
        begin
          URemoveMe := False;

          if IsIconic(UInstanceInfo^.PreviousHandle) then
            ShowWindow(UInstanceInfo^.PreviousHandle, SW_RESTORE);
          SetForegroundWindow(UInstanceInfo^.PreviousHandle);
        end
        else
        begin
          UInstanceInfo^.PreviousHandle := AAppHandle;
          UInstanceInfo^.RunCounter := 1 + UInstanceInfo^.RunCounter;

          Result := False;
        end
      end;
    end;
  end;
  if (Result) and (CommandLineParam <> '') then
  begin
    LCopyDataStruct.dwData := 0; //string
    LCopyDataStruct.cbData := 1 + Length(CommandLineParam);
    LCopyDataStruct.lpData := PChar(CommandLineParam);

    SendMessage(UInstanceInfo^.PreviousHandle, WM_COPYDATA, Integer(AAppHandle), Integer(@LCopyDataStruct));
  end;
end; (*RestoreIfRunning*)

initialization

finalization
  //remove this instance
  if URemoveMe then
  begin
    UMappingHandle := OpenFileMapping(
                        FILE_MAP_ALL_ACCESS, 
                        False, 
                        PChar(UMappingName));
    if UMappingHandle <> 0 then
    begin
      UInstanceInfo := MapViewOfFile(UMappingHandle,
                                  FILE_MAP_ALL_ACCESS,
                                  0,
                                  0,
                                  SizeOf(TInstanceInfo));

      UInstanceInfo^.RunCounter := -1 + UInstanceInfo^.RunCounter;
    end
    else
      RaiseLastOSError;
  end;

  if Assigned(UInstanceInfo) then UnmapViewOfFile(UInstanceInfo);
  if UMappingHandle <> 0 then CloseHandle(UMappingHandle);

end.

и в модуле основной формы:

procedure TFormMain.WMCopyData(var Msg: TWMCopyData);
var
  LMsgString: string;
begin
  Assert(Msg.CopyDataStruct.dwData = 0);
  LMsgString := PChar(Msg.CopyDataStruct.lpData);

  //do stuff with the received string

end;

Я почти уверен, что проблема в том, что я пытаюсь отправить сообщение дескриптору запущенного экземпляра приложения, но пытаюсь обработать сообщение в основной форме. Думаю, у меня есть два варианта:

A) Из дескриптора приложения каким-то образом получить дескриптор его основной формы и отправить туда сообщение.

Б) Обработка получения сообщения на уровне приложения, а не на уровне основной формы.

Я тоже не совсем уверен, как поступить. Есть ли лучший подход?

Спасибо.


person lukeck    schedule 21.10.2008    source источник


Ответы (4)


Вам не нужно создавать сопоставление файлов, если вы используете WM_COPYDATA. В этом весь смысл WM_COPYDATA - он все это делает за вас.

Чтобы отправить строку

procedure IPCSendMessage(target: HWND;  const message: string);
var
  cds: TCopyDataStruct;
begin
  cds.dwData := 0;
  cds.cbData := Length(message) * SizeOf(Char);
  cds.lpData := Pointer(@message[1]);

  SendMessage(target, WM_COPYDATA, 0, LPARAM(@cds));
end;

Чтобы получить строку

procedure TForm1.WMCopyData(var msg: TWMCopyData);
var
  message: string;
begin
  SetLength(message, msg.CopyDataStruct.cbData div SizeOf(Char));
  Move(msg.CopyDataStruct.lpData^, message[1], msg.CopyDataStruct.cbData);

  // do something with the message e.g.
  Edit1.Text := message;
end;

При необходимости измените, чтобы отправить другие данные.

person Tim Knipe    schedule 21.10.2008
comment
Цель сопоставления файлов - убедиться, что у меня работают только AMaxInstances моего приложения (в моем случае 1 экземпляр). Отправка сообщения правильной цели - это бит, с которым у меня проблемы. Спасибо хоть. - person lukeck; 21.10.2008
comment
Если я чего-то не упускаю? - person lukeck; 21.10.2008
comment
WM-COPYDATA не будет работать, когда одно приложение работает как служба, а другое запускается из состояния окна по умолчанию (например, в сеансе авторизованного пользователя). Использование объектов ядра намного надежнее и поддерживает это. - person Ritsaert Hornstra; 10.03.2012

Оказывается, надежно это сделать действительно сложно. Я просто потратил два часа, пытаясь устранить все глюки из пятиминутного решения :( Хотя, похоже, сейчас работает.

Приведенный ниже код работает в D2007 как в новом стиле (MainFormOnTaskbar = True), так и в старом стиле. Поэтому я считаю, что это также будет работать в более старой версии Delphi. Он был протестирован с приложением в свернутом и нормальном состоянии.

Тестовый проект доступен по адресу http://17slon.com/krama/ReActivate.zip (меньше чем 3 КБ).

Ниже прилагаются все важные блоки для интерактивного чтения, индексирования и резервного копирования.

Основная программа

program ReActivate;

uses
  Forms,
  GpReActivator, 
  raMain in 'raMain.pas' {frmReActivate};

{$R *.res}

begin
   if ReactivateApplication(TfrmReActivate, WM_REACTIVATE) then
    Exit;

  Application.Initialize;
  Application.MainFormOnTaskbar := True;
//  Application.MainFormOnTaskbar := False;
  Application.CreateForm(TfrmReActivate, frmReActivate);
  Application.Run;
end.

Основной модуль

unit raMain;

interface

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

const
  WM_REACTIVATE = WM_APP;

type
  TfrmReActivate = class(TForm)
  private
  public
    procedure ReActivate(var msg: TMessage); message WM_REACTIVATE;
  end;

var
  frmReActivate: TfrmReActivate;

implementation

{$R *.dfm}

uses
  GpReactivator;

{ TfrmReActivate }

procedure TfrmReActivate.ReActivate(var msg: TMessage);
begin
  GpReactivator.Activate;
end;                         

end.

Блок помощника

unit GpReActivator;

interface

uses
  Classes;

procedure Activate;
function ReActivateApplication(mainFormClass: TComponentClass; reactivateMsg: cardinal):
  boolean;

implementation

uses
  Windows,
  Messages,
  SysUtils,
  Forms;

type
  TProcWndInfo = record
    ThreadID     : DWORD;
    MainFormClass: TComponentClass;
    FoundWindow  : HWND;
  end; { TProcWndInfo }
  PProcWndInfo = ^TProcWndInfo;

var
  fileMapping      : THandle;
  fileMappingResult: integer;

function ForceForegroundWindow(hwnd: THandle): boolean;
var
  foregroundThreadID: DWORD;
  thisThreadID      : DWORD;
  timeout           : DWORD;
begin
  if GetForegroundWindow = hwnd then
    Result := true
  else begin

    // Windows 98/2000 doesn't want to foreground a window when some other
    // window has keyboard focus

    if ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion > 4)) or
      ((Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
      ((Win32MajorVersion > 4) or ((Win32MajorVersion = 4) and (Win32MinorVersion > 0)))) then
    begin

      // Code from Karl E. Peterson, www.mvps.org/vb/sample.htm
      // Converted to Delphi by Ray Lischner
      // Published in The Delphi Magazine 55, page 16

      Result := false;
      foregroundThreadID := GetWindowThreadProcessID(GetForegroundWindow,nil);
      thisThreadID := GetWindowThreadPRocessId(hwnd,nil);
      if AttachThreadInput(thisThreadID, foregroundThreadID, true) then begin
        BringWindowToTop(hwnd); //IE 5.5 - related hack
        SetForegroundWindow(hwnd);
        AttachThreadInput(thisThreadID, foregroundThreadID, false);
        Result := (GetForegroundWindow = hwnd);
      end;
      if not Result then begin

        // Code by Daniel P. Stasinski <[email protected]>

        SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @timeout, 0);
        SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(0), SPIF_SENDCHANGE);
        BringWindowToTop(hwnd); //IE 5.5 - related hack
        SetForegroundWindow(hWnd);
        SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(timeout), SPIF_SENDCHANGE);
      end;
    end
    else begin
      BringWindowToTop(hwnd); //IE 5.5 - related hack
      SetForegroundWindow(hwnd);
    end;

    Result := (GetForegroundWindow = hwnd);
  end;
end; { ForceForegroundWindow }

procedure Activate;
begin
  if (Application.MainFormOnTaskBar and (Application.MainForm.WindowState = wsMinimized))
     or
     ((not Application.MainFormOnTaskBar) and (not IsWindowVisible(Application.MainForm.Handle)))
  then
    Application.Restore
  else
    Application.BringToFront;
  ForceForegroundWindow(Application.MainForm.Handle);
end; { Activate }

function IsTopDelphiWindow(wnd: HWND): boolean;
var
  parentWnd: HWND;
  winClass  : array [0..1024] of char;
begin
  parentWnd := GetWindowLong(wnd, GWL_HWNDPARENT);
  Result :=
    (parentWnd = 0)
    or
    (GetWindowLong(parentWnd, GWL_HWNDPARENT) = 0) and
    (GetClassName(parentWnd, winClass, SizeOf(winClass)) <> 0) and
    (winClass = 'TApplication');
end; { IsTopDelphiWindow }

function EnumGetProcessWindow(wnd: HWND; userParam: LPARAM): BOOL; stdcall;
var
  procWndInfo: PProcWndInfo;
  winClass   : array [0..1024] of char;
begin
  procWndInfo := PProcWndInfo(userParam);
  if (GetWindowThreadProcessId(wnd, nil) = procWndInfo.ThreadID) and
     (GetClassName(wnd, winClass, SizeOf(winClass)) <> 0) and
     IsTopDelphiWindow(wnd) and
     (string(winClass) = procWndInfo.MainFormClass.ClassName) then
  begin
    procWndInfo.FoundWindow := Wnd;
    Result := false;
  end
  else
    Result := true;
end; { EnumGetProcessWindow }

function GetThreadWindow(threadID: cardinal; mainFormClass: TComponentClass): HWND;
var
  procWndInfo: TProcWndInfo;
begin
  procWndInfo.ThreadID := threadID;
  procWndInfo.MainFormClass := mainFormClass;
  procWndInfo.FoundWindow := 0;
  EnumWindows(@EnumGetProcessWindow, LPARAM(@procWndInfo));
  Result := procWndInfo.FoundWindow;
end; { GetThreadWindow }

function ReActivateApplication(mainFormClass: TComponentClass; reactivateMsg: cardinal):
  boolean;
var
  mappingData: PDWORD;
begin
  Result := false;
  if fileMappingResult = NO_ERROR then begin // first owner
    mappingData := MapViewOfFile(fileMapping, FILE_MAP_WRITE, 0, 0, SizeOf(DWORD));
    Win32Check(assigned(mappingData));
    mappingData^ := GetCurrentThreadID;
    UnmapViewOfFile(mappingData);
  end
  else if fileMappingResult = ERROR_ALREADY_EXISTS then begin // app already started
    mappingData := MapViewOfFile(fileMapping, FILE_MAP_READ, 0, 0, SizeOf(DWORD));
    if mappingData^ <> 0 then begin // 0 = race condition
      PostMessage(GetThreadWindow(mappingData^, mainFormClass), reactivateMsg, 0, 0);
      Result := true;
    end;
    UnmapViewOfFile(mappingData);
    Exit;
  end
  else
    RaiseLastWin32Error;
end; { ReActivateApplication }

initialization
  fileMapping := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0,
    SizeOf(DWORD), PChar(StringReplace(ParamStr(0), '\', '', [rfReplaceAll, rfIgnoreCase])));
  Win32Check(fileMapping <> 0);
  fileMappingResult := GetLastError;
finalization
  if fileMapping <> 0 then
    CloseHandle(fileMapping);
end.

Весь код передан в общественное достояние и может использоваться без каких-либо лицензионных требований.

person gabr    schedule 21.10.2008
comment
Я просто заметил, что вопрос был в том, как передать строку. Я такой глупый. Ваши копируемые данные в порядке, но вы должны использовать тот же метод, что и выше, чтобы получить дескриптор главного окна из идентификатора потока. - person gabr; 21.10.2008
comment
Похоже, он по-прежнему надежно выполняет то, что намеревается делать. Я объединю некоторые из ваших подходов в свой ответ. Спасибо за вашу помощь. - person lukeck; 22.10.2008

В итоге я сохранил дескриптор MainForm в записи InstanceInfo в сопоставлении файлов, а затем отправил сообщение в дескриптор основной формы предыдущего экземпляра, если он был.

В проекте dpr:

  if not AppInstanceControl.RestoreIfRunning(Application.Handle) then
  begin
    Application.Initialize;
    Application.MainFormOnTaskbar := True;
    Application.CreateForm(TFormMain, FormMain);
    SetRunningInstanceMainFormHandle(FormMain.Handle);
    Application.Run;
  end else
    SendMsgToRunningInstanceMainForm('Message string goes here');

AppInstanceControl.pas

type
  PInstanceInfo = ^TInstanceInfo;
  TInstanceInfo = packed record
    PreviousHandle: THandle;
    PreviousMainFormHandle: THandle;
    RunCounter: integer;
  end;

procedure SetRunningInstanceMainFormHandle(const AMainFormHandle: THandle);
begin
  UMappingHandle := OpenFileMapping(
                            FILE_MAP_ALL_ACCESS,
                            False,
                            PChar(UMappingName));
  if UMappingHandle <> 0 then
  begin
    UInstanceInfo := MapViewOfFile(UMappingHandle,
                                  FILE_MAP_ALL_ACCESS,
                                  0,
                                  0,
                                  SizeOf(TInstanceInfo));

    UInstanceInfo^.PreviousMainFormHandle := AMainFormHandle;
  end;
end;

procedure SendMsgToRunningInstanceMainForm(const AMsg: string);
var
  LCopyDataStruct : TCopyDataStruct;
begin
  UMappingHandle := OpenFileMapping(
                            FILE_MAP_ALL_ACCESS,
                            False,
                            PChar(UMappingName));
  if UMappingHandle <> 0 then
  begin
    UInstanceInfo := MapViewOfFile(UMappingHandle,
                                  FILE_MAP_ALL_ACCESS,
                                  0,
                                  0,
                                  SizeOf(TInstanceInfo));


    LCopyDataStruct.dwData := 0; //string
    LCopyDataStruct.cbData := 1 + Length(AMsg);
    LCopyDataStruct.lpData := PChar(AMsg);

    SendMessage(UInstanceInfo^.PreviousMainFormHandle, WM_COPYDATA, Integer(Application.Handle), Integer(@LCopyDataStruct));
  end;
end;

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

person lukeck    schedule 22.10.2008

Почему вы не используете DDE? Взгляните на ссылки, которые возвращает этот поиск: http://www.google.com/search?q=delphi+dde.

person Eduardo    schedule 21.10.2008
comment
Интересный. Похоже, я собираюсь почитать сегодня вечером. В конце концов, я могу использовать DDE, но мне все равно хотелось бы наладить работу, используя подход, с которого я начал. - person lukeck; 21.10.2008