Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

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

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 21-03-2007
cyberagl cyberagl is offline
Registrado
 
Registrado: ene 2007
Posts: 7
Poder: 0
cyberagl Va por buen camino
Problema corriendo un proceso

hola companneros

tengo el siguiente codigo para crear un nuevo proceso de consola, donde si se ejecuta algo como "DIR" o "netstat" , pues esta muy bien y siempre funciona.

Ahora, necesito correr un comando que luego de correrlo se queda con un prompt esperando mas comandos de mi parte. Como esto lo hago desde dentro de mi programa, entro en un ciclo infinito.

Lo que necesito es poder controlar el nuevo proceso creado, que no afecte mi propio programa y lo mas importante que pueda seguir mandandole comandos hasta que decida cerrarlo, mandandole el comando adecuado.

muchas gracias de antemano

Código Delphi [-]
Procedure TFormMain.EjecutaComando(C:String);
var
  buf: array[0..4095] of byte;
  si: STARTUPINFO;
  sa: SECURITY_ATTRIBUTES;
  sd: SECURITY_DESCRIPTOR;
  pi: PROCESS_INFORMATION;
  newstdin,newstdout,read_stdout,write_stdin: THandle;
  exitcod,bread,avail: Cardinal;
  count:integer;
begin
  count:= 0 ;
  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;
  // Tuberias
  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(buf,sizeof(buf),0);
           GetEnvironmentVariable('COMSPEC',@buf,sizeof(buf)-1);
           strcat(@buf,' /c ');
           strcat(@buf,PAnsiChar(C));
           if CreateProcess(nil,@buf,nil,nil,TRUE,CREATE_NEW_CONSOLE,nil,nil,si,pi) then
             begin
               memo1.lines.Clear;
               GetExitCodeProcess(pi.hProcess,exitcod);
               PeekNamedPipe(read_stdout,@buf,sizeof(buf)-1,@bread,@avail,nil);
               while (exitcod = STILL_ACTIVE) or (bread > 0) do
                  begin
                    if (bread > 0) then
                      begin
                        fillchar(buf,sizeof(buf),0);
                        if (avail > sizeof(buf)-1) then
                          while (bread >= sizeof(buf)-1)  do
                            begin
                              ReadFile(read_stdout,buf,sizeof(buf)-1,bread,nil);
                              memo1.lines.text := memo1.lines.Text + StrPas(@buf);
                              fillchar(buf,sizeof(buf),0);
                            end else
                            begin
                              ReadFile(read_stdout,buf,sizeof(buf)-1,bread,nil);
                              memo1.lines.text := memo1.lines.Text + StrPas(@buf);
                            end;
                      end;
                    GetExitCodeProcess(pi.hProcess,exitcod);
                    PeekNamedPipe(read_stdout,@buf,sizeof(buf)-1,@bread,@avail,nil);
                  end;
             end;
            CloseHandle(read_stdout);
            CloseHandle(newstdout);
         end;
      CloseHandle(newstdin);
      CloseHandle(write_stdin);
    end;
end;

Última edición por dec fecha: 21-03-2007 a las 22:58:27.
Responder Con Cita
  #2  
Antiguo 21-03-2007
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
 
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Poder: 24
seoane Va por buen camino
¿de donde sacaste ese código?
Responder Con Cita
  #3  
Antiguo 21-03-2007
cyberagl cyberagl is offline
Registrado
 
Registrado: ene 2007
Posts: 7
Poder: 0
cyberagl Va por buen camino
internet

Cita:
Empezado por seoane
¿de donde sacaste ese código?
de Internet

sabes, una solucion seria cerrar el handle del proceso, de esa forma tendria control de mi aplicacion de nuevo. pero luego no sabria como restablecer la comunicacion de nuevo con el proceso y continuar enviando comandos :-(.
Responder Con Cita
  #4  
Antiguo 21-03-2007
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
 
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Poder: 24
seoane Va por buen camino
Cita:
Empezado por cyberagl
de Internet
Ya me parecía ...
http://www.clubdelphi.com/foros/show...9&postcount=18

Volviendo a tu problema. Si te entiendo bien, el programas que ejecutas se queda esperando una entrada por tu parte, y lo que tu quieres es poder mandarle comandos. No es difícil hacer lo que tu quieres, pero vas a tener que replantear todo el código, ten en cuenta que no puedes meter todo dentro de una función, vas a tener que repartir el código a lo largo de los eventos de tu aplicación. Quizá si explicas un poco que es lo que hace tu aplicación, podemos decidir cual es el mejor sitio para colocar el código.
Responder Con Cita
  #5  
Antiguo 21-03-2007
cyberagl cyberagl is offline
Registrado
 
Registrado: ene 2007
Posts: 7
Poder: 0
cyberagl Va por buen camino
Cita:
Empezado por seoane
Ya me parecía ...
http://www.clubdelphi.com/foros/show...9&postcount=18

Volviendo a tu problema. Si te entiendo bien, el programas que ejecutas se queda esperando una entrada por tu parte, y lo que tu quieres es poder mandarle comandos. No es difícil hacer lo que tu quieres, pero vas a tener que replantear todo el código, ten en cuenta que no puedes meter todo dentro de una función, vas a tener que repartir el código a lo largo de los eventos de tu aplicación. Quizá si explicas un poco que es lo que hace tu aplicación, podemos decidir cual es el mejor sitio para colocar el código.
ok, gracias. Me parece increible que reconozcas el codigo, tomando en cuenta todo lo que escribes de codigo y de ayuda a otros en este foro. pero bien , yendo al tema en cuestion.


basicamente necesito ejecutar el comando kd (kernel debugger) pero no desde la consola lo que seria obvio; sino desde mi programa en delphi. Cuando abro el "crash dump" que necesito analizar el kd me presenta el prompt para seguir mandandole los comandos como por ejemplo "!process 0 0" para ver los procesos que hay en "memory dump".

Al hacer esto desde delphi, pierdo todo control sobre mi aplicacio hasta que el proceso que llame no termina y regresa. Pero resulta que este en cuestion no termina y no regresa nunca.

que hacer?

gracias.
Responder Con Cita
  #6  
Antiguo 22-03-2007
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
 
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Poder: 24
seoane Va por buen camino
Vamos partir de la versión revisada del código que puedes encontrar en la sección de trucos (truco 54), y la vamos a modificar para enviar un "retorno de carro" para poder asi finalizar el comando "time".

Código Delphi [-]
uses
  Windows, SysUtils;

function IsWinNT: boolean;
var
  OSV: OSVERSIONINFO;
begin
  OSV.dwOSVersionInfoSize := sizeof(osv);
  GetVersionEx(OSV);
  result := OSV.dwPlatformId = VER_PLATFORM_WIN32_NT;
end;

function CmdExec(Cmd: string): string;
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;
  Str: string;
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
// ***********************
// Para mandar caracteres al proceso hijo, solo tenemos que usar la función
// WriteFile con el handle de la tubería de entrada (write_stdin) 
        // Puedes mandar cualquier texto, yo aqui solo mando el "retorno de carro"
        Str:= #13;
        WriteFile(write_stdin,PChar(Str)^,Length(Str),bread,nil);

//  *********************
        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;
          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;

begin
  Writeln(CmdExec('Time'));
end.
El código anterior no tiene mucha utilidad pero ilustra perfectamente como comunicarte con el proceso hijo.
Responder Con Cita
  #7  
Antiguo 22-03-2007
Avatar de ArdiIIa
[ArdiIIa] ArdiIIa is offline
Miembro Premium
 
Registrado: nov 2003
Ubicación: Valencia city
Posts: 1.481
Poder: 22
ArdiIIa Va por buen camino
Hola y perdón por la intromisión.
Yo hace tiempo que utilicé esa técnica con varios motores de ajedrez, a los que les mandaba diferentes comandos , esperaba su respuesta y teniendo un control absoluto sobre la entrada y salida...


Código Delphi [-]
procedure TFormMain.Launch(cmdline : string; ShowWindow : integer);
var ProcessInfo : TProcessInformation;
    StartupInfo : TStartupInfo;
begin
    CreatePipe(hOutReadPipe, hOutWritePipe, nil, 2024);
    DuplicateHandle(GetCurrentProcess(),
                              hOutWritePipe,  GetCurrentProcess(),
                              @hDupWritePipe, 0, True,
DUPLICATE_CLOSE_SOURCE or  DUPLICATE_SAME_ACCESS);

    CreatePipe(hInReadPipe, hInWritePipe, nil, 2024);
    DuplicateHandle(GetCurrentProcess(),
hInReadPipe,GetCurrentProcess(),
                    @hDupReadPipe, 0, True, DUPLICATE_CLOSE_SOURCE or
DUPLICATE_SAME_ACCESS);


  FillChar(StartupInfo,Sizeof(StartupInfo),#0);
  StartupInfo.cb := Sizeof(StartupInfo);
  StartupInfo.hStdOutput := hDupWritePipe;
  StartupInfo.hStdError  := hDupWritePipe;
  StartupInfo.hStdInput  := hDupReadPipe;
  StartupInfo.wShowWindow := ShowWindow;
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

  CreateProcess(nil, PChar(cmdline), nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil,StartupInfo, ProcessInfo);

end;


Luego un par de funciones accesorias de control

Código Delphi [-]
function TFormMain.ReadPipe(var S : string): Boolean;
var
  dwAvail, dwRead : Cardinal;
  PipeHandle : THandle;
begin
  Result := False;
  PipeHandle := hOutReadPipe;
  dwAvail := 0;
  PeekNamedPipe(PipeHandle, nil, 0, nil, @dwAvail, nil);
  if dwAvail > 0 then
  begin
    SetLength(S, dwAvail);
    ReadFile(PipeHandle, Pointer(S)^, dwAvail, dwRead, nil);
    Result := True;
  end;
  Application.ProcessMessages;
end;

procedure TFormMain.WritePipe(s: string);
var Pstr : array[0..255] of char;
    len : cardinal;
    PipeHandle : THandle;
begin
  PipeHandle := hInWritePipe;
  StrPCopy(Pstr, s);
  len := length(s);
  WriteFile(PipeHandle, Pstr, len, len, nil);
  Sleep(10);
end;



Otra alternativa es esta:


Código Delphi [-]


{---------------------------CreateDOSProcessRedirected--------------------------
 Description    : executes a (DOS!) app defined in the CommandLine parameter
                  redirected to take input from InputFile (optional) and give
                  output to OutputFile
 Result         : True on success
 Parameters     : CommandLine : the command line for app, including full path
                  InputFile   : the ascii file where from the app takes input,
                                 empty if no input needed/required.
                  OutputFile  : the ascii file to which the output is redirected
                  ErrMsg      : additional error message string. Can be empty
 Error checking : YES
 Target         : Delphi 2, 3, 4
 Author         : Theodoros Bebekis, email bebekis@otenet.gr
 Notes          :
 Example call   : CreateDOSProcessRedirected('C:\MyDOSApp.exe',
                                             'C:\InputPut.txt',
                                             'C:\OutPut.txt',
                                             'Please, record this message')
-------------------------------------------------------------------------------}

function TFormMain.CreateDOSProcessRedirected(const CommandLine, InputFile,OutputFile: string): boolean;
var OldCursor: TCursor;
    pCommandLine: array[0..MAX_PATH] of char;
    pInputFile, pOutPutFile: array[0..MAX_PATH] of char;
    StartupInfo: TStartupInfo;
    ProcessInfo: TProcessInformation;
    SecAtrrs: TSecurityAttributes;
    hAppProcess, hAppThread, hInputFile, hOutputFile: THandle;
begin
  result := false;
  if ((InputFile <> '') and (not fileexists(InputFile))) then exit;
  hAppProcess := 0;
  hAppThread := 0;
  hInputFile := 0;
  hOutputFile := 0;
  OldCursor := Screen.Cursor;
  Screen.Cursor := crHourglass;
  try
    StrPCopy(pCommandLine, CommandLine);
    StrPCopy(pInputFile, InputFile);
    StrPCopy(pOutPutFile, OutputFile);
    FillChar(SecAtrrs, SizeOf(SecAtrrs), #0);
    SecAtrrs.nLength := SizeOf(SecAtrrs);
    SecAtrrs.lpSecurityDescriptor := nil;
    SecAtrrs.bInheritHandle := true;
    if (InputFile <> '') then
    begin
      hInputFile := CreateFile(pInputFile, GENERIC_READ or GENERIC_WRITE,
         FILE_SHARE_READ or FILE_SHARE_WRITE, @SecAtrrs, OPEN_ALWAYS,
         FILE_ATTRIBUTE_NORMAL or FILE_FLAG_WRITE_THROUGH, 0);
      if (hInputFile = INVALID_HANDLE_VALUE) then exit;
    end else hInputFile := 0;
    hOutputFile := CreateFile(pOutPutFile, GENERIC_READ or GENERIC_WRITE,
       FILE_SHARE_READ or FILE_SHARE_WRITE, @SecAtrrs, CREATE_ALWAYS,
       FILE_ATTRIBUTE_NORMAL or FILE_FLAG_WRITE_THROUGH, 0);
    if (hOutputFile = INVALID_HANDLE_VALUE) then exit;
    FillChar(StartupInfo, SizeOf(StartupInfo), #0);
    StartupInfo.cb := SizeOf(StartupInfo);
    StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
    StartupInfo.wShowWindow := SW_HIDE;
    StartupInfo.hStdOutput := hOutputFile;
    StartupInfo.hStdInput := hInputFile;
    Application.ProcessMessages;
    result := CreateProcess(nil, pCommandLine, nil, nil, TRUE,
                            HIGH_PRIORITY_CLASS  ,
                            nil, nil, StartupInfo, ProcessInfo);
    Application.ProcessMessages;
    if (result) then
    begin
      WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
      hAppProcess := ProcessInfo.hProcess;
      hAppThread := ProcessInfo.hThread;
    end else exit;
  finally
    Application.ProcessMessages;
    if (hOutputFile <> 0) then CloseHandle(hOutputFile);
    if (hInputFile <> 0) then CloseHandle(hInputFile);
    if (hAppThread <> 0) then CloseHandle(hAppThread);
    if (hAppProcess <> 0) then CloseHandle(hAppProcess);
    Screen.Cursor := OldCursor;
  end;
end;


Uno de los casos en los que también lo utilicé, fue para ejecutar y leer el comando NETSTAT. Pena que cuando me hacía falta, seoane todavía no había insertado su código su post, y a mí me hacía falta hace tiempo
__________________
Un poco de tu generosidad puede salvar la vida a un niño. ASÍ DE SENCILLO
Responder Con Cita
  #8  
Antiguo 22-03-2007
cyberagl cyberagl is offline
Registrado
 
Registrado: ene 2007
Posts: 7
Poder: 0
cyberagl Va por buen camino
wow, muchas gracias

super, ahora mismo trato de ajustar mi codigo a lo que me han dado.

muchas gracias,
suerte
Responder Con Cita
  #9  
Antiguo 22-03-2007
Avatar de ArdiIIa
[ArdiIIa] ArdiIIa is offline
Miembro Premium
 
Registrado: nov 2003
Ubicación: Valencia city
Posts: 1.481
Poder: 22
ArdiIIa Va por buen camino
Ya nos contarás algo de como fue
__________________
Un poco de tu generosidad puede salvar la vida a un niño. ASÍ DE SENCILLO
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

Temas Similares
Tema Autor Foro Respuestas Último mensaje
verificar si una aplicacion esta corriendo dblx Varios 12 15-12-2006 01:29:31
Pueden estar corriendo Apache y IIS simultaneamente? JuanErasmo .NET 1 02-12-2006 00:35:18
Saber si MySQL esta corriendo DTAR Varios 11 22-11-2006 18:12:43
Aplicación corriendo como servicio verm83 Varios 2 15-04-2004 11:34:28
Re... .... corriendo los objetos Anubys OOP 7 19-12-2003 18:53:09


La franja horaria es GMT +2. Ahora son las 23:37:04.


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