{
 ßßßßßßßß  ßßßßßß    ßß   ßß
   ßß     ßß   ßß   ßß  ßß
  ßß     ßß   ßßß  ßßßßß  The DoorKit!
 ßß     ßß   ßß   ßß  ßß
ßß     ßßßßßß    ßß    ßß
The BBS Door Development Kit By The People - For The People!


   Feel free to modify or optimize this code at will. All I ask is that if
   find a better way to do things (and you will), please send me a copy of
   your modifications. Thanks in advance!....Larry L. Athey....

   This is the utility unit. This unit contains all of the actual useful
   functions when it comes to dealing with strings and files. All system
   time slicing and OS detection is handled here as well.}

{$A+,B-,D+,E+,F+,G+,I-,L+,N-,O+,P-,Q-,R-,S-,T-,V+,X+}
UNIT DOORKIT2;

INTERFACE

USES _EXIT, DOS;

{Ä--[Headers]-ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

PROCEDURE FillWord(VAR X; Count : WORD; A : BYTE; C : CHAR);
{^ Just like FillChar, except you give it 2 bytes to use for the fill.
   This is also a 16 Bit procedure, unlike the 8 Bit fillchar TP uses.
   This is useful for filling in a text screen.}
FUNCTION IsOlder(F1,F2 : STRING) : BOOLEAN;
{^ Is file #1 older than file #2?}
FUNCTION GetFileName(InString : STRING) : STRING;
{^ Takes a full path and file name and returns just the file name.}
FUNCTION GetFilePath(InString : STRING) : STRING;
{^ Takes a full path and file name and returns just the path.}
FUNCTION FSize(Fn : PathStr) : LONGINT;
{^ Returns the size of the file "Fn" in bytes.}
FUNCTION FErase(Fn : PathStr) : BOOLEAN;
{^ Erases the file "Fn" from the hard drive.}
FUNCTION FExist(Fn : PathStr) : BOOLEAN;
{^ Returns true if the file "Fn" exists.}
FUNCTION DExist(Fn : PathStr) : BOOLEAN;
{^ Returns true if the directory "Fn" exists.}
PROCEDURE MakeDir(DirName : STRING);
{^ Like MkDir only checks for the directory's existence first.}
FUNCTION CopyFile(SourceFile,TargetFile : STRING) : BYTE;
{^ Copies SourceFile to TargetFile and returns a result code.}
FUNCTION CommaInt(Number : LONGINT) : STRING;
{^ Inserts commas into a number and returns a string of the number with the
   commas. ie: s:=Commint(1000000); (* s='1,000,000' *) Makes Larger numbers
   easier to read.}
FUNCTION PadLeft(S : STRING; Ch : CHAR; Len : BYTE) : STRING;
{^ Pad the front of the string with CH, up to LEN.}
FUNCTION PadRight(S : STRING; Ch : CHAR; Len : BYTE) : STRING;
{^ Pad the end of the string with CH, up to LEN.}
FUNCTION IStr(N : LONGINT; Pad : BYTE) : STRING;
{^ Converts a number to a string with padding.
   Pad = how many 0's will be padded in front of the string, to make
         the number a certain length. ie: istr(45,3) = '045'}
FUNCTION IntToStr(N : LONGINT) : STRING;
{^ Converts a number to a string with no 0 padding.}
FUNCTION StrToInt(S : STRING) : LONGINT;
{^ Converts a string to a number. If the string is invalid, 0 is returned.}
FUNCTION BooleanToStr(B : BOOLEAN) : STRING;
{^ Does not produce the same "TRUE" "FALSE" as pascal, but "True" "False".}
FUNCTION BoolToStr(B : BOOLEAN) : STRING;
{^ Converts BOOLEANs to Ys and Ns}
FUNCTION StrToBool(S : STRING) : BOOLEAN;
{^ If S[1] = 'Y' Then StrToBool := TRUE Else StrToBool := FALSE;}
FUNCTION NoPath(Txt : STRING) : STRING;
{^ Removes blank spaces and trailing backslash from a directory name.}
FUNCTION FixPath(Txt : STRING) : STRING;
{^ Adds a trailing backslash to a directory name.}
FUNCTION AllCaps(S : STRING) : STRING;
{^ Conerts a string to upper case}
FUNCTION Lower(S : STRING) : STRING;
{^ Converts a string to lower case}
FUNCTION Proper(S : STRING) : STRING;
{^ Converts a string to a properly capitalized string.}
FUNCTION Dup(Ch : CHAR; Times : BYTE) : STRING;
{^ Dups Ch "times" and returns, good for things like: "---------------" }
FUNCTION Center(St : STRING; MaxPlace : BYTE) : STRING;
{^ Center the text string to fit in between MaxPlace.}
FUNCTION StripLead(St : STRING; Ch : CHAR) : STRING;
FUNCTION StripTrail(St : STRING; Ch : CHAR) : STRING;
FUNCTION StripBoth(St : STRING; Ch : CHAR) : STRING;
{^ The above functions will strip characters from the beginning and ends of
   a string. "Ch" is the character you wish to strip.}
FUNCTION IntToHex(Num : LONGINT; Digits : BYTE) : STRING;
{^ Converts an integer value to a hexadecimal string.}
FUNCTION HexToInt(HexStr : STRING) : LONGINT;
{^ Converts a hexadecimal string to integer value.}
PROCEDURE HideCursor;
{^ LOCAL ONLY: turns the cursor off}
PROCEDURE ShowCursor;
{^ LOCAL ONLY: turns the cursor on.}
PROCEDURE SetCursorSize(Top,Bot : BYTE);
{^ LOCAL ONLY: Set the size of the cursor. top=top scanline; bot=bottom
   scanline of cursor. Both in the range of 1..8. (7,8)="normal" cursor,
   (1,8)=block cursor....}
PROCEDURE Log(LogLine : STRING);
{^ Use this if you are using activity logging.}
PROCEDURE Terminate(S : STRING);
{^ Halts the program with the Error String "S".}
PROCEDURE ErrorLog(LogLine : STRING ; ELevel : BYTE ; BailOut : BOOLEAN);
{^ Use this if you are tracking errors in your program. If BailOut is True,
   then the program will terminate immediately after writing to the log.}
FUNCTION CvtVars(Txt : STRING) : STRING;
{^ Converts a string with embedded global system veriables to a translated
   string. You may add/change variables as you see fit.}
FUNCTION DateVariable : STRING;
{^ Returns a nice MM/DD/YY formatted date string.}
FUNCTION TimeVariable : STRING;
{^ Returns a nice ##:##am or ##:##pm formatted time string.}
PROCEDURE SaveScreen;
{^ This saves a text screen to an array in RAM so it can be restored later.}
PROCEDURE RestoreScreen;
{^ This restores the screen you saved with the above command.}
PROCEDURE ShellToDos;
{^ *Just as it says, it shells the program to DOS. This procedure is made
    specifically for door use.}
PROCEDURE DosShell;
{^ * Same as above except this version uses the SaveScreen and
     RestoreScreen procedures. This isn't normally used for doors.}
FUNCTION  LocateFile(FName : STRING) : STRING;
{^ Locates a file in the DOS PATH and returns the full path & file name.}
PROCEDURE _Execute(FName,Params : STRING);
{^ *Runs an external executable/com with no text screen save.}
PROCEDURE Execute(FName,Params : STRING);
{^ *Runs an exteral executable/com with text screen save.}
PROCEDURE _RunBatFile(TheBat : STRING);
{^ *Runs a batch file with no text screen save.}
PROCEDURE RunBatFile(TheBat : STRING);
{^ *Runs a batch file with text screen save.}
{  *NOTE: When these processes run, only a 1.2K footprint of the program
          is left in memory giving you the most RAM for child processes.}
PROCEDURE DetectOS;
{^ Detects what operating system you are running.}
PROCEDURE TimeSlice;
{^ Gives up remaining CPU time to the rest of the OS. This procedure is set
   up in the sReadkey function already, along with a few other procedures.
   You can use it for your own needs as well.}
FUNCTION OSstr : STRING;
{^ Returns a string containing the name of the current Operating System.}
PROCEDURE BeginCritical;
{^ Begins a "Critical" block. After calling this under Multi-Tasking systems,
   the majority of the CPU time will be given to your program, until you call
   "EndCritical". This should be called right before sections of code that
   need your program to be as smooth as possible. (If your not running under
   a Multi-Tasking system, then this does nothing)}
PROCEDURE EndCritical;
{^ Ends a "Critical" block. This should be called after a call has been made
   to "BeginCritical" and your critical section is done. (it does no harm if
   BeginCritical was not called before this). Be sure to call this at some
   point if you do call BeginCritical!  Otherwise you'll probably slow down
   the rest of the system until your door exits.}
PROCEDURE Wait(Seconds : WORD);
{^ Wait a number of seconds. Seconds is not just an approximation like TP's
   Delay procedure. This also does Time Slicing while waiting.}
PROCEDURE SplitUserName;
{^ In some cases you may need to change the DoorSys.UserName....After you do
   that, you will need to refill the UFirst and ULast variables. That's what
   this procedure does for you.}
FUNCTION Translate(InString : STRING) : STRING;
{^ Translates a string of characters of high ASCII to low ASCII.}
FUNCTION AltToNormal(C: CHAR): CHAR;
{^ Converts ALT keypresses to their normal counterpart.}

IMPLEMENTATION

USES CRT, EXEC, TDK_VARS, DOORKIT1, DOORKIT3;

VAR
  Buffer : ARRAY[1..4000] OF BYTE;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE FillWord(VAR X; Count : WORD; A : BYTE; C : CHAR); Assembler;
Asm
  les   di,X
  mov   cx,[Count]
  SHR   cx,1
  mov   al,[C]
  mov   ah,[A]
  rep   stosw
  test  [Count],1 {Just in case you give it an odd count.}
  jz    @END
  stosb
@END :
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION IsOlder(F1,F2 : STRING) : BOOLEAN;
VAR
  DInfo1  : SEARCHREC;
  DInfo2  : SEARCHREC;
  D1      : DATETIME;
  D2      : DATETIME;
  I1      : LONGINT;
  I2      : LONGINT;
BEGIN
  IsOlder := FALSE;
  FINDFIRST(F1,Archive,DInfo1); I1 := DInfo1.Time; UNPACKTIME(I1,D1);
  FINDFIRST(F2,Archive,DInfo2); I2 := DInfo2.Time; UNPACKTIME(I2,D2);
  IF (D1.Year < D2.Year) THEN IsOlder := TRUE;
  IF (D1.Year = D2.Year) AND (D1.Month < D2.Month) THEN IsOlder := TRUE;
  IF (D1.Year = D2.Year) AND (D1.Month = D2.Month) AND (D1.Day < D2.Day) THEN IsOlder := TRUE;
  IF (D1.Month = D2.Month) AND (D1.Day = D2.Day) AND (D1.Year = D2.Year) THEN BEGIN
    IF (D1.Hour < D2.Hour) THEN IsOlder := TRUE;
    IF (D1.Hour = D2.Hour) AND (D1.Min < D2.Min) THEN IsOlder := TRUE;
  END;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION GetFileName(InString : STRING) : STRING;
VAR
  Work : BYTE;
BEGIN
  InString := StripBoth(InString,' ');
  REPEAT
    Work := POS('\',InString);
    IF Work <> 0 THEN DELETE(InString,1,Work);
  UNTIL Work = 0;
  GetFileName := InString;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION GetFilePath(InString : STRING) : STRING;
VAR
  Loop : BYTE;
BEGIN
  InString := StripBoth(InString,' ');
  IF InString[LENGTH(InString)] = '\' THEN
  BEGIN
    GetFilePath := InString;
    EXIT;
  END;
  Loop := LENGTH(InString);
  REPEAT
    DEC(Loop);
  UNTIL ((Loop = 0) OR (InString[Loop] = '\'));
  IF Loop <> 0 THEN DELETE(InString,Loop + 1,LENGTH(InString) - Loop) ELSE InString := '';
  GetFilePath := InString;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION FSize(Fn : PathStr) : LONGINT;
VAR
  F : FILE;
BEGIN
  ASSIGN(F,Fn);
  RESET(F,1);
  IF IORESULT = 0 THEN BEGIN
    FSize := FILESIZE(F);
    CLOSE(F);
  END;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION FErase(Fn : PathStr) : BOOLEAN;
VAR
  F : FILE;
BEGIN
  ASSIGN(F,Fn);
  ERASE(F);
  FErase := IORESULT = 0;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION FExist(Fn : PathStr) : BOOLEAN;
VAR
  DirInfo : SEARCHREC;
BEGIN
  FINDFIRST(Fn,Anyfile - Directory - VolumeID,DirInfo);
  FExist := DOSERROR = 0;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION DExist(Fn : PathStr) : BOOLEAN;
VAR
  OrgDir : PathStr;
BEGIN
  GETDIR(0,OrgDir);
  Fn := NoPath(FExpand(Fn));
  CHDIR(Fn);
  DExist := IORESULT = 0;
  CHDIR(OrgDir);
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE MakeDir(DirName : STRING);
BEGIN
  DirName := NoPath(AllCaps(DirName));
  IF NOT DExist(DirName) THEN MKDIR(DirName);
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION CopyFile(SourceFile,TargetFile : STRING) : BYTE;
{ Return Codes:  0 Successful
                 1 Source and target the same
                 2 Cannot open source
                 3 Unable to create target
                 4 Error during copy }
VAR
  Source,
  Target  : FILE;
  BRead,
  BWrite  : WORD;
  FileBuf : ARRAY[1..2048] OF CHAR;
BEGIN
  SourceFile := StripBoth(SourceFile,' ');
  TargetFile := StripBoth(TargetFile,' ');
  IF SourceFile = TargetFile THEN BEGIN
    CopyFile := 1;
    EXIT;
  END;
  ASSIGN(Source,SourceFile);
  {$I-}RESET(Source,1);{$I+}
  IF IORESULT <> 0 THEN BEGIN
    CopyFile := 2;
    EXIT;
  END;
  ASSIGN(Target,TargetFile);
  {$I-}REWRITE(Target,1);{$I+}
  IF IORESULT <> 0 THEN BEGIN
    CopyFile := 3;
    EXIT;
  END;
  REPEAT
    BLOCKREAD(Source,FileBuf,SIZEOF(FileBuf),BRead);
    BLOCKWRITE(Target,FileBuf,Bread,BWrite);
  UNTIL (BRead = 0) OR (BRead <> BWrite);
  CLOSE(Source);
  CLOSE(Target);
  IF BRead <> BWrite THEN CopyFile := 4 ELSE CopyFile := 0;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION CommaInt(Number : LONGINT) : STRING;
VAR
  NumStr : STRING[15];
  Len    : BYTE;
  I      : BYTE;
BEGIN
  STR(Number,NumStr);
  Len := LENGTH(NumStr);
  I   := Len + 1;
  WHILE (I > 4) AND (I <= Len + 1) DO BEGIN
    DEC(I,3);
    INSERT(',',NumStr,I);
  END;
  CommaInt := NumStr;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION PadRight(S : STRING; Ch : CHAR; Len : BYTE) : STRING;
BEGIN
  WHILE LENGTH(S) < Len DO S := S + Ch;
  PadRight := S;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION PadLeft(S : STRING; Ch : CHAR; Len : BYTE) : STRING;
BEGIN
  WHILE LENGTH(S) < Len DO S := Ch + S;
  PadLeft := S;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION IStr(N : LONGINT; Pad : BYTE) : STRING;
VAR
  St : STRING[20];
BEGIN
  STR(N,St);
  WHILE LENGTH(St) < Pad DO INSERT('0',St,1);
  IStr := St;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION IntToStr(N : LONGINT) : STRING;
VAR
  St : STRING;
BEGIN
  STR(N,St);
  IntToStr := St;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION StrToInt(S : STRING) : LONGINT;
VAR
  L : LONGINT;
  U : INTEGER;
BEGIN
  VAL(S,L,U);
  StrToInt := L;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION BooleanToStr(B : BOOLEAN) : STRING;
BEGIN
  IF B THEN BooleanToStr := 'True' ELSE BooleanToStr := 'False';
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION BoolToStr(B : BOOLEAN) : STRING;
BEGIN
  IF B THEN BoolToStr := 'Y' ELSE BoolToStr := 'N';
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION StrToBool(S : STRING) : BOOLEAN;
BEGIN
  S := StripBoth(S,' ');
  S := AllCaps(S);
  IF POS('Y',S) = 1 THEN StrToBool := TRUE ELSE StrToBool := FALSE;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION NoPath(Txt : STRING) : STRING;
VAR
  Work : BYTE;
BEGIN
  Txt := StripBoth(Txt,' ');
  Txt := StripTrail(Txt,'\');
  NoPath := Txt;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION FixPath(Txt : STRING) : STRING;
VAR
  Loop,EndCh : BYTE;
BEGIN
  Txt := StripBoth(Txt,' ');
  EndCh := LENGTH(Txt);
  FOR Loop := 1 TO LENGTH(Txt) DO Txt[Loop] := UPCASE(Txt[Loop]);
  IF Txt[EndCh] <> '\' THEN Txt := Txt + '\';
  FixPath := Txt;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION AllCaps(S : STRING) : STRING;
VAR
  SLen : BYTE ABSOLUTE S;
  X    : INTEGER;
BEGIN
  FOR X := 1 TO SLen DO S[X] := UpCase(S[X]);
  AllCaps := S;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION Lower(S : STRING) : STRING;
VAR
  SLen : BYTE ABSOLUTE S;
  I    : INTEGER;
FUNCTION LoCase(Ch : CHAR) : CHAR;
BEGIN
  IF (Ch IN ['A'..'Z']) THEN LoCase := CHR(ORD(Ch) + 32) ELSE LoCase := Ch;
END;
BEGIN
  FOR I := 1 TO SLen DO S[I] := LoCase(S[I]);
  Lower := S;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION Proper(S : STRING) : STRING;
VAR
  SLen : BYTE ABSOLUTE S;
  I    : INTEGER;
BEGIN
  S := Lower(S);
  FOR I := 1 TO SLen DO BEGIN
    IF I = 1 THEN S[1] := UPCASE(S[1])
    ELSE IF S[I - 1] = ' ' THEN S[I] := UPCASE(S[I])
    ELSE IF (ORD(S[I - 1]) IN [32..64]) AND (S[I - 1] <> '''')
    THEN S[I] := UPCASE(S[I]);
  END;
  Proper := S;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION Dup(Ch : CHAR; Times : BYTE) : STRING;
VAR
  Temp : STRING;
BEGIN
  FILLCHAR(Temp[1],Times,Ch);
  Temp[0] := CHAR(Times);
  Dup := Temp;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION Center(St : STRING; MaxPlace : BYTE) : STRING;
CONST
  JustChar : CHAR = ' ';
VAR
  Temp : STRING;
  Num  : BYTE;
BEGIN
  Num    := (MaxPlace DIV 2) - (LENGTH(St) DIV 2);
  Temp   := Dup(JustChar,Num);
  Temp   := Temp + St;
  Temp   := Temp + Dup(JustChar,MaxPlace - Num - LENGTH(St));
  Center := Temp;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION StripLead(St : STRING; Ch : CHAR) : STRING;
VAR
  TempStr : STRING;
BEGIN
  TempStr := St;
  WHILE ((TempStr[1] = Ch) AND (LENGTH(TempStr) > 0)) DO TempStr := COPY(TempStr,2,LENGTH(TempStr));
  StripLead := TempStr;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION StripTrail(St : STRING; Ch : CHAR) : STRING;
VAR
  TempStr : STRING;
  I       : INTEGER;
BEGIN
  TempStr := St;
  I := LENGTH(St);
  WHILE ((I > 0) AND (St[I] = Ch)) DO I := I - 1;
  TempStr[0] := CHR(I);
  StripTrail := TempStr;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION StripBoth(St : STRING; Ch : CHAR) : STRING;
BEGIN
  StripBoth := StripTrail(StripLead(St,Ch),Ch);
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION IntToHex(Num : LONGINT; Digits : BYTE) : STRING;
CONST
  HexId : ARRAY[0..$F] OF CHAR = '0123456789ABCDEF';
VAR
  S : STRING;
  C : BYTE;
  N : ARRAY[1..SIZEOF(LONGINT)] OF BYTE ABSOLUTE Num;
BEGIN
  S := '';
  FOR C := 4 DOWNTO 1 DO S := S + HexId[N[C] SHR 4] + HexId[N[C] AND $F];
  IntToHex := COPY(S,8 - Digits + 1,Digits);
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION HexToInt(HexStr : STRING) : LONGINT;
VAR
  I,HexNibble : WORD;
  Temp        : LONGINT;
  Code        : INTEGER;
BEGIN
  Temp   := 0;
  HexStr := AllCaps(HexStr);
  FOR I := LENGTH(HexStr) DOWNTO 1 DO IF NOT (HexStr[I] IN ['0'..'9','A'..'F']) THEN DELETE(HexStr,I,1);
  FOR I := LENGTH(HexStr) DOWNTO 1 DO BEGIN
    IF HexStr[I] IN ['0'..'9'] THEN HexNibble := BYTE(HexStr[I]) - BYTE('0')
                               ELSE HexNibble := BYTE(HexStr[I]) - BYTE('A') + 10;
    INC(Temp,LONGINT(HexNibble) * (1 SHL (4 * (LONGINT(LENGTH(HexStr)) - I))));
  END;
  HexToInt := Temp;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE HideCursor; Assembler;
Asm
  Mov ax,0100h
  Mov cx,2607h
  INT 10h
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE ShowCursor; Assembler;
asm
  Mov ax,0100h
  Mov cx,0506h
  INT 10h
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE SetCursorSize(Top,Bot : BYTE); Assembler;
Asm
  Mov ah,01h
  Mov ch,[Top]
  Mov cl,[Bot]
  INT 10h
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE Log(LogLine : STRING);
VAR
  TheLog : Text;
BEGIN
  IF (NOT UseLog) OR (LogFile = '') THEN EXIT;
  ASSIGN(TheLog,LogPath + LogFile);
  IF NOT FExist(LogPath + LogFile) THEN BEGIN
    REWRITE(TheLog);
    CLOSE(TheLog);
  END;
  APPEND(TheLog);
  IF (LogLine = 'BEGIN') AND (NOT Shotgun) THEN BEGIN
    WRITELN(TheLog,'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
    WRITELN(TheLog,' Activity Log Created By: ' + ProgramName);
    WRITELN(TheLog,'ÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
  END;
  IF (LogLine <> 'BEGIN') AND (LogLine <> 'END') THEN WRITELN(TheLog,'  ' + TimeVariable + ' ³  ' + LogLine);
  IF (ShowLog) AND (LogLine <> 'BEGIN') AND (LogLine <> 'END') THEN WRITELN('  ' + TimeVariable + ' ³  ' + LogLine);
  IF (LogLine = 'END') AND (NOT Shotgun) THEN
     WRITELN(TheLog,'ÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
  CLOSE(TheLog);
  IF (Graphics IN [MAX,RIP]) AND (NOT Local) AND (NOT ShowLog) THEN DVWrite(2,24,15,PadRight(LogLine,' ',78));
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE Terminate(S : STRING);
BEGIN
  TextAttr := 7;
  CLRSCR;
  TextAttr := 12;
  WRITELN(S);
  AlertTones;
  TextAttr := 7;
  DELAY(1000);
  HALT(ErrLevel);
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE ErrorLog(LogLine : STRING ; ELevel : BYTE ; BailOut : BOOLEAN);
VAR
  LogFile : Text;
BEGIN
  ASSIGN(LogFile,LogPath + 'ERROR.LOG');
  IF NOT FExist(LogPath + 'ERROR.LOG') THEN BEGIN
    REWRITE(LogFile);
    WRITELN(LogFile,' Error Log Created By: ' + ProgramName);
    WRITELN(LogFile,'ÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
    CLOSE(LogFile);
  END;
  APPEND(LogFile);
  WRITELN(LogFile,'  ' + TimeVariable + ' ³  ' + LogLine);
  IF BailOut THEN WRITELN(LogFile,'  ' + TimeVariable + ' ³  Exiting At ErrorLevel ' + IntToStr(ELevel));
  CLOSE(LogFile);
  ErrLevel := ELevel;
  IF BailOut THEN Terminate(LogLine);
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION CvtVars(Txt : STRING) : STRING;
VAR
  Loop   : BYTE;
  Count  : BYTE;
  LStart : BOOLEAN;
  LPad   : BOOLEAN;
  RStart : BOOLEAN;
  RPad   : BOOLEAN;
  Cvt    : BOOLEAN;
  Parm   : STRING;
  Temp   : STRING;
BEGIN
  Cvt    := FALSE;
  LStart := FALSE;
  RStart := FALSE;
  LPad   := FALSE;
  RPad   := FALSE;
  Count  := 0;
  Parm   := '';
  Temp   := '';
  FOR Loop := 1 TO LENGTH(Txt) DO BEGIN
    IF (LStart) AND (Txt[Loop] <> '_') THEN BEGIN
      LStart := FALSE;
      RStart := TRUE;
    END;
    IF Txt[Loop] = '{' THEN BEGIN
      Cvt    := TRUE;
      LStart := TRUE;
    END;
    IF NOT Cvt THEN Parm := Parm + Txt[Loop];
    IF (LStart) AND (Txt[Loop] = '_') THEN LPad := TRUE;
    IF (RStart) AND (Txt[Loop] = '_') THEN RPad := TRUE;
    IF (Cvt) THEN BEGIN
      INC(Count);
      IF ((LStart) AND (Txt[Loop] <> '_')) OR ((RStart) AND (Txt[Loop] <> '_')) THEN Temp := Temp + Txt[Loop];
    END;
    IF Txt[Loop] = '}' THEN BEGIN
      IF Temp = '{TIME}'     THEN Temp := TimeVariable;
      IF Temp = '{DATE}'     THEN Temp := DateVariable;
      IF Temp = '{NODE}'     THEN Temp := IntToStr(DoorSys.Node);
      IF Temp = '{BAUD}'     THEN Temp := IntToStr(DoorSys.BaudRate);
      IF Temp = '{MINS}'     THEN Temp := IntToStr(DoorSys.SecondsLeft DIV 60);
      IF Temp = '{EVENT}'    THEN Temp := IntToStr(DoorSys.Event);
      IF Temp = '{PORT}'     THEN Temp := IntToStr(DoorSys.Comport);
      IF Temp = '{SEC}'      THEN Temp := IntToStr(DoorSys.Access);
      IF Temp = '{BBS}'      THEN Temp := Ctl.BBSname;
      IF Temp = '{USER}'     THEN Temp := DoorSys.UserName;
      IF Temp = '{USER#}'    THEN Temp := IntToStr(DoorSys.UserNumber);
      IF Temp = '{SYSOP}'    THEN Temp := Ctl.SFirst + ' ' + Ctl.SLast;
      IF Temp = '{UFIRST}'   THEN Temp := UFirst;
      IF Temp = '{ULAST}'    THEN Temp := ULast;
      IF Temp = '{SFIRST}'   THEN Temp := Ctl.SFirst;
      IF Temp = '{SLAST}'    THEN Temp := Ctl.SLast;
      IF Temp = '{PROG}'     THEN Temp := ProgramName;
      IF Temp = '{ADDR}'     THEN Temp := Ctl.HexAddr;
      IF Temp = '{IRQ}'      THEN Temp := IntToStr(Ctl.IRQ);
      IF Temp = '{SYSSEC}'   THEN Temp := IntToStr(Ctl.SysSec);
      IF Temp = '{SERIAL}'   THEN Temp := Ctl.SerialNumber;
      IF Temp = '{INSERT1}'  THEN Temp := Insert1;
      IF Temp = '{INSERT2}'  THEN Temp := Insert2;
      IF Temp = '{INSERT3}'  THEN Temp := Insert3;
      IF Temp = '{INSERT4}'  THEN Temp := Insert4;
      IF Temp = '{INSERT5}'  THEN Temp := Insert5;
      IF LPad THEN Temp := PadLeft(Temp,' ',Count);
      IF RPad THEN Temp := PadRight(Temp,' ',Count);
      Parm   := Parm + Temp;
      Temp   := '';
      Cvt    := FALSE;
      LStart := FALSE;
      RStart := FALSE;
      LPad   := FALSE;
      RPad   := FALSE;
      Count  := 0;
    END;
  END;
  IF (Cvt) AND (Loop = LENGTH(Txt)) THEN Parm := Parm + Temp;
  CvtVars := Parm;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION DateVariable : STRING;
VAR
  Mo,
  Da,Yr      : STRING[4];
  Year,Month,
  Day,Dow    : WORD;
BEGIN
  GETDATE(Year,Month,Day,Dow);
  STR(Year,Yr); DELETE(Yr,1,2);
  STR(Month,Mo);
  IF Month < 10 THEN Mo := '0' + Mo;
  STR(Day,Da);
  IF Day < 10   THEN Da := '0' + Da;
  DateVariable := Mo + '/' + Da + '/' + Yr;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION TimeVariable : STRING;
VAR
  TStr,
  Hr,Mn      : STRING[2];
  Hour,Min,
  Sec,Sec100 : WORD;
BEGIN
  GETTIME(Hour,Min,Sec,Sec100);
  IF Hour < 12 THEN TStr := 'am' ELSE TStr := 'pm';
  IF Hour = 0  THEN Hour := 12;
  IF Hour > 12 THEN Hour := Hour - 12;
  STR(Hour,Hr);
  STR(Min,Mn);
  IF Min < 10  THEN Mn := '0' + Mn;
  IF Min = 0   THEN Mn := '00';
  IF Hour < 10 THEN Hr := ' ' + Hr;
  TimeVariable := Hr + ':' + Mn + TStr;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE SaveScreen;
BEGIN
  MOVE(Mem[$B800:0000],Buffer,4000);
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE RestoreScreen;
BEGIN
  MOVE(Buffer,Mem[$B800:0000],4000);
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE ShellToDos;
VAR
  TheDir : STRING;
BEGIN
  sWriteln(''); sWriteln('');
  IceText('The SysOp Has Shelled To DOS, Please Wait....',FALSE);
  GETDIR(0,TheDir);
  WINDOW(1,1,80,25);
  CLRSCR;
  ShowCursor;
  DeInitComport;
  PutEnv('PROMPT=Type: EXIT and press <ENTER> to return to '+ProgramName+'!$_$p$g');
  Do_Exec(GetEnv('COMSPEC'),' /C ' + GetEnv('COMSPEC'),Use_All,$ffff,TRUE);
  InitComport;
  CLRSCR;
  WINDOW(1,1,80,24);
  ShowStatusBar;
  CHDIR(TheDir);
  sClrScr;
  IceText('The SysOp Has Returned From DOS....',TRUE);
  sWriteln('');
  IceText('Press Any Key To Redraw Screen',FALSE);
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE DosShell;
VAR
  TheDir : STRING;
BEGIN
  SaveScreen;
  GETDIR(0,TheDir);
  WINDOW(1,1,80,25);
  CLRSCR;
  ShowCursor;
  PutEnv('PROMPT=Type: EXIT and press <ENTER> to return to '+ProgramName+'!$_$p$g');
  Do_Exec(GetEnv('COMSPEC'),' /C ' + GetEnv('COMSPEC'),Use_All,$ffff,TRUE);
  CHDIR(TheDir);
  RestoreScreen;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION LocateFile(FName : STRING) : STRING;
VAR
  F : STRING;
BEGIN
  IF NOT FExist(FName) THEN BEGIN
    F := FSearch(FName,GetEnv('PATH'));
    LocateFile := FExpand(F);
    EXIT;
  END ELSE LocateFile := FName;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE _Execute(FName,Params : STRING);
VAR
  TheDir : STRING;
BEGIN
  FName := LocateFile(FName);
  IF FName = '' THEN EXIT;
  GETDIR(0,TheDir);
  Do_Exec(FName,Params,Use_All,$ffff,TRUE);
  CHDIR(TheDir);
  DoorSys.IdleCount := 0;
  UpdateTime;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE Execute(FName,Params : STRING);
VAR
  TheDir : STRING;
BEGIN
  FName := LocateFile(FName);
  IF FName = '' THEN EXIT;
  GETDIR(0,TheDir);
  SaveScreen;
  DeInitComport;
  Do_Exec(FName,Params,Use_All,$ffff,TRUE);
  InitComport;
  RestoreScreen;
  ShowStatusBar;
  CHDIR(TheDir);
  DoorSys.IdleCount := 0;
  UpdateTime;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE _RunBatFile(TheBat : STRING);
VAR
  TheDir : STRING;
BEGIN
  GETDIR(0,TheDir);
  Do_Exec(GetEnv('COMSPEC'),' /C ' + TheBat,Use_All,$ffff,TRUE);
  CHDIR(TheDir);
  DoorSys.IdleCount := 0;
  UpdateTime;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE RunBatFile(TheBat : STRING);
VAR
  TheDir : STRING;
BEGIN
  GETDIR(0,TheDir);
  SaveScreen;
  DeInitComport;
  Do_Exec(GetEnv('COMSPEC'),' /C ' + TheBat,Use_All,$ffff,TRUE);
  InitComport;
  RestoreScreen;
  ShowStatusBar;
  CHDIR(TheDir);
  DoorSys.IdleCount := 0;
  UpdateTime;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE DetectOS; Assembler;
Asm
@CheckDV :
    mov   AX, $2B01
    mov   CX, $4445
    mov   DX, $5351
    INT   $21
    cmp   AL, $FF
    je    @CheckNetwork
    mov   SystemEnv, DV
    jmp   @Done

@CheckNetwork :
    mov   AX, $E400
    INT   $21
    cmp   AL, $00
    je    @CheckWindows
    mov   SystemEnv, Network
    jmp   @Done

@CheckWindows :
    mov   AX, $1600
    INT   $2F
    cmp   AL, $00
    je    @CheckOS2
    cmp   AL, $80
    je    @CheckOS2
    mov   SystemEnv, WIN
    jmp   @Done

@CheckOS2 :
    mov   AX, $3001
    INT   $21
    cmp   AL, $0A
    je    @InOS2
    cmp   AL, $14
    jne   @CheckDoubleDos
  @InOS2 :
    mov   SystemEnv, OS2
    jmp   @Done

@CheckDoubleDos :
    mov   AX,$7A00
    INT   $2F
    cmp   AL,$FF
    jne   @NoTasker
    mov   SystemEnv, DDOS
    jmp   @Done

@NoTasker :
    mov   SystemEnv, NoTasker

@Done :
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE TimeSlice;
BEGIN
  CASE SystemEnv OF
    NoTasker : Asm INT $28 END;
    DDOS     : Asm mov ax,$EE01; INT $21 END;
    DV       : Asm mov ax,$1000; INT $15 END;
    WIN,OS2  : Asm mov ax,$1680; INT $2F END;
    Network  : Asm mov bx,$000A; INT $7A END;
  END;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION OSstr : STRING;
BEGIN
  CASE SystemEnv OF
    NoTasker  : OsStr := 'DOS / No Multi-Tasker';
    DDOS      : OsStr := 'Double-Dos';
    DV        : OsStr := 'DesqView';
    WIN       : OsStr := 'MS Windows';
    OS2       : OsStr := 'IBM OS/2';
    Network   : OsStr := 'Network';
  END;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE BeginCritical; Assembler;
Asm
  cmp   SystemEnv, DV
  je    @DVCrit
  cmp   SystemEnv, DDOS
  je    @DoubleDOSCrit
  cmp   SystemEnv, WIN
  je    @WinCrit
  jmp   @EndCrit

@DVCrit :
  mov   AX,$101B
  INT   $15
  jmp   @EndCrit

@DoubleDOSCrit :
  mov   AX,$EA00
  INT   $21
  jmp   @EndCrit

@WinCrit :
  mov   AX,$1681
  INT   $2F
  jmp   @EndCrit

@EndCrit :
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE EndCritical; Assembler;
Asm
  cmp   SystemEnv, DV
  je    @DVCrit
  cmp   SystemEnv, DDOS
  je    @DoubleDOSCrit
  cmp   SystemEnv, WIN
  je    @WinCrit
  jmp   @EndCrit

@DVCrit :
  mov   AX,$101C
  INT   $15
  jmp   @EndCrit

@DoubleDOSCrit :
  mov   AX,$EB00
  INT   $21
  jmp   @EndCrit

@WinCrit :
  mov   AX,$1682
  INT   $2F
  jmp   @EndCrit

@EndCrit :
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE Wait;
VAR
  U,Chs,Shs,CurSec,StartSec : WORD;
BEGIN
  GETTIME(U,U,StartSec,Shs);
  WHILE Seconds > 0 DO BEGIN
    REPEAT
      GETTIME(U,U,CurSec,Chs);
      TimeSlice;
      TimeSlice;
    UNTIL (CurSec <> StartSec);
    StartSec := CurSec;
    DEC(Seconds);
  END;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
PROCEDURE SplitUserName;
VAR
  Loop  : BYTE;
  FDone,
  LDone : BOOLEAN;
BEGIN
  UFirst := ''; ULast := ''; FDone := FALSE; LDone := TRUE;
  FOR Loop := 1 TO LENGTH(DoorSys.UserName) DO BEGIN
    IF DoorSys.UserName[Loop - 1] = ' ' THEN BEGIN
      FDone := TRUE;
      LDone := FALSE;
    END;
    IF (NOT FDone) AND (DoorSys.UserName[Loop] <> ' ') THEN UFirst := UFirst + DoorSys.UserName[Loop];
    IF NOT LDone THEN ULast := ULast + DoorSys.UserName[Loop];
  END;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION NewChar(Ch : CHAR) : CHAR;
BEGIN
  CASE Ch OF
    #0         : Ch := ' ';
    #1..#7     : Ch := '@';
    #8         : Ch := '#';
    #9         : Ch := '*';
    #10        : Ch := '#';
    #11..#15   : Ch := '*';
    #16        : Ch := '>';
    #17        : Ch := '<';
    #18..#21   : Ch := '!';
    #22        : Ch := '*';
    #23..#25   : Ch := '!';
    #26        : Ch := '>';
    #27        : Ch := '<';
    #28        : Ch := '+';
    #29..#31   : Ch := '^';
    #128       : Ch := 'C';
    #129       : Ch := 'u';
    #130       : Ch := 'e';
    #131..#134 : Ch := 'a';
    #135       : Ch := 'c';
    #136..#138 : Ch := 'e';
    #139..#141 : Ch := 'i';
    #142..#143 : Ch := 'A';
    #144       : Ch := 'E';
    #145       : Ch := 'a';
    #146       : Ch := 'A';
    #147..#149 : Ch := 'o';
    #150..#151 : Ch := 'u';
    #152       : Ch := 'y';
    #153       : Ch := 'O';
    #154       : Ch := 'U';
    #155       : Ch := 'c';
    #156       : Ch := 'L';
    #157       : Ch := 'Y';
    #158       : Ch := 'P';
    #159       : Ch := 'f';
    #160       : Ch := 'a';
    #161       : Ch := 'i';
    #162       : Ch := 'o';
    #163       : Ch := 'u';
    #164       : Ch := 'n';
    #165       : Ch := 'N';
    #166       : Ch := 'a';
    #167       : Ch := 'o';
    #168       : Ch := '?';
    #169..#170 : Ch := '+';
    #171       : Ch := '2';
    #172       : Ch := '4';
    #173       : Ch := '!';
    #174       : Ch := '<';
    #175       : Ch := '>';
    #176..#178 : Ch := '#';
    #179..#182 : Ch := '|';
    #183..#184 : Ch := '+';
    #185..#186 : Ch := '|';
    #187..#192 : Ch := '+';
    #193..#194 : Ch := '-';
    #195       : Ch := '|';
    #196       : Ch := '-';
    #197       : Ch := '+';
    #198..#199 : Ch := '|';
    #200..#201 : Ch := '+';
    #202..#203 : Ch := '-';
    #204       : Ch := '|';
    #205       : Ch := '-';
    #206       : Ch := '+';
    #207..#210 : Ch := '-';
    #211..#218 : Ch := '+';
    #219..#223 : Ch := '#';
    #224       : Ch := 'a';
    #225       : Ch := 'B';
    #226       : Ch := 'T';
    #227       : Ch := 'n';
    #228       : Ch := 'E';
    #229       : Ch := 'o';
    #230       : Ch := 'u';
    #231       : Ch := 't';
    #232       : Ch := 'o';
    #233..#237 : Ch := 'O';
    #238       : Ch := 'E';
    #239       : Ch := 'N';
    #240       : Ch := '=';
    #241       : Ch := '+';
    #242       : Ch := '>';
    #243       : Ch := '<';
    #244..#245 : Ch := '!';
    #246       : Ch := '/';
    #247       : Ch := '~';
    #248..#250 : Ch := '.';
    #251       : Ch := '/';
    #252       : Ch := 'n';
    #253       : Ch := '2';
    #254       : Ch := '*';
    #255       : Ch := ' ';
  END;
  NewChar := Ch;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION Translate(InString : STRING) : STRING;
VAR
  Loop : BYTE;
  Ch   : CHAR;
  Temp : STRING;
BEGIN
  Temp := '';
  FOR Loop := 1 TO LENGTH(InString) DO BEGIN
    Ch := InString[Loop];
    IF (Ch > #127) OR (Ch < #32) THEN Ch := NewChar(Ch);
    Temp := Temp + Ch;
  END;
  Translate := Temp;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
FUNCTION AltToNormal(C: CHAR): CHAR;
BEGIN
  CASE C OF
    #30:  AltToNormal := 'A';
    #48:  AltToNormal := 'B';
    #46:  AltToNormal := 'C';
    #32:  AltToNormal := 'D';
    #18:  AltToNormal := 'E';
    #33:  AltToNormal := 'F';
    #34:  AltToNormal := 'G';
    #35:  AltToNormal := 'H';
    #23:  AltToNormal := 'I';
    #36:  AltToNormal := 'J';
    #37:  AltToNormal := 'K';
    #38:  AltToNormal := 'L';
    #50:  AltToNormal := 'M';
    #49:  AltToNormal := 'N';
    #24:  AltToNormal := 'O';
    #25:  AltToNormal := 'P';
    #16:  AltToNormal := 'Q';
    #17:  AltToNormal := 'R';
    #31:  AltToNormal := 'S';
    #20:  AltToNormal := 'T';
    #22:  AltToNormal := 'U';
    #47:  AltToNormal := 'V';
    #17:  AltToNormal := 'W';
    #45:  AltToNormal := 'X';
    #21:  AltToNormal := 'Y';
    #44:  AltToNormal := 'Z';
    #120: AltToNormal := '1';
    #121: AltToNormal := '2';
    #122: AltToNormal := '3';
    #123: AltToNormal := '4';
    #124: AltToNormal := '5';
    #125: AltToNormal := '6';
    #126: AltToNormal := '7';
    #127: AltToNormal := '8';
    #128: AltToNormal := '9';
    #129: AltToNormal := '0';
    ELSE  AltToNormal := C;
  END;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
END.
