Ver Mensaje Individual
  #9  
Antiguo 19-01-2007
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
 
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Reputación: 24
seoane Va por buen camino
Bueno, yo sigo dandole vueltas al asunto

Se me ocurre tener 2 aplicaciones, una es el propio programa y la otra vigila a la primera. El vigilante seria una aplicación como esta:
Código Delphi [-]
program Bitacora;

{$APPTYPE CONSOLE}

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 Min(i,j: Cardinal): Cardinal;
begin
  if i < j then
    Result:= i
  else
    Result:= j;
end;

procedure Loop(Cmd: string);
var
  Buffer: PChar;
  Si: STARTUPINFO;
  Sa: SECURITY_ATTRIBUTES;
  Sd: SECURITY_DESCRIPTOR;
  Pi: PROCESS_INFORMATION;
  NewStdin, NewStdout, Read_Stdout, Write_Stdin: THandle;
  Exitcod, Bread, Avail: Cardinal;
begin
  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, 1) then
  begin
    if CreatePipe(Read_stdout, Newstdout, @Sa, 1) then
    begin
      GetStartupInfo(Si);
      with Si do
      begin
        dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
        wShowWindow := SW_SHOW;
        hStdOutput := NewStdout;
        hStdError := NewStdout;
        hStdInput := NewStdin;
      end;
      if CreateProcess(nil, PChar(Cmd), nil, nil, TRUE, CREATE_NEW_CONSOLE,
         nil, nil, Si, Pi) then
      begin
        GetMem(Buffer,4096);
        try
          repeat
            if not PeekNamedPipe(Read_Stdout, nil, 0, nil, @Avail, nil) then
              break;
            if Avail > 0 then
            begin
              FillChar(Buffer^, 4096, 0);
              ReadFile(Read_Stdout, Buffer^, Min(Avail,4095), Bread, nil);
              if Bread > 0 then Write(String(Buffer));
              // Aqui podiamos guardarlo en un archivo por ejemplo
            end else
              Sleep(10);
            GetExitCodeProcess(Pi.hProcess, Exitcod);
          until (exitcod <> STILL_ACTIVE);
        finally
          FreeMem(Buffer);
        end;
      end;
      CloseHandle(Read_Stdout);
      CloseHandle(NewStdout);
    end;
    CloseHandle(NewStdin);
    CloseHandle(Write_Stdin);
  end;
end;

var
 i: integer;
 Str: String;
begin
  Str:= ParamStr(1);
  for i:= 2 to ParamCount do
    Str:= Str + #32 + ParamStr(i);
  if Str <> EmptyStr then
    Loop(Str);
  // Esto es solo para que no se cierre inmediatamente
  Readln;
end.

Ahora en la aplicación principal usaríamos un procedure tal como este:
Código Delphi [-]
procedure log(Str: string);
var
  StdError: THandle;
begin
  StdError:= GetStdHandle(STD_ERROR_HANDLE);
  if (StdError <> STD_ERROR_HANDLE) and (StdError <> 0) then
  begin
    FileWrite(StdError,PChar(Str + #13#10)^,Length(Str)+2);
  end;
end;

// Por ejemplo
log('Hola Mundo');

De esta manera, si iniciamos la aplicación principal solamente, el procedure no tendrá ningún efecto. Sin embargo, si la ejecutamos desde la aplicación bitácora, esta mostrara los mensajes. Por ejemplo:
Código:
  Bitacora.exe Principal.exe /Algunparametro
¿Sera matar moscas a cañonazos?
Responder Con Cita