Aqui les mando las funsiones principales parea abordar esta tecnica de
PIPES espero que le sea util
//Las variables
Código:
type
Tbuffer=array[1..4096] of char;
var
pi: PROCESS_INFORMATION;
sd: SECURITY_DESCRIPTOR;
si: TSTARTUPINFO;
sa: SECURITY_ATTRIBUTES;
buffer: Tbuffer;
function IsWinNT: boolean;//Funsion auxiliar
var
OSV: OSVERSIONINFO;
begin
OSV.dwOSVersionInfoSize := sizeof(osv);
GetVersionEx(OSV);
result := OSV.dwPlatformId = VER_PLATFORM_WIN32_NT;
end;
// La siguiente funsion crea el redireccionamiento (PIPE) tuberia
procedure TFormMain.Createpipe(cmdline : string);
// se le debe pasar programa de consola a controlar
var ProcessInfo : TProcessInformation;
startupInfo : TStartupInfo;
namep,Programexe:Pchar;
begin
if IsWinNT then
begin
InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION);
SetSecurityDescriptorDacl(@sd, true, nil, false);
sa.lpSecurityDescriptor := @sd;
end
else
sa.lpSecurityDescriptor := nil;
sa.nLength := sizeof(SECURITY_ATTRIBUTES);
sa.bInheritHandle := true;
if CreatePipe(newstdin1, write_stdin1, @sa, 0) then
begin
if CreatePipe(read_stdout1, newstdout1, @sa, 0) then
begin
GetStartupInfo(si);
with si do
begin
dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
wShowWindow := SW_HIDE;
hStdOutput := newstdout1;
hStdError := newstdout1;
hStdInput := newstdin1;
//hStdInput :=GetStdHandle(STD_INPUT_HANDLE)
end;
Fillchar(Buffer, SizeOf(Buffer), 0);
StrPCopy(buffer,cmdline);
Fillchar(Buffer, SizeOf(Buffer), 0);
GetEnvironmentVariable('COMSPEC', @Buffer, SizeOf(Buffer) - 1);
Programexe:=pchar(cmdline);
namep:=pchar(extractfilename(cmdline));
CreateProcess(nil, PChar(cmdline),nil, nil, True,CREATE_NEW_CONSOLE, nil, nil,Si, Pi);
end;
end
end;
//Este procedimiento lee sobre la tuberia creada
function TFormMain.ReadPipe(var s:Tbuffer): Boolean;
var
dwAvail, dwRead : Cardinal;
PipeHandle : THandle;
lines:integer;
begin
Result := False;
line:='';
dwAvail := 6;
PipeHandle:=read_stdout1;
lines:=1;
repeat
PeekNamedPipe(read_stdout1, @buffer, SizeOf(buffer) - 1, @bread, @avail, nil);// inspecciona si hay algo en la tuberia sin extraer
if bread>0 then
begin
ReadFile(read_stdout1, buffer, bread, bread, nil);// lee pipe
line:=buffer;//deposita en line contenido buffer
memo1.Lines.Add(buffer);
inc(lines);
end;
Application.ProcessMessages;
//GetExitCodeProcess(pi.hProcess, exitcod);
until (bread=0);
if bread>0 then Result := True
else result := false;
s:=buffer;
Application.ProcessMessages;
end;
// Este procedimiento escribe sobre la tuberia (envia comandos a programa de consola)
procedure TFormMain.WritePipe(s: string);
var Pstr : Tbuffer;
len : cardinal;
Wasok:boolean;
begin
StrPCopy(Pstr, s);
len := length(s);
Wasok:=Writefile(write_stdin1, Pstr, len, len, nil); //se debe escribir sobre la entrada standart de proceso de consola
if not wasok then showmessage('error write in pipe')
end;
Bueno espero que le sea util aqui en este foro hay personas geniales
y todos nos ayudamos mutuamentes