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 !!