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

I am using this code with Mutex and custom Message to force the 1st instance of application to appear on screen if the user tries to start a 2nd instance. There must be only 1 instance of my app running.

It seems that this code is not working properly under Win10, it makes the Application Icon to flick on TaskBar, but the actual Window is not appearing on top of other Windows.

function ForceForeground(AppHandle:HWND): boolean;
const
 SPI_GETFOREGROUNDLOCKTIMEOUT = $2000;
 SPI_SETFOREGROUNDLOCKTIMEOUT = $2001;
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;

CodePudding user response：

I have managed to make a complete demo program that shows my suggestion in the 2nd comment above. Create a new VCL application. Rename the form to MainForm, place a TListBox on it, align it to client, rename it to ListBox, then make empty events for the form's OnCreate and OnDestroy.

Then copy/paste this PASCAL source into your main form's PAS file from right after "interface", overwriting the code already there:

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 $01<>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.

When you initially run the application, it'll show the command line in the ListBox. If you then run it again, it'll detect the other window already exists (using a bit-encoded Global Atom to signify the initial instance's main form Handle) and move it to the foreground (after placing its own window out-of-screen, and thus being an invisible foreground window). It'll then use WM_COPYDATA to send the new instance's command line to the initial instance, and the initial instance will then log the received command line to the listbox.

Caveats:

It's the MAIN form that is brought to front, receives and processes the command line. If you have child forms open, the behaviour is undefined (as in: I haven't tested this).
The Atom name is a 32- (or 64-) character long name, consisting of a repeated pattern of the program executable's A-Z characters. If your application doesn't have A-Z character in its name, this will fail.
To test if the Window decoded from the Global Atom is one we recognize, I call a WM_PEEK message on that window. This could lead to an unexpected message call into a foreign application, if your main instance is allowed to start (and create the Atom) and then not terminate properly (so that the Atom is deleted in FormDestroy).