Оформил: 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 <g>. 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<BR> 
        Last modified       2003-02-23<P> 
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.