[[nlsgarcia]]

elmago00,

Empezado por elmago00

...el ejemplo funciona...en Delphi...VCL...al intentar pasarlo para que funcione en FireMonkey...tengo problemas...

Revisa este código:

Código Delphi [-]
unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Rtti, System.Classes,
  System.Variants, FMX.Controls, FMX.Forms, FMX.Dialogs,
  FMX.StdCtrls, FMX.Layouts, FMX.Memo, FMX.Types;

type

  TArg = reference to procedure(const Arg: T);
 
  TForm1 = class(TForm)
    Memo1: TMemo;
    ProgressBar1: TProgressBar;
    Button1: TButton;
    StyleBook1: TStyleBook;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
     procedure CaptureConsoleOutput(const ACommand, AParameters: String; CallBack: TArg);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses ShellApi, Windows;

{$R *.fmx}

procedure TForm1.CaptureConsoleOutput(const ACommand, AParameters: String; CallBack: TArg);
const
   CReadBuffer = 2400;

var
   sa: TSecurityAttributes;
   hRead: THandle;
   hWrite: THandle;
   si: TStartupInfo;
   pi: TProcessInformation;
   pBuffer: array [0 .. CReadBuffer] of AnsiChar;
   dBuffer: array [0 .. CReadBuffer] of AnsiChar;
   dRead: DWORD;
   dRunning: DWORD;
   dAvailable: DWORD;

begin

   sa.nLength := SizeOf(TSecurityAttributes);
   sa.bInheritHandle := true;
   sa.lpSecurityDescriptor := nil;
   if CreatePipe(hRead, hWrite, @sa, 0) then
   try
      FillChar(si, SizeOf(TStartupInfo), #0);
      si.cb := SizeOf(TStartupInfo);
      si.hStdInput := hRead;
      si.hStdOutput := hWrite;
      si.hStdError := hWrite;
      si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
      si.wShowWindow := SW_HIDE;
      if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), @sa, @sa, true,
                       NORMAL_PRIORITY_CLASS, nil, nil, si, pi)
      then
      try
         repeat
            dRunning := WaitForSingleObject(pi.hProcess, 100);
            PeekNamedPipe(hRead, nil, 0, nil, @dAvailable, nil);
            if (dAvailable > 0) then
            repeat
               dRead := 0;
               ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
               pBuffer[dRead] := #0;
               OemToCharA(pBuffer, dBuffer);
               CallBack(dBuffer);
               ProgressBar1.Max := ProgressBar1.Max + dRead;
               ProgressBar1.Value := ProgressBar1.Value + dRead;
            until (dRead < CReadBuffer);
            Application.ProcessMessages;
         until (dRunning <> WAIT_TIMEOUT);
         ProgressBar1.Max := dRead;
      finally
         CloseHandle(pi.hProcess);
         CloseHandle(pi.hThread);
      end;
   finally
      CloseHandle(hRead);
      CloseHandle(hWrite);
   end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin

   ProgressBar1.Min := 0;
   ProgressBar1.Max := 1000;
   ProgressBar1.Value := 0;
   Memo1.SelectAll;
   Memo1.ClearSelection;
   if Memo1.Lines.Count <> 0 then
      Memo1.Lines.Delete(0);
   Memo1.WordWrap := False;

   CaptureConsoleOutput('chkdsk', 'c:', procedure(const Line: PAnsiChar)
                                        begin
                                           Memo1.Lines.Add(String(Line));
                                        end
                       );
end;

end.

El código anterior es una variante del código propuesto en el Msg #2, para su funcionamiento en Delphi XE4 con FireMonkey HD bajo Windows 7 Professional x32.

Nota: Te sugiero que si esta aplicación va a ser utilizada bajo Windows implementes el código del Msg #2, FireMonkey fue diseñado para aplicaciones multiplataforma (Windows, iOS, OSX y Android), lo cual no es el caso del ejemplo anterior dado que depende completamente de funciones del API de Windows para su correcto funcionamiento.

Espero sea útil

Nelson.