home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / dossys / logger / logger.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-02-02  |  3.9 KB  |  140 lines
  1. program logger;
  2. {$A+,B-,D-,E-,F-,I+,L-,N-,O-,R-,S+,V+}
  3. {$M 4096,0,0}
  4.  
  5. { Program to log all stdout and stderr output of any (?) program to a file.
  6.   Useful when you want to record the output of a program that is being
  7.   spawned by another one.  Works with both .COM and .EXE files.  Could
  8.   easily be modified to redirect other handles (0=stdin, 1=stdout,
  9.   2=stderr, 3=stdaux, 4=stdprt).
  10.  
  11.   Instructions:
  12.   Move the original program to a directory that's not on the PATH.  Use
  13.   \LOGPROGS, or store the name of the directory actually used in the
  14.   environment variable "LOGPROGS".
  15.  
  16.   Rename LOGGER.EXE to the name of the program to log.  When invoked, it
  17.   will write an entry to the file named in the environment variable LOGFILE
  18.   (default is LOGGER.LOG in the current directory), then invoke the original
  19.   program.  All output from the original program that would have gone through
  20.   DOS to the console will be logged to the same file.
  21.  
  22.   If used with DOS 2, the name as well as the path to the original program
  23.   must be given in the environment variable LOGPROGS, since LOGGER won't be
  24.   able to figure out what name you called it.
  25.  
  26.   Written by Duncan Murdoch for the public domain.  Send comments to me
  27.   at:
  28.      Compuserve    71631,122
  29.      Internet      dmurdoch@watstat.waterloo.edu
  30.      Fidonet       dj murdoch at 1:221/177.40
  31. }
  32. uses
  33.   dos,
  34.   envunit; { N.B. "envunit" is from the excellent package TPENV, by
  35.                   Mike Babulic, and available in the BPROGA forum
  36.                   on Compuserve. }
  37.  
  38. const
  39.   stdout = 1;
  40.   stderr = 2;
  41.  
  42. var
  43.   logfilename : pathstr;
  44.   logfile : text;
  45.   execfilename : pathstr;
  46.   exitcode : integer;
  47.  
  48. procedure force_dup(existing,second:word);
  49. var
  50.   r:registers;
  51. begin
  52.   r.ah := $46;
  53.   r.bx := existing;
  54.   r.cx := second;
  55.   msdos(r);
  56.   if (r.flags and fcarry) <> 0 then
  57.     writeln(logfile,'Error ',r.ax,' changing handle ',second);
  58. end;
  59.  
  60. procedure timestamp;
  61. const
  62.   monthname:array[1..12] of string[3] =
  63.   ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  64. var
  65.   year,month,day,dayofweek,hour,minute,second,sec100:word;
  66. begin
  67.   getdate(year,month,day,dayofweek);
  68.   gettime(hour,minute,second,sec100);
  69.   write(logfile,
  70.                 day:2,' ',monthname[month],year mod 100:3,
  71.                 hour:3,':',minute:2,':',second:2,' ');
  72. end;
  73.  
  74. begin
  75.   { Open the log file }
  76.   logfilename := getenv('LOGFILE');
  77.   if logfilename = '' then
  78.     logfilename := 'LOGGER.LOG';
  79.  
  80.   assign(logfile,logfilename);
  81.   if fileexists(logfilename) then
  82.     {$i-} append(logfile) {$i+}
  83.   else
  84.     {$i-} rewrite(logfile); {$i+}
  85.  
  86.   if ioresult <> 0 then
  87.   begin
  88.     writeln('Logger can''t open logfile!!!! Aborting.');
  89.     halt(99);
  90.   end;
  91.  
  92.   timestamp;
  93.  
  94.   { Redirect STDOUT and STDERR }
  95.  
  96.   force_dup(textrec(logfile).handle,stdout);
  97.   force_dup(textrec(logfile).handle,stderr);
  98.  
  99.   { Find and invoke the real program }
  100.  
  101.   execfilename := getenv('LOGPROGS');
  102.   if execfilename <> '' then
  103.   begin
  104.     if not fileexists(execfilename) then
  105.     begin
  106.       if execfilename[length(execfilename)] <> '\' then
  107.         execfilename := execfilename + '\';
  108.       execfilename := execfilename + myname + myext;
  109.     end;
  110.   end
  111.   else  { no environment string }
  112.   begin
  113.     execfilename := '\LOGPROGS\' + myname + myext;
  114.   end;
  115.  
  116.   if not fileexists(execfilename) then
  117.   begin
  118.     writeln(logfile,'LOGGER unable to find ',execfilename,' to execute!');
  119.     exitcode := 1;
  120.   end
  121.   else
  122.   begin
  123.     writeln(logfile,'LOGGER executing ',execfilename,' ',paramstring);
  124.     flush(logfile);
  125.     {$ifdef ver50}
  126.     swapvectors;
  127.     {$endif}
  128.     exec(execfilename,paramstring);
  129.     {$ifdef ver50}
  130.     swapvectors;
  131.     {$endif}
  132.     exitcode := dosexitcode;
  133.     writeln(logfile);
  134.     timestamp;
  135.     writeln(logfile,'LOGGER received exit code ',exitcode);
  136.   end;
  137.   close(logfile);
  138.   halt(exitcode);
  139. end.
  140.