Archer
29-09-2005, 16:49:46
Hola, ire directo al grano, tengo este procedimiento:
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:
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.
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.
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:
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.
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.