Como Pasar proceso de consola a progressbar?
 

hola amigos,

estoy intentando ver el progreso de una consola MS-DOS en una barra de progreso.
pero no veo como.
con esto ejecuto la consola en un memo. y funciona perfecto.

Código Delphi [-]
unit RunConsolProgAndCapture_MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, StrUtils, DBCtrls;

type
  TAnoPipe=record
    Input : THandle;
    Output: THandle;

  end;

  TForm1 = class(TForm)
    Memo1: TMemo;
    BitBtn1: TBitBtn;
    ComboBox1: TComboBox;
    procedure BitBtn1Click(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
 type
    TArg = reference to procedure(const Arg: T);

 procedure CaptureConsoleOutput(const ACommand, AParameters: String; CallBack: TArg);
const
  CReadBuffer = 2400;
var
  saSecurity: TSecurityAttributes;
  hRead: THandle;
  hWrite: THandle;
  suiStartup: TStartupInfo;
  piProcess: TProcessInformation;
  pBuffer: array [0 .. CReadBuffer] of AnsiChar;
  dBuffer: array [0 .. CReadBuffer] of AnsiChar;
  dRead: DWORD;
  dRunning: DWORD;
  dAvailable: DWORD;
begin
  saSecurity.nLength := SizeOf(TSecurityAttributes);
  saSecurity.bInheritHandle := true;
  saSecurity.lpSecurityDescriptor := nil;
  if CreatePipe(hRead, hWrite, @saSecurity, 0) then
    try
      FillChar(suiStartup, SizeOf(TStartupInfo), #0);
      suiStartup.cb := SizeOf(TStartupInfo);
      suiStartup.hStdInput := hRead;
      suiStartup.hStdOutput := hWrite;
      suiStartup.hStdError := hWrite;
      suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
      suiStartup.wShowWindow := SW_HIDE;
      if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), @saSecurity, @saSecurity, true, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup,
        piProcess) then
        try
          repeat
            dRunning := WaitForSingleObject(piProcess.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);
              until (dRead < CReadBuffer);
            Application.ProcessMessages;
          until (dRunning <> WAIT_TIMEOUT);
        finally
          CloseHandle(piProcess.hProcess);
          CloseHandle(piProcess.hThread);
        end;
    finally
      CloseHandle(hRead);
      CloseHandle(hWrite);
    end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);

begin
 CaptureConsoleOutput('C:\Windows\System32\ipconfig.exe '+ComboBox1.Text, '',
            procedure(const Line: PAnsiChar)
            begin
                Memo1.Lines.Add(String(Line));
            end

);
end;
end.

pero quiero que la barra de progreso avance según la consola ejecute tantos comandos como le mande.


gracias por su ayuda.

elmago00,

Revisa este código:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type

  TArg = reference to procedure(const Arg: T);

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

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.StepBy(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.Position := 0;
   Memo1.Clear;

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

end.

El código anterior ejecuta, visualiza y registra el progreso de Comandos de Consola DOS en un componente TMemo en Delphi 2010 bajo Windows 7 Professional x32 utilizando métodos anónimos, como se puede ver en la siguiente imagen:



Espero sea útil :)

Nelson.

solucionado.
amigo me has ayudado en cada post que hago, y siempre me das la solución que necesito mil gracias.

hola, el ejemplo funciona muy bien en delphi pero solo en vcl.
al intentar pasarlo para que funcione en firemomkey, es donde tengo problemas.

te agradezco por tu ayuda.

elmago00,

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.

elmago00,

Revisa esta imagen:



Esta es la sintaxis original del tipo indicado en la imagen asociado a un método anónimo, el cual no se visualiza correctamente en los Msg #2 y Msg #5.

Espero sea útil :)

Nelson.

Hola Nelson.

Para evitar el borrado que provocan los caracteres < y >, podes dejar un espacio posterior a < y otro previo a >.

Ejemplo:

Código Delphi [-]
type
  TGenericArray < T > = array of T;

type
  TMyData< T >= class(TObject)

Saludos :).

Daniel,

Gracias por la información :) ^\||/

Nelson.

me han dejado sin palabras nlsgarcia, ecfisa.


muchas gracias por haberme ayudado

alguien podria pasar el codigo del mensaje # 2 para poderlo usar en delphi 7 ?

muchas gracias de antemano ...

realunlocker,

¡¡¡ Bienvenido al Club Delphi !!! :)

Revisa este código:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type

  TCallBack = procedure(const Arg : PAnsiChar);

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure Console(const Line : PAnsiChar);
begin
   with Form1 do
   begin
      Memo1.Lines.Add(String(Line));
   end;
end;

procedure TForm1.CaptureConsoleOutput(const ACommand, AParameters: String; CallBack : TCallBack);
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.StepBy(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.Position := 0;
   Memo1.Clear;

   CaptureConsoleOutput('chkdsk', 'c:', Console);

end;

end.

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

Espero sea útil :)

Nelson.

Muchas Gracias Nelson! lo probare.

yo tambien soy de Venezuela, un saludo hermano.