Ver Mensaje Individual
  #11  
Antiguo 21-04-2014
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Reputación: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
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.

Última edición por nlsgarcia fecha: 22-04-2014 a las 00:02:59.
Responder Con Cita