[Lazarus-es] TProcess Handle

[Antonio Évora]

Hola a todos,
Al final consegui una solucion mas o menos satisfactoria. Bueno, para 
muestra un botón, aquí tenéis el código de la clase por si a alguno le 
interesa:

//*******************************************COPIAR DESDE 
AQUI********************************************************

unit cEmbutido;

{$mode objfpc}{$H+}

interface

uses
   Classes, Forms, SysUtils, Windows, process, Controls;

type
   TVentanaGuardianThread= class;

   TVentanaEmbutida = class (TObject)
   private
     FChangedParent: boolean;
     FClase: string;
     FClaseClick: string;
     FClicked: boolean;
     FHandle: THANDLE;
     FHandleClick: THANDLE;
     FTitulo: string;
     FTituloClick: string;
   public
     property Clase: string read FClase write FClase;
     property Titulo: string read FTitulo write FTitulo;
     property Handle: THANDLE read FHandle write FHandle;
     property ChangedParent: boolean read FChangedParent write 
FChangedParent;
     property ClaseClick: string read FClaseClick write FClaseClick;
     property TituloClick: string read FTituloClick write FTituloClick;
     property HandleClick: THANDLE read FHandleClick write FHandleClick;
     property Clicked: boolean read FClicked write FClicked;
   end;

   TNuevaVentanaEvent = procedure(Sender: TObject; Ventana: 
TVentanaEmbutida) of object;

   TTerminateStatus = (tsError, tsClose, tsTerminate);

   TEmbutido = class (TObject)
   private
     FExecName: string;
     FNewParent: TWinControl;
     FOnNuevaVentana: TNuevaVentanaEvent;
     FOnWindowCaptured: TNuevaVentanaEvent;
     FParamExec: TStringList;
     FVentanasEmbutidas: TList;
     FPID: integer;
     FProceso: TProcess;
     FVentanaGuardianThread: TVentanaGuardianThread;
     FOldResize: TNotifyEvent;
     procedure NuevaVentana(Sender: TObject; Ventana: TVentanaEmbutida);
     procedure ChangeParent(WindowsHandle: THandle);
     procedure SetNewParent(AValue: TWinControl);
     procedure Resize(Sender: TObject);
     property OnNuevaVentana: TNuevaVentanaEvent read FOnNuevaVentana 
write FOnNuevaVentana;
     function Kill(ProcessID: DWORD; Timeout: Integer = MAXINT): 
TTerminateStatus;
   public
     constructor Create();
     destructor Destroy();override;
     function Run(): boolean;
     function Stop(Clear: boolean): boolean;
     procedure AddVentana(Ventana: TVentanaEmbutida);overload;
     procedure AddVentana(Clase, Titulo: string);overload;
     procedure AddVentana(Clase, Titulo, ClaseClick, TituloClick: 
string);overload;
     property ExecName: string read FExecName write FExecName;
     property ParamExec: TStringList read FParamExec;
     property PID: integer read FPID write FPID;
     property NewParent: TWinControl read FNewParent write SetNewParent;
     property VentanasEmbutidas: TList read FVentanasEmbutidas write 
FVentanasEmbutidas;
     property OnWindowCaptured: TNuevaVentanaEvent read 
FOnWindowCaptured write FOnWindowCaptured;
   end;

   TVentanaGuardianThread = class(TThread)
   public
     MustDie: boolean;
     Owner: TEmbutido;
   protected
     procedure CallEvent;
     procedure Execute; override;
   published
     property Terminated;
   end;

implementation

function EnumProcess(hHwnd: HWND; lParam: LPARAM): LongBool;stdcall;
var
   pPid : DWORD;
   title,
   ClassName : string;
   n: integer;
   CurrentVentana: TVentanaEmbutida;
   Propietario: TEmbutido;
begin
   Result:=false;
   if lParam=0 then
   begin
     exit;
   end;
   Propietario:=TEmbutido(lParam);

   //Si returna NULL entonces fallo
   Result:=not (hHwnd=NULL);
   if not Result then
   begin
     exit;
   end
   else
   begin
     if not IsWindowVisible(hHwnd) then
     begin
       exit;
     end;

     //Cojo el PID de la ventana
     GetWindowThreadProcessId(hHwnd,pPid);
     //Asigno memoria para recibir el classname del proceso
     SetLength(ClassName, 255);
     //Asigno el ClassName y ajusto la cadena
     SetLength(ClassName,
               GetClassName(hHwnd,
                            PChar(className),
                            Length(className)));
     //Asigno memoria para recibir el titulo del proceso
     SetLength(title, 255);
     //Asigno el titulo y ajusto la cadena
     SetLength(title, GetWindowText(hHwnd, PChar(title), Length(title)));
     //Convierto el titulo de ansi a utf8 por si tuviera acentos o 
cualquier caracter no ASCII
     title:=AnsiToUtf8(title);

     //Compruebo el PID
     if (pPid=Propietario.PID) then
     begin
       for n:=0 to Propietario.VentanasEmbutidas.Count-1 do
       begin
         //if Propietario.ExecName='C:\Documents and 
Settings\xx\Escritorio\MK_GPXTool_1.3.3\MK_GPXTool.exe' then
         //begin
         //  Propietario.ExecName:=Propietario.ExecName+'';
         //end;
CurrentVentana:=TVentanaEmbutida(Propietario.VentanasEmbutidas[n]);
         if ClassName=CurrentVentana.Clase then
         begin
           if CurrentVentana.Titulo='' then
           begin
             CurrentVentana.Handle:=hHwnd;
           end
           else
           begin
             if CurrentVentana.Titulo=title then
             begin
               CurrentVentana.Handle:=hHwnd;
             end;
           end;
         end;
       end;
     end
     else
     begin
       //No no es mi PID miro si hay alguna ventana embutida sin clase 
definida
       for n:=0 to Propietario.VentanasEmbutidas.Count-1 do
       begin
CurrentVentana:=TVentanaEmbutida(Propietario.VentanasEmbutidas[n]);
         if CurrentVentana.Clase='' then
         begin
           if CurrentVentana.Titulo=title then
           begin
             //Encontre la ventana
             CurrentVentana.Handle:=hHwnd;

             //Sustituyo el PID por el nuevo PID
             Propietario.PID:=pPid;
           end;
         end;
       end;
     end;
   end;
end;

function EnumChildProc(hHwnd: HWND; lParam : LPARAM): LongBool; stdcall;
var
   pPid : DWORD;
   title,
   ClassName : string;
   n: integer;
   CurrentVentana: TVentanaEmbutida;
   Propietario: TEmbutido;
begin
   Result:=false;
   if lParam=0 then
   begin
     exit;
   end;
   Propietario:=TEmbutido(lParam);

   Result:=not (hHwnd=NULL);
   if not Result then
   begin
     exit;
   end
   else
   begin
     GetWindowThreadProcessId(hHwnd,pPid);
     SetLength(ClassName, 255);
     SetLength(ClassName,
               GetClassName(hHwnd,
                            PChar(className),
                            Length(className)));
     SetLength(title, 255);
     SetLength(title, GetWindowText(hHwnd, PChar(title), Length(title)));

     if (pPid=Propietario.PID) then
     begin
       for n:=0 to Propietario.VentanasEmbutidas.Count-1 do
       begin
CurrentVentana:=TVentanaEmbutida(Propietario.VentanasEmbutidas[n]);
         if (ClassName=CurrentVentana.ClaseClick) and 
(title=CurrentVentana.TituloClick) then
         begin
           CurrentVentana.HandleClick:=hHwnd;
         end;
       end;
     end;
     Result := true;
   end;
end;

procedure TVentanaGuardianThread.CallEvent;
var
   aVentana: TVentanaEmbutida;
   n: integer;
begin
   if Assigned(Owner.FOnNuevaVentana) then
   begin
     for n:=0 to Owner.VentanasEmbutidas.Count-1 do
     begin
       aVentana:=TVentanaEmbutida(Owner.VentanasEmbutidas[n]);
       if (aVentana.Handle>0) and (not aVentana.ChangedParent) then
       begin
         Owner.FOnNuevaVentana(Owner,aVentana);
       end;
     end;
   end;
end;

procedure TVentanaGuardianThread.Execute;
begin
   try
     while not MustDie do
     begin
       EnumWindows(@EnumProcess,LPARAM(Owner));
       Synchronize(@CallEvent);
     end;
   finally
     Terminate;
   end;
end;

procedure TEmbutido.NuevaVentana(Sender: TObject; Ventana: 
TVentanaEmbutida);

   function MouseClick(x: DWORD; y: DWORD): DWORD;
   var
     P: TPoint;
   begin
     GetCursorPos(P); // Guardo las coordenadas del mouse

     SetCursorPos(x, y);

     mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);  // Press
     mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);    // Release

     SetCursorPos(P.x, P.y); // Restauro las coordenadas del Mouse
   end;

var
   Rectangulo: TRect;
begin
   ChangeParent(Ventana.Handle);
   Ventana.ChangedParent:=true;
   FNewParent.SetFocus;

   if Ventana.ClaseClick<>'' then
   begin
     EnumChildWindows(Ventana.Handle, en EnumChildProc,LPARAM(self));
     if Ventana.HandleClick>0 then
     begin
       GetWindowRect(Ventana.HandleClick,Rectangulo);
       MouseClick(Rectangulo.Left+2,Rectangulo.Top+2);
     end;
   end;

   if Assigned(FOnWindowCaptured) then
   begin
     FOnWindowCaptured(self,Ventana);
   end;
end;

procedure TEmbutido.ChangeParent(WindowsHandle: THandle);
var
   WindowsStyle,
   FAppThreadID: LongInt;
begin
   WindowsStyle:=GetWindowLong(WindowsHandle,GWL_STYLE);
WindowsStyle:=WindowsStyle-WS_CAPTION-WS_BORDER-WS_OVERLAPPED-WS_THICKFRAME;
   SetWindowLong(WindowsHandle,GWL_STYLE,WindowsStyle);

   FAppThreadID:=GetWindowThreadProcessId(WindowsHandle,nil);
   AttachThreadInput(GetCurrentThreadId,FAppThreadID,true);

   windows.SetParent(WindowsHandle,NewParent.Handle);
   SendMessage(NewParent.Handle,WM_UPDATEUISTATE,UIS_INITIALIZE,0);
   UpdateWindow(WindowsHandle);

   SetWindowLong(NewParent.Handle,GWL_STYLE, 
GetWindowLong(NewParent.Handle, GWL_STYLE) or WS_CLIPCHILDREN);
SetWindowPos(WindowsHandle,0,0,0,NewParent.Width,NewParent.Height,SWP_NOZORDER);
   SetForegroundWindow(WindowsHandle);

MoveWindow(WindowsHandle,0,0,NewParent.Width,NewParent.Height,true);
end;

procedure TEmbutido.SetNewParent(AValue: TWinControl);
begin
   if FNewParent=AValue then
   begin
     exit;
   end;

   if FNewParent<>nil then
   begin
     //Libero el onresize del parent antiguo
     FNewParent.OnResize:=FOldResize;
   end;

   FNewParent:=AValue;

   FOldResize:=FNewParent.OnResize;
   FNewParent.OnResize:=@Resize;
end;

procedure TEmbutido.Resize(Sender: TObject);
var
   n: integer;
   CurrentVentana: TVentanaEmbutida;
begin
   for n:=0 to FVentanasEmbutidas.Count-1 do
   begin
     CurrentVentana:=TVentanaEmbutida(FVentanasEmbutidas[n]);

     if (CurrentVentana.Handle>0) and (CurrentVentana.ChangedParent) then
     begin
MoveWindow(CurrentVentana.Handle,0,0,FNewParent.Width,FNewParent.Height,true);
     end;
   end;

   if Assigned(FOldResize) then
   begin
     FOldResize(Sender);
   end;
end;

function EnumWindowsProc(hHwnd: HWND; lParam: LPARAM): LongBool;stdcall;
var
   PID: DWORD;
begin
   GetWindowThreadProcessId(hHwnd, @PID);
   if lParam=PID then
   begin
     PostMessage(hHwnd,WM_CLOSE,0,0);
   end;
   Result:=True;
end;

function TEmbutido.Kill(ProcessID: DWORD; Timeout: Integer
   ): TTerminateStatus;
var
   ProcessHandle: THandle;
begin
   Result:=tsError;
   if ProcessID<>GetCurrentProcessId then
   begin
     ProcessHandle:=OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, 
ProcessID);
     try
       if ProcessHandle<>0 then
       begin
         if Timeout>=0 then
         begin
           EnumWindows(@EnumWindowsProc,FPID);
           if WaitForSingleObject(ProcessHandle,Timeout)=WAIT_OBJECT_0 then
             Result:=tsClose
           else
             if TerminateProcess(ProcessHandle,0) then
               Result:=tsTerminate;
         end
         else
           if TerminateProcess(ProcessHandle,0) then
             Result:=tsTerminate;
       end;
     finally
       CloseHandle(ProcessHandle);
     end;
   end;
end;

constructor TEmbutido.Create;
begin
   FVentanasEmbutidas:=TList.Create;
   FParamExec:=TStringList.Create;
   FProceso:=TProcess.Create(nil);

   FVentanaGuardianThread:=TVentanaGuardianThread.Create(true);
   FVentanaGuardianThread.Owner:=self;
   FVentanaGuardianThread.MustDie:=false;

   FOnNuevaVentana:=@NuevaVentana;
   FNewParent:=nil;

   FPID:=0;
end;

destructor TEmbutido.Destroy;
begin
   if FVentanaGuardianThread<>nil then
   begin
     FVentanaGuardianThread.FreeOnTerminate:=false;
     FVentanaGuardianThread.MustDie:= true;
     if FPID>0 then
     begin
       while not FVentanaGuardianThread.Terminated do
       begin
         Application.ProcessMessages;
       end;
     end;
     FVentanaGuardianThread.Free;
     FVentanaGuardianThread:=nil;
   end;

   if FPID>0 then
   begin
     Kill(FPID,10);
   end;

   FVentanasEmbutidas.Clear;
   FVentanasEmbutidas.Free;
   FProceso.Free;
   FParamExec.Free;

   inherited Destroy;
end;

function TEmbutido.Run: boolean;
begin
   FProceso.Executable:=ExecName;
   FProceso.Parameters.Assign(FParamExec);
   FProceso.Execute;
   FPID:=FProceso.ProcessID;

   FVentanaGuardianThread.Start;
end;

function TEmbutido.Stop(Clear: boolean): boolean;
var
   n: integer;
   Ventana: TVentanaEmbutida;
begin
   Result:=(Kill(FPID,10)<>tsError);

   if Clear then
   begin
     for n:=0 to FVentanasEmbutidas.Count-1 do
     begin
       TVentanaEmbutida(FVentanasEmbutidas[n]).Free;
     end;

     FVentanasEmbutidas.Clear;
     FParamExec.Clear;
   end
   else
   begin
     for n:=0 to FVentanasEmbutidas.Count-1 do
     begin
       Ventana:=TVentanaEmbutida(FVentanasEmbutidas[n]);
       Ventana.Handle:=0;
       Ventana.ChangedParent:=false;
       Ventana.HandleClick:=0;
       Ventana.Clicked:=false;
     end;
   end;
end;

procedure TEmbutido.AddVentana(Ventana: TVentanaEmbutida);
begin
   Ventana.Handle:=0;
   Ventana.ChangedParent:=false;
   Ventana.HandleClick:=0;
   Ventana.Clicked:=false;
   FVentanasEmbutidas.Add(Ventana);
end;

procedure TEmbutido.AddVentana(Clase, Titulo: string);
begin
   AddVentana(Clase,Titulo,'','');
end;

procedure TEmbutido.AddVentana(Clase, Titulo, ClaseClick, TituloClick: 
string);
var
   TempVentana: TVentanaEmbutida;
begin
   TempVentana:=TVentanaEmbutida.Create;
   TempVentana.Clase:=Clase;
   TempVentana.Titulo:=Titulo;
   TempVentana.Handle:=0;
   TempVentana.ChangedParent:=false;
   TempVentana.ClaseClick:=ClaseClick;
   TempVentana.TituloClick:=TituloClick;
   TempVentana.HandleClick:=0;
   TempVentana.Clicked:=false;
   AddVentana(TempVentana);
end;

end.

//*******************************************HASTA 
AQUI********************************************************

Para abrir google earth y embutir su ventana seria algo como:

Embutido.ExecName:='C:\Archivos de programa\Google\Google 
Earth\client\googleearth.exe';
Embutido.AddVentana('QWidget','Google Earth');
Embutido.OnWindowCaptured:=@wincap;
Embutido.Run();


Espero os sirva.
Saludos.