{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvAppInst.pas, released on 2003-10-07.

The Initial Developer of the Original Code is Andreas Hausladen [Andreas dott Hausladen att gmx dott de]
Portions created by Andreas Hausladen are Copyright (C) 2003 Andreas Hausladen.
All Rights Reserved.

Contributor(s): -

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org

Known Issues:
-----------------------------------------------------------------------------}
// $Id$

unit JvAppInst;

{$I jvcl.inc}
{$I windowsonly.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, Forms,
  Classes, { Classes must be after Forms for Delphi 5 compatibility. }
  JclAppInst;

type
  TJvAppInstDataKind = TJclAppInstDataKind; // = Integer

  TInstanceChangeEvent = procedure(Sender: TObject; ProcessId: Cardinal) of object;
  TUserNotifyEvent = procedure(Sender: TObject; Param: Integer) of object;
  TDataAvailableEvent = procedure(Sender: TObject; Kind: TJvAppInstDataKind;
    Data: Pointer; Size: Integer) of object;
    { Data contains the sent data and is released when the function returns }
  TCmdLineReceivedEvent = procedure(Sender: TObject; CmdLine: TStrings) of object;

  { TJvAppInstance encapsulates the TJclAppInstance class. To set a
    UniqueAppIdGuidStr you must call JclAppInst.JclAppInstances in the
    initialization section of a unit or before the forms are created (OnCreate
    is too late).
    This class is not thread safe. }
  {$IFDEF RTL230_UP}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32{$IFDEF RTL360_UP} or pidWin64x{$ENDIF RTL360_UP})]
  {$ENDIF RTL230_UP}
  TJvAppInstances = class(TComponent)
  private
    FHandle: THandle;
    FOnInstanceCreated: TInstanceChangeEvent;
    FOnInstanceDestroyed: TInstanceChangeEvent;
    FOnUserNotify: TUserNotifyEvent;
    FOnDataAvailable: TDataAvailableEvent;
    FOnCmdLineReceived: TCmdLineReceivedEvent;
    FOnRejected: TNotifyEvent;
    FAutoActivate: Boolean;
    FMaxInstances: Integer;
    FActive: Boolean;
    FSendCmdLine: Boolean;
    FAppInstances: TJclAppInstances; // don't free, it's a singleton

    function GetAppInstances: TJclAppInstances;
    function GetUniqueAppId: string;
  protected
    procedure Loaded; override;
    procedure WndProc(var Msg: TMessage); virtual;
    function GetIsRemoteInstanceActive: Boolean;
    procedure DoInstanceCreated(ProcessId: Cardinal); virtual;
    procedure DoInstanceDestroyed(ProcessId: Cardinal); virtual;
    procedure DoUserNotify(Param: Integer); virtual;
    procedure DoDataAvailable(Kind: TJvAppInstDataKind; Data: Pointer; Size: Integer); virtual;
    procedure DoCmdLineReceived(CmdLine: TStrings); virtual;
    procedure DoRejected; virtual;
    property Handle: THandle read FHandle;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Check;
    procedure UserNotify(Param: Integer);
    function SendData(DataKind: TJclAppInstDataKind; Data: Pointer; Size: Integer): Boolean;
    property AppInstances: TJclAppInstances read GetAppInstances;
  published
    property Active: Boolean read FActive write FActive default True;
    property AutoActivate: Boolean read FAutoActivate write FAutoActivate default True;
     { AutoActivate: True means that the first instance is brought to front
       by the second process instance. }
    property MaxInstances: Integer read FMaxInstances write FMaxInstances default 1;
     { MaxInstances: 0 means no restriction }
    property SendCmdLine: Boolean read FSendCmdLine write FSendCmdLine default True;
     { SendCmdLine: True means that the second process instance sends it's
       CmdLine to the first instance before it terminates. }
    property UniqueAppId: string read GetUniqueAppId;
    property OnInstanceCreated: TInstanceChangeEvent read FOnInstanceCreated write FOnInstanceCreated;
    property OnInstanceDestroyed: TInstanceChangeEvent read FOnInstanceDestroyed write FOnInstanceDestroyed;
    property OnUserNotify: TUserNotifyEvent read FOnUserNotify write FOnUserNotify;
    property OnDataAvailable: TDataAvailableEvent read FOnDataAvailable write FOnDataAvailable;
    property OnCmdLineReceived: TCmdLineReceivedEvent read FOnCmdLineReceived write FOnCmdLineReceived;
    property OnRejected: TNotifyEvent read FOnRejected write FOnRejected;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL$';
    Revision: '$Revision$';
    Date: '$Date$';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

procedure SetUniqueAppId(const AUniqueAppId: string);

implementation

uses
  SysUtils,
  JvJVCLUtils;

const
  sAppInstancesWindowClassName = 'JvAppInstances_WindowClass'; // do not localize
  AI_GETACTIVE = $0004;
  AI_SETACTIVE = $0005;

var
  FirstJvAppInstance: Boolean = True;
  FUniqueAppId: string;

procedure SetUniqueAppId(const AUniqueAppId: string);
begin
  FUniqueAppId := AUniqueAppId;
end;

constructor TJvAppInstances.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  if not (csDesigning in ComponentState) then
  begin
    FHandle := AllocateHWndEx(WndProc, sAppInstancesWindowClassName);
    if FirstJvAppInstance then
    begin
      FirstJvAppInstance := False;
      AppInstances.CheckInstance($FFFF); // increase shared instance count
    end;
  end;

  FActive := True;
  FMaxInstances := 1;
  FAutoActivate := True;
  FSendCmdLine := True;
end;

destructor TJvAppInstances.Destroy;
begin
  if not (csDesigning in ComponentState) then
    DeallocateHWndEx(FHandle);
  inherited Destroy;
end;

procedure TJvAppInstances.Check;
begin
  if Active and not (csDesigning in ComponentState) then
    if MaxInstances > 0 then
      if AppInstances.InstanceIndex[GetCurrentProcessId] >= MaxInstances then  // Mantis 3990
      begin
        if GetIsRemoteInstanceActive then
        begin
          DoRejected;
          if AutoActivate then
            AppInstances.SwitchTo(0);
          if SendCmdLine then
            AppInstances.SendCmdLineParams(sAppInstancesWindowClassName, Handle);

          // As ExitProcess will prevent ANY finalization to occur, we free the
          // AppInstances object so that it can cleanup the process information
          AppInstances.Free;
          ExitProcess(0);
        end;
      end;
end;

procedure TJvAppInstances.DoCmdLineReceived(CmdLine: TStrings);
begin
  if Assigned(FOnCmdLineReceived) then
    FOnCmdLineReceived(Self, CmdLine);
end;

procedure TJvAppInstances.DoDataAvailable(Kind: TJvAppInstDataKind;
  Data: Pointer; Size: Integer);
begin
  if Assigned(FOnDataAvailable) then
    FOnDataAvailable(Self, Kind, Data, Size);
end;

procedure TJvAppInstances.DoInstanceCreated(ProcessId: Cardinal);
begin
  if Assigned(FOnInstanceCreated) then
    FOnInstanceCreated(Self, ProcessId);
end;

procedure TJvAppInstances.DoInstanceDestroyed(ProcessId: Cardinal);
begin
  if Assigned(FOnInstanceDestroyed) then
    FOnInstanceDestroyed(Self, ProcessId);
end;

procedure TJvAppInstances.DoUserNotify(Param: Integer);
begin
  if Assigned(FOnUserNotify) then
    FOnUserNotify(Self, Param);
end;

procedure TJvAppInstances.DoRejected;
begin
  if Assigned(FOnRejected) then
    FOnRejected(Self);
end;

function TJvAppInstances.GetAppInstances: TJclAppInstances;
begin
  if csDesigning in ComponentState then
    Result := nil
  else
  begin
    if not Assigned(FAppInstances) then
      FAppInstances := JclAppInstances(FUniqueAppId); // create AppInstance

    Result := FAppInstances;
  end;
end;

procedure TJvAppInstances.Loaded;
begin
  inherited Loaded;
  Check;
end;

procedure TJvAppInstances.WndProc(var Msg: TMessage);
var
  Kind: TJvAppInstDataKind;
  Data: Pointer;
  Size: Integer;
  CmdLine: TStrings;
begin
  try
    if Msg.Msg = AppInstances.MessageID then
    begin
      case Msg.WParam of
        AI_INSTANCECREATED:
          if Cardinal(Msg.LParam) <> GetCurrentProcessId then
            DoInstanceCreated(Cardinal(Msg.LParam));
        AI_INSTANCEDESTROYED:
          DoInstanceDestroyed(Cardinal(Msg.LParam));
        AI_USERMSG:
          DoUserNotify(Msg.LParam);
        AI_GETACTIVE:
          SendMessage(HWND(Msg.LParam), AppInstances.MessageID,
            AI_SETACTIVE, Ord(Active));
        AI_SETACTIVE:
          Active := Msg.LParam <> 0;
      end;
    end
    else
    begin
      Kind := ReadMessageCheck(Msg, Handle);
      case Kind of
        AppInstDataKindNoData:
          ; // do nothing
        AppInstCmdLineDataKind:
          begin
            if Assigned(FOnCmdLineReceived) then
            begin
              CmdLine := TStringList.Create;
              try
                ReadMessageStrings(Msg, CmdLine);
                DoCmdLineReceived(CmdLine);
              finally
                CmdLine.Free;
              end;
            end;
            Exit;
          end;
      else
        if Assigned(FOnDataAvailable) then
        begin
          ReadMessageData(Msg, Data, Size);
          try
            DoDataAvailable(Kind, Data, Size);
          finally
            FreeMem(Data);
          end;
        end;
        Exit;
      end;
    end;
  except
    on E: Exception do
      Application.ShowException(E);
  end;

  with Msg do
    Result := DefWindowProc(Handle, Msg, WParam, LParam);
end;

procedure TJvAppInstances.UserNotify(Param: Integer);
begin
  AppInstances.UserNotify(Param);
end;

function TJvAppInstances.SendData(DataKind: TJclAppInstDataKind;
  Data: Pointer; Size: Integer): Boolean;
begin
  Result := AppInstances.SendData(sAppInstancesWindowClassName, DataKind, Data,
    Size, Handle);
end;

type
  PEnumWinData = ^TEnumWinData;
  TEnumWinData = record
    Instance: TJvAppInstances;
    Message: TMessage;
  end;

function EnumWinProc(Wnd: HWND; Data: PEnumWinData): BOOL; stdcall;
begin
  with Data^.Message do
    SendMessage(Wnd, Msg, WParam, LParam);
  Result := Data^.Instance.Active;
end;

function TJvAppInstances.GetIsRemoteInstanceActive: Boolean;
var
  I: Integer;
  Wnd: HWND;
  TID: DWORD;
  Data: TEnumWinData;
begin
  for I := 0 to AppInstances.InstanceCount - 1 do
  begin
    if AppInstances.ProcessIDs[I] = GetCurrentProcessId then
      Continue;
    Wnd := AppInstances.AppWnds[I];
    TID := GetWindowThreadProcessId(Wnd, nil);
    Data.Instance := Self;
    Data.Message.Msg := AppInstances.MessageID;
    Data.Message.WParam := AI_GETACTIVE;
    Data.Message.LParam := Handle;
    EnumThreadWindows(TID, @EnumWinProc, LPARAM(@Data));
    if not Active then
      Break;
  end;
  Result := Active;
end;

function TJvAppInstances.GetUniqueAppId: string;
begin
  Result := FUniqueAppId;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.
