Rodar um segundo executável no mesmo ícone do primeiro

Delphi

06/02/2015

Boa noite,

Estou migrando as minhas aplicações do Delphi 7 para o Delphi XE6. Em função do tempo estou convertendo módulo (dll) um a um; para isso para cada dll transformei em executável. Dessa forma já tem vários módulos em Delphi XE6 com Firedac, está tudo rodando sem problemas. A questão é que essas dlls no Delphi roda no mesmo ícone do executável principal. Para o usuário final é como só existe um programa rodando. Agora para cada executável no Delphi XE6 abre um ícone na barra de tarefa gerando um transtorno para o usuário em função da quantidade de módulos que ele possa abrir ao mesmo tempo.

Existe uma forma de eu ter minha aplicação principal em Delphi 7 chamar uma aplicação em Delphi XE6 e os ícones das duas aplicações ficaram como se fosse uma só na barra de tarefa?

Obrigado!
Jones Kleber
Jones Santos

Jones Santos

Curtidas 0

Respostas

Renato Rubinho

Renato Rubinho

06/02/2015

Buenos,

Uma vez vi um artigo falando sobre isso e achei interessante.
O processo é relativamente simples. Você abre o executável e pelo nome atribui o Parent ao Handle de algum container, podendo ser um novo form, um panel, etc.
Logo, ele abre o executável normalmente, mas "joga-o" dentro do projeto que o chamou.
Um problema que terá que controlar é que se você fechar sua aplicação principal sem fechar o outro exe, ele ficará rodando em background, então terá que armazenar em variáveis os executáveis que abrir e antes de fechar sua aplicação, fechá-los antes.

Segue um exemplo simples.
Não me lembro em detalhes, pois apenas utilizei para testar por curiosidade. Se não me engano, usando desta forma, em algumas situações o projeto principal eventualmente não localizava o novo executável aberto.

 WinExec('calc.exe',SW_NORMAL);
 Windows.SetParent( FindWindow( nil, 'calculadora' ),panel1.handle ) ;


Fiz um "projetinho" localizando o exe nos processos do windows para garantir a abertura.

unit uPrincipal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellAPI, TLHelp32, PsAPI;

type
  TFrmPrincipal = class(TForm)
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    function RetornaValorTag(fn_Tag, fn_Xml: string): string;

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmPrincipal: TFrmPrincipal;
  fPrograma: HWnd;
  SUInfo  : TStartupInfo;
  ProcInfo: TProcessInformation;
  CmdLine : string;
  tsAux1: TStringList;

implementation

{$R *.dfm}


procedure TFrmPrincipal.Button1Click(Sender: TObject);
var
  i    : integer;
  sAux1: string;

  Function FileExec(const aCmdLine: String; aHide, aWait,bWait: Boolean):Boolean;
  //
  // aHide = Se vai ser exibido ou oculto
  // aWait = Se o aplicativo será executado em segundo plano
  // bWait = Se o Sistema deve esperar este aplicativo ser finalizado para
  // prosseguir ou não
  //
  var
    StartupInfo : TStartupInfo;
    ProcessInfo : TProcessInformation;
  begin
    FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
    with StartupInfo do
    begin
      cb      := SizeOf(TStartupInfo);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
      if aHide then
        wShowWindow := SW_HIDE
      else
        wShowWindow:= SW_SHOWNORMAL;
    end;

    Result := CreateProcess(nil,PChar(aCmdLine), nil, nil, False,NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo);

    if aWait and Result then
    begin
      WaitForInputIdle(ProcessInfo.hProcess, INFINITE);
      if bWait then
        WaitForSingleObject(ProcessInfo.hProcess,INFINITE);
    end;
  end;

  function EnumProcess(hHwnd: HWND; lParam: integer): boolean; stdcall;
  var
    pPid : DWORD;
    title, ClassName : string;

    function GetPathFromPID(const PID: cardinal): string;
    var
      hProcess: THandle;
      path    : array[0..MAX_PATH - 1] of char;
    begin
      hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, PID);
      if hProcess <> 0 then
        try
          if GetModuleFileNameEx(hProcess, 0, path, MAX_PATH) = 0 then
            RaiseLastOSError;
          result := path;
        finally
          CloseHandle(hProcess)
        end
      else
        RaiseLastOSError;
    end;
  begin
    //if the returned value in null the
    //callback has failed, so set to false and exit.
    if (hHwnd = NULL) then
      result := False
    else
    begin
      //additional functions to get more
      //information about a process.
      //get the Process Identification number.
      GetWindowThreadProcessId(hHwnd,pPid);
      //set a memory area to receive
      //the process class name
      SetLength(ClassName, 255);
      //get the class name and reset the
      //memory area to the size of the name
      SetLength(ClassName,
                GetClassName(hHwnd,
                             PChar(className),
                             Length(className)));
      SetLength(title, 255);

      //get the process title; usually displayed
      //on the top bar in visible process
      SetLength(title, GetWindowText(hHwnd, PChar(title), Length(title)));

      //Display the process information
      //by adding it to a list box
      try
        tsAux1.Add('<exe>' + GetPathFromPID(pPid) + '</exe>' +
                   '<hwnd>' + IntToStr(hHwnd) + '</hwnd>');
      Except
      end;             

      Result := True;
    end;
  end;

begin
  if not OpenDialog1.Execute then
    exit;

  FileExec(OpenDialog1.FileName, True, True, False);

  tsAux1 := TStringList.Create;

  EnumWindows(@EnumProcess,i);

  for i := tsAux1.Count-1 downto 0 do
    if ( AnsiLowerCase(RetornaValorTag('exe',tsAux1[i])) <> AnsiLowerCase(OpenDialog1.FileName) ) then
      tsAux1.Delete(i);

  for i := tsAux1.Count-1 downto 0 do
  begin
    try
      ShowWindow(StrToInt(RetornaValorTag('hwnd',tsAux1[i])), SW_SHOW);
    except
    end;

    Windows.SetParent( StrToInt(RetornaValorTag('hwnd',tsAux1[i])), Self.Handle ) ;
  end;
end;

function TFrmPrincipal.RetornaValorTag(fn_Tag, fn_Xml: string): string;
begin
  Result := Copy(fn_Xml,
                 Pos('<' + fn_Tag + '>', fn_Xml) + Length(fn_Tag) + 2,
                 Pos('</' + fn_Tag + '>',fn_Xml) - Length(fn_Tag) - 2 - Pos('<' + fn_Tag + '>', fn_Xml));
end;

end.
GOSTEI 0
POSTAR