Код:
procedure TForm1.Button2Click(Sender: TObject);
function PipeIs(StdOutR:dword):dword;
var I,X:dword;
begin
I:=0;X:=50;
while true do begin
sleep(10);
PeekNamedPipe(StdOutR,nil,0,0,@I,nil);
if I<>0 then begin PipeIs:=I;exit;end;
dec(X);
if X=0 then begin PipeIs:=X;exit;end;
end;
end;
var
sa:SECURITY_ATTRIBUTES;
IR:dword;
StdInR,StdOutR,StdInW,StdOutW,StdIn,StdOut:dword;
pi: TProcessInformation;
si: TStartupInfo;
I,TimeOut:dword;
STin,STout:string;
begin
sa.nLength := sizeof(sa);
sa.bInheritHandle := true;
sa.lpSecurityDescriptor := nil;
CreatePipe(StdOutR,StdOutW,@sa,0);
DuplicateHandle($ffffffff,StdoutW,$ffffffff,@Stdout,0,true,DUPLICATE_SAME_ACCESS);
CloseHandle(StdOutW);
CreatePipe(StdInR,StdInW, @sa,0);
DuplicateHandle($ffffffff,StdinR, $ffffffff,@Stdin ,0,true,DUPLICATE_SAME_ACCESS);
CloseHandle(StdInR);
ZeroMemory(@si, SizeOf(TStartupInfo));
si.cb := SizeOf(TStartupInfo);
si.hStdInput := Stdin;
si.hStdOutput := Stdout;
si.hStdError := Stdout;
si.dwFlags :=STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
CreateProcess(nil,PChar('cmd.exe'), // command line
nil,nil,TRUE,0,nil,nil,
si,pi);
memo1.Lines.Clear;
while PipeIs(StdOutR)<>0 do begin
I:=10000;setlength(STin,I);
Readfile(StdOutR, STin[1], I, I, nil);
if I<>0 then begin
setlength(STin,I);OemToChar(PAnsiChar(STin),PAnsiChar(STin));
memo1.Lines.Add(STin);
end;
end;
STout := 'Dir c:\'#$D#$A;
I := Length(STout);
WriteFile(StdInW, STout[1], I, I, nil);
memo1.Lines.Add(STout);
while PipeIs(StdOutR)<>0 do begin
I:=10000;setlength(STin,I);
Readfile(StdOutR, STin[1], I, I, nil);
if I<>0 then begin
setlength(STin,I);OemToChar(PAnsiChar(STin),PAnsiChar(STin));
memo1.Lines.Add(STin);
end;
end;
STout := 'Format G:'#$D#$A;
I := Length(STout);
WriteFile(StdInW, STout[1], I, I, nil);
memo1.Lines.Add(STout);
while PipeIs(StdOutR)<>0 do begin
I:=10000;setlength(STin,I);
Readfile(StdOutR, STin[1], I, I, nil);
if I<>0 then begin
setlength(STin,I);OemToChar(PAnsiChar(STin),PAnsiChar(STin));
memo1.Lines.Add(STin);
end;
end;
terminateprocess(pi.hProcess,0);
end;