PDA

Ver la Versión Completa : Como Pasar proceso de consola a progressbar?

elmago00
15-02-2014, 06:57:37
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.

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<T> = reference to procedure(const Arg: T);

procedure CaptureConsoleOutput(const ACommand, AParameters: String; CallBack: TArg<PAnsiChar>);
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
16-02-2014, 02:38:32
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:

unit Unit1;

interface

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

type

TArg<T> = 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<PAnsiChar>);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CaptureConsoleOutput(const ACommand, AParameters: String; CallBack: TArg<PAnsiChar>);
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:

http://imageshack.com/a/img839/4633/71r0.jpg

Espero sea útil :)

Nelson.
elmago00
16-02-2014, 05:46:24
solucionado.
amigo me has ayudado en cada post que hago, y siempre me das la solución que necesito mil gracias.
elmago00
17-02-2014, 23:28:24
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
18-02-2014, 00:31:31
elmago00,


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


Revisa este código:

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<PAnsiChar>);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses ShellApi, Windows;

{$R *.fmx}

procedure TForm1.CaptureConsoleOutput(const ACommand, AParameters: String; CallBack: TArg<PAnsiChar>);
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
18-02-2014, 01:33:07
elmago00,

Revisa esta imagen:

http://imageshack.com/a/img854/486/mjpn.jpg

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
18-02-2014, 01:47:53
Hola Nelson.

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

Ejemplo:

type
TGenericArray < T > = array of T;

type
TMyData< T >= class(TObject)


Saludos :).
nlsgarcia
18-02-2014, 01:51:34
Daniel,

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

Nelson.
elmago00
18-02-2014, 05:05:52
me han dejado sin palabras nlsgarcia, ecfisa.


muchas gracias por haberme ayudado
realunlocker
21-04-2014, 21:44:35
alguien podria pasar el codigo del mensaje # 2 para poderlo usar en delphi 7 ?

muchas gracias de antemano ...
nlsgarcia
21-04-2014, 23:39:55
realunlocker,

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


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


Revisa este código:

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
22-04-2014, 15:28:48
Muchas Gracias Nelson! lo probare.

yo tambien soy de Venezuela, un saludo hermano.