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

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

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) Из дескриптора приложения каким-то образом получить дескриптор его основной формы и отправить там сообщение.

B) Обрабатывать сообщение в приложении, а не на основном уровне формы.

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

Спасибо.

Ответы

Ответ 1

Вам не нужно создавать сопоставление файлов, если вы используете 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;

Измените при необходимости отправку других данных.

Ответ 2

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

Код ниже работает в 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.

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

Ответ 3

Я закончил тем, что сохранил дескриптор 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-кода, который выглядит так, что он намного более надежно устанавливает фокус на исполняемый экземпляр первым.