Question

我有一个应用程序可以检测是否有另一个应用程序正在运行，如果找到则退出。这部分似乎可靠地工作。我的应用程序采用命令行参数，我想传递给已经运行的实例。到目前为止，我有以下代码：

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

{基于Zarko Gajic在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.

并在主窗体中：

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;

我很确定问题是我正在尝试将消息发送到正在运行的应用程序实例的句柄，但是尝试在主窗体上处理消息。我想我有两个选择：

A）从应用程序的句柄以某种方式获取其主窗体的句柄并在那里发送消息。

B）处理在应用程序而不是主表单级别接收消息。

我不确定如何去做。有更好的方法吗？

感谢。

Answer 1

如果使用WM_COPYDATA，则无需创建文件映射。这就是WM_COPYDATA的重点 - 它为你做了所有这些。

发送字符串

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;

接收字符串

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;

根据需要修改以发送其他数据。

Answer 2

事实证明，这很难可靠。我花了两个小时试图从五分钟的解决方案中解决所有问题:(虽然现在似乎正在工作。

下面的代码在D2007中使用新风格（MainFormOnTaskbar = True）和旧式方法。因此，我相信它也适用于较旧的Delphi版本。它在最小化和正常状态下进行了测试。

测试项目位于http://17slon.com/krama/ReActivate.zip（小于3 KB）。

对于在线阅读，索引目的和备份，所有重要单位都附在下面。

主程序

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.

主机

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.

辅助单位

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 <dannys@karemor.com>

        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.

所有代码都发布到公共领域，可以在没有许可和许可考虑的情况下使用。

Answer 3

我最终将MainForm的句柄保存到文件映射中的InstanceInfo记录中，然后将消息发送到前一个实例的主表单句柄（如果有的话）。

在项目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;

这似乎可靠地运作。我打算发布完整的源代码，但我想整合一些gabr的代码，看起来它更可靠地首先将焦点设置为正在运行的实例。

Answer 4

为什么不使用DDE？请查看此搜索返回的链接：http://www.google.com/search?q=delphi+dde

将字符串传递给已在运行的应用程序实例

Project1.dpr

AppInstanceControl.pas

并在主窗体中：

4 个答案:

主程序

主机

辅助单位

AppInstanceControl.pas