Como Pasar proceso de consola a progressbar?

elmago00 · #1 15-02-2014

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.

[nlsgarcia] · #2 16-02-2014

elmago00,

Cita:

Empezado por elmago00

...estoy intentando ver el progreso de una consola MS-DOS en una barra de progreso...quiero que la barra de progreso avance según la consola ejecute tantos comandos...

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.

elmago00 · #3 16-02-2014

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

elmago00 · #4 17-02-2014

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.

[nlsgarcia] · #5 18-02-2014

elmago00,

Cita:

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.

[nlsgarcia] · #6 18-02-2014

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.

ecfisa · #7 18-02-2014

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

.

[nlsgarcia] · #8 18-02-2014

Daniel,

Gracias por la información

Nelson.

elmago00 · #9 18-02-2014

me han dejado sin palabras nlsgarcia, ecfisa.

muchas gracias por haberme ayudado

realunlocker · #10 21-04-2014

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

muchas gracias de antemano ...

[nlsgarcia] · #11 21-04-2014

realunlocker,

¡¡¡ Bienvenido al Club Delphi !!!

Cita:

Empezado por realunlocker

...¿Alguien podría pasar el código del Mensaje #2 para poderlo usar en Delphi 7?...

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.

realunlocker · #12 22-04-2014

Muchas Gracias Nelson! lo probare.

yo tambien soy de Venezuela, un saludo hermano.

Temas Similares
Tema	Autor	Foro	Respuestas	Último mensaje
progressbar avance segun demore proceso	jonydread	OOP	11	22-08-2012 04:54:09
¿como modalform con progressbar?	JXJ	Varios	4	21-12-2011 08:32:03
Ejecutar proceso en consola pricipal	Toni	Windows	2	25-01-2011 11:30:37
Como programar un ProgressBar	pablopessoa	Internet	4	15-10-2010 02:44:05
progressbar como la de emule.	JXJ	Varios	8	14-08-2008 18:13:58