home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_PAS / UTIL178.ZIP / UTILITY.DOC < prev    next >
Text File  |  1994-02-26  |  78KB  |  1,500 lines
  1. {
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.  
  9.  
  10.  
  11.  
  12.  
  13.  
  14.  
  15.  
  16.  
  17.  
  18.  
  19.  
  20.  
  21.  
  22.  
  23.                                  Utility 17.8
  24.  
  25.                   Copyright (C) 1990, 1994 by Gemini Systems
  26.  
  27.  
  28.  
  29.  
  30.  
  31.  
  32.  
  33.  
  34.  
  35.  
  36.  
  37.  
  38.  
  39.  
  40.  
  41.  
  42.  
  43.  
  44.  
  45.  
  46.  
  47.  
  48.  
  49.  
  50.  
  51.  
  52.  
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  
  59.  Utility 17.8  (c) Copyright 1994 by Gemini Systems. ALL RIGHTS RESERVED
  60.  
  61.  
  62. ╒════════════════════════════════════════════════════════════════════════╕
  63. │          This UNIT was written for TURBO PASCAL by:                    │
  64. │                                                                        │
  65. │                      Gemini Systems                                    │
  66. │                      7748 Lake Ridge Drive                             │
  67. │                      Waterford, MI 48327                               │
  68. │                                                                        │
  69. │                      BBS Support (810) 360-6407                        │
  70. │                      FAX Support (810) 360-6407 (class 2)              │
  71. │                                                                        │
  72. │  This code is Shareware.  If you use any part of it for more than 10   │
  73. │  days you must register it.  To register, send $10.00 to the above     │
  74. │  address.                                                              │
  75. │                                                                        │
  76. │  To use in your programs, simply state UTILITY in your uses clause and │
  77. │  compile your program with the $V- compiler directive.                 │
  78. │                                                                        │
  79. │  example:      PROGRAM prog_name;                                      │
  80. │                  USES utility;                                         │
  81. ├────────────────────────────────────────────────────────────────────────┤
  82. │ Modification History:                                                  │
  83. │                                                                        │
  84. │      Version Number    Date             Change Made                    │
  85. │  ───────────────────────────────────────────────────────────────────── │
  86. │         14.4         04-09-91         ADDED READ_MONEY AND READ_DIGIT  │
  87. │         14.5         04-10-91         Modified READ_MONEY to allow     │
  88. │                                       number of decimal places.        │
  89. │         14.6         04-14-91         Speed improvements to READ_MONEY │
  90. │         14.7         05-10-91         EventHandler, and BLANKS added.  │
  91. │         14.8         05-18-91         Added Control-Alpha Keys         │
  92. │         14.9         05-19-91         Revised default exit-chars       │
  93. │         15.0         05-28-91         Bug in READ_STR RIGHT & LEFT     │
  94. │         15.1         06-06-91         Bug in PRINTER_READY             │
  95. │         15.2         08-04-91         SetBlink (works with CGA)        │
  96. │         15.3         08-16-91         FW Does not scroll at 80,25      │
  97. │         15.4         10-11-91         Add PackKey & UnPackKey          │
  98. │         15.5         10-18-91         Minor bug in WRITE_DATE          │
  99. │         15.6         10-23-91         Added X_IN & X_OUT               │
  100. │         15.7         10-28-91         Minor speed improvements         │
  101. │         15.8         10-30-91         Add COMMAND_BUFFER               │
  102. │         15.9         11-11-91         Speed up FW                      │
  103. │         16.0         11-21-91         Bug in READCH, GOTOXY POP_MESSAGE│
  104. │         16.1         12-09-91         Add StuffBuffer                  │
  105. │         16.2         03-18-92         Support for B-Tree filer version │
  106. │         16.3         07-24-92         Added DATE_MATH & PAD_CH_LEFT    │
  107. │         16.4         10-20-92         Added DUMP_RECORD & GET_CHOICE   │
  108. │         16.5         11-13-92         Added SCREEN_BLANKER &           │
  109. │                                       ScreenEvent handler              │
  110. │         16.6         11-13-92         Modified for TP & BP v7.0        │
  111. │         16.7         11-30-92         Modified for v7.0 speed          │
  112. │         16.8         01-23-93         Added GSI_DATE & ValidDate       │
  113. │         16.9         03-01-93         Several small bugs               │
  114. │         17.0         03-13-93         Compatibility with USEFILER      │
  115. │         17.1         05-05-93         Added SHIFT_TAB                  │
  116. │         17.3         01-13-94         Added UTILITY.GO command file    │
  117. │         17.4         01-22-94         Modifications to command file    │
  118. │                                       (UTILITY.GO checked at startup   │
  119. │                                       only)                            │
  120. │         17.5         01-24-94         GO file modifications            │
  121. │         17.6         01-25-94         GO file only executed on startup │
  122. │         17.7         02-07-94         Added DynamicPathExec            │
  123. │         17.8         02-09-94         FW If LENGTH(LINE) = 0 FIXED     │
  124. ╘════════════════════════════════════════════════════════════════════════╛
  125.  
  126.  
  127.  
  128. }
  129. UNIT UTILITY;
  130. INTERFACE
  131.   USES CRT, DOS, PRINTER;
  132.  
  133. CONST
  134.   DynamicPathExec: Boolean = True;         { With this variable set to True,
  135.                                              all calls to PATHEXEC first
  136.                                              free all memory from the heap
  137.                                              and restore it on return.    }
  138.   GEMINI_SYSTEMS : STRING[14] = ' ';
  139.   BLANK_MESS     : STRING[19] = '';        { Whatever you put in this field
  140.                                              will appear below the moving
  141.                                              box on the screen_blanker    }
  142.  
  143.   COMMAND_BUFFER : STRING = '';            { If this is <> '' then whenever
  144.                                              you call any of the UTILITY
  145.                                              read procedures, the first
  146.                                              character of this string will
  147.                                              be returned instead of keyboard
  148.                                              input.                           }
  149.  
  150.   VERSION : STRING[15] = 'UTILITY 17.8';   { Reset in Application if Desired   }
  151.                                            { Example:    VERSION := 'V1.0';    }
  152.   RESET_CURSOR : BOOLEAN = TRUE;           { Cursor will be reset to normal    }
  153.                                            { at exit of program if left TRUE   }
  154.  
  155.   ENTER_KEY  : STRING[3] = CHR(17)+CHR(196)+CHR(217);
  156.                           { The Symbol for Enter Key }
  157.  
  158.   BTfiler    : STRING[15] = ''; { Internal use - do not use or change }
  159.   HELP_ATTR  : BYTE = $4F;      { Color used to display help line below   }
  160.   HELP_LINE  : STRING[79] = '  Alt-F10 for Version Number';
  161.                           { If user presses Alt key this line is displayed  }
  162.                           { Set this to '' to de-activate this option       }
  163.  
  164.   HELP_ATTR2 : BYTE = $4F;  { Color used to display help line below         }
  165.   HELP_LINE2 : STRING[79] = '  No Control Keys defined';
  166.                           { If user presses CtrL key this line is displayed }
  167.                           { Set this to '' to de-activate this option       }
  168.  
  169.   EventHandler : POINTER = NIL;   { Set this pointer to the address of any
  170.                                     procedure and that procedure will be
  171.                                     called after every keypress handled
  172.                                     by any of the read commands in this
  173.                                     utility.  THIS PROCEDURE MUST BE
  174.                                     COMPILED WITH THE $F+ DIRECTIVE.   }
  175.  
  176.   SCREEN_BLANKER : LONGINT = 0;   { Set this value to the number of seconds
  177.                                     before the built in screen blanker
  178.                                     kicks in.  A 0 value deactivates the
  179.                                     screen blanker }
  180.   ScreenEvent    : POINTER = NIL; { Set this pointer to the address of any
  181.                                     procedure you would like the screen
  182.                                     blanker to call.  This procedure
  183.                                     will be called every ScreenEventTimer
  184.                                     seconds.
  185.                                     THIS PROCEDURE MUST BE COMPILED WITH
  186.                                     THE $f+ DIRECTIVE                     }
  187.   ScreenEventTimer : LONGINT = 300;
  188.                                   { See ScreenEvent                       }
  189.  
  190.   FUNC1    = #127;
  191.   FUNC2    = #128;
  192.   FUNC3    = #129;
  193.   FUNC4    = #130;
  194.   FUNC5    = #131;
  195.   FUNC6    = #132;
  196.   FUNC7    = #133;
  197.   FUNC8    = #134;
  198.   FUNC9    = #135;
  199.   FUNC10   = #136;
  200.   FUNC11   = #137;
  201.   FUNC12   = #138;
  202.   AF1      = #139;   { ALT-F1 }
  203.   AF2      = #140;
  204.   AF3      = #141;
  205.   AF4      = #142;
  206.   AF5      = #143;
  207.   AF6      = #144;
  208.   AF7      = #145;
  209.   AF8      = #146;
  210.   AF9      = #147;
  211.   AF10     = #148;
  212.   AF11     = #149;  { Future Use Only }
  213.   AF12     = #150;  { Future Use Only }
  214.   ALT_A    = #151;
  215.   ALT_B    = #152;
  216.   ALT_C    = #153;
  217.   ALT_D    = #154;
  218.   ALT_E    = #155;
  219.   ALT_F    = #156;
  220.   ALT_G    = #157;
  221.   ALT_H    = #158;
  222.   ALT_I    = #159;
  223.   ALT_J    = #160;
  224.   ALT_K    = #161;
  225.   ALT_L    = #162;
  226.   ALT_M    = #163;
  227.   ALT_N    = #164;
  228.   ALT_O    = #165;
  229.   ALT_P    = #166;
  230.   ALT_Q    = #167;
  231.   ALT_R    = #168;
  232.   ALT_S    = #169;
  233.   ALT_T    = #170;
  234.   ALT_U    = #171;
  235.   ALT_V    = #172;
  236.   ALT_W    = #173;
  237.   ALT_X    = #174;
  238.   ALT_Y    = #175;
  239.   ALT_Z    = #176;
  240.   SHIFT_TAB= #212;
  241.   CF1      = #200;   { CONTROL-F1 }
  242.   CF2      = #201;
  243.   CF3      = #202;
  244.   CF4      = #203;
  245.   CF5      = #204;
  246.   CF6      = #205;
  247.   CF7      = #206;
  248.   CF8      = #207;
  249.   CF9      = #208;
  250.   CF10     = #209;
  251.   CF11     = #210;   { Future Use Only }
  252.   CF12     = #211;   { Future Use Only }
  253.   C_A      = #1;     { CONTROL-A }
  254.   C_B      = #2;
  255.   C_C      = #3;
  256.   C_D      = #4;
  257.   C_E      = #5;
  258.   C_F      = #6;
  259.   C_G      = #7;
  260.   C_H      = #8;
  261.   C_I      = #9;
  262.   C_J      = #10;
  263.   C_K      = #11;
  264.   C_L      = #12;
  265.   C_M      = #13;
  266.   C_N      = #14;
  267.   C_O      = #15;
  268.   C_P      = #16;
  269.   C_Q      = #17;
  270.   C_R      = #18;
  271.   C_S      = #19;
  272.   C_T      = #20;
  273.   C_U      = #21;
  274.   C_V      = #22;
  275.   C_W      = #23;
  276.   C_X      = #24;
  277.   C_Y      = #25;
  278.   C_Z      = #26;
  279.   PGUP     = #178;
  280.   PGDN     = #179;
  281.   UP       = #180;
  282.   DOWN     = #181;
  283.   LEFT     = #191;
  284.   RIGHT    = #192;
  285.   BACKUP   = #194;
  286.   HOMEKEY  = #196;
  287.   ENDKEY   = #197;
  288.   INSKEY   = #198;
  289.   DELKEY   = #199;
  290.   BACKSPACE= #8;
  291.   TAB      = #9;
  292.   ENTER    = #13;
  293.   RETURN   = #13;
  294.   ESCAPE   = #27;
  295.  
  296. TYPE
  297.   STR2     = STRING [2];
  298.   STR3     = STRING [3];
  299.   STR8     = STRING [8];
  300.   STR16    = STRING [16];
  301.   STR20    = STRING [20];
  302.   STR80    = STRING [80];
  303.   BUFFER   = ARRAY [1..4000] OF CHAR;  { Use for calls to SAVE_SCREEN      }
  304.   BUF160   = ARRAY [1..160]  OF BYTE;  { Use for calls to SAVE_LINE        }
  305.   LINE_SET = SET OF 1..80;             { Use for calls to SET_ATTR         }
  306.   CURTYPE  = (BLOCK,                   { Use for calls to SET_CURSOR       }
  307.               UNDERLINE,
  308.               NONE,
  309.               HALF);
  310.   ETYPE    = SET OF CHAR;
  311.   CTYPE    = SET OF 1..80;
  312.   TYPEN    = (RNUM,LNUM,INUM);
  313.   UT_TYPE  = RECORD
  314.                TIMEX         : INTEGER;
  315.                TIMEY         : INTEGER;
  316.                TIME_TYPE     : CHAR;
  317.                DATEX         : INTEGER;
  318.                DATEY         : INTEGER;
  319.                DATE_TYPE     : CHAR;
  320.                INPUT_ATTR    : BYTE;
  321.                DEFAULT_ATTR  : BYTE;
  322.                COMPILED_DATE : STR8;
  323.                COMPILED_TIME : STRING[5];
  324.                NOCONV        : BOOLEAN;
  325.                EXITCH        : ARRAY [1..255] OF BOOLEAN;
  326.              END;
  327.  
  328. VAR
  329.   CH         : CHAR;                { Global CHAR Variable              }
  330.   NOCONV     : CHAR;                { If included in EXITCH to READSTR  }
  331.                                     { LEFT or RIGHT is not converted to }
  332.                                     { UP or DOWN if in first or last
  333.                                     { position.                         }
  334.   CLEAR      : CHAR;                { If included in EXITCH to READSTR  }
  335.                                     { the value being edited is set to  }
  336.                                     { spaces.                           }
  337.   CGA_PRESENT: BOOLEAN;             { Is TRUE if CGA-ABILITY is Present }
  338.   EGA_PRESENT: BOOLEAN;             { Is TRUE if EGA-ABILITY is Present }
  339.   VGA_PRESENT: BOOLEAN;             { Is TRUE if VGA-ABILITY is Present }
  340.   SHOW_ERROR : BOOLEAN;             { If set to FALSE in Application,   }
  341.                                     { Error Handler is De-Activated.    }
  342.  
  343.   DOS_VER    : STRING [4];          { Contains DOS Version at Startup   }
  344.                                     { i.e.  "6.20"                      }
  345.  
  346.   TIME       : STR8;                { Is set to Current Time at Startup }
  347.   DATE       : STRING[30];          { Is set to Current Date at Startup }
  348.                                     { Date & Time are updated when any  }
  349.                                     { of the following routines are     }
  350.                                     { called:                           }
  351.                                     {     READSTR     Updates Time      }
  352.                                     {     READSTR_BIG Updates Time      }
  353.                                     {     READ_REAL   Updates Time      }
  354.                                     {     READ_INT    Updates Time      }
  355.                                     {     READCHTIME  Updates Time      }
  356.                                     {     WRITE_TIME  Updates Time      }
  357.                                     {     READCHT     Updates Time      }
  358.                                     {     WRITE_DATE  Updates Date      }
  359.   TIM        : LONGINT;             { Is used with START_TIMER at Entry }
  360.                                     { or can be used by application.    }
  361.  
  362.   P          : ^BUFFER;             { Pointer to Video Memory           }
  363.   CUR        : CURTYPE;             { Stores the Current Cursor Shape   }
  364.   DISPLAY    : CHAR;
  365.   NUM_INPUTS : INTEGER;
  366.  
  367.   CHANGED    : BOOLEAN;             { Set to TRUE or FALSE after each     }
  368.                                     { call to:
  369.                                               READSTR
  370.                                               READ_REAL
  371.                                               READ_INT
  372.                                       depending if that value has changed.}
  373.   DOW        : WORD;                { Contains Day-of-Week after a call to
  374.                                       WRITE_DATE                          }
  375.   NOW        : INTEGER;             { After each all to WRITE_TIME this
  376.                                       integer contains the number of minutes
  377.                                       since 12:00 midnight                  }
  378.   TEXTATTR_AT_ENTRY  : BYTE;        { Set to TEXTATTR at entry to program   }
  379.                                     { at exit of program the default colors }
  380.                                     { are reset to whatever this value is   }
  381.   UT                 : UT_TYPE;     { Global variables                      }
  382.  
  383.   X_IN               : INTEGER;     { Cursor position on entry to READ_STR  }
  384.   X_OUT              : INTEGER;     { Cursor position on exit from READ_STR }
  385.  
  386.   GLOBAL             : STRING[15] ABSOLUTE $0000:$04F0;
  387.                                     { This variable acces 16 bytes of memory }
  388.                                     { that are reserved for programmer use.  }
  389.                                     { This location allows one program to    }
  390.                                     { to communicate with another.           }
  391.                                     { If you set this value in one program   }
  392.                                     { you can later read it in any other     }
  393.                                     { and the original value will be there.  }
  394.  
  395. (*════════════════════════════════════════════════════════════════════════*)
  396. PROCEDURE BEEP;
  397.  
  398. (*                                    Nicer than CHR(7).                  *)
  399. (*════════════════════════════════════════════════════════════════════════*)
  400. FUNCTION BLANKS(INSTRING : STRING) : BOOLEAN;
  401.  
  402. {   S : STRING;                       Returns true of the string passed   }
  403. {                                     is blanks.  The Length byte is used }
  404. {   S := '    ';                      and only that many characters are.  }
  405. {   IF S = BLANKS THEN                checked.                            }
  406. {     PROCESS_ROUTINE;                                                    }
  407. (*════════════════════════════════════════════════════════════════════════*)
  408. PROCEDURE BLANK_SCREEN;
  409. {                                     Screen saver type blank screen.     }
  410. {                                     Moving box on screen prompts for    }
  411. {  BEGIN                              <space bar> to return.              }
  412. {    BLANK_SCREEN;                                                        }
  413. {  END;                                                                   }
  414. (*════════════════════════════════════════════════════════════════════════*)
  415. PROCEDURE BLINK_OFF;
  416.  
  417. {                                     If an EGA or VGA card is installed  }
  418. {                                     this call will change the blink     }
  419. {                                     attribute to a high-intensity attr. }
  420. {                                     This allows you to use hi-intensity }
  421. {                                     colors for a background color       }
  422. (*════════════════════════════════════════════════════════════════════════*)
  423. PROCEDURE BLINK_ON;
  424. {                                     If an EGA or VGA card is installed  }
  425. {                                     this call will change the blink     }
  426. {                                     attribute back to normal.  See      }
  427. {                                     BLINK_OFF above.                    }
  428. (*════════════════════════════════════════════════════════════════════════*)
  429. PROCEDURE SET_BORDER(COLOR : INTEGER);
  430.  
  431. {                                     Sets the border to COLOR.           }
  432. (*════════════════════════════════════════════════════════════════════════*)
  433. procedure SetBlink(On : Boolean);
  434.   {-Enable text mode attribute blinking if On is True}
  435. (*════════════════════════════════════════════════════════════════════════*)
  436. FUNCTION SetEnv(NAME, VALUE : STRING) : BOOLEAN;
  437. {                                     Set environment string, returning   }
  438. {                                     true if successful.  This routine   }
  439. {                                     sets the Master Environment, not a  }
  440. {                                     copy of it like most.               }
  441. (*════════════════════════════════════════════════════════════════════════*)
  442. FUNCTION CAPS_ARE_ON : BOOLEAN;
  443.  
  444. {           Returns TRUE if CAPS LOCK is ON.                  }
  445. (*════════════════════════════════════════════════════════════════════════*)
  446. PROCEDURE CAPS_OFF;
  447.  
  448. {           Turns CAPS LOCK KEY off.                          }
  449. (*════════════════════════════════════════════════════════════════════════*)
  450. PROCEDURE CAPS_ON;
  451.  
  452. {           Turns CAPS LOCK KEY on.                           }
  453. (*════════════════════════════════════════════════════════════════════════*)
  454. PROCEDURE CENTER(Y, ATTRIB : INTEGER; LINE : STRING);
  455.  
  456. {                                     Centers LINE on Line y              }
  457. {                                     using ATTRIB for colors.            }
  458. (*════════════════════════════════════════════════════════════════════════*)
  459. PROCEDURE CENTER_PRINT(LINE     : STRING;
  460.                         LEN     : INTEGER;
  461.                     VAR NEXTPOS : INTEGER;
  462.                         CR      : BOOLEAN);
  463.  
  464. {                                     Prints LINE on Printer Centered on  }
  465. {                                     a line LEN characters long.         }
  466. {                                     NEXTPOS returns the cursor position }
  467. {                                     off the print head. Set CR to True  }
  468. {                                     to issue a WRITELN or False to issue}
  469. {                                     a WRITE.                            }
  470. (*════════════════════════════════════════════════════════════════════════*)
  471. PROCEDURE CLEAR_BUFFER(VAR SCREEN : BUFFER;
  472.                          ATTR : INTEGER);
  473.  
  474. {                                     Clears a BUFFER variable to spaces   }
  475. {                                     with the screen attributes ATTR     }
  476. (*════════════════════════════════════════════════════════════════════════*)
  477. FUNCTION COMBINE(S1, S2 : STRING;
  478.                     MAX : INTEGER;
  479.            INSERT_COMMA : BOOLEAN) : STRING;
  480. {                                                                         }
  481. {    S1 := 'Tom         ';                                                }
  482. {    S2 := 'Hunter      ';                                                }
  483. {    WRITELN(COMBINE(S2,S1,20,TRUE));                                     }
  484. {                                                                         }
  485. {      Result:                         Combines the two variables S1 & S2 }
  486. {         Hunter, Tom                  removing trailing blanks from S1.  }
  487. {                                      If passed TRUE it will insert a    }
  488. {                                      comma between the two variables.   }
  489. {                                      Will always return a string MAX    }
  490. {                                      characters in length.              }
  491. (*════════════════════════════════════════════════════════════════════════*)
  492. FUNCTION  COMMA(VAR VALUE; FIELDWIDTH,
  493.                                 PLACES : INTEGER;
  494.                                  NTYPE : TYPEN) : STRING;
  495.  
  496.  
  497. {        WRITE(COMMA(R,I,J,RNUM));       Will take the real value  }
  498. {                                        R and return a string I   }
  499. {        R := 1234567.89                 characters long with J    }
  500. {        WRITE(COMMA(R,12,2,RNUM));      decimal places.           }
  501. {                                                                  }
  502. {          Result:                                                 }
  503. {            1,234,567.89                RNUM for REAL Numbers     }
  504. {                                        INUM for INTEGER Numbers  }
  505. {                                        LNUM for LONGINT Numbers  }
  506. {                                                                  }
  507. (*════════════════════════════════════════════════════════════════════════*)
  508. FUNCTION DATE_MATH(DT : STR8; NUM : INTEGER) : STR8;
  509. {                                                                           }
  510. {                                     Adds NUM to DT and returns the date   }
  511. {                                     in the form of MM-DD-YY.  DT must     }
  512. {                                     also be in the form MM-DD-YY.  If     }
  513. {                                     NUM is negative it subtracts days.    }
  514. (*════════════════════════════════════════════════════════════════════════*)
  515. FUNCTION DATE_TIME_KEY : STR16;
  516.  
  517. {                                     Returns a string in the form of:      }
  518. { 1990022013211222                    YYYYMMDDHHMMSSHH                      }
  519. {                              YEAR,MONTH,DAY,HOUR,MINURES,SECONDS,HUNDREDS }
  520. {                              See KEY_TO_DATE Function.           }
  521. (*════════════════════════════════════════════════════════════════════════*)
  522. procedure DayWeek(DT : STR8; var DayNum: integer;
  523.                   var DayName: Str3);
  524. {                                                                           }
  525. {                                     Pass this routine a date in the form  }
  526. {                                     of mm-dd-yy, and it will return the   }
  527. {                                     DAYNUM (sun=0, sat=6) and a string    }
  528. {                                     of 3 for the day name (SUN,MON,ETC)   }
  529. (*════════════════════════════════════════════════════════════════════════*)
  530. PROCEDURE DUMP_RECORD(VAR REC;
  531.                           NUM_BYTES   : INTEGER;
  532.                           IDNAME      : STR80;
  533.                           DESTINATION : STR80);
  534.  
  535. { This routine will dump any record to either the screen, printer, or to
  536.   a disk file.  A sample of how to use it follows:
  537.  
  538.        DUMP_RECORD(INFO_REC,SIZEOF(INFO_REC),'Information Record','PRN');
  539.  
  540.   The destination can be set to:   'PRN'      = Printer
  541.                                    'CON'      = Screen
  542.                                    'FILE.TXT' = Any valid DOS filename.
  543.                                    ''         = user will be prompted
  544.                                                 for destination.
  545.  
  546.   If file exists the next dump will be appended to the end of it.
  547.  
  548. }
  549. (*════════════════════════════════════════════════════════════════════════*)
  550. FUNCTION DUP(MASK : CHAR; N : INTEGER) : STRING;
  551.  
  552. {                                     Returns a string N characters long,   }
  553. {                                     with all characters equal to MASK.    }
  554. (*════════════════════════════════════════════════════════════════════════*)
  555. FUNCTION CREATE_NEW_FILE(FILENAME, MESS : STR80) : BOOLEAN;
  556.  
  557. {                                     Displays a message on screen that     }
  558. {                                     says FILENAME is not found and program}
  559. {                                     is being aborted.  Informs user to    }
  560. {                                     contact MESS for information.         }
  561. {                                     Pressing ALT-F1 at this message will  }
  562. {                                     return TRUE, any other key returns    }
  563. {                                     FALSE.                                }
  564. (*════════════════════════════════════════════════════════════════════════*)
  565. PROCEDURE DOWN_SOUND;
  566.  
  567. {           Makes a Sound of Decreasing Pitch.                }
  568. (*════════════════════════════════════════════════════════════════════════*)
  569. FUNCTION DRIVE_READY(DRIVE : CHAR) : BOOLEAN;
  570.  
  571. {    IF DRIVE_READY('A') THEN         Returns TRUE if drive is ready.     }
  572. {      ASSIGN(F,'A:TEST.DTA');                                            }
  573. {                                                                         }
  574. (*════════════════════════════════════════════════════════════════════════*)
  575. FUNCTION  ELAP_TIME(T : LONGINT) : LONGINT;
  576.  
  577. {           ELAP_TIME(TIM);           Will Return the number of seconds }
  578. {                                     that have elapsed since the last  }
  579. {                                     call to START_TIMER with TIM, or  }
  580. {                                     any other LONGINT variable.       }
  581. {                                     See START_TIMER.                  }
  582. (*════════════════════════════════════════════════════════════════════════*)
  583. FUNCTION  ELAP_TIME_STR(TIM : LONGINT) : STRING;
  584.  
  585. {           ELAP_TIME_STR(TIM);       Will Return the amount of time    }
  586. {                                     that have elapsed since the last  }
  587. {                                     call to START_TIMER with TIM, or  }
  588. {                                     any other LONGINT variable.       }
  589. {                                     The returned string will be in the}
  590. {                                     form of:
  591. {                                     2 days, 11 hrs, 12 mins, 21 sec   }
  592. {                                                                       }
  593. {                                     Leading numbers will not be shown }
  594. {                                     if they are zero.                 }
  595. {                                                                       }
  596. {                                     If a timer is left running for    }
  597. {                                     25 years, the longest string that }
  598. {                                     would be returned would be 35     }
  599. {                                     characters in length.             }
  600. {                                     (Always PADDED to 35 chars.)      }
  601. (*════════════════════════════════════════════════════════════════════════*)
  602. PROCEDURE ENCRYPT(VAR LINE : STRING; I : INTEGER);
  603.  
  604. {                                     Encrypts a string using I as a key.  }
  605. {                                     See UN_ENCRYPT                       }
  606. (*════════════════════════════════════════════════════════════════════════*)
  607. FUNCTION FILE_EXIST(FILENAME : STRING) : BOOLEAN;
  608.  
  609. (*                                     Returns True if File exists or
  610.                                        false if it does not.              *)
  611. (*                                     Can be used on any type File.      *)
  612. (*════════════════════════════════════════════════════════════════════════*)
  613. FUNCTION FILE_OPEN(VAR F) : BOOLEAN;
  614.  
  615. (*                                     Returns True if File F is Open or
  616.                                        returns False if it is closed.     *)
  617. (*════════════════════════════════════════════════════════════════════════*)
  618. PROCEDURE FILL_SCREEN(X1,Y1,X2,Y2 : INTEGER; CH : CHAR; ATTR : INTEGER);
  619.  
  620. {    FILL_SCREEN(1,1,80,25,'░',$1F);   Fills the section of the screen     }
  621. {                                      definded by X1, Y1, X2, X2 with     }
  622. {                                      character CH, in the text attribute }
  623. {                                      of ATTR.                            }
  624. {                                      $1F = Color 1 for Background Color  }
  625. {                                          and color F (15) for foreground }
  626. (*════════════════════════════════════════════════════════════════════════*)
  627. PROCEDURE FW(X,Y : INTEGER; ATTR : BYTE; LINE : STR80);
  628.  
  629. {        FW(X,Y,$07,S);               Writes the value of string  }
  630. {          or                         S at X,Y with 0 Background  }
  631. {        FW(X,Y,$01,S1+S2+'X');       color and 7 Foreground.     }
  632. {                                     This Procedure Supports     }
  633. {                                     43 line mode. (1 >= Y <= 43 }
  634. {                             $07 = Color 0 for Background Color  }
  635. {                                      and color 7 for foreground }
  636. (*════════════════════════════════════════════════════════════════════════*)
  637. PROCEDURE FWB(VAR SCREEN : BUFFER;
  638.                 X,Y,ATTR : INTEGER;
  639.                 INSTRING : STR80);
  640.  
  641. {                                     Same as FW procedure except it writes}
  642. {                                     INSTRING to a BUFFER variable.      }
  643. (*════════════════════════════════════════════════════════════════════════*)
  644. FUNCTION GET_CHOICE(ATTR1 : BYTE;    { WINDOW Attribute    }
  645.                     ATTR2 : BYTE;    { LIGHT-BAR Attribute }
  646.                     ATTR3 : BYTE;    { Hot-Key Attribute   }
  647.                     TITLE,
  648.                     S1    : STR80;   { Item 1 on the Menu          }
  649.                     P1    : BYTE;    { Hot-Key position in Item 1  }
  650.                     S2    : STR80;
  651.                     P2    : BYTE;
  652.                     S3    : STR80;
  653.                     P3    : BYTE;
  654.                     S4    : STR80;
  655.                     P4    : BYTE;
  656.                     S5    : STR80;
  657.                     P5    : BYTE;
  658.                     S6    : STR80;
  659.                     P6    : BYTE;
  660.                     S7    : STR80;
  661.                     P7    : BYTE;
  662.                     S8    : STR80;
  663.                     P8    : BYTE;
  664.                     S9    : STR80;
  665.                     P9    : BYTE;
  666.                     S10   : STR80;
  667.                     P10   : BYTE) : INTEGER;
  668.  
  669. { Pops up a window allowing selection with lightbar or hotkey.  Returns   }
  670. { an integer corresponding to the item selected.  If escape is pressed    }
  671. { a zero is returned.                                                     }
  672. (*════════════════════════════════════════════════════════════════════════*)
  673. FUNCTION GET_FILE_INFO(FILENAME : STRING) : STR80;
  674.  
  675. {   INSTRING := GET_FILE_INFO('C:\AUTOEXEC.BAT');                         }
  676.  
  677. {                                     Returns a string containing         }
  678. {                                     file size, date, and time.          }
  679. {                                                                         }
  680. {                                     "      345  6/04/90 12:44p"         }
  681. (*════════════════════════════════════════════════════════════════════════*)
  682. FUNCTION GET_FILE_NAME(MASK : STRING; DEL : BOOLEAN) : STRING;
  683.  
  684. {   INSTRING := GET_FILE_NAME('*.*',TRUE);
  685.  
  686. {                                     Pops up a window displaying         }
  687. {                                     filenames matching filespec.        }
  688. {                                     Returns a selected filename         }
  689. {                                     and allows deletions if TRUE.       }
  690. {                                     If <ESC> is pressed, will return a  }
  691. {                                     null string                         }
  692. (*════════════════════════════════════════════════════════════════════════*)
  693. PROCEDURE GOTOXY43(X,Y : INTEGER);
  694.  
  695. {           GOTOXY43(10,43);          This will move the cursor to    }
  696. {                                     10,43 if 43 line mode is active }
  697. {                                     Even in 25 line mode this will  }
  698. {                                     work if y is <= 25              }
  699. (*════════════════════════════════════════════════════════════════════════*)
  700. FUNCTION GSI_DATE(INDATE : STR8; MASK : STR20) : STR80;
  701.                 { INDATE must in format mm/dd/yy
  702.  
  703.                   MASK:
  704.                          DD  = Day in format '01'
  705.                          dd  = Day in format ' 1'
  706.                          D   = Day in format '1'
  707.                          MM  = Month in format '02'
  708.                          mm  = Month in format ' 2'
  709.                          M   = Month in format '2'
  710.                          WW  = Month in word format
  711.                          YY  = Year in format  '1993'
  712.                          yy  = Year in format  '93'
  713.  
  714.                          All other characters in MASK
  715.                          remain unchanged.
  716.                                                          }
  717. (*════════════════════════════════════════════════════════════════════════*)
  718. FUNCTION INT_STR(I,LEN : INTEGER) : STR80;
  719.  
  720. {         INT_STR(2300,6);            This will return a string       }
  721. {                                     "  2300"                        }
  722. (*════════════════════════════════════════════════════════════════════════*)
  723. FUNCTION JULIAN(DT : STR8) : LONGINT;
  724.  
  725. {         JULIAN(DATE)                Returns a LONGINT value that    }
  726. {                                     can be used to calculate the    }
  727. {                                     difference between two dates.   }
  728. {                                     DT must be in the form mm-dd-yy }
  729. (*════════════════════════════════════════════════════════════════════════*)
  730. FUNCTION JulToMDY(JulianDay: longint) : STR8;
  731.  
  732. {         JULTOMDY(LONG)              Returns a DATE in the form of   }
  733. {                                     mm-dd-yy.  See JULIAN.          }
  734. (*════════════════════════════════════════════════════════════════════════*)
  735. FUNCTION KEY_TO_DATE(ST : STRING) : STRING;
  736.  
  737. {                                     Converts a DATE_TIME_KEY back   }
  738. {                                     to a valid date and time.       }
  739. {                                     See DATE_TIME_KEY Function.     }
  740. (*════════════════════════════════════════════════════════════════════════*)
  741. PROCEDURE LINES25;
  742.  
  743. {                                     After a call to LINES43, this   }
  744. {                                     will return you to 25 line mode.}
  745. (*════════════════════════════════════════════════════════════════════════*)
  746. PROCEDURE LINES43;
  747.  
  748. {                                     If EGA card is present this     }
  749. {                                     will put you in 43 line mode.   }
  750. (*════════════════════════════════════════════════════════════════════════*)
  751. FUNCTION LONGINT_STR(I : LONGINT; LEN : INTEGER) : STR80;
  752.  
  753. {     LONGINT_STR(230000,10);            This will return a string       }
  754. {                                     "    230000"                       }
  755. (*════════════════════════════════════════════════════════════════════════*)
  756. FUNCTION NUM_LOCK_IS_ON : BOOLEAN;
  757.  
  758. {           Returns TRUE if NUM-LOCK is ON.                   }
  759. (*════════════════════════════════════════════════════════════════════════*)
  760. PROCEDURE NUM_LOCK_OFF;
  761.  
  762. {           Turns NUM LOCK KEY off.                           }
  763. (*════════════════════════════════════════════════════════════════════════*)
  764. PROCEDURE NUM_LOCK_ON;
  765.  
  766. {           Turns NUM LOCK KEY on.                            }
  767. (*════════════════════════════════════════════════════════════════════════*)
  768. FUNCTION  PAD(S : STRING; LEN : INTEGER) : STRING;
  769.  
  770. {          PAD(S,20);                 Will return S + spaces exactly 20   }
  771. {                                     characters long. Padded with spaces }
  772. {                                     at the end of S.                    }
  773. (*════════════════════════════════════════════════════════════════════════*)
  774. Function PackKey(Dte, Tme : str8) : longint;
  775.  
  776. {                                               See UnPackKey.            }
  777. {  var L : longint;                            Set Parms to '' to         }
  778. {                                              return key for current     }
  779. {     L := PackKey('10-11-91','12:14:22');     date & time.               }
  780. (*════════════════════════════════════════════════════════════════════════*)
  781. FUNCTION  PAD_LEFT(S : STRING; LEN : INTEGER) : STRING;
  782.  
  783. {          PAD_LEFT(S,20);            Will return S + spaces exactly 20   }
  784. {                                     characters long. Padded with spaces }
  785. {                                     at the beginning of S.              }
  786. (*════════════════════════════════════════════════════════════════════════*)
  787. FUNCTION  PAD_CH_LEFT(S : STRING; LEN : INTEGER; CH : CHAR) : STRING;
  788. {         PAD_CH_LEFT(S,20,'A');      Will return 'A's + S exactly 20     }
  789. {                                     characters long. Padded with CH's   }
  790. {                                     at the beginning of S.              }
  791. (*════════════════════════════════════════════════════════════════════════*)
  792. FUNCTION  PAD_CH(S : STRING; LEN : INTEGER; CH : CHAR) : STRING;
  793.  
  794. {          PAD_CH(S,20,'A');          Will return S + CH's   exactly 20   }
  795. {                                     characters long.  S will be padded  }
  796. {                                     with 'A's until it is 20 characters }
  797. {                                     in length.                          }
  798. (*════════════════════════════════════════════════════════════════════════*)
  799. PROCEDURE PATHEXEC(COMMAND : PATHSTR; PARMS : STRING);
  800.  
  801. {                                     Future use only                     }
  802. (*════════════════════════════════════════════════════════════════════════*)
  803. PROCEDURE POP_WINDOW(X1,Y1,X2,Y2 : INTEGER; STYLE : INTEGER; ATTR : BYTE);
  804.  
  805. {                                     Pops up a Window.  The window size  }
  806. {                                     is determined by X1,Y1,X2,Y2.       }
  807. {                                     These parameters work exactly as    }
  808. {                                     the window command in Turbo Pascal. }
  809. {                                                                         }
  810. {                                     If STYLE is set to 0, there will be }
  811. {                                     no border around the window.  If it }
  812. {                                     is set to 1 there will be a single  }
  813. {                                     line border.  If it is set to 2     }
  814. {                                     the border will be a double line.   }
  815. {                                     0,1,2 will place a shadow at bottom }
  816. {                                     and right side.                     }
  817. {                                                                         }
  818. {                                     If STYLE is set to 10, there will be }
  819. {                                     no border around the window.  If it  }
  820. {                                     is set to 11 there will be a single  }
  821. {                                     line border.  If it is set to 12     }
  822. {                                     the border will be a double line.    }
  823. {                                     10,11,12 will not place a shadow.    }
  824. {                                                                         }
  825. {                                     ATTR is the color attribute of the  }
  826. {                                     window.                             }
  827. (*════════════════════════════════════════════════════════════════════════*)
  828. PROCEDURE POP_MESSAGE(        X,Y : INTEGER;
  829.                      BORDER, ATTR : BYTE;
  830.                             MATTR : BYTE;
  831.                           MESSAGE : STR80);
  832.  
  833. {                                    Pops a window at X,Y around MESSAGE  }
  834. {                                    If X is set to 0, the window is      }
  835. {                                    centered on the screen horizontally  }
  836. {                                    X,Y = Upper Left Corner of window    }
  837. {                                    BORDER = (See POP_WINDOW)            }
  838. {                                    ATTR   = Color of border             }
  839. {                                    MATTR  = Color of MESSAGE            }
  840. {                                    MESSAGE = Message to be displayed    }
  841. (*════════════════════════════════════════════════════════════════════════*)
  842. PROCEDURE POP_WINDOW_TITLE(   X,Y,X1,Y1 : INTEGER;
  843.                            BORDER, ATTR : BYTE;
  844.                                   TATTR,
  845.                                      TY : BYTE;
  846.                                   TITLE : STR80);
  847.  
  848. {                                     Pops a window (X,Y,X1,Y1) same as   }
  849. {                                     POP_WINDOW.  TITLE will be centered }
  850. {                                     based on the window width, on line  }
  851. {                                     TY in the color of TATTR.           }
  852. (*════════════════════════════════════════════════════════════════════════*)
  853. PROCEDURE PRINT_SCREEN(X1,Y1,X2,Y2 : INTEGER; EXT : BOOLEAN);
  854.  
  855. {                                                                         }
  856. {    PRINT_SCREEN(1,1,80,25,TRUE);    Prints a section of the screen,     }
  857. {                                     bounded by the coordinates.  The    }
  858. {                                     screen coordinates are the same as  }
  859. {                                     Turbo Pascal's WINDOW procedure.    }
  860. {                                     To print IBM Extended Graphic       }
  861. {                                     characters use TRUE.  FALSE will    }
  862. {                                     print spaces instead of graphics.   }
  863. {                                     The above example would print the   }
  864. {                                     entire screen.                      }
  865. (*════════════════════════════════════════════════════════════════════════*)
  866. FUNCTION  PRINTER_NOT_READY : BOOLEAN;
  867.  
  868. {           Returns TRUE if the Line Printer is not ready.    }
  869. (*════════════════════════════════════════════════════════════════════════*)
  870. FUNCTION PRINTER_READY : BOOLEAN;
  871. {                                                                         }
  872. {    IF PRINTER_READY THEN            If Printer is NOT READY, pops up    }
  873. {      WRITELN(LST,'HELLO WORLD');    a Window, asking for you to ready   }
  874. {                                     it.  Pressing <ESC> returns FALSE.  }
  875. {                                     Turning Print ON, (or if it was     }
  876. {                                     already on) returns TRUE.           }
  877. (*════════════════════════════════════════════════════════════════════════*)
  878. FUNCTION PROGRAM_LOCATION : STRING;
  879. {                                                                          }
  880. {                                     Returns a string containing the      }
  881. {                                     drive and complete pathname of       }
  882. {                                     where the currenly executing program }
  883. {                                     is located.                          }
  884. (*════════════════════════════════════════════════════════════════════════*)
  885. FUNCTION RANDOM_NUMBER(LOW, HIGH : INTEGER) : INTEGER;
  886.  
  887. (*                                     Produces a Random number between
  888.                                        0 and 99.  if LOW is less than 0
  889.                                        or HIGH is greater than 99 will
  890.                                        always return 0.  Do not call this
  891.                                        routine from a loop.  It uses 1/100
  892.                                        of a second from the system clock
  893.                                        to generate the numbers.  If called
  894.                                        from within a loop it will return
  895.                                        a sequence or pattern to its numbers.
  896.                                        Works fine for a ocassional Random
  897.                                        Number.                            *)
  898. (*════════════════════════════════════════════════════════════════════════*)
  899. PROCEDURE READCH(VAR CH : CHAR; ECHO : BOOLEAN);
  900.  
  901. {       READCH(CH,TRUE);          TRUE  for echo on screen.       }
  902. {                                 FALSE for no echo.              }
  903. {                                 If ALT-F10 is pressed it        }
  904. {                                 will call SHOW_VERSION.         }
  905. {                                 If the global var ut.timex      }
  906. {                                 is set to other than 0, the     }
  907. {                                 time is continually updated     }
  908. {                                 on the screen at ut.timex,      }
  909. {                                 ut.timey until a key is pressed }
  910. {                                                                 }
  911. {          also converts F-KEYS to FUNC1..FUNC10, HOMEKEY,        }
  912. {          UP, DOWN, LEFT, RIGHT, ECT.                            }
  913. {                                                                 }
  914. {          READCH(CH,TRUE);                                       }
  915. {          IF CH = FUNC1 THEN CALL_HELP;                          }
  916. (*════════════════════════════════════════════════════════════════════════*)
  917. PROCEDURE READCHT(VAR CH : CHAR; ECHO : BOOLEAN; TOO : LONGINT);
  918.  
  919. {   Waits TOO seconds for a key to be pressed, IF no key is pressed       }
  920. {   within TOO seconds, Routine is exited leaving CH unchanged.           }
  921. {                                                                         }
  922. {   READCHT(CH,FALSE,10);             Waits 10 seconds for a key to be    }
  923. {                                     pressed, If not CH is unchanged.    }
  924. (*════════════════════════════════════════════════════════════════════════*)
  925. PROCEDURE READCHTIME(VAR CH : CHAR; ECHO : BOOLEAN; X,Y : INTEGER);
  926.  
  927. {                                     This routine is for backward     }
  928. {                                     compatibility only.  Use READCH  }
  929. {                                     instead.  By setting the global  }
  930. {                                     vars UT.TIMEX and UT.TIMEY the   }
  931. {                                     time is kept automatically using }
  932. {                                     READCH                           }
  933. {                                                                      }
  934. {                                     Continually Updates TIME at X,Y  }
  935. {                                     until a key is pressed.  That    }
  936. {                                     key is returned in CH.           }
  937. {                                     If CH = 'M' Time will be in      }
  938. {                                     Military Time Format.            }
  939. (*════════════════════════════════════════════════════════════════════════*)
  940. PROCEDURE READ_DIGIT(    X,Y : INTEGER;
  941.                    VAR VALUE;          
  942.                   RIGHT_JUST : INTEGER;
  943.                    LOW, HIGH : LONGINT;
  944.                        NTYPE : TYPEN);
  945.  
  946. {                                     Reads a INT OR A LONGINT value from  }
  947. {                                     input.                               }
  948. {                                     This procedure should be used when   }
  949. {                                     calculator style input is desired.   }
  950. (*════════════════════════════════════════════════════════════════════════*)
  951. PROCEDURE READ_MONEY(X,Y : INTEGER;
  952.                    VAR R : REAL;
  953.                  DPLACES : INTEGER;
  954.               RIGHT_JUST : INTEGER;
  955.                LOW, HIGH : REAL);
  956.  
  957. {                                     Reads a Real value from input.       }
  958. {                                     This procedure should be used when   }
  959. {                                     calculator style input is desired.   }
  960. (*════════════════════════════════════════════════════════════════════════*)
  961. PROCEDURE READ_R(     X,Y : INTEGER;
  962.                     VAR R : REAL;
  963.                       MIN,
  964.                       MAX : REAL;
  965.                    PLACES : INTEGER;
  966.                RIGHT_JUST : INTEGER;
  967.                    ICOMMA : BOOLEAN);
  968.  
  969. {                                     Reads a Real value from input.       }
  970. {                                     This procedure should be used instead}
  971. {                                     of the old READ_REAL.                }
  972. (*════════════════════════════════════════════════════════════════════════*)
  973. PROCEDURE READ_I(     X,Y : INTEGER;
  974.                     VAR R : INTEGER;
  975.                       MIN,
  976.                       MAX : INTEGER;
  977.                RIGHT_JUST : INTEGER;
  978.                    ICOMMA : BOOLEAN);
  979.  
  980. {                                     Reads a Integer value from input.     }
  981. {                                     This procedure should be used instead }
  982. {                                     of the old READ_INT.                  }
  983. (*════════════════════════════════════════════════════════════════════════*)
  984. PROCEDURE READ_L(     X,Y : INTEGER;
  985.                     VAR R : LONGINT;
  986.                       MIN,
  987.                       MAX : LONGINT;
  988.                RIGHT_JUST : LONGINT;
  989.                    ICOMMA : BOOLEAN);
  990.  
  991. {                                     Reads a LongInt value from intput.    }
  992. (*════════════════════════════════════════════════════════════════════════*)
  993. PROCEDURE READ_INT(X,Y,LEN   : INTEGER;
  994.                     PATTR    : INTEGER;
  995.                     PROMPT   : STR80;
  996.                     IATTR    : INTEGER;
  997.                     VAR R    : INTEGER;
  998.                     LOW,HIGH : INTEGER;
  999.                     EXITCH   : ETYPE;
  1000.                     ICOMA    : BOOLEAN;
  1001.                     TX, TY   : INTEGER;
  1002.                     CH       : CHAR);
  1003. (*
  1004.  
  1005.   This procedure is provided only for backward compatibility.  Use the
  1006.   new procedure READ_I for keyboard in put of integer type variables.
  1007.  
  1008.   WHERE         X  = X Location of where Prompt will start.
  1009.                 Y  = Y Location of where Prompt will start.
  1010.               LEN  = Maximum Length of Field to be input.
  1011.             PATTR  = Color attributes of Prompt.
  1012.            PROMPT  = Prompt that will appear AT X,Y
  1013.             IATTR  = Color attributes of Input Field.
  1014.                 R  = Variable Parameter being Edited.
  1015.               LOW  = Lowest Value Allowed.
  1016.              HIGH  = Highest Value Allowed.
  1017.            EXITCH  = Characters Entered From Keyboard used to Exit Edit.
  1018.             ICOMA  = True for comma insertion, false for no comma.
  1019.               TX,
  1020.               TY   = Location on screen to update time (TX = 0 for
  1021.                      no time)
  1022.               CH   = 'M' for Military Time, else AM/PM
  1023.  
  1024.                   If NOCONV is included in EXITCH then
  1025.                   LEFT or RIGHT is not converted to
  1026.                   UP or DOWN if in first or last
  1027.                   position.
  1028.  
  1029.                   If CLEAR is included in EXITCH then
  1030.                   the value being edited is set to
  1031.                   spaces.
  1032.  
  1033.                   Insert keys & Delete keys are active
  1034.  
  1035. *)
  1036. (*════════════════════════════════════════════════════════════════════════*)
  1037. PROCEDURE READ_ONLY(NAME : STRING);
  1038.  
  1039. {                                     Sets Filename "NAME" to READ-ONLY.}
  1040. (*════════════════════════════════════════════════════════════════════════*)
  1041. PROCEDURE READ_REAL(X,Y,LEN  : INTEGER;
  1042.                     PATTR    : INTEGER;
  1043.                     PROMPT   : STR80;
  1044.                     IATTR    : INTEGER;
  1045.                     VAR R    : REAL;
  1046.                     DPLACES  : INTEGER;
  1047.                     LOW,HIGH : REAL;
  1048.                     EXITCH   : ETYPE;
  1049.                     ICOMA    : BOOLEAN;
  1050.                     TX, TY   : INTEGER;
  1051.                     CH       : CHAR);
  1052. (*
  1053.   This procedure is provided only for backward compatibility.  Use the
  1054.   new procedure READ_R for keyboard in put of real type variables.
  1055.  
  1056.   WHERE         X  = X Location of where Prompt will start.
  1057.                 Y  = Y Location of where Prompt will start.
  1058.               LEN  = Length of Field to be Input.
  1059.             PATTR  = Color Attributes of Prompt.
  1060.            PROMPT  = Prompt that will appear at X,Y
  1061.             IATTR  = Color Attributes of Input Field.
  1062.                 R  = Variable Parameter being Edited.
  1063.           DPLACES  = Number of Decimal Places.
  1064.               LOW  = Lowest Value Allowed.
  1065.              HIGH  = Highest Value Allowed.
  1066.            EXITCH  = Characters Entered From Keyboard Used to Exit Edit.
  1067.             ICOMA  = True for Comma Insertion, False for no commas.
  1068.               TX,
  1069.               TY   = Location on Screen to Update Time (TX = 0 for
  1070.                      no Time.)
  1071.               CH   = 'M' for Military Time, else AM/PM
  1072.  
  1073.                   If NOCONV is included in EXITCH then
  1074.                   LEFT or RIGHT is not converted to
  1075.                   UP or DOWN if in first or last
  1076.                   position.
  1077.  
  1078.                   If CLEAR is included in EXITCH then
  1079.                   the value being edited is set to
  1080.                   spaces.
  1081.  
  1082.                   Insert keys & Delete keys are active
  1083. *)
  1084. (*════════════════════════════════════════════════════════════════════════*)
  1085. FUNCTION READ_SCREEN(X,Y : INTEGER) : CHAR;
  1086.  
  1087. {   CH := READ_SCREEN(10,15);                                             }
  1088. {                                     Returns the character on the screen }
  1089. {                                     at X,Y. (at 10,15 in this case)     }
  1090. (*════════════════════════════════════════════════════════════════════════*)
  1091. PROCEDURE READSTR(X,Y,LEN : INTEGER;
  1092.                     PATTR : INTEGER;
  1093.                    PROMPT : STR80;
  1094.                     IATTR : INTEGER;
  1095.              VAR INSTRING : STR80;
  1096.                     VALID : ETYPE;
  1097.                   CANEDIT : CTYPE;
  1098.                    EXITCH : ETYPE;
  1099.                    XLOC,
  1100.                    YLOC   : INTEGER;
  1101.                    CH1    : CHAR);
  1102. (*
  1103.  
  1104.   WHERE         X  = X Location of Where Prompt will start.
  1105.                 Y  = Y Location of Where Prompt will start.
  1106.               LEN  = Maximum Length of Input Field.
  1107.             PATTR  = Color Attributes of Prompt.
  1108.            PROMPT  = Prompt that will appear at X,Y.
  1109.             IATTR  = Color Attributes of Input Field.
  1110.          INSTRING  = Variable Parameter being Edited.
  1111.             VALID  = Valid Characters that can be entered for Field.
  1112.           CANEDIT  = Which Positions of Field that can be edited.
  1113.            EXITCH  = Characters Entered from Keyboard Used to Exit Edit.
  1114.             XLOC,
  1115.             YLOC   = Location on screen to Update Time (XLOC = 0 for
  1116.                      no time.) Add 100 to XLOC to initialize the
  1117.                      cursor at the end of the input field instead of at
  1118.                      the beginning.
  1119.                      (Add 100 to YLOC for Auto Capitilization of Words)
  1120.                      (Add 200 to YLOC for Auto Caps of all characters )
  1121.              CH1   = 'M' for Military Time, else AM/PM
  1122.  
  1123.  
  1124.       If you are in the first position of a field and press the RIGHT
  1125.       ARROW, CH is converted to UP. If you are in the last position of
  1126.       a field and press RIGHT ARROW, CH is converted to DOWN.
  1127.  
  1128.         UNLESS: If you include NOCONV in your EXITCH, conversion does
  1129.         not take place.  If you are in the first postion of a field,
  1130.         pressing LEFT ARROW will cause you to exit and leave the value
  1131.         of CH set to LEFT.  If you are in the last position of a field
  1132.         pressing RIGHT ARROW will cause you to exit and leave the value
  1133.         CH set to RIGHT.
  1134.  
  1135.         If CLEAR is included in EXITCH then the value being edited is
  1136.         set to spaces.
  1137.  
  1138.         Insert keys & Delete keys are active.
  1139.  
  1140. *)
  1141. (*════════════════════════════════════════════════════════════════════════*)
  1142. PROCEDURE READ_STR(X,Y          : INTEGER;
  1143.                    VAR INSTRING : STR80;
  1144.                    MASK         : STR80);
  1145. (*
  1146.  
  1147.   WHERE         X  = X Location of Where Prompt will start.
  1148.                 Y  = Y Location of Where Prompt will start.
  1149.          INSTRING  = Variable Parameter being Edited.
  1150.              MASK  = Input mask:
  1151.  
  1152.               ' '  Allows any keyboard input at this location.
  1153.               'c'  Same as ' ' except turns on Auto Word Capitalization
  1154.                    for entire string.
  1155.               'y'  Either a 'Y' or an 'N' is allowed in this position.
  1156.                    If lower case is entered it is automatically converted
  1157.                    to uppercase.
  1158.               'A'  Any character is allowed.  Alpha at this location is
  1159.                    converted to uppercase.
  1160.               '0'  Numeric.  Characters 0 thru 9 only are allowed.
  1161.               '1'  Numeric.  Characters 0 thru 9 and ' ' are allowed.
  1162.               '.'  Numeric.  Characters 0 thru 9 and '.' are allowed.
  1163.               '!'  Numeric.  Characters 0 thru 9 and ' ' and '.' are allowed.
  1164.               '+'  Numeric.  Characters 0 thru 9 and ' ' and '.' and '+'
  1165.                    and '-' are allowed.
  1166.               'x'  Restricts this position from being edited.  The cursor
  1167.                    will skip this field.
  1168.  
  1169.               'Any other character in the mask' will be inserted into the
  1170.                input string.
  1171.  
  1172.               Examples:
  1173.  
  1174.                   read_str(30,12,name,'(111)x000-0000');
  1175.  
  1176.                   will initialize positions 1,5 and 10 to :  '(   )    -    ';
  1177.                   will allow spaces or digits for area code.
  1178.                   will allow only digits for number.
  1179.  
  1180. *)
  1181. (*════════════════════════════════════════════════════════════════════════*)
  1182. PROCEDURE READSTR_BIG(X,Y,LEN : INTEGER;
  1183.                         PATTR : INTEGER;
  1184.                        PROMPT : STR80;
  1185.                         IATTR : INTEGER;
  1186.                  VAR INSTRING : STRING;
  1187.                         VALID : ETYPE;
  1188.                       CANEDIT : CTYPE;
  1189.                        EXITCH : ETYPE;
  1190.                        XLOC,
  1191.                        YLOC   : INTEGER;
  1192.                        CH1    : CHAR;
  1193.                        WIN    : INTEGER);
  1194.  
  1195. (*                                     Scrolling string Input.            *)
  1196. (*                                     All parameters are the same as     *)
  1197. (*                                     READSTR except the addition of WIN.*)
  1198. (*                                     WIN is the size of the input field *)
  1199. (*                                     for this input, LEN is the total   *)
  1200. (*                                     possible length of INSTRING.       *)
  1201. (*                                                                        *)
  1202. (*                                     *** CANEDIT is set automaticall    *)
  1203. (*                                         to all positions   ****        *)
  1204. (*                                                                        *)
  1205. (*                                     Insert keys & Delete keys are      *)
  1206. (*                                     active.                            *)
  1207. (*════════════════════════════════════════════════════════════════════════*)
  1208. PROCEDURE READ_WRITE(NAME : STRING);
  1209.  
  1210. {                                     Sets Filename "NAME" to READ-WRITE.}
  1211. (*════════════════════════════════════════════════════════════════════════*)
  1212. FUNCTION REAL_STR(R : REAL; LEN, PLACES : INTEGER) : STR80;
  1213.  
  1214. {      REAL_STR(123.22,10,2);         This would return a string         }
  1215. {                                     "    123.22"                       }
  1216. (*════════════════════════════════════════════════════════════════════════*)
  1217. PROCEDURE REBOOT;
  1218.  
  1219. {                                     Performs a re-boot of the computer }
  1220. (*════════════════════════════════════════════════════════════════════════*)
  1221. PROCEDURE REBUILD_LINE(Y : INTEGER; STR : BUF160);
  1222.  
  1223. {    DEFINE A VARIABLE:                                         }
  1224. {         VAR                                                   }
  1225. {           S : BUF160;                                         }
  1226. {                                                               }
  1227. {          SAVE_LINE(5,S);       Saves Line 5 in S.             }
  1228. {          REBUILD_LINE(5,S);    Restores Line 5 from S.        }
  1229. {                                                               }
  1230. {          This routine saves screen characters and attributes  }
  1231. {                                                               }
  1232. {   CAUTION ! IN 43 LINE MODE, USE ONLY FOR FIRST 25 LINES      }
  1233. (*════════════════════════════════════════════════════════════════════════*)
  1234. PROCEDURE REBUILD_SCREEN(VAR SCREEN : BUFFER);
  1235.  
  1236. {    SEE SAVE_SCREEN                                          }
  1237. {                                                             }
  1238. {   CAUTION ! In 43 Line Mode, Will only Restore top 25 lines.}
  1239. (*════════════════════════════════════════════════════════════════════════*)
  1240. PROCEDURE SAVE_LINE(Y : INTEGER; VAR STR : BUF160);
  1241.  
  1242. {    DEFINE A VARIABLE:                                         }
  1243. {         VAR                                                   }
  1244. {           S : BUF160;                                         }
  1245. {                                                               }
  1246. {          SAVE_LINE(5,S);       Saves Line 5 in S.             }
  1247. {          REBUILD_LINE(5,S);    Restores Line 5 from S.        }
  1248. {                                                               }
  1249. {          This routine saves screen characters and attributes  }
  1250. {                                                               }
  1251. {   CAUTION ! IN 43 LINE MODE, USE ONLY FOR FIRST 25 LINES      }
  1252. (*════════════════════════════════════════════════════════════════════════*)
  1253. PROCEDURE SAVE_SCREEN(VAR SCREEN : BUFFER);
  1254.  
  1255. {    DEFINE A VARIABLE:                                       }
  1256. {         VAR                                                 }
  1257. {           S : BUFFER;                                       }
  1258. {                                                             }
  1259. {          SAVE_SCREEN(S);       Saves Current Screen in S.   }
  1260. {          REBUILD_SCREEN(S);    Restores Screen to S.        }
  1261. {                                                             }
  1262. {   CAUTION ! IN 43 LINE MODE, WILL ONLY SAVE TOP 25 LINES    }
  1263. (*════════════════════════════════════════════════════════════════════════*)
  1264. FUNCTION SCREEN_ATTR(X,Y : INTEGER) : BYTE;
  1265.  
  1266. {   TEXTATTR := SCREEN_ATTR(10,20);                                       }
  1267. {                                     Returns the Screen Color at X,Y.    }
  1268. (*════════════════════════════════════════════════════════════════════════*)
  1269. PROCEDURE SET_ATTR(X : LINE_SET; Y : INTEGER;ATTRIB : BYTE);
  1270.  
  1271. {           SET_ATTR([1..4,10],Y,$07);                        }
  1272.  
  1273. {           Sets the Columns 1 thru 4 and 10 on line Y        }
  1274. {           to  Background Color 0 (BLACK)                    }
  1275. {           and Foreground COLOR 7 (LIGHTGRAY)                }
  1276. {   CAUTION ! Use this only above line 26 if in 43 line mode. }
  1277. {           Leaves text on screen unchanged                   }
  1278. {                         $07 = Color 0 for Background Color  }
  1279. {                                  and color 7 for foreground }
  1280. (*════════════════════════════════════════════════════════════════════════*)
  1281. PROCEDURE SCREEN_ON;
  1282.  
  1283. {                                     Turns the Screen back on after    }
  1284. {                                     it has been turned off with       }
  1285. {                                     SCREEN_OFF                        }
  1286. (*════════════════════════════════════════════════════════════════════════*)
  1287. PROCEDURE SCREEN_OFF;
  1288.  
  1289. {                                     Turns the Screen off to a black   }
  1290. {                                     screen.  Use SCREEN_ON to turn    }
  1291. {                                     it back on .                      }
  1292. (*════════════════════════════════════════════════════════════════════════*)
  1293. PROCEDURE SCROLL_LOCK_ON;
  1294. {                                                                         }
  1295. {           Turns the Scroll Lock key on.                                 }
  1296. (*════════════════════════════════════════════════════════════════════════*)
  1297. PROCEDURE SCROLL_LOCK_OFF;
  1298. {                                                                         }
  1299. {           Turns the Scroll Lock key off.                                }
  1300. (*════════════════════════════════════════════════════════════════════════*)
  1301. FUNCTION SCROLL_LOCK_IS_ON : BOOLEAN;
  1302. {                                                                         }
  1303. {           Returns TRUE if the Scroll Lock Key is on else returns FALSE. }
  1304. (*════════════════════════════════════════════════════════════════════════*)
  1305. PROCEDURE SET_ATTR_BUFFER(VAR SC : BUFFER;
  1306.                                X : LINE_SET;
  1307.                                Y : INTEGER;
  1308.                           ATTRIB : BYTE);
  1309.  
  1310. {           SET_ATTR_BUFFER(SC,[1..4,10],Y,$07);                        }
  1311.  
  1312. {           This routine alters the attributes of a BUFFER    }
  1313. {           screen, not the active video screen.              }
  1314.  
  1315. {           Sets the Columns 1 thru 4 and 10 on line Y        }
  1316. {           to  Background Color 0 (BLACK)                    }
  1317. {           and Foreground COLOR 7 (LIGHTGRAY)                }
  1318. {   CAUTION ! Use this only above line 26 if in 43 line mode. }
  1319. {           Leaves text on screen unchanged                   }
  1320. {                         $07 = Color 0 for Background Color  }
  1321. {                                  and color 7 for foreground }
  1322. (*════════════════════════════════════════════════════════════════════════*)
  1323. PROCEDURE SET_ATTR_BOX(X1,Y1,X2,Y2,ATT : INTEGER);
  1324.  
  1325. (*                                     Sets Screen Attributes of the box
  1326.                                        X1,Y1,X2,Y2 to the Colors of ATT.
  1327.                                        Coordinates are the same as Turbo
  1328.                                        Pascals Window Procedure.          *)
  1329. {                                      Leaves text on screen unchanged     }
  1330. (*════════════════════════════════════════════════════════════════════════*)
  1331. PROCEDURE SET_CURSOR(CURS : CURTYPE);
  1332.  
  1333. {    SET_CURSOR(NONE);          Makes Cursor Invisable.    }
  1334. {    SET_CURSOR(UNDERLINE);     Makes Normal Cursor.       }
  1335. {    SET_CURSOR(BLOCK);         Makes Block Cursor.        }
  1336. {    SET_CURSOR(HALF);          Makes a Half Cursor.       }
  1337.  
  1338. {                               Cursor is returned to      }
  1339. {                               normal on exit of program, }
  1340. {                               unless RESET_CURSOR is set }
  1341. {                               to FALSE                   }
  1342. (*════════════════════════════════════════════════════════════════════════*)
  1343. FUNCTION SHIFT_KEYS(KEY : CHAR) : BOOLEAN;
  1344.  
  1345. {  KEY = 'R' for Right, 'L' for Left, 'C' for Control, 'A' for Alt }
  1346.  
  1347. {  Returns true if key is pressed                                  }
  1348. (*════════════════════════════════════════════════════════════════════════*)
  1349. PROCEDURE SHOW_VERSION;
  1350.  
  1351. {           Displays a Window and the contents of the         }
  1352. {           global variable    VERSION.                       }
  1353. {           Also displays the version of UTILITY your program }
  1354. {           was compiled with.                                }
  1355. {           From any of UTILITY read procedures pressing      }
  1356. {           ALT-F10 will call this routine                    }
  1357. (*════════════════════════════════════════════════════════════════════════*)
  1358. FUNCTION  SPACES(NUM : Word) : STRING;
  1359.  
  1360. {            S := SPACES(25);         Will Initialize the variable S   }
  1361. {                                     to 25 spaces.                    }
  1362. (*════════════════════════════════════════════════════════════════════════*)
  1363. FUNCTION STRIP(ST : STRING; IMBED : BOOLEAN) : STRING;
  1364.  
  1365. {                                     Removes Leading and Trailing      }
  1366. {                                     spaces from a string variable.    }
  1367. {                                     If IMBED is set to true it will   }
  1368. {                                     also removes all but 1 blank      }
  1369. {                                     between words.                    }
  1370. (*════════════════════════════════════════════════════════════════════════*)
  1371. PROCEDURE START_TIMER(VAR T : LONGINT);
  1372.  
  1373. {           START_TIMER(TIM);         Will Start a timer by setting the }
  1374. {                                     value of TIM (or any LONGINT) to  }
  1375. {                                     a time related value.             }
  1376. {                                     By calling ELAP_TIME with this    }
  1377. {                                     same variable, you can tell how   }
  1378. {                                     many seconds has elapsed.         }
  1379. {                                     This routine works accurately     }
  1380. {                                     for over 30 years.                }
  1381. (*════════════════════════════════════════════════════════════════════════*)
  1382. PROCEDURE StuffBuffer(S : STR16);
  1383.  
  1384. {         StuffBuffer('DIR');         Will Stuff S into the keyboard    }
  1385. {                                     buffer, just as if it were        }
  1386. {                                     entered from the keyboard.        }
  1387. (*════════════════════════════════════════════════════════════════════════*)
  1388. PROCEDURE UN_ENCRYPT(VAR LINE : STRING; I : INTEGER);
  1389.  
  1390. {                                     UN-ENCRYPTS A STRING USING I AS KEY.}
  1391. {                                     See ENCRYPT.                        }
  1392.  
  1393. (*════════════════════════════════════════════════════════════════════════*)
  1394. Function UnPackKey(PK : longint) : str20;
  1395.  
  1396. {                                                 See PackKey             }
  1397. {                                                 Returns a string equal  }
  1398. {  write(UnPackKey(L)); ==> 10-10-91 12:14:22     to the Date & Time      }
  1399. {                                                 Packed into L.          }
  1400. (*════════════════════════════════════════════════════════════════════════*)
  1401. FUNCTION  UPPERCASE(S : STRING) : STRING;
  1402.  
  1403. {            S := UPPERCASE(S);       Will Uppercase all Lowercase    }
  1404. {                                     characters in the string S.     }
  1405. (*════════════════════════════════════════════════════════════════════════*)
  1406. PROCEDURE UP_SOUND;
  1407.  
  1408. {           Makes a Sound of Increasing Pitch.                }
  1409. (*════════════════════════════════════════════════════════════════════════*)
  1410. Function ValidDate(INDATE : STR8) : Boolean;
  1411.                 { INDATE must in format mm/dd/yy  }
  1412.  
  1413. {                                     Returns TRUE if INDATE is valid date
  1414.                                       else returns FALSE                   }
  1415. (*════════════════════════════════════════════════════════════════════════*)
  1416. FUNCTION VGA_INSTALLED : BOOLEAN;
  1417.  
  1418. {                                   Returns TRUE if a VGA card is present }
  1419. (*════════════════════════════════════════════════════════════════════════*)
  1420. FUNCTION  WHOAMI : STRING;
  1421.  
  1422. {          S := WHOAMI;               Returns the complete Drive & }
  1423. {                                     Pathname & Filename of the   }
  1424. {       C:\TEST\FILENAME.EXE          program being executed.      }
  1425. (*════════════════════════════════════════════════════════════════════════*)
  1426. PROCEDURE WRITE_DATE(X, Y : INTEGER; WORDS    : CHAR);
  1427.  
  1428. {           WRITE_DATE(X,Y,'W');      Will display the current     }
  1429. {                                     date in words at screen      }
  1430. {                                     location X,Y.                }
  1431. {    If words = 'W'   March 2, 1988                                }
  1432. {    If words = 'D'   Monday April 8, 1991                         }
  1433. {    else             03/02/88                                     }
  1434.  
  1435. {                                     Any character except W or D  }
  1436. {                                     will display it in           }
  1437. {                                     03/02/88 format.             }
  1438. {                                                                  }
  1439. {                                     Also update the Global       }
  1440. {                                     variable DATE to the         }
  1441. {                                     current date.  If X=0        }
  1442. {                                     DATE is updated without      }
  1443. {                                     anything being written       }
  1444. {                                     to the screen.               }
  1445. (*════════════════════════════════════════════════════════════════════════*)
  1446. PROCEDURE WRITE_TIME(X, Y : INTEGER; MILITARY : CHAR);
  1447.  
  1448. {           WRITE_TIME(X,Y,'M');      Will display the current   }
  1449. {                                     time in Military Format    }
  1450. {             14:52                   at screen location  X,Y.   }
  1451. {              2:52 pm                                           }
  1452. {                                     Any Character Except M     }
  1453. {                                     will display time in AM/PM.}
  1454. {                                     The Colon Will Blink.      }
  1455. {                                                                }
  1456. {                                     Also update the Global     }
  1457. {                                     variable TIME to the       }
  1458. {                                     current time.  If X=0      }
  1459. {                                     TIME is updated without    }
  1460. {                                     anything being written     }
  1461. {                                     to the screen.             }
  1462. (*════════════════════════════════════════════════════════════════════════*)
  1463. PROCEDURE WRITE_X80_Y25(CH : CHAR; ATTRIB : INTEGER);
  1464.  
  1465. (*                                     Writes CH at Column 80 on Line 25
  1466.                                        in the Colors of ATTRIB without
  1467.                                        scrolling.                         *)
  1468. (*════════════════════════════════════════════════════════════════════════*)
  1469. FUNCTION _REAL(INSTRING : STRING) : REAL;
  1470.  
  1471. {                                     Returns a REAL value from string.   }
  1472. {                                     Spaces in string are ignored.       }
  1473. (*════════════════════════════════════════════════════════════════════════*)
  1474. FUNCTION _INTEGER(INSTRING : STRING) : INTEGER;
  1475.  
  1476. {                                     Returns an INTEGER value from string.}
  1477. {                                     Spaces in string are ignored.       }
  1478. (*════════════════════════════════════════════════════════════════════════*)
  1479. FUNCTION _LONGINT(INSTRING : STRING) : LONGINT;
  1480.  
  1481. {                                     Returns a LONGINT from a string.     }
  1482. {                                     Spaces in string are ignored.       }
  1483. (*════════════════════════════════════════════════════════════════════════*)
  1484. (*════════════════════════════════════════════════════════════════════════*)
  1485. FUNCTION _WORD(INSTRING : STRING) : WORD;
  1486.  
  1487. {                                     Returns a WORD from a string.       }
  1488. {                                     Spaces in string are ignored.       }
  1489. (*════════════════════════════════════════════════════════════════════════*)
  1490. FUNCTION KEYPRESS : BOOLEAN;
  1491.  
  1492. {                                     Returns TRUE if KEYPRESSED or       }
  1493. {                                     COMMAND_BUFFER <> ''.               }
  1494. (*════════════════════════════════════════════════════════════════════════*)
  1495. PROCEDURE SPECIAL_KEY(VAR CH : CHAR);
  1496.  
  1497. {                                     Used to convert function keys       }
  1498. {                                                                         }
  1499. (*════════════════════════════════════════════════════════════════════════*)
  1500.