[comp.lang.pascal] Turbo Pascal I/O logging unit

abcscnuk@csuna.csun.edu (Naoto Kimura) (03/04/89)

Here's the Turbo pascal I/O logging that I described in a previous
message.  Please feel free to make suggestions.

---- cut here -------- cut here -------- cut here -------- cut here ----
unit Logger;
(*====================================================================*\
|| UNIT NAME:    LOGGER                                               ||
|| PROGRAMMER:   Naoto Kimura                                         ||
||                                                                    ||
|| DESCRIPTION:  This is an attempt to try to make a unit that will   ||
||               allow me create a log of the input and output        ||
||               without having to reimplement the CRT unit.          ||
||                                                                    ||
|| REFERENCE                                                          ||
|| MATERIALS:    Turbo Pascal User's Manual                           ||
||                     Borland International                          ||
||               Interrupt List (from Usenet)                         ||
||                     Ralf Brown                                     ||
||                                                                    ||
|| DEPENDENCIES: Dos.TPU                                              ||
||                                                                    ||
|| LAST MOD:     8902.27                                              ||
\*====================================================================*)
interface

uses dos;

implementation

{$F+}
const
    CopyRight	: string
	= 'LOGGER (02/27/89)                Copyright (c) Naoto Kimura';

type
    LogRec	= record
		Unused		: array [1..8] of byte;
		LogFileRec	: ^TextRec;
		OldInOutFunc	: pointer
		end;

(*--------------------------------------------------------------------*\
| The following is used for performing an indirect call to an I/O      |
| routine used by the text file driver.                                |
\*--------------------------------------------------------------------*)
{$IFDEF VER40}
const
    IndirectAddr	: pointer	= NIL;

{static far} function PerformIO (var f : TextRec) : integer;
    inline($FF/$1E/IndirectAddr);	{CALL  [IndirectAddr]}
{$ENDIF}
{$IFDEF VER50}
type
    IOfunction	= function (var f : TextRec) : integer;
{$ENDIF}

(*--------------------------------------------------------------------*\
| NAME:  OutputToLog                                                   |
|                                                                      |
|     This private routine is used to output stuff to the log file.    |
|                                                                      |
| EXTERNALS:  type     registers (Dos), TextRec (Dos)                  |
\*--------------------------------------------------------------------*)
{static} procedure OutputToLog(
	var f	: TextRec;
	var Dat	: pointer;
	    Len	: word     );
    var
	i	: word;
	result	: integer;
    begin
	with f do begin
	    i := 0;
	    while i < Len do begin
		if BufPos >= BufSize then begin
{$IFDEF VER40}
		    IndirectAddr := InOutFunc;
		    result := PerformIO(f);
{$ENDIF}
{$IFDEF VER50}
		    result := IOfunction(InOutFunc)(f)
{$ENDIF}
		  end;
		BufPtr^[BufPos] := TextBuf(Dat^)[i];
		inc(BufPos);
		inc(i)
	      end;
	    if f.BufPos >= f.BufSize then begin
{$IFDEF VER40}
		IndirectAddr := InOutFunc;
		result := PerformIO(f)
{$ENDIF}
{$IFDEF VER50}
		result := IOfunction(f.InOutFunc)(f)
{$ENDIF}
	      end
	  end
    end;    (* OutputToLog *)

(*--------------------------------------------------------------------*\
| NAME:  LogOutput                                                     |
|                                                                      |
|     This is the routine to send output to both the standard output   |
| handle and the log file.   This procedure is only used if logging is |
| to be performed.                                                     |
|                                                                      |
| EXTERNALS:  type     registers (Dos), TextRec (Dos)                  |
\*--------------------------------------------------------------------*)
{static far} function LogOutput(var f : TextRec) : integer;
    const
	NumChrs	: word		= 0;
	result	: integer	= 0;
    begin
	with f,LogRec(UserData) do begin
	    NumChrs := BufPos;
{$IFDEF VER40}
	    IndirectAddr := OldInOutFunc;
	    result := PerformIO(f);
{$ENDIF}
{$IFDEF VER50}
	    result := IOfunction(OldInOutFunc)(f);
{$ENDIF}
	    OutputToLog(LogFileRec^,pointer(BufPtr),NumChrs)
	  end;
	LogOutput := result
    end;   (* LogOutput *)

(*--------------------------------------------------------------------*\
| NAME:  LogInput                                                      |
|                                                                      |
|     This is the routine that handles input in the Logger unit.  It   |
| calls the original input routine to perform input, then calls the    |
| appropriate routine to log input to the log file.                    |
|                                                                      |
| EXTERNALS:  type     registers (Dos), TextRec (Dos)                  |
\*--------------------------------------------------------------------*)
{static far} function LogInput (var f : TextRec) : integer;
    var
	result	: integer;
    begin
	with f,LogRec(UserData) do begin
{$IFDEF VER40}
	    IndirectAddr := OldInOutFunc;
	    result := PerformIO(f);
{$ENDIF}
{$IFDEF VER50}
	    result := IOfunction(OldInOutFunc)(f);
{$ENDIF}
	    OutputToLog(LogFileRec^,pointer(BufPtr),BufEnd)
	  end;
	LogInput := Result
    end;   (* LogInput *)

(*--------------------------------------------------------------------*\
| NAME:  LogIgnore                                                     |
|                                                                      |
| This routine is used to perform a do-nothing function, usually for   |
| don't care conditions that may occur during I/O.  This is an         |
| internal service routine and will not be directly used by any        |
| procedure outside of this unit.                                      |
|                                                                      |
| EXTERNALS:  type     TextRec (Dos)                                   |
\*--------------------------------------------------------------------*)
{static far} function LogIgnore(var f : TextRec) : integer;
    begin
	LogIgnore := 0
    end;   (* LogIgnore *)


(*--------------------------------------------------------------------*\
| NAME: OpenLogging                                                    |
|                                                                      |
\*--------------------------------------------------------------------*)
function OpenLogging(var f : TextRec) : integer;
    begin
	with TextRec(f),LogRec(UserData) do begin
	    if Mode = fmInput then begin
		InOutFunc := @LogInput;
		FlushFunc := @LogIgnore
	      end
	    else begin
		Mode := fmOutput;
		InOutFunc := @LogOutput;
		FlushFunc := @LogOutput
	      end
	  end;
	OpenLogging := 0
    end;    (* OpenLogging *)

(*--------------------------------------------------------------------*\
| NAME: CloseLogging                                                   |
|                                                                      |
\*--------------------------------------------------------------------*)
function CloseLogging(var f : TextRec) : integer;
    begin
	CloseLogging := 0
    end;    (* CloseLogging *)

(*--------------------------------------------------------------------*\
| NAME: AssignLogging                                                  |
|                                                                      |
\*--------------------------------------------------------------------*)
procedure AssignLogging(
	var IO_File,
	    LogFile	: text);
    begin
	with TextRec(IO_File) do begin
	    Mode     := fmClosed;
	    BufSize  := SizeOf(Buffer);
	    BufPtr   := @Buffer;
	    OpenFunc := @OpenLogging;
	    with LogRec(UserData) do begin
		LogFileRec	:= @TextRec(LogFile);
		OldInOutFunc	:= InOutFunc;
	      end;
	  end
    end;    (* AssignLogging *)

{static} function RptStr(
	ch	: char;
	rpt	: byte ):string;
    var
	buf	: string;
    begin
	buf[0] := chr(rpt);	(* set length of string *)
	while rpt >0 do begin
	    buf[rpt] := ch;
	    dec(rpt)
	  end;
	RptStr := buf
    end;

var
    StdErr,
    StdCon,
    LogFile	: text;
    LogFileName	: string;
    Choice	: char;
    DoLogging	: boolean;
    OldExitProc	: pointer;

{static far} procedure Cleanup;
    begin
	ExitProc := OldExitProc;
	close(LogFile)
    end;

const
    DEFAULT	= 'S';

begin
    assign(StdErr,'con');	rewrite(StdErr);
    assign(StdCon,'con');	reset(StdCon);
    writeln(StdErr);
    writeln(StdErr,#201,RptStr(#205,70),#187);
    writeln(StdErr,#186' ',CopyRight,'':(68-length(CopyRight)),' '#186);
    writeln(StdErr,#200,RptStr(#205,70),#188);
    repeat
	writeln(StdErr,#13#10'  Select one of the following:'#13#10);
	writeln(StdErr,'      S      screen only');
	writeln(StdErr,'      P      screen and printer');
	writeln(StdErr,'      F      screen and file'#13#10);
	write  (StdErr,'  Please enter selection (default=',DEFAULT,
			') : ');
	if not (SeekEoln(StdCon) or SeekEof(StdCon)) then
	    readln(StdCon,Choice)
	else begin
	    Choice := DEFAULT;
	    if not eof(StdCon) then readln(StdCon)
	  end
    until Choice in ['S','s','P','p','F','f'];
    case Choice of
    'S','s':DoLogging := FALSE;
    'P','p':begin
		LogFileName := 'LPT1';
		DoLogging := TRUE;
	    end;
    'F','f':begin
		write (StdErr,#13#10'  Enter Log file name : ');
		DoLogging := not SeekEoln(StdCon);
		readln(StdCon,LogFileName)
	    end
    end;
    if DoLogging then begin
	assign(LogFile,LogFileName);
	{$I-}
	rewrite(LogFile);
	{$I+}
	if IOresult <> 0 then
	    writeln(StdErr,'Cannot write to file "',LogFileName,
			   '"!  No logging will be done.')
	else begin
	    OldExitProc := ExitProc;
	    ExitProc := @Cleanup;
	    AssignLogging( input, LogFile );
	    reset(input);
	    AssignLogging( output, LogFile );
	    rewrite(output)
	  end
      end;
    writeln(StdErr,#13#10'-- Program execution begins --');
    close(StdErr);
    close(StdCon)
end.
---- cut here -------- cut here -------- cut here -------- cut here ----

                //-n-\\			 Naoto Kimura
        _____---=======---_____		 (abcscnuk@csuna.csun.edu)
    ====____\   /.. ..\   /____====
  //         ---\__O__/---         \\	Enterprise... Surrender or we'll
  \_\                             /_/	send back your *&^$% tribbles !!