Ver Mensaje Individual
  #5  
Antiguo 17-02-2011
Rolando Glez Rolando Glez is offline
Miembro
 
Registrado: nov 2004
Ubicación: Havana
Posts: 62
Reputación: 20
Rolando Glez Va por buen camino
Funsiones Principales para abordar PIPES (redirecionamiento)

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
Responder Con Cita