کجای کارم مشکل داره : به این صورت استفاده کردم !!!
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons, Vcl.ComCtrls;
type
TForm1 = class(TForm)
gtbtn: TBitBtn;
Memo1: TMemo;
BitBtn1: TBitBtn;
ProgressBar1: TProgressBar;
procedure gtbtnClick(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure ProgressBar1ContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
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.gtbtnClick(Sender: TObject);
begin
CaptureConsoleOutput
('d:\cmd.exe ', ' dir c:\*.* ',procedure(const Line: PAnsiChar)
begin
// Writeln(String(Line));
Memo1.Lines.Add(String(Line)) ;
end);
end;