UNIT TAGDEV;

{
  ÕÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͸
  ³ ÜÛÛÛÛÛÛÛÛÛÛÜ  ÜÛÛÛÛÛÛÛÜ   ÜÛÛÛÛÛÛÛÛÜ ÜÛÛÛÛÛÛÛÛÜ  ÜÛÛÛÛÛÛÛÛÛÜ ÜÛÛÜ   ÜÛÛÜ ³
  ³ ßßßßÛÛÛÛßßßß ÛÛÛÛßßßÛÛÛÛ ÛÛÛÛß   ßßß ÛÛÛÛ   ßÛÛÛ ÛÛÛÛ    ßßß ÛÛÛÛ   ÛÛÛÛ ³
  ³     ÛÛÛÛ     ÛÛÛÛÜÜÜÛÛÛÛ ÛÛÛÛ  ÜÜÜÜ  ÛÛÛÛ    ÛÛÛ ÛÛÛÛÜÜÜÜÜ   ÛÛÛÛ   ÛÛÛÛ ³
  ³     ÛÛÛÛ     ÛÛÛÛÛÛÛÛÛÛÛ ÛÛÛÛ  ßßÛÛÛ ÛÛÛÛ    ÛÛÛ ÛÛÛÛßßßßß   ßÛÛÛÜ ÜÛÛÛß ³
  ³     ÛÛÛÛ     ÛÛÛÛ   ÛÛÛÛ ÛÛÛÛÛÜÜÜÛÛÛ ÛÛÛÛÜÜÜÛÛÛß ÛÛÛÛ    ÜÜÜ  ßÛÛÛÛÛÛÛß  ³
  ³     ßÛÛß     ßÛÛß   ßÛÛß  ßÛÛÛÛÛÛÛÛß ßÛÛÛÛÛÛÛß   ßÛÛÛÛÛÛÛÛÛß    ßÛÛÛß    ³
  ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ;

                             Version 1.00 Standard

     All routines are public domain/free to distribute, modify, and steal!
                       Routines compiled by Joe McElmeel.

           Send all bug reports, questions, inquiries or comments to:

                           Joe McElmeel (1:2410/480)
}

INTERFACE

USES
   CRT,         {* Required for various screen/color routines.   *}
   DOS,         {* Required for various time/date/file routines. *}
   TAGR27;      {* Required for some TAG-specific functions.     *}

CONST
   MonthDays : ARRAY [1..12] of ShortInt = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 31, 31);

VAR
   Year, Month, Date, Day, Hour, Min, Sec, Sec100 : Word;
   Pm                                             : Boolean;
   StartClock, StopClock                          : Real;

FUNCTION FileExistWild(Mask : String): Boolean;
{* Tells you if "Mask" exists. Fully supports MS-DOS wildcards. *}

FUNCTION SizeFile(FName : String): LongInt;
{* Reports the size of an MS-DOS file.  Returns -1 if file doesn't exist. *}

FUNCTION Int_To_Str(Number : LongInt): String;
{* Converts an Integer to a string. *}

FUNCTION Real_to_Str(Number : Real): String;
{* Converts a real number to a string. *}

FUNCTION Str_To_Int(St : String): Integer;
{* Converts a String to an Integer. *}

FUNCTION RWithCommas(W : Real): String;
{* Converts a Real number to a string and adds commas every three places. *}

FUNCTION WithCommas(W : LongInt): String;
{* Converts an Integer to a string and adds commas every three places. *}

PROCEDURE TC(I : Byte);
{* Works the same way as "TextColor()" except it saves you keystrokes. *}

PROCEDURE ResetColor;
{* Sets foreground color to 7, background color to 0, and disables blinking. *}

PROCEDURE NL;
{* A shorter way of saying "WriteLn;". "NL" = "Next line". *}

PROCEDURE CStr(Str : String);
{* Writes a string to the screen the same way "Write()" does, but it fully *}
{* supports Renegade-like pipe codes! (e.g. '|15Hello!' would come out in  *}
{* high-intensity white on black.                                          *}

PROCEDURE CStrLn(Str : String);
{* The same as "CStr()" except it puts a blank line after it. *}

PROCEDURE CenterStr(S : String);
{* Centers "S" on an 80-column line, fully supportive of pipe codes. *}

FUNCTION AllCaps(S : String): String;
{* Capitalizes all lower-case letters in a string. *}

FUNCTION RemoveCtrlP(Stri: String): String;
{* Removes ^C# codes from a color-string in a TAG data file. *}

FUNCTION FullDate : String;
{* Reports the current date in "Wednesday August 10th, 1994" format. *}

FUNCTION Lower(Str : String): String;
{* Changes all upper-case letters in a string to lower-case. *}

FUNCTION Proper(Str : String): String;
{* Changes the first letter of each word to upper-case and all the rest to *}
{* lower-case in a string. Accomodates for "'"'s and "."'s properly.       *}

PROCEDURE ClockOn;
PROCEDURE ClockOff;
{* Enables the program timer. Use at the beginning of your program, and *}
{* use ClockOff; at the end to figure out how long it ran for. The      *}
{* results are stored in StartClock and StopClock. Simple subtraction   *}
{* will tell you exactly how many seconds your program took to run.     *}

FUNCTION Ynq(S : String; Mode : Byte): Boolean;
{* Sends a Yes/No question ("S"), and prompts for an answer where the user *}
{* can use the cursor keys to select between a highlighted Yes or No box.  *}
{* "Mode" controls the default position of the Yes/No highlight. See the   *}
{* code for more details.                                                  *}

PROCEDURE FixSpaces(var S : String);
{* Converts all underscore characters in a string to spaces. Useful if *}
{* your command-line parameter checking chokes on spaces.              *}

FUNCTION ListARFlags(AR : ARFlagSet): String;
FUNCTION ListSFFlags(SF : FlagSet): String;
{* Lists AR and SF flags in the exact same way as TAG's SDR codes list them *}
{* if you were to use them in a displayable file.                           *}

FUNCTION UnpakTagDate(TagDate : Word): String;
FUNCTION UnpakTagTime(TagTime : Word): String;
FUNCTION PakTagDate(S : String): Word;
FUNCTION PakTagTime(S : String): Word;
{* These routines are used to pack and un-pack TAG "Semi MS-DOS 1900 format" *}
{* dates that are used in the USER.LST and other data files.                 *}

FUNCTION GetWord(S : String; W : Integer): String;
{* Returns "word" number "W" from string "S". *}

FUNCTION CoolDate : String;
FUNCTION CoolTime : String;
{* Returns the current date/time in 00/00/00 format for the date and 00:00:00 *}
{* format for the time.                                                       *}

FUNCTION OutDate(KMonth, KDate, KYear : Word): String;
FUNCTION OutTime(KHour, KMin, KSec : Word): String;
{* Returns the dates/times in "cool" format, but these functions accept *}
{* other values for the time/date instead of using the system time/date *}

FUNCTION ExtendedDate : String;
{* Returns the date in the same way the TAG SDR code ^S! does. *}

FUNCTION SeeWords(St: String): Integer;
{* Tells you how many words are in a text string. *}

FUNCTION PadRight(St: String; Ch: Char; L: Integer): String;
FUNCTION PadLeft(St: String; Ch: Char; L: Integer): String;
{* The best way to explain these functions is by example.

VAR
   S : String

BEGIN
   S := '1';
   WriteLn(PadLeft(S,'0',5));
END.

...Would output:

00001

It's useful when you're lining up output in columns (on either the right side
or the left. *}

PROCEDURE Exec(Path,CmdLine : String);
{* This is a drop-in replacement for the DOS.Exec procedure, except that *}
{* this one has more features. It FULLY supports pipe-ins and pipe-outs. *}
{* For instance, you can "muffle" the output of PKZIP by adding "> NUL"  *}
{* on the end of your Exec() procedure that calls it.                    *}

FUNCTION DayNum(Dt : String): Word;
{* Tells you how many days it's been since "Dt". Dt is a "cool" date string. *}
{* For instance, August 10th, 1994 in a "cool" date string is "08/10/94".    *}
{* TAG stores some of its dates in this format (like in the *.DIR files).    *}

FUNCTION WordToHex(W : Word): String;
{* Simply converts any Integer or Word value to a Hexadecimal number. *}

PROCEDURE TNTExitProc;
{* The error handling routines that I have packaged for you. It does quite a *}
{* bit for you. When there is a runtime error in your program, instead of    *}
{* just saying "Runtime error 002 at 0000:ABCD" it says exactly what kind of *}
{* error it was (to the user), when it happened (time/date), and has a five  *}
{* second pause in case the screen gets cleared somehow. It also creates a   *}
{* text capture of the current 80x25 user screen and saves it to a file so   *}
{* you, the author, knows exactly what was on the screen (and the cursor     *}
{* position!) when it happened.                                              *}

FUNCTION StatusBar(Total, Amt : LongInt): String;
{* Ever see those programs that have those percentage (%) status bars along *}
{* with a nice graph that increments as the program gets complete? Well,    *}
{* I found this routines in SWAG snippets so I thought I'd share it here.   *}
{* Basically, it figures out the math for you so all you have to do it feed *}
{* it the record number or whatever that you're on and how many there are   *}
{* total in the operation, and you can use a For loop to print the graph.   *}
{* Quick example:

VAR
   I            : ShortInt;
   Whatever     : WhateverRec;
   WhateverFile : File of WhateverRec;

BEGIN
   For I := 1 to FileSize(WhateverFile) do
    BEGIN
       GotoXY(10,10);
       WriteLn(StatusBar(I,FileSize(WhateverFile));
       Seek(WhateverFile,I);
       Read(WhateverFile,Whatever);
    END;
END. *}

FUNCTION EraseFiles(Path, Mask : String): Integer;
{* Erases file(s) without questions (fully wildcard supportive). *}

IMPLEMENTATION

VAR
   H, M, S, S100, VS : Word;
   TNTExitPtr        : Pointer;

{****************************************************************************}
FUNCTION FileExistWild(Mask : String): Boolean;
VAR
   SR : SearchRec;
BEGIN
   FindFirst(Mask,AnyFile,SR);
   If DosError <> 18 then FileExistWild := TRUE ELSE FileExistWild := FALSE;
END;
{****************************************************************************}
FUNCTION SizeFile(FName : String): LongInt;
VAR
   SR  : SearchRec;
   Idx : Integer;
BEGIN
   SizeFile := 0;
   FindFirst(FName,AnyFile,SR);
   If DosError = 0 then SizeFile := SR.Size ELSE SizeFile := -1;
END;
{****************************************************************************}
FUNCTION VidSeg : Word;
BEGIN
   If Mem[$0000:$0049] = 7 then
   VidSeg := $B000 ELSE VidSeg := $B800;
END;
{****************************************************************************}
PROCEDURE ClockOn;
VAR
   Hr, Mn, Sc, Sc100 : Real;
BEGIN
   GetTime(H,M,S,S100);
   Hr := H; Mn := M; Sc := S; Sc100 := S100;
   StartClock := Hr * 3600 + (Mn * 60) + Sc + (Sc100 / 100);
END;
{****************************************************************************}
PROCEDURE ClockOff;
VAR
   Hr, Mn, Sc, Sc100 : Real;
BEGIN
   GetTime(H,M,S,S100);
   Hr := H; Mn := M; Sc := S; Sc100 := S100;
   StopClock := Hr * 3600 + (Mn * 60) + Sc + (Sc100 / 100);
END;
{******************************************************************************}
FUNCTION Int_To_Str(Number : LongInt): String;
VAR
   Temp : String[64];
BEGIN
   Str(Number,Temp);
   Int_To_Str := Temp;
END;
{******************************************************************************}
FUNCTION Real_to_Str(Number : Real): String;
BEGIN
   Real_to_Str := Int_To_Str(Trunc(Number));
END;
{******************************************************************************}
FUNCTION Str_To_Int(St: String): Integer;
VAR
   I, Ecode : Integer;
BEGIN
   Val(St,I,Ecode);
   If (Ecode = 0) then Str_To_Int := I ELSE Str_to_Int := 0;
END;
{******************************************************************************}
FUNCTION RWithCommas(W : Real): String;
VAR
   CC : LongInt;
   S  : String[64];
BEGIN
   S := Real_to_str(W);
   CC := Length(S)-3;
   While (CC > 0) do
    BEGIN
       Insert(',',S,CC+1);
       CC := CC-3;
    END;
   RWithCommas := S;
END;
{***************************************************************************}
FUNCTION WithCommas(W : LongInt): String;
VAR
   CC : LongInt;
   S  : String[64];
BEGIN
   S := int_to_str(W);
   CC := Length(S)-3;
   While (CC > 0) do
    BEGIN
       Insert(',',S,CC+1);
       CC := CC-3;
    END;
   WithCommas := S;
END;
{******************************************************************************}
PROCEDURE TC(I : Byte);
BEGIN
   TextColor(I);
END;
{******************************************************************************}
PROCEDURE ResetColor;
BEGIN
   TC(7);
   TextBackGround(0);
END;
{******************************************************************************}
PROCEDURE NL;
BEGIN
   WriteLn;
END;
{******************************************************************************
PROCEDURE CStr(S : String);
VAR
   I        : Byte;
   SmallStr : String[2];
   IntColor : Byte;
   Code     : Integer;

   PROCEDURE DoColor(Color : Byte; VAR B : Byte);
   BEGIN
      Inc(B);
      If (Color < 16) then TC(Color) ELSE TextBackGround(Color-16);
   END;

   FUNCTION Test(C : Char): Boolean;
   VAR
      I, Ecode : Integer;
   BEGIN
      Ecode := 0;
      Val(C,I,Ecode);
      If (Ecode = 0) then Test := TRUE ELSE Test := FALSE;
   END;

BEGIN
   ResetColor;
   I := 1;
    WHILE (I <= Length(S)) do
     BEGIN
        If (S[I] = '|') and (Test(S[I+1]) = TRUE) then
         BEGIN
            SmallStr := Copy(S,I+1,I+2);
            Inc(I);
            Val(SmallStr,IntColor,Code);
            If (IntColor > 22) then
             BEGIN
                Inc(I,2);
                Write(SmallStr);
                Continue;
             END ELSE DoColor(IntColor,I);
         END ELSE Write(S[I]); Inc(I);
     END;
    ResetColor;
END;
 ******************************************************************************}
PROCEDURE CStr(Str : String);
VAR
   StrPos, Err: Integer;
   Col: Byte;

BEGIN
   StrPos := 1;
   IF Length(Str) < 1 THEN Exit;
   REPEAT
      IF (Str[StrPos] = '|') THEN
       BEGIN
          Val(Copy(Str,StrPos+1,2),Col,Err);
          IF (Err = 0) AND (Col IN [0..23]) THEN
             IF Col IN [0..15] THEN TextColor(Col)
             ELSE TextBackGround(Col-16);
          Inc(StrPos,3);
       END
      ELSE
       BEGIN
          Write(Str[StrPos]);
          Inc(StrPos);
       END;
   UNTIL (StrPos > Length(Str));
END;
{******************************************************************************}
PROCEDURE CStrLn(Str : String);
BEGIN
   CStr(Str);
   NL;
END;
{******************************************************************************}
PROCEDURE CenterStr(S : String);
VAR
   X, J, Counter : Byte;
BEGIN
   Counter := 0;
   For J := 1 to Length(S) do If (S[J] = '|') then Inc(Counter,3);
   X := (Length(S)-Counter);
   J := X DIV 2;
   For X := 1 to (40-J) do Write(' ');
   CStrLn(S);
END;
{******************************************************************************}
FUNCTION AllCaps(S : String): String;
VAR
   I : Integer;
BEGIN
   For I := 1 to ord(S[0]) do S[I] := Upcase(S[I]);
   AllCaps := S;
END;
{******************************************************************************}
FUNCTION RemoveCtrlP(Stri : String): String;
VAR
   CtrlPStr : String;
   Location : Integer;
BEGIN
   CtrlPStr := Stri;
    REPEAT
       If (Pos('',CtrlPStr) <> 0) then
        BEGIN
           Location := Pos('',CtrlPStr);
           Delete(CtrlPStr,Location,2);
        END;
    UNTIL Pos('',CtrlPStr) = 0;
   RemoveCtrlP := CtrlPStr;
END;
{******************************************************************************}
FUNCTION FullDate : String;
TYPE
   WeekDays = ARRAY [0..6] of String[9];
   Months = ARRAY [1..12] of String[9];

CONST
   DayNames : WeekDays = ('Sunday','Monday','Tuesday','Wednesday',
                          'Thursday','Friday','Saturday');
   MonthNames : Months = ('January','February','March','April','May',
                          'June','July','August','September',
                          'October','November','December');

BEGIN
   GetDate(Year,Month,Date,Day);
   FullDate := DayNames[Day]+' '+MonthNames[Month]+' '+int_to_str(Date)+', '+int_to_str(Year);
END;
{******************************************************************************}
FUNCTION Lower(Str: String): String;
VAR
   I : Integer;
BEGIN
   For I := 1 to Length(Str) do
    If ord(Str[I]) in [65..90] then Str[I] := chr(ord(Str[I]) + 32);
   Lower := Str;
END;
{******************************************************************************}
FUNCTION Proper(Str: String): String;
VAR
  I           : Integer;
  SpaceBefore : Boolean;
BEGIN
   SpaceBefore := TRUE;
   Str := Lower(Str);
   For I := 1 to Length(Str) do
    If ((SpaceBefore) or (ord(Str[I-1]) in [33..47])) and (ord(Str[I]) in [97..122]) then
     BEGIN
        SpaceBefore := FALSE;
        If (Str[I-1] <> '''') then Str[I] := UpCase(Str[I]);
     END ELSE
    If (not SpaceBefore) and (Str[I] = ' ') then SpaceBefore := TRUE;
    Proper := Str;
END;
{******************************************************************************}
PROCEDURE ReadTime;
BEGIN
   GetTime(Hour,Min,Sec,Sec100);
   GetDate(Year,Month,Date,Day);
   If (Hour < 12) then Pm := FALSE;
   If (Hour >= 12) then
    BEGIN
       Pm := True;
       Dec(Hour,12);
    END;
END;
{****************************************************************************}
FUNCTION Ynq(S : String; Mode: Byte): Boolean;
VAR
   Ch      : Char;
   J, X, Y : Byte;

   PROCEDURE Yes;
   BEGIN
      CStr('|17|15 Yes |16|15 No ');
   END;

   PROCEDURE No;
   BEGIN
      CStr('|16|15 Yes |17|15 No ');
   END;

BEGIN
   Ch := #0;
   TC(9);
   CStr(S+' ');
   X := WhereX;
   Y := WhereY;
   If (Mode = 1) then Yes ELSE No;
    WHILE not (Ch in ['Y', 'N', #13]) do
     BEGIN
         REPEAT
            Ch := UpCase(ReadKey);
         UNTIL (Ch in ['Y', 'N', #13, #0]);
         CASE Ch of
            'Y' : BEGIN
                     GotoXY(X,Y);
                     Yes;
                     Ynq := TRUE;
                  END;
            'N' : BEGIN
                     GotoXY(X,Y);
                     No;
                     Ynq := FALSE;
                  END;
            #13 : If (Mode = 1) then Ynq := TRUE ELSE Ynq := FALSE;
            #0  : BEGIN
                     Ch := ReadKey;
                     If (Ch = 'K') or (Ch = 'M') then
                      If (Mode = 1) then
                       BEGIN
                          GotoXY(X,Y);
                          No;
                          Mode := 2;
                       END ELSE
                       BEGIN
                          GotoXY(X,Y);
                          Yes;
                          Mode := 1;
                       END;
                  END;
        END;
     END;
   NL;
END;
{****************************************************************************}
PROCEDURE FixSpaces(var S : String);
VAR
   I : Integer;
BEGIN
   For I := 1 to Length(S) do If S[I] = '_' then S[I] := ' ';
END;
{****************************************************************************}
FUNCTION ListARFlags(AR : ARFlagSet): String;
VAR
   S : String[26];
   C : Char;
BEGIN
   S := '';
   For C := 'A' to 'Z' do
    If C in AR then S := S + C ELSE S := S + '-';
   ListARFlags := S;
END;
{******************************************************************************}
FUNCTION ListSFFlags(SF : FlagSet): String;
VAR
   S : String[24];
   I : Integer;
BEGIN
   S := '';
   If AutoPrivDel   in SF then S := S + 'A' ELSE S := S + '-';
   If NoPostCall    in SF then S := S + 'B' ELSE S := S + '-';
   If ForceULScan   in SF then S := S + 'C' ELSE S := S + '-';
   If RAnon         in SF then S := S + 'D' ELSE S := S + '-';
   If RBBSlist      in SF then S := S + 'E' ELSE S := S + '-';
   If RChat         in SF then S := S + 'F' ELSE S := S + '-';
   If NoDlLimit     in SF then S := S + 'G' ELSE S := S + '-';
   If RPubMsg       in SF then S := S + 'H' ELSE S := S + '-';
   If RPrivMsg      in SF then S := S + 'I' ELSE S := S + '-';
   If RVoting       in SF then S := S + 'J' ELSE S := S + '-';
   If OneCall       in SF then S := S + 'K' ELSE S := S + '-';
   If PubNotVal     in SF then S := S + 'L' ELSE S := S + '-';
   If ProtDel       in SF then S := S + 'M' ELSE S := S + '-';
   If NoFilePts     in SF then S := S + 'N' ELSE S := S + '-';
   If RFileVal      in SF then S := S + 'O' ELSE S := S + '-';
   If Pause         in SF then S := S + 'P' ELSE S := S + '-';
   If ANSI          in SF then S := S + 'Q' ELSE S := S + '-';
   If Color         in SF then S := S + 'R' ELSE S := S + '-';
   If OneKey        in SF then S := S + 'S' ELSE S := S + '-';
   If Alert         in SF then S := S + 'T' ELSE S := S + '-';
   If FlagRecUnused in SF then S := S + 'U' ELSE S := S + '-';
   If MBoxClosed    in SF then S := S + 'V' ELSE S := S + '-';
   If Tabs          in SF then S := S + 'W' ELSE S := S + '-';
   If ClsChar       in SF then S := S + 'X' ELSE S := S + '-';
   ListSFFlags := S;
END;
{****************************************************************************}
FUNCTION UnpakTagDate(TagDate : Word): String;
VAR
   S          : String[8];
   MM, DD, YY : Word;
BEGIN
    S := '';
    MM := (TagDate SHR 5) AND $0F;
    DD := (TagDate AND $1F);
    YY := (TagDate SHR 9) AND $7F;
    If (MM < 10) then S := '0';
    S := S + int_to_str(MM) + '/';
    If (DD < 10) then S := S + '0';
    S := S + int_to_str(DD) + '/';
    If (YY < 10) then S := S + '0';
    S := S + int_to_str(YY);
    UnpakTagDate := S;
END;
{******************************************************************************}
FUNCTION UnpakTagTime(TagTime : Word): String;
VAR
   S          : String[8];
   HH, MM, SS : Word;
BEGIN
   S := '';
   HH := (TagTime SHR 11) AND $1F;
   MM := (TagTime SHR 5) AND $35;
   SS := (TagTime AND $1F) * 2;
   If (HH < 10) then S := '0';
   S := S + int_to_str(HH) + ':';
   If (MM < 10) then S := S + '0';
   S := S + int_to_str(MM) + ':';
   If (SS < 10) then S := S + '0';
   S := S + int_to_str(SS);
   UnpakTagTime := S;
END;
{******************************************************************************}
FUNCTION GetWord(S : String; W : Integer): String;
VAR
   WordNum   : ARRAY [0..60] of String[60];
   WCount, I : Integer;
BEGIN
   S := S + ' ';
   WCount := 0;
   For I := 0 to 60 do WordNum[I] := ' ';
    WHILE (Length(S) > 0) do
     BEGIN
        WordNum[WCount] := Copy(S,1,Pos(' ',S)-1);
        Delete(S,1,Length(WordNum[WCount])+1);
        Inc(WCount);
     END;
   GetWord := WordNum[W-1];
END;
{******************************************************************************}
FUNCTION CoolDate : String;
VAR
   Temp : String[8];
BEGIN
   Temp := '';
   GetDate(Year,Month,Date,Day);
   If (Month < 10) then Temp := '0';
   Temp := Temp + int_to_str(Month) + '/';
   If (Date < 10) then Temp := Temp + '0';
   Temp := Temp + int_to_str(Date) + '/' + int_to_str(Year-1900);
   CoolDate := Temp;
END;
{******************************************************************************}
FUNCTION CoolTime : String;
VAR
   Temp : String[8];
BEGIN
   Temp := '';
   GetTime(Hour,Min,Sec,Sec100);
   If (Hour < 10) then Temp := '0';
   Temp := Temp + int_to_str(Hour) + ':';
   If (Min < 10) then Temp := Temp + '0';
   Temp := Temp + int_to_str(Min) + ':';
   If (Sec < 10) then Temp := Temp + '0';
   Temp := Temp + int_to_str(Sec);
   CoolTime := Temp;
END;
{******************************************************************************}
FUNCTION ExtendedDate : String;
CONST
   DayName   : ARRAY [0..6] of String[3] = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
   MonthName : ARRAY [1..12] of String[3] = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov',
                                             'Dec');
VAR
   TempStr : String;
   Pm      : Boolean;
BEGIN
   TempStr := '';
   GetDate(Year,Month,Date,Day);
   GetTime(Hour,Min,Sec,Sec100);
   If (Hour < 12) then Pm := FALSE;
   If (Hour >= 12) then
    BEGIN
       Pm := TRUE;
       Dec(Hour,12);
    END;
   If (Hour = 0) then TempStr := '12:' ELSE
   If (Hour < 10) then TempStr := '0';
   TempStr := TempStr + int_to_str(Hour) + ':';
   If (Min < 10) then TempStr := TempStr + '0'; TempStr := TempStr + int_to_str(Min) + ' ';
   If (Pm = TRUE) then TempStr := TempStr + 'pm  ' ELSE TempStr := TempStr + 'am  ';
   TempStr := TempStr + DayName[Day] + ' ' + MonthName[Month] + ' ';
   If (Date < 10) then TempStr := TempStr + '0' + int_to_str(Date) ELSE TempStr := TempStr + int_to_str(Date);
   TempStr := TempStr + ', ' + int_to_str(Year);
   ExtendedDate := TempStr;
END;
{******************************************************************************}
FUNCTION SeeWords(St : String): Integer;
VAR
   T : String;
   I : Integer;
BEGIN
   T := St;
   I := 1;
    REPEAT
       If (Pos(' ',T) <> 0) then
        BEGIN
           Delete(T,1,Pos(' ',T));
           Inc(I);
        END;
    UNTIL (Pos(' ',T) = 0);
   SeeWords := I;
END;
{******************************************************************************}
FUNCTION PadRight(St: String; Ch: Char; L: Integer): String;
VAR
   I       : Integer;
   TempStr : String;
BEGIN
   TempStr := St;
   If (Length(TempStr) > L) then TempStr[0] := chr(L);
   If (Length(TempStr) < L) then
    BEGIN
       For I := Length(TempStr) + 1 to L do TempStr[I] := Ch;
       TempStr[0] := chr(L);
    END;
   PadRight := TempStr;
END;
{****************************************************************************}
FUNCTION PadLeft(St: String; Ch: Char; L: Integer): String;
VAR
   TempStr : String;
   I       : Word;
BEGIN
   If Length(St) >= L then PadLeft := Copy(St,1,L) ELSE
    BEGIN
       For i := 1 to (L - Length(St)) do TempStr[i] := Ch;
       TempStr[0] := Chr(L - Length(St));
       PadLeft := TempStr + St;
    END;
END;
{****************************************************************************}
Function ExtractFileName(Var Line : String;Index : Integer) : String;

Var
  Temp : String;

Begin
  Delete(Line,Index,1);
  While (Index <= Length(Line)) AND (Line[Index] = ' ')
    Do Delete(Line,Index,1);
  Temp := '';
  While (Index <= Length(Line)) AND (Line[Index] <> ' ') Do
  Begin
    Temp := Temp + Line[Index];
    Delete(Line,Index,1);
  End;
  ExtractFileName := Temp;
End;

Procedure CloseHandle(Handle : Word);

Var
  Regs : Registers;

Begin
  With Regs Do
  Begin
    AH := $3E;
    BX := Handle;
    MsDos(Regs);
  End;
End;

Procedure Duplicate(SourceHandle : Word;Var TargetHandle : Word);

Var
  Regs : Registers;

Begin
  With Regs Do
  Begin
    AH := $45;
    BX := SourceHandle;
    MsDos(Regs);
    TargetHandle := AX;
  End;
End;

Procedure ForceDuplicate(SourceHandle : Word;Var TargetHandle : Word);

Var
  Regs : Registers;

Begin
  With Regs Do
  Begin
    AH := $46;
    BX := SourceHandle;
    CX := TargetHandle;
    MsDos(Regs);
    TargetHandle := AX;
  End;
End;

Procedure Exec(Path,CmdLine : String);

Var
  StdIn   : Word;
  Stdout  : Word;
  Index   : Integer;
  FName   : String[80];
  InFile  : Text;
  OutFile : Text;

  InHandle  : Word;
  OutHandle : Word;
         { ===============>>>> }   { change below for STDERR }
Begin
  StdIn := 0;
  StdOut := 1;                    { change to 2 for StdErr       }
  Duplicate(StdIn,InHandle);      { duplicate standard input     }
  Duplicate(StdOut,OutHandle);    { duplicate standard output    }
  Index := Pos('>',CmdLine);
  If Index > 0 Then               { check for output redirection }
  Begin
    FName := ExtractFileName(CmdLine,Index);  { get output file name  }
    Assign(OutFile,FName);                    { open a text file      }
    Rewrite(OutFile);                         { .. for output         }
    ForceDuplicate(TextRec(OutFile).Handle,StdOut);{ make output same }
  End;
  Index := Pos('<',CmdLine);
  If Index > 0 Then               { check for input redirection }
  Begin
    FName := ExtractFileName(CmdLine,Index);  { get input file name  }
    Assign(InFile,FName);                     { open a text file     }
    Reset(InFile);                            { for input            }
    ForceDuplicate(TextRec(InFile).Handle,StdIn);  { make input same }
  End;
  DOS.Exec(Path,CmdLine);           { run EXEC }
  ForceDuplicate(InHandle,StdIn);   { put standard input back to keyboard }
  ForceDuplicate(OutHandle,StdOut); { put standard output back to screen  }
  CloseHandle(InHandle);            { close the redirected input file     }
  CloseHandle(OutHandle);           { close the redirected output file    }
End;
{****************************************************************************}
FUNCTION Value(I : String): LongInt;
VAR
   N  : LongInt;
   N1 : Integer;
BEGIN
   Val(I, N, N1);
   If (N1 <> 0) then
    BEGIN
       I := Copy(I, 1, N1 - 1);
       Val(I, N, N1)
    END;
   Value := N;
   If (I = '') then Value := 0;
END;
{******************************************************************************}
FUNCTION LeapYear(Yr : Word): Boolean;
BEGIN
   LeapYear := ((Yr MOD 4) = 0) AND (((Yr MOD 100) <> 0) or ((Yr MOD 400) = 0));
END;
{******************************************************************************}
FUNCTION Days(Mo, Yr : Word): Word;
VAR
   D : Word;
BEGIN
   D := MonthDays[Mo];
   If (Mo = 2) and LeapYear(Yr) then Inc(D);
   Days := d;
END;
{******************************************************************************}
FUNCTION DayCount(Mo, Yr : Word): Word;
VAR
   M, T : Word;
BEGIN
   T := 0;
   For M := 1 to (Mo - 1) do T := T + Days(M, Yr);
   DayCount := T;
END;
{******************************************************************************}
FUNCTION ValidMDY(VAR mm, dd, yy : Word; MinYr, MaxYr, DefYr : Word): Boolean;
VAR
   Changed : Boolean;
   MaxD    : Word;
   CurYear : ShortInt;
BEGIN
   ReadTime;
   CurYear := Year - 1900;
   Changed := False;
   If (Mm < 1) or (Mm > 12) then
    BEGIN
       Changed := TRUE;
       Mm := 1;
    END;
   If (Yy < 1900) then Yy := Yy + 1900;
   If (Yy < MinYr) or (Yy > MaxYr) then
    BEGIN
       Changed := TRUE;
       If DefYr <> 0 THEN Yy := DefYr ELSE Yy := CurYear;
    END;
   If (Dd < 1) then
    BEGIN
       Changed := TRUE;
       Dd := 1;
    END;
   If (Dd > 28) then
    BEGIN
       MaxD := Days(mm, yy);
       If (Dd > MaxD) then
        BEGIN
           Changed := TRUE;
           Dd := MaxD;
        END;
    END;
   ValidMDY := NOT Changed;
END;
{******************************************************************************}
FUNCTION DateStToMDY(Dt : String; VAR m, d, Y : Word; MinYr, MaxYr, DefYr : Word): Boolean;
BEGIN
   M := Value(Copy(Dt,1,2));
   D := Value(Copy(Dt,4,2));
   If Copy(Dt,6,1)='ý' then Y := 2000 + Value(Copy(Dt, 7, 2)) ELSE
    Y := 1900 + Value(Copy(Dt, 7, 2));
   DateStToMDY := ValidMDY(m, d, Y, MinYr, MaxYr, DefYr);
END;
{******************************************************************************}
FUNCTION DayNum(Dt : String): Word;
VAR
   D, M, Y, T, C : Word;
BEGIN
   T := 0;
   If DateStToMDY(Dt,m,d,Y,1985,2027,1985) then
    BEGIN
       For C := 1985 to Y - 1 do
        If (LeapYear(C)) then Inc(T,366) ELSE Inc(T,365);
       T := T + DayCount(M,Y) + (D - 1);
    END;
   DayNum := T;
END;
{******************************************************************************}
FUNCTION WordToHex(W : Word): String;
CONST
   Hex : ARRAY [0..15] of Char = '0123456789ABCDEF';
VAR
   H : String[4];
BEGIN
   H[0] := Chr(4);
   H[1] := Hex[(W SHR 12) AND $0F];
   H[2] := Hex[(W SHR 8) AND $0F];
   H[3] := Hex[(W SHR 4) AND $0F];
   H[4] := Hex[W AND $0F];
   WordToHex := H;
END;
{******************************************************************************}
PROCEDURE TNTExitProc;
VAR
   VidSeg                 : Word;
   X, Y                   : Byte;
   C                      : Char;
   S                      : String[80];
   ErrorType, Description : String[128];
   Fil                    : Text;
BEGIN
   If (ErrorAddr <> NIL) then
    BEGIN
       If (ExitCode < 99) then ErrorType := 'DOS error' ELSE
       If (ExitCode < 149) then ErrorType := 'I/O error' ELSE
       If (ExitCode < 199) then ErrorType := 'Critical error' ELSE
        ErrorType := 'Fatal error';
        CASE ExitCode of
             1 : Description := 'Invalid function number';
             2 : Description := 'File not found';
             3 : Description := 'Path not found';
             4 : Description := 'Too many open files';
             5 : Description := 'File access denied';
             6 : Description := 'Invalid file handle';
            12 : Description := 'Invalid file access code';
            15 : Description := 'Invalid drive number';
            16 : Description := 'Cannot remove current directory';
            17 : Description := 'Cannot rename across drives';
            18 : Description := 'No more files';
           100 : Description := 'Disk read error';
           101 : Description := 'Disk write error';
           102 : Description := 'File not assigned';
           103 : Description := 'File not open';
           104 : Description := 'File not open for input';
           105 : Description := 'File not open for output';
           106 : Description := 'Invalid numeric format';
           150 : Description := 'Disk is write-protected';
           151 : Description := 'Unknown unit';
           152 : Description := 'Drive not ready';
           153 : Description := 'Unknown command';
           154 : Description := 'CRC error in data';
           155 : Description := 'Bad drive request structure length';
           156 : Description := 'Disk seek error';
           157 : Description := 'Unknown media type';
           158 : Description := 'Sector not found';
           159 : Description := 'Printer out of paper';
           160 : Description := 'Device write fault';
           161 : Description := 'Device read fault';
           162 : Description := 'Hardware failure';
           200 : Description := 'Division by zero';
           201 : Description := 'Range check error';
           202 : Description := 'Stack overflow error';
           203 : Description := 'Heap overflow error';
           204 : Description := 'Invalid printer operation';
           205 : Description := 'Floating-point overflow';
           206 : Description := 'Floating-point underflow';
           207 : Description := 'Invalid floating-point operation';
           208 : Description := 'Overlay manager not installed';
           209 : Description := 'Overlay file read error';
           210 : Description := 'Object not installed';
           211 : Description := 'Call to abstract method';
           212 : Description := 'Stream registration error';
           213 : Description := 'Collection index out of range';
           214 : Description := 'Collection overflow error';
           215 : Description := 'Arithmetic overflow error';
           216 : Description := 'General protection fault';
        END;
       NL; NL;
       CStrLn('|07Runtime error     : |15'+int_to_str(ExitCode)+'.');
       CStrLn('|07Type of error     : |15'+ErrorType+'.');
       CStrLn('|07Error description : |15'+Description+'.');
       CStrLn('|07Memory address    : |15'+WordToHex(Seg(ErrorAddr^))+':'+WordToHex(Ofs(ErrorAddr^))+'.');
       Assign(Fil,'RUNERROR.LOG');
       {$I-} Append(Fil); {$I+} if (IOResult <> 0) then
        BEGIN
           Rewrite(Fil);
           WriteLn(Fil,'Runtime Error Log');
           WriteLn(Fil,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
           WriteLn(Fil);
           WriteLn(Fil,'Please notify the author of this software immediately of this problem. Be sure');
           WriteLn(Fil,'to attach a copy of this error log file with your message. For information on');
           WriteLn(Fil,'contacting the author, please refer to the documentation.');
           WriteLn(Fil);
           WriteLn(Fil,'A "Û" character in the below screen image(s) indicates the current position of');
           WriteLn(Fil,'the cursor at the time(s) of error.');
        END;
       WriteLn(Fil);
       WriteLn(Fil,'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
       WriteLn(Fil,'Time of error     : ',CoolTime,' on ',CoolDate,'.');
       WriteLn(Fil,'Runtime error     : ',ExitCode,'.');
       WriteLn(Fil,'Type of error     : ',ErrorType,'.');
       WriteLn(Fil,'Error description : ',Description,'.');
       WriteLn(Fil,'Memory address    : '+WordToHex(Seg(ErrorAddr^)),':',WordToHex(Ofs(ErrorAddr^)),'.');
       WriteLn(Fil);
       WriteLn(Fil,'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ[ Start of Screen Capture ]ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
       If (Mem[$0000:$0449] = 7) then VidSeg := $B000 ELSE VidSeg := $B800;
       For Y := 1 to 25 do
        BEGIN
           S := '';
           For X := 1 to 80 do
            BEGIN
               C := Chr(Mem[VidSeg:(160*(Y-1)+2*(X-1))]);
               If (C = #0) then C := #32;
               If (X = WhereX) and (Y = WhereY) then C := #219;
               If (X <> 80) or ((X = 80) and (C <> #32)) then S := S + C;
            END;
           WriteLn(Fil,S);
        END;
       WriteLn(Fil,'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ[ End of Screen Capture ]ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
       Flush(Fil);
       Close(Fil);
       NL;
       CStr('|14[> Pausing for five seconds... ');
       Delay(5000);
       NL;
       ExitProc := TNTExitPtr;
       ErrorAddr := NIL;
    END;
END;
{****************************************************************************}
FUNCTION PakTagDate(S : String): Word;
VAR
   Ecode      : Integer;
   I, M, D, Y : LongInt;
BEGIN
   Ecode := 0;
   Val(Copy(S,1,2),I,Ecode);
   If (Ecode = 0) then M := I ELSE M := 0;
   Val(Copy(S,4,2),I,Ecode);
   If (Ecode = 0) then D := I ELSE D := 0;
   Val(Copy(S,7,2),I,Ecode);
   If (Ecode = 0) then Y := I ELSE Y := 0;
   PakTagDate := (Y SHL 9) + (M SHL 5) + D;
END;
{****************************************************************************}
FUNCTION PakTagTime(S : String): Word;
VAR
   I, Ecode : Integer;
   H, M, Se : LongInt;
BEGIN
   Ecode := 0;
   Val(Copy(S,1,2),I,Ecode);
   If (Ecode = 0) then H := I ELSE H := 0;
   Val(Copy(S,4,2),I,Ecode);
   If (Ecode = 0) then M := I ELSE M := 0;
   Val(Copy(S,7,2),I,Ecode);
   If (Ecode = 0) then Se := I ELSE Se := 0;
   PakTagTime := (H SHL 11) + (M SHL 5) + (Se DIV 2);
END;
{****************************************************************************}
FUNCTION OutDate(KMonth, KDate, KYear : Word): String;
VAR
   I             : Integer;
   TempStr, Temp : String;
BEGIN
   I := KYear - 1900;
   Str(KMonth,TempStr);
   Temp := TempStr + '-';
   Str(KDate,TempStr);
   If KDate < 10 then Temp := Temp + '0' + TempStr + '-' ELSE Temp := Temp + TempStr + '-';
   Str(I,TempStr);
   If I < 10 then Temp := Temp + '0' + TempStr ELSE Temp := Temp + TempStr;
   OutDate := Temp;
END;
{****************************************************************************}
FUNCTION OutTime(KHour, KMin, KSec : Word): String;
VAR
   Temp : String;
   Pm   : Boolean;
BEGIN
   Pm := FALSE;
   If (KHour >= 12) then
    BEGIN
       Pm := TRUE;
       Dec(KHour,12);
    END;
   If (KHour = 0) then Temp := '12:' ELSE Temp := int_to_str(KHour) + ':';
   If (KMin < 10) then Temp := Temp + '0' + int_to_str(KMin) ELSE Temp := Temp + int_to_str(KMin);
   If (Pm = TRUE) then Temp := Temp + 'p' ELSE Temp := Temp + 'a';
   OutTime := Temp;
END;
{****************************************************************************}
FUNCTION StatusBar(Total, Amt : LongInt): String;
CONST
   BarLength = 40;
VAR
   A, B, C, D : LongInt;
   I          : Integer;
   Percent    : Real;
   St, TmpSt  : String;

BEGIN
   If (Total = 0) or (Amt = 0) then
    BEGIN
       StatusBar := '';
       Exit;
    END;
   If (Amt > Total) then Amt := Total;
   Percent := Amt / Total * (BarLength * 10);
   A := Trunc(Percent);
   B := A DIV 10;
   C := 1;
   Percent := Amt / Total * 100;
   D := Trunc(Percent);
   St := ' (' + int_to_str(D) + '%)';
   TmpSt := '';
   TmpSt := PadRight(TmpSt,'Û',B*C) + PadRight(TmpSt,'°',(BarLength-(B*C))) + St;
   StatusBar := TmpSt;
END;
{****************************************************************************}
FUNCTION EraseFiles(Path, Mask : String): Integer;
VAR
   S : SearchRec;

   PROCEDURE KillFile(S : String);
   VAR
      F : File;
   BEGIN
      Assign(F,S);
      {$I-} Erase(F); {$I+}
   END;

BEGIN
   FindFirst(Path + Mask, AnyFile - Directory, S);
   If (DosError = 18) then Exit;
   KillFile(Path + S.Name);
    REPEAT
       FindNext(S);
       If not (DosError = 18) then KillFile(Path + S.Name);
    UNTIL DosError = 18;
   EraseFiles := IOResult;
END;
{****************************************************************************}
BEGIN
   ReadTime;
   TNTExitPtr := ExitProc;    {* Initalizes the error handler... *}
   ExitProc := @TNTExitProc;
   VS := VidSeg;              {* Initalizes the screen capture routines. *}
END.