Переслать командную строку из второго экземпляра программы в первый

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

{

I set up a file type (.myfile) to be run by my program, and everything works

okay. The program opens it fine. The problem is, if I double-click some file

on my HD, it opens a new instance of my app, rather than sending the file to

the already opened one. How can I fix this?

}

{

Example for using DDE to open files from Explorer:

http://codecentral.borland.com/codecentral/ccweb.exe/finder

and search for submission ID 17787

}

{That is the comprehensive solution . There are simpler ones but they tend

to get problems if more than one file is opened at once from Explorer. Those

problems can be handled, but it gets a bit complex to do that.

Basically you proceed like this:

In your programs main block (DPR file) you create a named global kernel

object, e.g. a Mutex or memory-mapped file, using a unique name (e.g. a GUID).

The first instance will create this object successfully and hold on to the

objects handle until it closes. All further instances will detect that the

object already exists, so know that they are not supposed to show up to the

user. But they have to pass over any command-line they may have been handed

from Explorer. They do that by sending a WM_COPYDATA message with the command

line contents to the first instances main window. For that they have to find

the windows handle, for which they use FindWindow with the main forms

classname (which should definitely be somewhat more unique than «Form1»!). The

problem is that the first instance may not have gotten around to creating its

main window yet (if more than one file has been opened from Explorer and the

program was not already running). So the second instance may have to wait in a

loop (using Sleep to suspend itself for a little bit) until the first

instances window shows up.

Bits and pieces of this process have been posted many times on the groups in

the past, but i don’t remember if a solution covering all bases was among

them. So since it is Sunday and i’m a wee bit bored let’s try for a generic

solution. The meat is in the PBOnceOnly unit given further down. I explain its

usage first. Note that this has been tested on Windows 2000 only, and not very

extensively either.

In the projects DPR file you have code looking like this:

}

program OneInstanceDemo;

uses

Forms,

Unit1 in ‘Unit1.pas’ {OneInstanceDemoMainform},

PBOnceOnly;

{$R *.res}

const

ProcessName = ‘{53F0DF5B-B69D-40B7-9B2C-A9E515CCFC80}’;

begin

if AlreadyRunning(ProcessName, TOneInstanceDemoMainform) then

Exit;

Application.Initialize;

Application.CreateForm(TOneInstanceDemoMainform, OneInstanceDemoMainform);

Application.Run;

end.

{You can create a GUID for the processname via Ctrl-Shift-G in the IDE, just

remove the enclosing square brackets.

The main form needs a message handler for WM_COPYDATA, and also a method to

handle a command-line parameter. The example form only shows the passed

parameter in a memo.}

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ComCtrls, Buttons, StdCtrls;

type

TOneInstanceDemoMainform = class(TForm)

Memo1: TMemo;

procedure FormCreate(Sender: TObject);

private

procedure WMCopyData(var msg: TWMCopyData); message WM_COPYDATA;

procedure HandleParameter(const param: string);

public

{ Public declarations }

end;

var

OneInstanceDemoMainform: TOneInstanceDemoMainform;

implementation

uses PBOnceOnly;

{$R *.DFM}

procedure TOneInstanceDemoMainform.FormCreate(Sender: TObject);

begin

memo1.Text := Format(‘Thread ID: %x’#13#10, [GetCurrentThreadID]);

HandleCommandline(HandleParameter);

end;

procedure TOneInstanceDemoMainform.HandleParameter(const param: string);

begin

memo1.Lines.Add(param);

end;

procedure TOneInstanceDemoMainform.WMCopyData(var msg: TWMCopyData);

begin

HandleSendCommandline(msg.CopyDataStruct^, HandleParameter);

end;

end.

{The work of dissecting the passed commandline is left to the PBOnceOnly unit,

since it «knows» how it packaged the parameters in the other instance. The

technique used by the unit is rather simple: the first instance creates a

memory mapped file and stores its main threads thread ID into this file. It

cannot store the main forms handle since the form has not been created yet

when AlreadyRunning is called. It would be a bad idea anyway since a forms

handle can change over the form objects lifetime. The second instance gets

this handle, uses EnumThreadWindows to find the first instances main form

handle (doing this way avoids problems with the IDE designers form instance

during development), packages the command line and sends it over to the found

window. The second instance will then terminate since AlreadyRunning returns

true in it. It never creates any of the autocreated forms or datamodules and

never enters its message loop.}

{== PBOnceOnly ========================================================}

{: Implements a function to detect a running instance of the program and

(optionally) pass over any command line to the first instances main

window.

@author Dr. Peter Below

@desc Version 1.0 created 2003-02-23

Last modified 2003-02-23

If a command line has to be passed over we need the window handle of the

first instances main window, to send a WM_COPYDATA message to it. Since

the first instance may not have gotten around to creating its main

form window handle yet we retry a couple of times and wait a bit in

between. This process can be configured by setting the MAX_RETRIES and

RETRIES_INTERVAL variables before calling AlreadyRunning. }

{======================================================================}

{$BOOLEVAL OFF} {Unit depends on shortcut boolean evaluation}

unit PBOnceOnly;

interface

uses Windows;

var

{: Specifies how often we retry to find the first instances main

window. }

MAX_RETRIES: Integer = 10;

{: Specifies how long, in milliseconds, we sleep between retries. }

RETRIES_INTERVAL: Integer = 1000;

{— AlreadyRunning —————————————————-}

{: Checks for another instance of the program and optionally passes over

this instances command line.

@Param aProcessName is a unique name to be used to identify this program.

@Param aMainformClass is the programs main form class, can be nil.

@Param passCommandline indicates whether to pass the command line, true

by default.

@Param allowMultiuserInstances indicates whether to allow other

instances of the program to run in another user context. Only applies

to Windows terminal server or XP. True by default.

@Returns true if there is another instance running, false if not.

@Precondition The function has not been called already. It must only

be called once per program run.

@Desc Creates a memory mapped file with the passed process name,

optionally with an added ‘Global’ prefix. If the MMF already existed

we know that this is a second instance. The first instance stores its

main thread ID into the MMF, the second one uses that with

EnumThreadWindows to find the first instances main window and sends

the command line via WM_COPYDATA to this window, if requested.

@Raises Exception if creation of the MMF fails for some reason.

}{ Created 2003-02-23 by P. Below

————————————————————————}

function AlreadyRunning(const aProcessName: string;

aMainformClass: TClass = nil;

passCommandline: Boolean = true;

allowMultiuserInstances: Boolean = true): Boolean;

type

{: Callback type used by HandleSendCommandline. The callback will

be handed one parameter at a time. }

TParameterEvent = procedure(const aParam: string) of object;

{— HandleSendCommandline ———————————————}

{: Dissect a command line passed via WM_COPYDATA from another instance

@Param data contains the data received via WM_COPYDATA.

@Param onParameter is a callback that will be called with every passed

parameter in turn.

@Precondition onParameter nil

}{ Created 2003-02-23 by P. Below

————————————————————————}

procedure HandleSendCommandline(const data: TCopyDataStruct;

onParameter: TParameterEvent);

{— HandleCommandline ————————————————-}

{: This is a convenience procedure that allows handling of this

instances command line parameters to be done the same way as

a command line send over from another instance.

@Param onParameter will be called for every command line parameter in turn.

@Precondition onParameter nil

}{ Created 2003-02-23 by P. Below

————————————————————————}

procedure HandleCommandline(onParameter: TParameterEvent);

implementation

uses Messages, Classes, Sysutils;

{ The THandledObject and TShareMem classes come from the D6 IPCDemos

demo project. }

type

THandledObject = class(TObject)

protected

FHandle: THandle;

public

destructor Destroy; override;

property Handle: THandle read FHandle;

end;

{ This class simplifies the process of creating a region of shared memory.

In Win32, this is accomplished by using the CreateFileMapping and

MapViewOfFile functions. }

TSharedMem = class(THandledObject)

private

FName: string;

FSize: Integer;

FCreated: Boolean;

FFileView: Pointer;

public

constructor Create(const Name: string; Size: Integer);

destructor Destroy; override;

property Name: string read FName;

property Size: Integer read FSize;

property Buffer: Pointer read FFileView;

property Created: Boolean read FCreated;

end;

procedure Error(const Msg: string);

begin

raise Exception.Create(Msg);

end;

{ THandledObject }

destructor THandledObject.Destroy;

begin

if FHandle 0 then

CloseHandle(FHandle);

end;

{ TSharedMem }

constructor TSharedMem.Create(const Name: string; Size: Integer);

begin

try

FName := Name;

FSize := Size;

{ CreateFileMapping, when called with $FFFFFFFF for the handle value,

creates a region of shared memory }

FHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,

Size, PChar(Name));

if FHandle = 0 then abort;

FCreated := GetLastError = 0;

{ We still need to map a pointer to the handle of the shared memory region

}

FFileView := MapViewOfFile(FHandle, FILE_MAP_WRITE, 0, 0, Size);

if FFileView = nil then abort;

except

Error(Format(‘Error creating shared memory %s (%d)’, [Name,

GetLastError]));

end;

end;

destructor TSharedMem.Destroy;

begin

if FFileView nil then

UnmapViewOfFile(FFileView);

inherited Destroy;

end;

var

{ This object is destroyed by the unit finalization }

ProcessInfo: TSharedMem = nil;

{ Check if we are running in a terminal client session }

function IsRemoteSession: Boolean;

const

sm_RemoteSession = $1000; { from WinUser.h }

begin

Result := GetSystemMetrics(sm_RemoteSession) 0;

end;

{ Check if we are running on XP or a newer version. XP is Windows NT 5.1 }

function IsXP: Boolean;

begin

Result :=

(Sysutils.Win32Platform = VER_PLATFORM_WIN32_NT)

and

((Sysutils.Win32MajorVersion > 5)

or

((Sysutils.Win32MajorVersion = 5)

and

(Sysutils.Win32MinorVersion > 0)

)

);

end;

{ Check if we are running in a Windows terminal client session or on

Windows XP. }

function IsWTSOrXP: Boolean;

begin

Result := IsRemoteSession or IsXP

end;

type

{ Helper class to hold classname and found window handle for

EnumThreadWindows }

TEnumhelper = class

public

FClassname: string;

FWnd: HWND;

constructor Create(const aClassname: string);

function Matches(wnd: HWND): Boolean;

end;

constructor TEnumhelper.Create(const aClassname: string);

begin

inherited Create;

FClassname := aClassname;

end;

function TEnumhelper.Matches(wnd: HWND): Boolean;

var

classname: array[0..127] of Char;

begin

classname[0] := #0;

Windows.GetClassname(wnd, classname, sizeof(classname));

Result := AnsiSametext(Fclassname, classname);

if result then

FWnd := wnd;

end;

function EnumProc(wnd: HWND; helper: TEnumHelper): BOOL; stdcall;

begin

Result := not helper.Matches(wnd);

end;

function FindFirstInstanceMainform(const aClassname: string): HWND;

var

threadID: DWORD;

helper: TEnumHelper;

begin

threadID := PDWORD(Processinfo.FFileView)^;

helper := TEnumHelper.Create(aclassname);

try

EnumThreadWindows(threadID, @EnumProc, Integer(helper));

Result := helper.FWnd;

finally

helper.Free;

end;

end;

function AlreadyRunning(const aProcessName: string;

aMainformClass: TClass = nil;

passCommandline: Boolean = true;

allowMultiuserInstances: Boolean = true): Boolean;

function Processname: string;

begin

if not allowMultiuserInstances and IsWTSorXP then

Result := ‘Global\’ aProcessName

else

Result := aProcessName;

end;

procedure StoreThreadID;

begin

PDWORD(ProcessInfo.FFileView)^ := GetCurrentThreadID;

end;

function GetCommandline: string;

var

sl: TStringlist;

i: Integer;

begin

if ParamCount = 1 then

Result := ParamStr(1)

else begin

sl := TStringlist.Create;

try

for i := 1 to ParamCount do

sl.Add(ParamStr(i));

Result := sl.Text;

finally

sl.free;

end; { Finally }

end;

end;

procedure DoPassCommandline;

var

wnd: HWND;

S: string;

copydata: TCopyDataStruct;

retries: Integer;

begin

retries := 0;

repeat

wnd := FindFirstInstanceMainform(aMainformclass.Classname);

if wnd 0 then

begin

S := GetCommandline;

copydata.dwData := Paramcount;

copydata.cbData := Length(S) 1;

copydata.lpData := PChar(S);

SendMessage(wnd, WM_COPYDATA, 0, integer(@copydata));

end

else begin

Inc(retries);

Sleep(RETRIES_INTERVAL);

end;

until (wnd 0) or (retries > MAX_RETRIES);

end;

begin

Assert(not Assigned(ProcessInfo),

‘Do not call AlreadyRunning more than once!’);

ProcessInfo := TSharedMem.Create(Processname, Sizeof(DWORD));

Result := not ProcessInfo.Created;

if Result then

begin

if passCommandline and Assigned(aMainformClass) and (ParamCount > 0) then

DoPassCommandline;

end

else

StoreThreadID;

end;

procedure HandleSendCommandline(const data: TCopyDataStruct;

onParameter: TParameterEvent);

var

i: Integer;

sl: TStringlist;

begin

Assert(Assigned(onParameter), ‘OnParameter cannot be nil’);

if data.dwData = 1 then

onParameter(PChar(data.lpData))

else

begin

sl := TStringlist.Create;

try

sl.Text := PChar(data.lpData);

for i := 0 to sl.Count — 1 do

onParameter(sl[i]);

finally

sl.Free;

end; { Finally }

end;

end;

procedure HandleCommandline(onParameter: TParameterEvent);

var

i: Integer;

begin

Assert(Assigned(onParameter), ‘OnParameter cannot be nil’);

for i := 1 to ParamCount do

onParameter(ParamStr(i));

end;

initialization

finalization

ProcessInfo.Free;

end.

{/codecitation}

Добавить комментарий