Ir al contenido


Foto

Ayuda con automatización de Procesos

Automatización Procesos Consola

  • Por favor identifícate para responder
26 respuestas en este tema

#21 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.111 mensajes
  • LocationMadrid - España

Escrito 12 diciembre 2016 - 01:41

Añado. Parece que GetStartupInfoA pide un puntero y no una referencia en Lazarus64:
 

delphi
  1. GetStartupInfoA (@Si); 

En realidad esa es la verdadera declaración que hace M$.


Saludos.
  • 0

#22 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.111 mensajes
  • LocationMadrid - España

Escrito 12 diciembre 2016 - 02:17

Revisando las modificaciones de Delphius desde mi smartphone veo esto, que es un error:


delphi
  1. si: LPSTARTUPINFOA; // Se cambió el tipo!

Debe ser así:


delphi
  1. si: STARTUPINFOA;
  2. ........
  3.  
  4. GetStartupInfoA(@si);

Por eso salta el error en ejecución!!


Saludos.


  • 0

#23 Delphius

Delphius

    Advanced Member

  • Administrador
  • 6.295 mensajes
  • LocationArgentina

Escrito 12 diciembre 2016 - 02:21

A esos cambios añade STARTUPINFOA y GetStartupInfoA.


Saludos.

 
 

Añado. Parece que GetStartupInfoA pide un puntero y no una referencia en Lazarus64:
 


delphi
  1. GetStartupInfoA (@Si); 

En realidad esa es la verdadera declaración que hace M$.


Saludos.

 

 
Efectivamente con esos cambios ahora si compiló.
Y al ejecutar no dió AVs. Tendría que probarse el programa para comprobar que haga el trabajo correctamente aunque viniendo de escafandra seguro que lo hace.
 
A todo esto estos son los cambios ejectuados:


delphi
  1. unit PipeShell2;
  2.  
  3.  
  4. interface
  5.  
  6. uses
  7. Windows, Messages, SysUtils, FileUtil, Classes, LazUTF8;
  8.  
  9. const
  10. BUFFERSIZE = 4*1024;
  11.  
  12. type
  13. TPipeShell = class
  14. private
  15. PipeIn, PipeOut, PipeWrite, PipeRead: THANDLE;
  16. hProcess: THANDLE;
  17. Buffer: PAnsiChar;
  18. protected
  19. public
  20. constructor Create;
  21. destructor Destroy; override;
  22. function Write(S: String): DWORD;
  23. function Read: String;
  24. end;
  25.  
  26. implementation
  27.  
  28. constructor TPipeShell.Create;
  29. var
  30. sd: SECURITY_DESCRIPTOR;
  31. sa: SECURITY_ATTRIBUTES;
  32. si: STARTUPINFOA;
  33. pi: PROCESS_INFORMATION;
  34. begin
  35. PipeIn:= 0;
  36. PipeOut:= 0;
  37. PipeWrite:= 0;
  38. PipeRead:= 0;
  39. hProcess:= 0;
  40.  
  41. GetMem(Buffer, BUFFERSIZE);
  42. InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION);
  43. sa.lpSecurityDescriptor:= @sd;
  44. // sa.lpSecurityDescriptor:= nil;
  45. sa.nLength:= sizeof(SECURITY_ATTRIBUTES);
  46. sa.bInheritHandle:= TRUE;
  47. // Tuberia de entrada
  48. if CreatePipe(PipeIn, PipeWrite, @sa, 0) then
  49. begin
  50. // Tuberia de salida
  51. if CreatePipe(PipeRead, PipeOut, @sa, 0) then
  52. begin
  53. GetStartupInfoA(@Si);
  54. // Indicamos tuberias del proceso
  55. si.hStdOutput:= PipeOut;
  56. si.hStdError:= PipeOut;
  57. si.hStdInput:= PipeIn;
  58. si.dwFlags:= STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  59. si.wShowWindow:= SW_HIDE;
  60. //si.wShowWindow:= SW_SHOW;
  61. // Ruta del shell
  62. ZeroMemory(Buffer, BUFFERSIZE);
  63. GetEnvironmentVariableA('COMSPEC', Buffer, BUFFERSIZE - 1);
  64. // Ejecutamos el shell
  65. if CreateProcessA(nil, Buffer, nil, nil, TRUE, CREATE_NEW_CONSOLE, nil, nil, si, pi) then
  66. begin
  67. hProcess:= pi.hProcess;
  68. CloseHandle(pi.hThread);
  69. end;
  70. end;
  71. end;
  72. end;
  73.  
  74. destructor TPipeShell.Destroy;
  75. var
  76. ExitCode: DWORD;
  77. begin
  78. // Tratamos de terminar el shell
  79. repeat
  80. Write('quit'); Read;
  81. Write('q'); Read;
  82. Write('exit'); Read;
  83. GetExitCodeProcess(hProcess, ExitCode);
  84. until ExitCode <> STILL_ACTIVE;
  85.  
  86. if PipeIn <> 0 then CloseHandle(PipeIn);
  87. if PipeOut <> 0 then CloseHandle(PipeOut);
  88. if PipeWrite <> 0 then CloseHandle(PipeWrite);
  89. if PipeRead <> 0 then CloseHandle(PipeRead);
  90. if hProcess <> 0 then CloseHandle(hProcess);
  91. if Buffer <> nil then FreeMem(Buffer);
  92. if WaitForSingleObject(hProcess, 9000) <> WAIT_OBJECT_0 then
  93. TerminateProcess(hProcess, DWORD(-1));
  94. //GetExitCodeProcess(hProcess, ExitCode);
  95. //inherited;
  96. end;
  97.  
  98. function TPipeShell.Write(S: String): DWORD;
  99. begin
  100. if PipeWrite = 0 then exit;
  101. lstrcpy(Buffer, PAnsiCHAR(S + #10));
  102. WriteFile(PipeWrite, Buffer^, lstrlen(Buffer), Result, nil);
  103. end;
  104.  
  105. function TPipeShell.Read: String;
  106. var
  107. dwRead, dwBytesAvail: DWORD;
  108. begin
  109. if PipeRead = 0 then exit;
  110.  
  111. dwRead:= 0;
  112. // Esperamos a que tengamos algo que leer en PipeRead
  113. repeat
  114. sleep(100);
  115. PeekNamedPipe(PipeRead, Buffer, BUFFERSIZE, @dwRead, @dwBytesAvail, nil);
  116. if dwRead > 0 then
  117. begin
  118. // Leemos y vaciamos el PipeRead
  119. ZeroMemory(Buffer, BUFFERSIZE);
  120. ReadFile(PipeRead, Buffer^, dwRead, PDWORD(0)^, nil);
  121. OemToCharBuffA(Buffer, Buffer, dwRead);
  122. //Result:= Result + SysToUTF8(Buffer);
  123. Result := Result + LazUTF8.SysToUTF8(Buffer);
  124. end;
  125. until dwBytesAvail = 0;
  126. end;
  127.  
  128. end.

Pueden ver al final que invoco a la versión SysToUTF8() de LazUTF8. Entre las pruebas me había dicho que estaba marcada como obsoleta y se aconsejaba usar la de la unidad LazUTF8.
Un detalle final que noté al probarlo un poco es la falta de las ñ y palabras con acentos que son reemplazadas con ?. Es algo menor, y se lo puede dejar de tarea. ;)
 
Saludos,
PD: Si alguien recuerda como era para marcar/resaltar en la etiqueta de código una línea que me lo diga. Me hizo falta en esta ocasión.


  • 1

#24 Delphius

Delphius

    Advanced Member

  • Administrador
  • 6.295 mensajes
  • LocationArgentina

Escrito 12 diciembre 2016 - 02:30

Revisando las modificaciones de Delphius desde mi smartphone veo esto, que es un error:


delphi
  1. si: LPSTARTUPINFOA; // Se cambió el tipo!

Debe ser así:


delphi
  1. si: STARTUPINFOA;
  2. ........
  3.  
  4. GetStartupInfoA(@si);

Por eso salta el error en ejecución!!


Saludos.

 

Ya está amigo.

Ya hice los cambios como sugeriste. el código final está en el post #23 ;)

Nos estamos cruzando en los mensajes, parece el teléfono descompuesto... :D

 

Lo que queda al final es el tema de los carácteres "especiales" como la ñ que la reemplaza con ?


  • 0

#25 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.111 mensajes
  • LocationMadrid - España

Escrito 12 diciembre 2016 - 02:31

Veo que ya te compila y funcionó, Delphius:ap:
A mi con SysToUTF8 me sale Ok el texto en Lazarus32.
De hecho es la función que siempre usé en Lazarus32 para ajustar esos caracteres. En fin, les gusta cambiar cosas no siempre para arreglarlo. Cuando llegue a casa hago unas pruebas.

Saludos.
  • 0

#26 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.111 mensajes
  • LocationMadrid - España

Escrito 12 diciembre 2016 - 02:34

Delphius, soy muy lento escribiendo en el smartphone.  :(

 

Saludos.


  • 0

#27 Delphius

Delphius

    Advanced Member

  • Administrador
  • 6.295 mensajes
  • LocationArgentina

Escrito 12 diciembre 2016 - 03:33

Veo que ya te compila y funcionó, Delphius:ap:
A mi con SysToUTF8 me sale Ok el texto en Lazarus32.
De hecho es la función que siempre usé en Lazarus32 para ajustar esos caracteres. En fin, les gusta cambiar cosas no siempre para arreglarlo. Cuando llegue a casa hago unas pruebas.

Saludos.

 

Para Windows en 64bits, o al menos eso sospecho, o quizá sea a que uso posiblemente otra versión de Lazarus y han cambiado las cosas, los caracteres especiales no son bien reconocidos. Para arreglar esto al menos para mi ha sido necesario emplear WinCPToUTF8.

En este documento de la wiki explican algunas cosas relacionadas justo sobre esto.

 

 

Delphius, soy muy lento escribiendo en el smartphone.  :(

 

Saludos.

 

Yo también lo soy amigo.

No te preocupes.

Lo importante es que me guiaste a la solución para que pudiera probarlo.

 

Tu sabes como odio a los punteros... al día de hoy me cuesta entender cuando va el @ y cuando no... 8o|

 

Saludos,


  • 0





Etiquetado también con una o más de estas palabras: Automatización, Procesos, Consola

IP.Board spam blocked by CleanTalk.