Passing a string to an already running instance of an application

Question

I have an application that detects if there is another instance of the app running and exits if one is found. This part seems to work reliably. My app takes a command-line argument that I would like to pass to the already running instance. I have the following code so far:

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

{ Based on code by Zarko Gajic found at 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.

and in the main form unit:

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;

I'm pretty sure the problem is that I'm trying to send the message to the handle of the running app instance but trying to process the message on the main form. I'm thinking I have two options here:

A) From the application's handle somehow get the handle of its main form and send the message there.

B) Handle receiving the message at the application rather than the main form level.

I'm not really sure how to go about either. Is there a better approach?

Thanks.

Answer 1

You don't need to create a file mapping if you use WM_COPYDATA. That's the whole point of WM_COPYDATA - it does all that for you.

To send a string

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;

To receive a string

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;

Modify as needed to send other data.

Answer 2

It turns out that this is really hard to do reliably. I just spent two hours trying to get all the glitches out of a five-minute solution :( Seems to be working now, though.

The code below works in D2007 both with new-style (MainFormOnTaskbar = True) and old-style approach. Therefore, I believe it will also work in older Delphi version. It was tested with the application in minimized and normal state.

Test project is available at http://17slon.com/krama/ReActivate.zip (less than 3 KB).

For online reading, indexing purposes and backup, all important units are attached below.

Main program

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.

Main unit

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.

Helper unit

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.

All code is released to public domain and can be used without and licencing considerations.

Answer 3

I ended up saving the MainForm's handle into the InstanceInfo record in the file mapping then sending the message to the previous instance's main form handle if there was one.

In the project 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;

This seems to work reliably. I was going to post full source but I'd like to incorporate some of gabr's code that looks like it much more reliably sets focus to the running instance first.