Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > API de Windows
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 29-09-2005
Archer Archer is offline
Miembro
 
Registrado: sep 2005
Ubicación: Valencia
Posts: 28
Poder: 0
Archer Va por buen camino
Problemas con un tubo

Hola, ire directo al grano, tengo este procedimiento:

Código Delphi [-]
 procedure RunDosInMemo(Que:String; EnMemo:TMemo; EnArchivo:string);
 var
   LeerSalidaProceso, SalidaProceso : THandle;
   EntradaProceso, EscribirEntradaProceso : THandle;
   Buffer : array[0..4095] of byte;
   Buffer2 : array[0..2] of byte;
   si : STARTUPINFO;
   sa : SECURITY_ATTRIBUTES;
   sd : SECURITY_DESCRIPTOR;
   pi : PROCESS_INFORMATION;
   exitcod, bread, bwrite, avail, avail2 : Cardinal;
   cadena : PChar;
   archivo : Boolean;
   ArchivoSalida : TextFile;
 begin
   if EnArchivo = 'no' then
     archivo:=false
   else
     archivo:=true;
 
   Buffer2[0]:=78;
   Buffer2[1]:=13;
   Buffer2[2]:=10;
 
   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;
 
   {Creamos el pipe...}
   //TUBO ANONIMO 1
   if Createpipe (LeerSalidaProceso, SalidaProceso, @sa, 0) then
     //TUBO ANONIMO 2
     if Createpipe (EntradaProceso, EscribirEntradaProceso, @sa, 0) then
     begin
       fillchar(buffer,sizeof(buffer),0);
 
       GetStartupInfo(si);
       with si do
       begin
         dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
         wShowWindow := SW_HIDE;
         hStdOutput := SalidaProceso;
         hStdError := SalidaProceso;
         hStdInput := EntradaProceso;
         cb := SizeOf(si);
       end;
 
       if CreateProcess(nil, PChar(Que), @sa, @sa, true, NORMAL_PRIORITY_CLASS, nil, nil, si, pi) then
       begin
         // EnMemo.Lines.Clear;
         if archivo then
         begin
           AssignFile(ArchivoSalida, EnArchivo);
           if Fileexists(EnArchivo) then
             Append(ArchivoSalida)
           else
             Rewrite(ArchivoSalida);
         end;
         GetExitCodeProcess(pi.hProcess,exitcod);
         PeekNamedPipe(LeerSalidaProceso, @buffer, sizeof(buffer)-1, @bread, @avail, nil);
         while (exitcod = STILL_ACTIVE) or (bread > 0) do
         begin
           if (bread > 0) then
           begin
             fillchar(buffer,sizeof(buffer),0);
             if (avail > sizeof(buffer)-1) then
             while (bread >= sizeof(buffer)-1) do
             begin
               ReadFile(LeerSalidaProceso, buffer, sizeof(buffer)-1, bread, nil);
               cadena := Pchar(@buffer);
               OemToAnsi(cadena,cadena);
               EnMemo.lines.text := EnMemo.lines.Text + cadena;
               if archivo then Write(ArchivoSalida, cadena);
               fillchar(buffer,sizeof(buffer),0);
             end
             else
             begin
               ReadFile(LeerSalidaProceso, buffer, sizeof(buffer)-1, bread, nil);
               cadena := Pchar(@buffer);
               OemToAnsi(cadena,cadena);
               EnMemo.lines.text := EnMemo.lines.Text + cadena;
               if archivo then Write(ArchivoSalida, cadena);
             end;
           end;
           Application.ProcessMessages;
           GetExitCodeProcess(pi.hProcess,exitcod);
           PeekNamedPipe(LeerSalidaProceso, @buffer, sizeof(buffer)-1, @bread, @avail, nil);
           Sleep(1);
 
           // La linea inferior es la problematica!!!!
 
           PeekNamedPipe(EntradaProceso, nil, 0, nil, @avail2, nil);
           if avail2 = 0 then
             WriteFile(EscribirEntradaProceso, Buffer2, sizeof(buffer2), bwrite, nil);
         end;
         EnMemo.Lines.Add('');
         EnMemo.Lines.Add('----------');
         EnMemo.Lines.Add('');
         if archivo then
         begin
           Writeln(ArchivoSalida, '');
           Writeln(ArchivoSalida, '----------');
           Writeln(ArchivoSalida, '');
           CloseFile(ArchivoSalida);
         end;
         CloseHandle(LeerSalidaProceso);
         CloseHandle(SalidaProceso);
         CloseHandle(EntradaProceso);
         CloseHandle(EscribirEntradaProceso);
       end;
     end;
 end;
Añando la funcion IsWinNT por si alguien quiere probarlo:

Código Delphi [-]
 function IsWinNT: boolean;
 var
   osv: OSVERSIONINFO;
 begin
   osv.dwOSVersionInfoSize := sizeof(osv);
   GetVersionEx(osv);
   result:= osv.dwPlatformId = VER_PLATFORM_WIN32_NT;
 end;
Bueno como habreis visto es un codigo que ejecuta un comando de msdos, muestra su salida en un Memo y opcionalmente en un archivo, como quiero dejar todos los cabos bien atados menos el de la consulta os dire que en el procedimiento que llama a RunDosInMemo controlo si he de añadir "cmd /c" antes del comando dependiendo de si es interno o no.

Ahora planteo la consulta:

Uso Delphi 6 (aunque esto es bastante irrelevante ya que lo que me da problemas es una funcion de la API), en Windows XP.
Como habeis visto en el codigo el problema lo tengo en el;

PeekNamedPipe(EntradaProceso, nil, 0, nil, @avail2, nil);

Resulta que en determinados casos que expongo a continuacion se me suspende indefinidamente el programa (vamos que se cuelga).
Cuando ejecuto "cmd /c dir c:" no pasa nada el programa funciona bien, esto es debido a que este comando no hace uso de su entrada estandar, en cambio si ejecuto "chkdsk c: /f" (esta orden sobre la unidad donde reside el SO siempre pregunta esto:

CHKDSK no se puede ejecutar porque otro proceso ya está utilizando el
volumen. ¿Desea que se prepare este volumen para que sea comprobado
la próxima vez que se inicie el sistema? (S/N)

y se queda esperando respuesta)

ahora es cuando viene el problema, el proceso hijo (chkdsk, en este caso) se queda esperando contestacion por su entrada estandar en este caso en el tubo anonimo 2 (EntradaProceso), para solucionar esto escribo la respuesta por defecto en este caso "N" y un retorno de carro por su entrada estardar y asi el proceso hijo puede finalizar.

Consideraciones:
No puedo estar escribiendo 3 bytes cada ciclo del bucle, porque aunque las pipes tienen bastante buffer, este se llena, esta comprobado, imaginaos que ejecutamos "cmd /c dir c: /s" y que c: tiene 120GB con una cantidad de archivos ingente, esta orden tardara en completarse, y pudiera ser posible que el buffer del tubo anonimo 2 se llenara con lo cual al hacer el write, nos suspenderiamos hasta que alguien leyera, como "dir" no lee, nos colgariamos, y no es plan...
Saber si un proceso esta suspendido a la espera de leer en un tubo, es simplemente imposible, y mas si no lo has programado tu (y no puedes modificar su codigo para añadir algun mutex o algo asi).

Posible solucion:
La solucion que se me ocurrio es hacer un Peek y ver si hay informacion sino escribo los 3 bytes de la respuesta, en el proximo ciclo de bucle si no han sido leidos ya no los escribo con lo cual ya no saturo el tubo, hasta aqui todo correcto, el problema;

QUE NO FUNCIONA

En el caso de ejecutar un comando que no lea de su entrada estandar va bien, pero en el caso de que si que lea, mi programa se suspende indefinidamente, lo cual no tiene ningun sentido ya que, copio textualmente de la ayuda de la API:

Remarks

PeekNamedPipe is similar to the ReadFile function with the following exceptions:

· The data read from the pipe is not removed from the pipe's buffer.
· The function always returns immediately, even if there is no data in the pipe. The wait mode of a named pipe handle (blocking or nonblocking) has no effect on the function.
· The function can return additional information about the contents of the pipe.

Segun el segundo punto "la funcion SIEMPRE finaliza inmediatamente", FALSO!!!!!!!!!

y este es el objetivo de este post, alguien sabe porque?, alguien tiene alguna sugerencia inteligente?

Para evitar respuestas "tontas" en la medida de lo posible, contesto la mas probable aqui mismo:

Respuesta "tonta" con contra-respuesta:

Si el tubo es anonimo por que usas PeekNamedPipe, eso es para tubos con nombre, usa PeekPipe.

Para empezar PeekPipe no existe, y copio textualmente de la ayuda de la API:

The PeekNamedPipe function copies data from a named or anonymous pipe into a buffer without removing it from the pipe. It also returns information about data in the pipe.

Código:
 BOOL PeekNamedPipe(
   HANDLE hNamedPipe, // handle to pipe to copy from
   LPVOID lpBuffer, // pointer to data buffer
   DWORD nBufferSize, // size, in bytes, of data buffer
   LPDWORD lpBytesRead, // pointer to number of bytes read
   LPDWORD lpTotalBytesAvail, // pointer to total number of bytes available
   LPDWORD lpBytesLeftThisMessage // pointer to unread bytes in this message
 );
Parameters

hNamedPipe

Identifies the pipe. This parameter can be a handle to a named pipe instance, as returned by the CreateNamedPipe or CreateFile function, or it can be a handle to the read end of an anonymous pipe, as returned by the CreatePipe function. The handle must have GENERIC_READ access to the pipe.

lpBuffer ....

Aqui deja bien claro que si que puede usar con tubos anonimos, es mas en las otras llamadas a PeekNamedPipe, es decir las que hago sobre el tubo anonimo 1, no me dan ningun problema, aunque este vacio...

Ultima consideracion:

En el tubo anonimo 1 solo leo yo, en cambio en el tubo anonimo 2 lee el proceso hijo, de todas formas (no me canso de leerlo):

· The function always returns immediately, even if there is no data in the pipe. The wait mode of a named pipe handle (blocking or nonblocking) has no effect on the function.

Asi pues hacer un Peek leyera quien leyera y tuviera contenido o no, no deberia de suspenderme la aplicacion lesches!!!!

Si el tubo tiene informacion el Peek no se suspende.
Si el tubo esta vacio pero no lo lee el proceso hijo en ningun momento (ej. dir) el Peek no se suspende.

De todas formas no deberia de suspenderse nunca!! si alguien sabe por que lo hace que me lo diga plz!, y en caso que nadie lo sepa (lamentablemente cosa muy probable) si alguien se anima a plantear alguna solucion alternativa, sera bienvenida, eso si que sea elegante porfavor! que las chapucillas yo tambien las se hacer, pero no es plan.

Si habeis llegado hasta aqui solo me queda daros las gracias por haber leido el rollo este, y esperar que lo hayais entedido (sino os ha quedado claro algo decidlo y lo explico).

Saludos.

Última edición por dec fecha: 29-09-2005 a las 18:08:13. Razón: ¡¡Encerrad el código fuente entre las etiquetas [DELPHI] ... [/DELPHI]!!
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 13:18:17.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi