[Lazarus-es] Problema con texto generado desde tprocess

metal box metalbox9000 en gmail.com
Dom Ago 4 18:40:08 CEST 2013


function CmdExec(Cmd: string): string;
{
ESTA FUNCION MUESTRA LA SALIDA DE CMD
EJEMPLO
SHOWMESSAGE(CmdExec(echo hola))
}
var
  Buffer: array[0..4096] of Char;
  si: STARTUPINFO;
  sa: SECURITY_ATTRIBUTES;
  sd: SECURITY_DESCRIPTOR;
  pi: PROCESS_INFORMATION;
  newstdin, newstdout, read_stdout, write_stdin: THandle;
  exitcod, bread, avail: Cardinal;
begin
  Result:= '';
  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(newstdin, write_stdin, @sa, 0) then
  begin
    if CreatePipe(read_stdout, newstdout, @sa, 0) then
    begin
      GetStartupInfo(si);
      with si do
      begin
        dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
        wShowWindow := SW_HIDE;
        hStdOutput := newstdout;
        hStdError := newstdout;
        hStdInput := newstdin;
      end;
      Fillchar(Buffer, SizeOf(Buffer), 0);
      GetEnvironmentVariable('COMSPEC', @Buffer, SizeOf(Buffer) - 1);
      StrCat(@Buffer,PChar(' /c ' + Cmd));
      if CreateProcess(nil, @Buffer, nil, nil, TRUE, CREATE_NEW_CONSOLE,
nil, nil, si, pi) then
      begin
        repeat
          PeekNamedPipe(read_stdout, @Buffer, SizeOf(Buffer) - 1, @bread,
@avail, nil);
          if bread > 0 then
          begin
            Fillchar(Buffer, SizeOf(Buffer), 0);
            ReadFile(read_stdout, Buffer, bread, bread, nil);
            Result:= Result + String(PChar(@Buffer));
          end;
          Application.ProcessMessages;
          GetExitCodeProcess(pi.hProcess, exitcod);
        until (exitcod <> STILL_ACTIVE) and (bread = 0);
      end;
      CloseHandle(read_stdout);
      CloseHandle(newstdout);
    end;
    CloseHandle(newstdin);
    CloseHandle(write_stdin);
  end;
end;


Como vez alli en  la funcion StrCat colocan CMD  por lo que asi como esta
funciona solo en windows no se si podria funcionar con la consola de linux.

Una Pregunta windows 8 Trae CMD o lo eliminaron totalmente por el nuevo
shell


El 3 de agosto de 2013 19:52, Martin Gomez <mmgomez en gmail.com> escribió:

>
> 2013/8/3 metal box <metalbox9000 en gmail.com>
>
>> Bueno, gracias de todos modos pero me encontre una funcion que obtiene el
>> valor de salida y lo guado desde un memo y al cargar funciona correctamente.
>
>
> Y cual sería esa función?
> Yo uso la del ejemplo que envié y me resulta, pero quizás la tuya sea mas
> simple?
>
>
>
>
> --
> Try not to become a man of success but rather to become a man of value. *Albert
> Einstein*
>
> _______________________________________________
> Lazarus-es mailing list
> Lazarus-es en lists.lazarus.freepascal.org
> http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus-es
>
>


-- 
*Saludos.

Jose Daboin*
------------ próxima parte ------------
Se ha borrado un adjunto en formato HTML...
URL: <http://lists.lazarus-ide.org/pipermail/lazarus-es/attachments/20130804/aee92991/attachment-0002.html>


More information about the Lazarus-es mailing list