从后台强制应用程序 Window 到前台（通过来自其他进程的消息）

Question

我将这段代码与 Mutex 和自定义消息一起使用，以在用户尝试启动第二个实例时强制第一个应用程序实例出现在屏幕上。我的应用程序必须只有 1 个实例运行.

这段代码似乎在 Win10 下无法正常工作，它使应用程序图标在任务栏上轻弹，但实际 Window 并没有出现在其他 Windows 之上。

function ForceForeground(AppHandle:HWND): boolean;
const
 SPI_GETFOREGROUNDLOCKTIMEOUT = 00;
 SPI_SETFOREGROUNDLOCKTIMEOUT = 01;
var
 ForegroundThreadID: DWORD;
 ThisThreadID      : DWORD;
 timeout           : DWORD;
 OSVersionInfo     : TOSVersionInfo;
 Win32Platform     : Integer;
begin
 if IsIconic(AppHandle) then ShowWindow(AppHandle, SW_RESTORE);
 if (GetForegroundWindow = AppHandle) then Result := true else
 begin
   Win32Platform := 0;
   OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
   if GetVersionEx(OSVersionInfo) then Win32Platform := OSVersionInfo.dwPlatformId;

   { Windows 98/2000 doesn't want to foreground a window when some other window has keyboard focus}

   if ((Win32Platform = VER_PLATFORM_WIN32_NT) and (OSVersionInfo.dwMajorVersion > 4)) or
      ((Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and ((OSVersionInfo.dwMajorVersion > 4) or
      ((OSVersionInfo.dwMajorVersion = 4) and (OSVersionInfo.dwMinorVersion > 0)))) then
   begin
     Result := false;
     ForegroundThreadID := windows.GetWindowThreadProcessID(GetForegroundWindow,nil);
     ThisThreadID := windows.GetWindowThreadPRocessId(AppHandle,nil);
     if AttachThreadInput(ThisThreadID, ForegroundThreadID, true) then
     begin
       BringWindowToTop(AppHandle);
       SetForegroundWindow(AppHandle);
       AttachThreadInput(ThisThreadID, ForegroundThreadID, false);
       Result := (GetForegroundWindow = AppHandle);
     end;
     if not Result then
     begin
       SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @timeout, 0);
       SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(0), SPIF_SENDCHANGE);
       BringWindowToTop(AppHandle);
       SetForegroundWindow(AppHandle);
       SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(timeout), SPIF_SENDCHANGE);
       Result := (GetForegroundWindow = AppHandle);
       if not Result then
         begin
         ShowWindow(AppHandle,SW_HIDE);
         ShowWindow(AppHandle,SW_SHOWMINIMIZED);
         ShowWindow(AppHandle,SW_SHOWNORMAL);
         BringWindowToTop(AppHandle);
         SetForegroundWindow(AppHandle);
         end;
     end;
   end else
   begin
     BringWindowToTop(AppHandle);
     SetForegroundWindow(AppHandle);
   end;
   Result := (GetForegroundWindow = AppHandle);
 end;
end;

Answer 1

我已经成功制作了一个完整的演示程序，在上面的第二条评论中显示了我的建议。创建一个新的 VCL 应用程序。将窗体重命名为 MainForm，在其上放置一个 TListBox，将其与客户端对齐，将其重命名为 ListBox，然后为窗体的 OnCreate 和 OnDestroy 创建空事件。

然后copy/paste将此 PASCAL 源代码从“界面”之后的右侧添加到主窗体的 PAS 文件中，覆盖已有的代码：

uses
  Winapi.Windows, Winapi.Messages,
  System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

CONST
  WM_PEEK       = WM_USER+1234;

type
  TMainForm = class(TForm)
    ListBox: TListBox;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    Running     : HWND;
    PROCEDURE   PEEK(VAR MSG : TMessage); MESSAGE WM_PEEK;
    PROCEDURE   CopyData(VAR MSG : TMessage); MESSAGE WM_COPYDATA;
    PROCEDURE   BringForward(Sender : TObject);
    PROCEDURE   SendString(H : HWND ; CONST S : STRING ; E : TEncoding);
    FUNCTION    CommandLine : STRING;
    FUNCTION    MakeAtomName(H : HWND) : STRING;
    FUNCTION    FindGlobalAtom(CONST S : STRING) : ATOM;
    FUNCTION    AddGlobalAtom(CONST S : STRING) : ATOM;
    FUNCTION    GetGlobalAtomName(H : ATOM) : STRING;
    FUNCTION    AtomNameToHandle(CONST S : STRING) : HWND;
    FUNCTION    DeleteGlobalAtom(A : ATOM) : DWORD;
  public
    { Public declarations }
    PROCEDURE   LOG(CONST S : STRING);
  end;

var
  MainForm: TMainForm;

implementation

USES System.Character;

{$R *.dfm}

PROCEDURE TMainForm.FormDestroy(Sender : TObject);
  VAR
    S   : STRING;
    A   : ATOM;

  BEGIN
    S:=MakeAtomName(0);
    REPEAT
      A:=FindGlobalAtom(S);
      IF A=0 THEN BREAK;
    UNTIL DeleteGlobalAtom(A)<>ERROR_SUCCESS
  END;

FUNCTION TMainForm.AddGlobalAtom(CONST S : STRING) : ATOM;
  BEGIN
    Result:=WinAPI.Windows.GlobalAddAtom(PChar(S))
  END;

FUNCTION TMainForm.MakeAtomName(H : HWND) : STRING;
  CONST
    L   = 8*SizeOf(POINTER); // 32 or 64 (number of bits in a handle)

  VAR
    S   : STRING;
    I   : Cardinal;
    C   : CHAR;

  BEGIN
    Result:=ChangeFileExt(ExtractFileName(ParamStr(0)),''); S:='';
    FOR C IN Result DO IF CharInSet(C,['A'..'Z','a'..'z']) THEN S:=S+C;
    WHILE LENGTH(S)<L DO S:=S+S;
    SetLength(S,L);
    Result:='';
    FOR I:=1 TO L DO BEGIN
      IF H AND <>0 THEN C:=S[I].ToUpper ELSE C:=S[I].ToLower;
      Result:=C+Result; H:=H SHR 1
    END
  END;

FUNCTION TMainForm.AtomNameToHandle(CONST S : STRING) : HWND;
  VAR
    C   : CHAR;

  BEGIN
    Result:=0;
    FOR C IN S DO BEGIN
      Result:=Result SHL 1;
      IF CharInSet(C,['A'..'Z']) THEN Result:=Result OR 1
    END
  END;

PROCEDURE TMainForm.BringForward(Sender : TObject);
  BEGIN
    SetForegroundWindow(Running);
    SendString(Running,CommandLine,TEncoding.UTF8);
    ExitProcess(0)
  END;

FUNCTION TMainForm.CommandLine : STRING;
  BEGIN
    Result:=GetCommandLine
  END;

PROCEDURE TMainForm.CopyData(VAR MSG : TMessage);
  VAR
    CDS : PCopyDataStruct;
    S   : STRING;
    B   : TBytes;

  BEGIN
    CDS:=PCopyDataStruct(MSG.LParam);
    SetLength(B,CDS.cbData);
    MOVE(CDS.lpData^,POINTER(B)^,LENGTH(B));
    S:=TEncoding.UTF8.GetString(B);
    LOG('Child['+IntToHex(MSG.WParam)+']: '+S)
  END;

FUNCTION TMainForm.DeleteGlobalAtom(A : ATOM) : DWORD;
  BEGIN
    SetLastError(ERROR_SUCCESS);
    WinAPI.Windows.GlobalDeleteAtom(A);
    Result:=GetLastError
  END;

FUNCTION TMainForm.FindGlobalAtom(CONST S : STRING) : ATOM;
  BEGIN
    Result:=WinAPI.Windows.GlobalFindAtom(PChar(S))
  END;

PROCEDURE TMainForm.FormCreate(Sender : TObject);
  VAR
    A   : ATOM;
    H   : HWND;
    S,T : STRING;

  BEGIN
    S:=MakeAtomName(Handle);
    REPEAT
      A:=FindGlobalAtom(S);
      IF A=0 THEN BREAK;
      T:=GetGlobalAtomName(A); H:=AtomNameToHandle(T);
      IF H<>Handle THEN
        IF SendMessage(H,WM_PEEK,NativeInt(A),NativeInt(H))=NativeInt(A)+NativeInt(H) THEN BREAK
    UNTIL DeleteGlobalAtom(A)<>ERROR_SUCCESS;
    IF A=0 THEN BEGIN
      A:=AddGlobalAtom(S);
      LOG('Main['+IntToHex(Handle)+'] : '+CommandLine)
    END ELSE BEGIN
      Running:=H; OnDestroy:=NIL; OnActivate:=BringForward;
      BorderStyle:=TFormBorderStyle.bsNone;
      SetBounds(-10000,-10000,10,10)
    END
  END;

FUNCTION TMainForm.GetGlobalAtomName(H : ATOM) : STRING;
  BEGIN
    SetLength(Result,255);
    SetLength(Result,WinAPI.Windows.GlobalGetAtomName(H,@Result[LOW(Result)],LENGTH(Result)))
  END;

PROCEDURE TMainForm.LOG(CONST S : STRING);
  BEGIN
    ListBox.ItemIndex:=ListBox.Items.Add(S)
  END;

PROCEDURE TMainForm.PEEK(VAR MSG : TMessage);
  BEGIN
    MSG.Result:=NativeInt(MSG.WParam)+MSG.LParam
  END;

PROCEDURE TMainForm.SendString(H : HWND ; CONST S : STRING ; E : TEncoding);
  VAR
    B   : TBytes;
    CDS : TCopyDataStruct;

  BEGIN
    B:=E.GetBytes(S);
    CDS.dwData:=1;
    CDS.cbData:=LENGTH(B);
    CDS.lpData:=POINTER(B);
    SendMessage(H,WM_COPYDATA,Handle,NativeInt(@CDS));
  END;

end.

当您最初运行应用程序时，它会在列表框中显示命令行。如果你再运行它，它会检测到另一个 window 已经存在（使用位编码的全局原子来表示初始实例的主窗体句柄）并将它移动到前台（放置后它自己 window 在屏幕外，因此是一个不可见的前景 window）。然后它将使用 WM_COPYDATA 将新实例的命令行发送到初始实例，然后初始实例会将接收到的命令行记录到列表框。

注意事项：

它是放在前面的 MAIN 窗体，它接收并处理命令行。如果您打开了子窗体，则行为未定义（如：我还没有测试过）。
Atom 名称是一个 32（或 64）个字符的长名称，由程序可执行文件的 A-Z 字符的重复模式组成。如果您的应用程序名称中没有 A-Z 字符，这将失败。
为了测试从 Global Atom 解码的 Window 是否是我们能识别的，我在那个 window 上调用了一条 WM_PEEK 消息。如果允许您的主实例启动（并创建 Atom）然后没有正确终止（以便在 FormDestroy 中删除 Atom），这可能会导致对外部应用程序的意外消息调用。

从后台强制应用程序 Window 到前台（通过来自其他进程的消息）

Force Application Window to Foreground from Background (via msg from other process)

delphi

winapi

delphi-7