375 lines
12 KiB
ObjectPascal
375 lines
12 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
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.sourceforge.net
|
|
|
|
Known Issues:
|
|
-----------------------------------------------------------------------------}
|
|
// $Id: JvAppInst.pas 10914 2006-08-24 11:48:26Z obones $
|
|
|
|
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. }
|
|
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;
|
|
function GetAppInstances: TJclAppInstances;
|
|
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 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: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvAppInst.pas $';
|
|
Revision: '$Revision: 10914 $';
|
|
Date: '$Date: 2006-08-24 13:48:26 +0200 (jeu., 24 août 2006) $';
|
|
LogPath: 'JVCL\run'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils,
|
|
JvJVCLUtils;
|
|
|
|
const
|
|
sAppInstancesWindowClassName = 'JvAppInstances_WindowClass'; // do not localize
|
|
AI_GETACTIVE = $0004;
|
|
AI_SETACTIVE = $0005;
|
|
|
|
{$IFDEF VisualCLX}
|
|
type
|
|
TPrivateComponent = class(TPersistent, IInterface, IInterfaceComponentReference)
|
|
protected
|
|
FOwner: TComponent;
|
|
FName: TComponentName;
|
|
FTag: Longint;
|
|
FComponents: TList;
|
|
public
|
|
function _AddRef: Integer; virtual; stdcall; abstract;
|
|
function _Release: Integer; virtual; stdcall; abstract;
|
|
function GetComponent: TComponent; virtual; abstract;
|
|
function QueryInterface(const IID: TGUID; out Obj): HRESULT; virtual; stdcall; abstract;
|
|
end;
|
|
{$ENDIF VisualCLX}
|
|
|
|
var
|
|
FirstJvAppInstance: Boolean = True;
|
|
|
|
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.InstanceCount > MaxInstances then
|
|
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
|
|
Result := JclAppInstances; // create AppInstance
|
|
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;
|
|
|
|
|
|
function TJvAppInstances.GetIsRemoteInstanceActive: Boolean;
|
|
type
|
|
PData = ^TData;
|
|
TData = record
|
|
Instance: TJvAppInstances;
|
|
Message: TMessage;
|
|
end;
|
|
|
|
var
|
|
I: Integer;
|
|
Wnd: HWND;
|
|
TID: DWORD;
|
|
Data: TData;
|
|
|
|
function EnumWinProc(Wnd: HWND; Data: PData): BOOL; stdcall;
|
|
begin
|
|
with Data^.Message do
|
|
SendMessage(Wnd, Msg, WParam, LParam);
|
|
Result := Data^.Instance.Active;
|
|
end;
|
|
|
|
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;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|
|
|