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