Simtel MSDOS 1992 June/SIMTEL_0692.cdr/msdos/catalog/dir405.arc/DIR405.PAS

Pascal/Delphi Source File | 1986-12-04 | 56KB | 1,839 lines

{
                  ╒═════════════════════════════════════════╕
                  │  DIR405.PAS         -         9/14/86   │
                  ╞═════════════════════════════════════════╡
                  │  Written by Wes Meier (76703,747) and   │
                  │  dedicated to the Public Domain.  The   │
                  │  directory read code was written by     │
                  │  Neil J. Rubenking. Fastwrite code by   │
                  │  Marshall Brain.                        │
                  │                                         │
                  │  Modified by Eugene White     12/4/86   │
                  ╘═════════════════════════════════════════╛

 Version history:
 ----------------

   4.00 - 2/25/86. Original Turbo Pascal version. Previous versions in Basic.
   4.01 - 3/15/86. Corrects unwanted "features" in 4.00.
   4.02 - 3/28/86. Adds multiple disk label printout. Cosmetic code changes.
   4.03 - 4/20/86. Adds code to restore the cursor shape to what it was
                   on entry. Thanks to Chris 'Seedy' Dunford.
   4.04 - 9/14/86. Adds Marshall Brain's Fastwrite code.
   4.05 - 12/4/86. Allows ability to change default drive; display total
                   number of files; save default drive in configuration file.
                   Modifications by E. White.
}

{$V- }

Type

  Regtype     = Record
                  Ax,Bx,Cx,Dx,Bp,Si,Di,Ds,Es,Flags : integer
                End;
  HalfRegtype = Record
                  Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh : byte
                End;
  filename_type = string[64];
  files_type = String[16];
  Str255 = String[255];
  Str80 = String[80];
  Time = Record
           Hours,Min,Sec,Hundreths : Byte
         End;
  DOW = (Sun,Mon,Tue,Wed,Thu,Fri,Sat);
  Date = Record
           Month,Day : Byte;
           Year : Integer;
           DayOfWeek : DOW
         End;

Const

{regs is defined as a typed constant in order to get it in the code segment}

  Regs : regtype = (Ax:0;Bx:0;Cx:0;Dx:0;Bp:0;Si:0;Di:0;Ds:0;Es:0;Flags:0);
  Max_Entries = 3500;
  DayName : Array [DOW] Of String[9] = ('Sunday','Monday','Tuesday',
                                        'Wednesday','Thursday','Friday',
                                        'Saturday');
  CurStart = 0;
  CurEnd = 12;
  On = True;
  Off = False;

Var

  SaveRegs   : regtype;
  HalfRegs   : halfregtype absolute regs;
  x,
  y,
  entries,
  fore,back,
  bord,
  fore_hi,
  attrib,
  Start_Line,
  End_Line   : integer;
  filepath   : filename_type;
  files      : Array [0..Max_Entries] of Files_Type;
  ok,
  Reading,
  Sort_Flag,
  List_Dta,
  List_Act   : boolean;
  defaultdrive,
  ch,choice  : char;
  cpi16      : string[20];
  sx,
  sy,
  diskstr,
  disk       : Str255;
  ft                          : text;
  a                           : byte;

Procedure Fastwrite(col,row,attrib:byte;str:str80);
  Begin
    Inline
      ($1E/$1E/$8A/$86/row/$B3/$50/$F6/$E3/$2B/$DB/$8A/$9E/col/
       $03/$C3/$03/$C0/$8B/$F8/$be/$00/$00/$8A/$BE/attrib/
       $8a/$8e/str/$22/$c9/$74/$3e/$2b/$c0/$8E/$D8/$A0/$49/$04/
       $1F/$2C/$07/$74/$22/$BA/$00/$B8/$8E/$DA/$BA/$DA/$03/$46/
       $8a/$9A/str/$EC/$A8/$01/$75/$FB/$FA/$EC/$A8/$01/$74/$FB/
       $89/$1D/$47/$47/$E2/$Ea/$2A/$C0/$74/$10/$BA/$00/$B0/
       $8E/$DA/$46/$8a/$9A/str/$89/$1D/$47/$47/$E2/$F5/$1F);
  End;

Procedure Set_Cursor(x, y : integer);
  var
    result : regtype;

  Begin
    with result do
      Begin
        ax := $100;
        cx := x shl 8 + y;
        intr($10,result)
      End
  End; { Proc Set_Cursor }

 Procedure Cursor(On : boolean);
   Begin
     if On
       then
         Set_Cursor(CurStart,CurEnd)
       else
         Set_Cursor($20,$20)
   End; { Proc Cursor }

Procedure Get_Cursor; { Stores the user's original cursor }

  type
    regs = Record
             ax,bx,cx,dx,bp,si,di,ds,es,flags : integer
           End;

   var
     result : regs;
     cursor : integer;
     mono   : boolean;

   Begin
     with result do
       Begin
         ax := $300;
         Intr($10,result);
         cursor := cx;
         ax := $0f00; { return current vid state in AL }
         Intr($10,result);
         mono := (lo(ax) = 7);
         if (mono and ((cursor = $0067) or (cursor = $0607)))
           then
             cursor := $0b0c;
         Start_line := hi(cursor);
         End_line := lo(cursor)
       End { with }
   End; { Proc Cursor }

Procedure Pad_Left(var x       : Str255;
                       padchar : char;
                       num     : byte);

  var k : byte;

  Begin
    for k := 1 to num do x := padchar + x;
    x := copy(x,length(x) + 1 - num,num)
  End; { Proc Pad_Left }

Procedure Pad_Right(var x       : Str255;
                        padchar : char;
                        num     : byte);
  Begin
    while length(x) < num do x := x + padchar;
    x := copy(x,1,num)
  End; { Proc Pad_Right }

Procedure Locate12;
  Begin
    ClrScr;
    GotoXY(1,12)
  End; { Proc Locate12 }

Procedure Check_Pos;
    Begin
      if WhereX > 70 then WriteLn;
      if WhereY > 23
        then
          Begin
            GotoXY(15,25);
            Write('Press any key to continue (* or Q to quit) ...');
            Repeat Until KeyPressed;
            Read(Kbd,choice);
            choice := UpCase(choice);
            if choice = 'Q' then choice := '*';
            ClrScr;
            GotoXY(1,1)
          End { if }
    End; { Proc Check_Pos }

Procedure AtEnd;
  var c : char;

  Begin
    GotoXY(20,25);
    Write('End of Directory. Press any key to continue ...');
    Repeat Until Keypressed
  End; { Proc AtEnd }

Procedure Get_File;

  type
    Dir_Entry   = Record
                    Reserved : array[1..21] of byte;
                    Attribute: byte;
                    Time, Date, FileSizeLo, FileSizeHi : integer;
                    Name : string[13]
                  End;

 var
   RetCode   : byte;
   Filename  : filename_type;
   Buffer    : Dir_Entry;
   Attribute : byte;

 Procedure CheckNulls;
   var v : integer;

   Begin
     for v := 1 to 12 do
       Begin
         if files[entries][v] = #0 then files[entries][v] := ' '
       End { for v }
   End; { Sub Proc CheckNulls }

 Procedure Disk_Trns_Addr(var Disk_Buf);
   var
     Registers : regtype;

  Begin
    with Registers do
      Begin
        Ax := $1A shl 8;                 { Set disk transfer address to  }
        Ds := seg(Disk_Buf);             { our disk buffer               }
        Dx := ofs(Disk_Buf);
        msdos(Registers)
      End
   End; { Proc Disk_Trns_Addr }

  Procedure Check_Max;
    Begin
      if entries > Max_Entries
        then
          Begin
            WriteLn;
            WriteLn;
            WriteLn(#7,'You have reached the Maximum number of entries!');
            WriteLn('Your DIR.DAT remains intact. You',#39,'ll have to create');
            WriteLn('another DIR.DAT file on a different data disk.');
            WriteLn;
            WriteLn('DIR Halted.');
            Halt
          End { if }
    End; { Proc Check_Max }

  Procedure Find_Next(var Att:byte;
                      var Filename : Filename_type;
                      var Next_RetCode : byte);
    var
      Registers  : regtype;
      Carry_flag : integer;
      N          : byte;

    Begin {Find_Next}
      Buffer.Name := '             ';      { Clear result buffer }
      with Registers do
        Begin
          Ax := $4F shl 8;                 { Dos Find next function }
          MsDos(Registers);
          Att := Buffer.Attribute;         { Set file attribute     }
          Carry_flag := 1 and Flags;       { Isolate the Error flag }
          Filename := '             ';
          if Carry_flag = 1
            then
              Next_RetCode := Ax and $00FF
            else
              Begin                         { Move file name         }
                Next_RetCode := 0;
                for N := 0 to 11 do FileName[N+1] := Buffer.Name[N]
              End { else }
        End  { with }
    End; { Proc Find_Next }

  Procedure Find_First (var Att: byte;
                        var Filename: Filename_type;
                        var RetCode_code : byte);

    var
      Registers  :regtype;
      Carry_flag :integer;
      Mask, N    :byte;

    Begin
     Disk_Trns_Addr(buffer);
     Filename := Filename + chr(0);
     Buffer.Name := '             ';
     with Registers do
       Begin
         Ax := $4E shl 8;                { Dos Find First Function }
         Cx := Att;                      { Attribute of file to fine }
         Ds := seg(Filename);            { Ds:Dx Ascii string to find }
         Dx := ofs(Filename) + 1;
         MsDos(Registers);
         Att := Buffer.Attribute;        { set the file attribute byte  }

                                         { If error occured set, Return code. }

         Carry_flag := 1 and Flags;      { If Carry flag, error occured }
                                         { and Ax will contain Return code }
         if Carry_flag = 1
           then
             RetCode_code := Ax and $00FF
           else
             Begin
               RetCode_code := 0;
               Filename := '             ';
               for N := 0 to 11 do FileName[N+1] := Buffer.Name[N]
             End { else }
       End  {with}
    End; { Proc Find_First }

  var
    attribyte : byte;

  Begin { Primary block of Get_File }
    filename := filepath;
    attribyte := 0;
    Find_First(attribyte,filename,Retcode);
    If Retcode = 0
      then
        Begin
          if Reading
            then
              Begin
                entries := entries + 1;
                Check_Max;
                files[entries] :=Filename;
                Pad_Right(files[entries],#32,12);
                files[entries] := files[entries] + disk;
                CheckNulls;
              End { if Reading }
            else
              Begin
                Write(filename);
                Check_Pos;
                if choice = '*' then Retcode := 1;
                choice := ' '
              End { else }
        End; { if Retcode }

    { Now we Repeat Find_Next Until an error occurs }

    Repeat
      Find_Next(attribyte,filename,Retcode);
      if Retcode = 0
        then
          Begin
            if Reading
              then
                Begin
                  entries := entries + 1;
                  Check_Max;
                  files[entries] :=Filename;
                  Pad_Right(files[entries],' ',12);
                  files[entries] := files[entries] + disk;
                  CheckNulls;
                End { if Reading }
              else
                Begin
                  Write(filename);
                  Check_Pos;
                  if choice = '*' then Retcode := 1;
                  choice := ' '
                End { else }
          End { if Retcode }
    Until Retcode <> 0;
    if not Reading
      then
        if choice <> '*'
          then
            AtEnd
  End; { Proc Get_File }

Procedure TimDat(var timestr, datestr, daystr :Str255);
  Procedure GetTime(Var T:Time);
    var regs : HalfRegType;

    Begin
      With Regs,T Do
        Begin
          AH := $2C;
          MsDos(Regs);
          Hours := CH;
          Min := CL;
          Sec := DH;
          Hundreths := DL
       End { with }
    End; { Sub Proc GetTime }

  Procedure GetDate(Var D:Date);
    var
      Regs : HalfRegType;

    Begin
      With Regs,D Do
        Begin
          AH := $2A;
          MsDos(Regs);
          Month := DH;
          Day := DL;
          Year := 256 * CH + CL;
          DayOfWeek := DOW(AL)
        End { with }
    End; { Sub Proc GetDate }

  Var
    T1 : Time;
    D1 : Date;
    s1 : string[5];

  Begin { Proc TimDat Main }
    GetTime(T1);
    GetDate(D1);
    With T1 Do
      Begin
        timestr := '';
        str(hours,s1);
        Pad_Left(s1,'0',2);
        timestr := s1 + ':';
        str(min,s1);
        Pad_Left(s1,'0',2);
        timestr := timestr + s1 + ':';
        str(sec,s1);
        Pad_Left(s1,'0',2);
        timestr := timestr + s1
      End; { with T1 }
    With D1 Do
      Begin
        datestr := '';
        str(month,s1);
        Pad_Left(s1,'0',2);
        datestr := s1 + '/';
        str(day,s1);
        Pad_Left(s1,'0',2);
        datestr := datestr + s1 + '/';
        str(year,s1);
        datestr := datestr + s1;
        daystr := DayName[DayOfWeek]
      End  { with T1 }
  End; { Proc TimDat }

Procedure Color(fr,bk,bd : integer);
  Begin
    TextColor(fr);
    TextBackground(bk);
    Port[$03d9] := bd
  End; { Proc Color }

Procedure UpperCase(var x : Str255);
  var i : integer;

  Begin
    for i := 1 to length(x) do x[i] := UpCase(x[i])
  End; { Proc UpperCase }

Procedure Sort;
 label
   B, C, D;

 var
   i,j,k,l,m,n : integer;
   t           : files_type;

 Begin
   Cursor(Off);
   Write ('Sorting');
   n := entries;
   m := n div 2;
   While m > 0 do
     Begin
       Write ('.');   { Just to show that something's going on.... }
       j := 1;
       k := n - m;
B:     i := j;
C:     l := i + m;
       if files[i] >= files[l]
         then
           Begin
             t := files[i];
             files[i] := files[l];
             files[l] := t;
             i := i - m;
             if i >= 1 then goto C
           End; { if }
D:     j := j + 1;
       if j <= k then goto B;
       m := m div 2
     End; { while m }
   WriteLn;
   Cursor(On)
 End; { Proc Sort }

Procedure Sort_By_Num;
  var i : integer;

  Begin
    if Sort_Flag
      then
        Begin
          Sort_Flag := False;
          for i := 1 to entries do
            files[i] := copy(files[i],5,12) + copy(files[i],1,4)
        End { if }
      else
        Begin
          Sort_Flag := True;
          for i := 1 to entries do
            files[i] := copy(files[i],13,4) + copy(files[i],1,12)
        End; { else }
    Sort
  End; { Proc Sort_By_Num }

Function Exist(filenam : files_type) : Boolean;
  var
    f : file;

  Begin
    Assign(f, filenam);
    {$I- }
    Reset(f);
    {$I+ }
    Exist := (IOresult = 0);
    close(f)
  End; { Function Exist }

Procedure Init;
  var
    fil    : text;

  Begin
    if not Exist('dir4.cfg')
      then
        Begin
          Assign(fil,'dir4.cfg');
          ReWrite(fil);
          {
            Create the default parameters
          }
          fore := Green;
          back := Black;
          bord := Black;
          fore_hi := Yellow;
          cpi16 := #27 + 'P'; { Default to the Epson/IBM string }
          defaultdrive := 'B';
          WriteLn(fil,fore);
          WriteLn(fil,back);
          WriteLn(fil,bord);
          WriteLn(fil,fore_hi);
          WriteLn(fil,cpi16);
          WriteLn(fil,defaultdrive);
        End { if }
      else
        Begin
          Assign(fil,'dir4.cfg');
          Reset(fil);
          ReadLn(fil,fore);
          ReadLn(fil,back);
          ReadLn(fil,bord);
          ReadLn(fil,fore_hi);
          ReadLn(fil,cpi16);
          ReadLn(fil,defaultdrive);
        End; { else }
    close(fil);
    Sort_Flag := False;
    color(fore,back,bord);
    a := ord(16 * back + fore);
    ClrScr;
    FastWrite(28, 9,a,'╒════════════════════════╕');
    FastWrite(28,10,a,'│                        │');
    FastWrite(28,11,a,'│        DIR 4.05        │');
    FastWrite(28,12,a,'│                        │');
    FastWrite(28,13,a,'│      by Wes Meier      │');
    FastWrite(28,14,a,'│                        │');
    FastWrite(28,15,a,'│  Modified by E. White  │');
    FastWrite(28,16,a,'│                        │');
    FastWrite(28,17,a,'│     December, 1986     │');
    FastWrite(28,18,a,'│                        │');
    FastWrite(28,19,a,'╞════════════════════════╡');
    FastWrite(28,20,a,'│');
    FastWrite(30,20, ord(16 * back + fore_hi),'FOR PUBLIC DOMAIN ONLY');
    FastWrite(52,20,a,'│');
    FastWrite(28,21,a,'╘════════════════════════╛');
    Delay(500);
  End; { Proc Init }

Procedure Read_Data_From_Disk;
  var
    dir_dat : text;

  Begin
    if not Exist('DIR.DAT')
      then
        Begin
          Assign(dir_dat,'DIR.DAT');
          ReWrite(dir_dat);
          Close(dir_dat)
        End; { if }
    Assign(dir_dat,'DIR.DAT');
    Reset(dir_dat);
    entries := 0;
    while not EOF(dir_dat) do
      Begin
        entries := entries + 1;
        ReadLn(dir_dat,sx);

        {
         Are we Reading an old DIR3.n file?
        }

        if pos('"',sx) > 0
          then
            Begin
              sx := copy(sx,2,15);
              sy := copy(sx,1,8);
              while sy[length(sy)] = ' ' do
                Begin
                  delete(sy,length(sy),1)
                End; { While }
              sy := copy(sy + copy(sx,9,4) + '            ',1,12);
              sx := sy + copy(sx,13,3);
              insert('0',sx,13)
            End; { if }
        if copy(sx,13,4) = '0000'
          then
            entries := entries - 1  { don't allow files with '0000' in them }
          else
            files[entries] := sx
      End; { while }
    close(dir_dat)
  End; { Proc Read_Data_From_Disk }

Procedure Dump_Data_To_Disk; { Terminal routine...re-execs the program }
  var
    dir_dat : text;
    dir4    : file;
    i       : integer;

  Begin
    Cursor(Off);
    TextColor(fore + blink);
    ClrScr;
    GotoXY(20,12);
    Write('Dumping Data to Disk ....');
    Assign(dir_dat,'dir.dat');
    ReWrite(dir_dat);
    for i := 1 to entries do
      Begin
        if files[i][1] <> ' ' then WriteLn(dir_dat,files[i])
      End; { for }
    close(dir_dat);
    Assign(dir4,'DIR4.COM');
    Set_Cursor(Start_Line,End_Line);
    {$I- }
      Execute(dir4);
    {$I+ }
    if IOResult <> 0
      then
        Begin
          Locate12;
          TextColor(fore);
          WriteLn(^G,'The file "DIR4.COM" was not found.');
          WriteLn('This program MUST be called "DIR4.COM" and be available in your default PATH.');
          WriteLn;
          WriteLn('Program Halted.');
          Halt
        End { if }
End; { Proc Dump_Data_To_Disk }

Procedure ShowMenu;

  var
    h   : byte;
    ent : str80;

  Begin
    ClrScr;
    a := ord(16 * back + fore);
    h := ord(16 * back + fore_hi);
    str(entries,ent);
    GotoXY(1,1);
    FastWrite(19, 8,a,'╒═════════════════════════════════════════╕');
    FastWrite(19, 9,a,'│     DIR 4.05 - ');
    FastWrite(37, 9,a,ent + ' Entries on File');
    FastWrite(61, 9,a,'│');
    FastWrite(19,10,a,'├─────────────────────────────────────────┤');
    FastWrite(19,11,a,'│ [');
    FastWrite(22,11,h,'F');
    FastWrite(23,11,a,']ind a File.                          │');
    FastWrite(19,12,a,'│ [');
    FastWrite(22,12,h,'A');
    FastWrite(23,12,a,']dd File(s) to the Data Record.       │');
    FastWrite(19,13,a,'│ [');
    FastWrite(22,13,h,'P');
    FastWrite(23,13,a,']rint or List the Data Record.        │');
    FastWrite(19,14,a,'│ [');
    FastWrite(22,14,h,'D');
    FastWrite(23,14,a,']elete File(s) from the Data Record.  │');
    FastWrite(19,15,a,'│ [');
    FastWrite(22,15,h,'L');
    FastWrite(23,15,a,']ist a Disk Directory (Data or Real). │');
    FastWrite(19,16,a,'│ [');
    FastWrite(22,16,h,'W');
    FastWrite(23,16,a,']rite a Diskette Label.               │');
    FastWrite(19,17,a,'│ [');
    FastWrite(22,17,h,'B');
    FastWrite(23,17,a,']ackup the Data Record File.          │');
    FastWrite(19,18,a,'│ [');
    FastWrite(22,18,h,'C');
    FastWrite(23,18,a,']onfigure DIR4.                       │');
    FastWrite(19,19,a,'│ [');
    FastWrite(22,19,h,'Esc');
    FastWrite(25,19,a,']ape Back to DOS.                   │');
    FastWrite(19,20,a,'╘═════════════════════════════════════════╛');
  End; { Proc ShowMenu }

  Function Yes : boolean;
    var
      c   : char;
      yup : boolean;

    Begin
      Repeat
        Repeat Until KeyPressed;
        Read(kbd,c);
        c := UpCase(c)
      Until c in [#13,'Y','N','0','1','-','+'];
      yup := (c in [#13,'Y','+','1']);
      yes := yup;
      if yup
        then
          WriteLn('Yes')
        else
          WriteLn('No')
    End; { Function Yes }

  Procedure Fix_Path(var x : files_type);
    Begin
      if x[length(x)] <> '\' then x := x + '\';
      if x[2] <> ':' then insert(':',x,2);
      if pos(x,'*.*') = 0 then x := x + '*.*'
    End; { Proc Fix_Path }

  Procedure Add; { a file or files to the data Record }
    Procedure Disk_Read;
      var
        drive : filename_type;
        done,
        f     : boolean;
        i,j,w,z,
        old_ent,
        count : integer;

      Begin{ Disk_Read }
        disk := '0000';
        done := False;
        Repeat { Until done }
          Repeat { Until Yes and disk <> '0000' }
            x := 0;
            ClrScr;
            GotoXY(20,3);
            val(disk,x,z);
            Write('Disk # to Read (1-9999). Default is ');
            Write(x + 1);
            Write(') ? ');
            z := WhereX;
            ReadLn(sx);
            if sx = ''
              then
                Begin
                  Str((x + 1),sx);
                  f := True
                End { if }
              else
                Begin
                  UpperCase(sx);
                  f := False
                End; { else }
            Pad_Left(sx,'0',4);
            disk := sx;
            if f
              then
                Begin
                  GotoXY(z,3);
                  Write(sx)
                End; { if }
            GotoXY(20,5);
            Write('Enter Drive or Path (Default is ',DefaultDrive,':\) ? ');
            z := WhereX;
            ReadLn(filepath);
            if filepath = ''
              then
                Begin
                  filepath := DefaultDrive + ':\';
                  f := True
                End { if }
              else
                f := False;
            Fix_Path(filepath);
            if f
              then
                Begin
                  GotoXY(z,5);
                  Write(filepath)
                End; { if }
            GotoXY(20,7);
            Write('Verify Disk #',disk,' on drive ',filepath,' correct ? ');
            if disk = '0000'
              then
                Begin
                  WriteLn;
                  WriteLn(^G,'"0000" is an illegal Disk value.');
                  WriteLn
                End { if }
          Until yes and (disk <> '0000');
          Reading := True;
          count := 0;
          Cursor(Off);
          for i := 1 to entries do
            Begin
              if disk = copy(files[i],13,4)
                then
                  Begin
                    files[i][1] := ' ';
                    count := count + 1
                  End { if }
            End; { for }
          old_ent := entries;
          Get_File;
          GotoXY(20,9);
          Write('Done. Total number of entries is ',entries);
          GotoXY(20,10);
          Write(entries - old_ent, ' Files were read. Read another disk? ');
          Cursor(On);
          Done := not Yes;
          Cursor(Off)
        Until done;
        WriteLn;
        GotoXY(20,11);
        Sort;
        Dump_Data_To_Disk
      End; { sub Proc Disk_Read }

    Procedure Manual_Entry;
      var
        done,
        new,
        k    : boolean;
        f,f1 : Str255;

      Begin{ Manual_Entry }
        new := False;
        done := False;
        k := False;
        Locate12;
        Repeat { Until Done }
          Repeat { Until done or k, where k = Yes }
            Write('Enter File ("*" to Quit) ? ');
            ReadLn(f);
            if f = '*'
              then
                Begin
                  done := True;
                  k := False
                End { if }
              else
                Begin
                  UpperCase(f);
                  WriteLn;
                  Write('Enter Disk # (1-9999) ? ');
                  ReadLn(f1);
                  Pad_Left(f1,'0',4);
                  UpperCase(f1);
                  WriteLn;
                  Write('Is ',f,' on Disk #',f1,' Correct ? ');
                  k := yes;
                  if f1 = '0000'
                    then
                      Begin
                        k := False;
                        WriteLn(^G,'"0000" is an illegal Disk label!');
                      End { if }
                End; { else }
            WriteLn
          Until done or k; { k = Yes }
          if k
            then
              Begin
                new := True;
                entries := entries + 1;
                Pad_Right(f,' ',12);
                files[entries] := f + f1
              End { if k }
        Until done;
        if new
          then
            Begin
              Sort;
              Dump_Data_To_Disk
            End { if }
      End; { sub Proc Manual_Entry }

    var
      chc : char;

    Begin { Add }
      ClrScr;
      GotoXY(20,12);
      Write('Manually ');
      TextColor(fore_hi + blink);
      Write('A');
      TextColor(fore);
      Write('dd file(s), Read a ');
      TextColor(fore_hi + blink);
      Write('D');
      TextColor(fore);
      Write('isk, or ');
      TextColor(fore_hi + blink);
      Write('Q');
      TextColor(fore);
      Write('uit ? ');
      Repeat
        Repeat Until Keypressed;
        Read(kbd,chc);
        chc := UpCase(chc)
      Until pos(chc,'ADQ*') > 0;
      Case chc of
        'A' : manual_entry;
        'D' : disk_Read
      End { Case chc }
    End; { Proc Add }

Procedure Configure;
  var
    chc,c :  char;
    done  :  boolean;
    i     :  integer;
    h     :  byte;

  Begin
    done := False;
    Repeat { Until done }
      h := ord(16 * back + fore_hi);
      a := ord(16 * back + fore);
      ClrScr;
      Cursor(Off);
      FastWrite(19, 1,a,'╒═════════════════════════════════════════╕');
      FastWrite(19, 2,a,'│      DIR 4.05 - Configuration Menu      │');
      FastWrite(19, 3,a,'├─────────────────────────────────────────┤');
      FastWrite(19, 4,a,'│ Change [');
      FastWrite(29, 4,h,'F');
      FastWrite(30, 4,a,']oreground Color.              │');
      FastWrite(19, 5,a,'│ Change [');    TextColor(Fore_hi);
      FastWrite(29, 5,h,'H');
      FastWrite(30, 5,a,']ighlight Color.               │');
      FastWrite(19, 6,a,'│ Change [');
      FastWrite(29, 6,h,'B');
      FastWrite(30, 6,a,']ackground Color.              │');
      FastWrite(19, 7,a,'│ Change Bo[');
      FastWrite(31, 7,h,'R');
      FastWrite(32, 7,a,']der Color.                  │');
      FastWrite(19, 8,a,'│ Enter [');
      FastWrite(28, 8,h,'P');
      FastWrite(29, 8,a,']rinter 16 cpi Control String:  │');
      FastWrite(19, 9,a,'│    Current String = ');
      FastWrite(42, 9,h,copy(cpi16 + '                    ',1,20));
      FastWrite(61, 9,a,'│');
      FastWrite(19,10,a,'│ [');
      FastWrite(22,10,h,'D');
      FastWrite(23,10,a,']efault Drive ');
      FastWrite(37,10,h,copy(defaultdrive + ':                   ',1,20));
      FastWrite(61,10,a,'│');
      FastWrite(19,11,a,'│ [');
      FastWrite(22,11,h,'S');
      FastWrite(23,11,a,']ave Configuration.                   │');
      FastWrite(19,12,a,'│ [');
      FastWrite(22,12,h,'Q');
      FastWrite(23,12,a,']uit Back to the Main Menu.           │');
      FastWrite(19,13,a,'╘═════════════════════════════════════════╛');
      Repeat { Until valid choice selected }
        Repeat Until KeyPressed;
        Read(kbd,chc);
        chc := UpCase(chc)
      Until pos(chc,'FHBRDSPQ*') > 0;
      Window(20,16,80,24);
      GotoXY(1,1);
      ClrScr;
      Cursor(On);
      Case chc of
        'F' : Begin
                for i:=0 to 15 do
                  Begin
                    TextColor(i);
                    Write('███')
                  End; { for }
                TextColor(fore);
                WriteLn;
                WriteLn(' 0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F');
                Write(' Select New Foreground Color (0-F) ');
                Repeat
                  Repeat Until KeyPressed;
                  Read(kbd,c);
                  c := UpCase(c);
                  i := pos(c,'0123456789ABCDEF')
                Until i > 0;
                fore := i - 1;
                TextColor(fore)
              End; { Case 'F' }
        'H' : Begin
                for i := 0 to 15 do
                  Begin
                    TextColor(i);
                    Write('███')
                  End; { for }
                TextColor(fore);
                WriteLn;
                WriteLn(' 0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F');
                Write(' Select New Highlight Color (0-F) ');
                Repeat
                  Repeat Until KeyPressed;
                  Read(kbd,c);
                  c := UpCase(c);
                  i := pos(c,'0123456789ABCDEF')
                Until i > 0;
                fore_hi := i - 1
              End; { Case 'H' }
        'B' : Begin
                for i := 0 to 7 do
                  Begin
                    TextColor(i);
                    Write('███')
                  End; { for }
                TextColor(fore);
                WriteLn;
                WriteLn(' 0  1  2  3  4  5  6  7');
                Write(' Select New Background Color (0-7) ');
                Repeat
                  Repeat Until KeyPressed;
                  Read(kbd,c);
                  c := UpCase(c);
                  i := pos(c,'01234567')
                Until i > 0;
                back := i - 1;
                TextBackground(back);
                window(1,1,80,25);
                color(fore,back,bord)
              End;  { Case 'B' }
        'R' : Begin
                for i := 0 to 7 do
                  Begin
                    TextColor(i);
                    Write('███')
                  End; { for }
                TextColor(fore);
                WriteLn;
                WriteLn(' 0  1  2  3  4  5  6  7');
                Write(' Select New Border Color (0-7) ');
                Repeat
                  Repeat Until KeyPressed;
                  Read(kbd,c);
                  c := UpCase(c);
                  i := pos(c,'01234567')
                Until i > 0;
                bord := i - 1;
                port[$03d9] := bord
              End;  { Case 'R' }
        'S' : Begin
                Cursor(Off);
                Assign(ft,'dir4.cfg');
                ReWrite(ft);
                WriteLn(ft,fore);
                WriteLn(ft,back);
                WriteLn(ft,bord);
                WriteLn(ft,fore_hi);
                WriteLn(ft,cpi16);
                WriteLn(ft,defaultdrive);
                close(ft);
                Cursor(On)
              End;  { Case 'S' }
        'D' : Begin
                Repeat
                ClrScr;
                Write('Enter the default drive letter (A - D): ');
                Read(Kbd,DefaultDrive);
                DefaultDrive := UpCase(DefaultDrive);
                If Not (DefaultDrive In ['A'..'D']) Then Write(#7);
                Until (DefaultDrive In ['A'..'D']);
              End;  { Case 'D' }
        'P' : Begin
                WriteLn('Enter the command string that places your printer into');
                WriteLn('condensed (16 cpi) mode. Use "{" for the Esc character');
                Write('and "^" for Ctrl. String ? ');
                ReadLn(cpi16);
                if pos('{',cpi16)>0 then cpi16[pos('{',cpi16)] := #27;
                i := pos('^',cpi16);
                if i > 0
                  then
                    Begin
                      cpi16[i + 1] := UpCase(cpi16[i + 1]);
                      if (ord(cpi16[i + 1]) -64 >= 0) and
                         (ord(cpi16[i + 1]) -64 <= 31)
                        then
                          Begin
                            cpi16[i + 1] := chr(ord(cpi16[i + 1]) - 64);
                            delete(cpi16,i,1)
                          End { if (ord ... }
                    End { if i ... }
              End       { Case 'P' }
         else           { Cases Q and * }
           done := True
      End               { Case of chc }
    Until Done;
    window(1,1,80,25)
  End;                  { Proc Configure }

Procedure Backup;
  var
    dir_dat : text;
    ft      : Str255;
    i       : integer;
    no_err  : boolean;

  Begin
    Cursor(Off);
    Locate12;
    Repeat { until no_err }
      Write('Backup "DIR.DAT" onto which drive ("*" to quit) ? ');
      ReadLn(ft);
      if ft = '*' then Exit;
      UpperCase(ft);
      if copy(ft,length(ft),1) <> ':' then ft := ft + ':';
      Assign(dir_dat,ft + 'dir.dat');
      {$I- }
        ReWrite(dir_dat);
      {$I+ }
      no_err := (IOResult = 0);
      if not no_err
        then
          Begin
            WriteLn;
            WriteLn(^G,'An I/O error occurred. Drive "',ft,'" is probably incorrect. Please try again.');
            WriteLn
          End { if }
    Until no_err;
    ClrScr;
    GotoXY(20,12);
    TextColor(fore + blink);
    Write('Backing "DIR.DAT" to drive ',ft);
    for i := 1 to entries do
      Begin
        if files[i][1] <> ' ' then WriteLn(dir_dat,files[i])
      End; { for }
    close(dir_dat);
    TextColor(fore)
  End; { Proc BackUp }

Procedure Zap; { Deletes one or more files or a complete diskette }
  var
    i,j,k  : integer;
    c      : char;
    sx     : Str255;
    mark,
    done,
    zapped : boolean;

  Begin
    zapped := False;
    Locate12;
    Write('Delete a ');
    TextColor(fore_hi + blink);
    Write('F');
    TextColor(fore);
    Write('ile, a ');
    TextColor (fore_hi + blink);
    Write('D');
    TextColor(fore);
    Write('isk, or ');
    TextColor (fore_hi + blink);
    Write('Q');
    TextColor(fore);
    Write('uit back to the Main Menu ? ');
    Repeat
      Repeat Until KeyPressed;
      Read(kbd,c);
      c := UpCase(c)
    Until pos(c,'FDQ*') > 0;
    Case c of
      'F' : Begin
              Locate12;
              done := False;
              Repeat { Until done }
                mark := False;
                Write('File to delete ("*" to quit) ? ');
                ReadLn(sx);
                UpperCase(sx);
                if sx = '*' then done := True;
                if not done
                  then
                    for i := 1 to entries do
                      Begin
                        if pos(sx,files[i]) > 0
                          then
                            Begin
                              files[i][1] := ' ';
                              mark := True;
                              zapped := True
                            End { if }
                      End; { for i }
                if not mark
                  then
                    Begin
                      WriteLn;
                      WriteLn('File "',sx,'" wasn',#39,'t found.');
                      WriteLn
                    End { if not mark }
                  else
                    WriteLn
              Until done
            End; { Case F }
      'D' : Begin
              j := 0;
              done := False;
              Locate12;
              done := False;
              Repeat { Until done }
                Write('Enter Disk # (1-9999) to Delete ("*" to Quit) ? ');
                ReadLn(sx);
                UpperCase(sx);
                if sx = '*'
                  then
                    done := True
                  else
                    Begin
                      Pad_Left(sx,'0',4) ;
                      mark := False;
                      j := 0;
                      for i := 1 to entries do
                        Begin
                          if sx = copy(files[i],13,4)
                          then
                            Begin
                              mark := True;
                              zapped := True;
                              files[i] := ' ';
                              j := j + 1
                            End { if }
                        End; { for i }
                      if mark
                        then
                          Begin
                            WriteLn;
                            WriteLn('Done. ',j,' files were deleted.')
                          End { if }
                        else
                          Begin
                            WriteLn;
                            WriteLn('Disk #',sx,' wasn',#39,'t found.')
                          End; { else }
                      WriteLn
                  End { else not done }
              Until done
            End { Case D }
    End; { Case of c }
    if zapped then Dump_Data_To_Disk
  End; { Proc Zap }

Procedure Strip_Z(var x : Str255); { Strip leading zeros }
  Begin
    while x[1] = '0' do delete(x,1,1)
  End; { Proc Strip_Z }

Procedure Find;
  Procedure Strip_S(var x : Str255); { Strips trailing spaces from a string }
    Begin
      while x[length(x)] = ' ' do delete(x,length(x),1)
    End; { Sub Proc Strip_S }

  var
    i,j              : integer;
    st,stmp,s        : Str255;
    done,found,mark  : boolean;

  Begin
    ClrScr;
    GotoXY(1,10);
    done := False;
    Repeat { Until done }
      Write('Enter File (or Partial) to Find ("*" to Quit) ? ');
      ReadLn(st);
      WriteLn;
      if st = '*'
        then
          done := True
        else
          Begin
            found := False;
            Repeat { Until found }
              UpperCase(st);
              mark := False;
              i := 0;
              Repeat { Until i >= entries OR Found }
                i := i + 1;
                if pos(st,copy(files[i],1,12)) > 0
                  then
                    Begin
                      mark := True;
                      stmp := copy(files[i],1,12);
                      Strip_S(stmp);
                      WriteLn(stmp,' may be found on Disk(s):');
                      s := copy(files[i],13,4);
                      Strip_Z(s);
                      i := i + 1;
                      Write(s,', ');
                      for j := i to entries do
                        Begin
                          if pos(stmp,files[j]) > 0
                            then
                              Begin
                                s := copy(files[j],13,4);
                                Strip_Z(s);
                                Write(s,', ');
                                i := i + 1
                              End { if }
                        End; { for j }
                      WriteLn;
                      WriteLn;
                      Write('Is this the file you wanted ? ');
                      Found := Yes;
                      WriteLn
                    End { if }
              Until (i >= entries) or Found;
              if not mark
                then
                  Begin
                    WriteLn;
                    WriteLn('"',st,'" wasn',#39,'t found.');
                    WriteLn;
                    found := True
                  End { if }
                else
                  Begin
                    if i >= entries
                      then
                        Begin
                          found := True;
                          WriteLn('No further incidences of "',st,'" were found.');
                          WriteLn
                        End { if }
                      else
                        WriteLn
                  End { else }
            Until Found
          End { else }
    Until done
  End; { Proc Find }

Procedure Print_List;
  Procedure Print_Prt;
    var
      i,page,pages   : integer;
      linestr,
      headerstr      : string[126];
      s,s1,ds,dys,ts : Str255;

    Begin{ Print_Prt - Prints 7 columns of 50 entries each }
      WriteLn;
      WriteLn;
      WriteLn('Position your printer to about ',#171,'" below the top perforation and press any');
      Write('key to start the printout ("*" to quit) ? ');
      Repeat Until Keypressed;
      Read(Kbd,ch);
      if ch = '*' then Exit;
      WriteLn;
      WriteLn;
      Write('Printing Data Record. Press any key to abort ....');
      Write(Lst,cpi16);
      pages := entries div 350 + 1;
      linestr :='';
      for i := 1 to 124 do linestr := linestr + '-';
      headerstr := '';
      for i := 1 to 7 do headerstr := headerstr + 'File        Disk  ';
      for page := 1 to pages do
        Begin
          WriteLn(Lst);
          TimDat(ts,ds,dys);
          WriteLn(Lst,'      DIR.DAT Listing as of ',dys,', ',ds,' @ ',ts,'.');
          WriteLn(Lst,'      Page ',page,' of ',pages,' Pages.');
          WriteLn(Lst,'      ',headerstr);
          WriteLn(Lst,'      ',linestr);
          for x:= (page - 1) * 350 to (page - 1) * 350 + 49 do
            Begin
              Write(Lst,'      ');
              y := 1;
              While y <= 350 do
                Begin
                  if KeyPressed
                    then
                      Exit
                    else
                      Begin
                        if (x + y) <= entries
                          then
                            Begin
                              if Sort_Flag
                                then
                                  Begin
                                    s := copy(files[x + y],1,4);
                                    Strip_Z(s);
                                    s1 := copy(files[x + y],5,12);
                                    s1 := copy(s1 + '    ',1,12);
                                    Write(Lst,s1,s:4,'  ')
                                  End { if Sort_Flag }
                                else
                                  Begin
                                    s := copy(files[x + y],13,4);
                                    Strip_Z(s);
                                    s1 := copy(files[x + y],1,12) + '    ';
                                    s1 := copy(s1,1,12);
                                    Write(Lst,s1,s:4,'  ')
                                  End { else if Sort_Flag }
                            End { if }
                      End; { else if KeyPressed }
                  y := y + 50
                End; { while y }
              WriteLn(Lst)
            End; { for x }
          WriteLn(Lst,'      ',linestr);
          for i := 1 to 10 do WriteLn(Lst)
        End; { for page }
      if KeyPressed then Read(Kbd,ch)
    End; { Sub Proc Print_Prt }

  Procedure Print_Crt;
    var
      i    : integer;
      s    : Str255;

    Begin{ Proc Print_Crt }
      ClrScr;
      GotoXY(1,1);
      i := 1;
      Repeat { Until c = * OR i > entries }
        if Sort_Flag
          then
            s := copy(files[i],1,4)
          else
            s := copy(files[i],13,4);
        Strip_Z(s);
        s := copy('    ' + s,length(s) + 1,4);
        if Sort_Flag
          then
            Write(s,' ',copy(files[i],5,12),'  ')
          else
            Write(s,' ',copy(files[i],1,12),'  ');
        Check_Pos;
        i := i + 1;
      Until (choice = '*') or (i > entries);
      choice := ' ';
      if i > entries then AtEnd;
      WriteLn
    End; { Sub Proc Print_Crt }

  var
    c : char;

  Begin{ Print_List Main }
    Locate12;
    Write('Do you want the Data Record Sorted by Disk Number ? ');
    if Yes
      then
        Begin
          WriteLn;
          Sort_By_Num
        End; { if }
    WriteLn;
    Write('Dump the Data Record to the ');
    TextColor(fore_hi + blink);
    Write('C');
    TextColor(Fore);
    Write('RT, the ');
    TextColor(fore_hi + blink);
    Write('P');
    TextColor(fore);
    Write('rinter, or ');
    TextColor(fore_hi + blink);
    Write('Q');
    TextColor(fore);
    Write('uit ? ');
    Repeat
      Repeat Until KeyPressed;
      Read(kbd,c);
      c := UpCase(c)
    Until pos(c,'CPQ*') > 0;
    Case c of
      'C' : Print_Crt;
      'P' : Print_Prt
    End { Case of c }
  End; { Proc Print_List }

Procedure List_Records;
  Procedure List_Actual;
    Var target : Str255;

    Begin
      Locate12;
      Write('Enter drive or path to be listed ("*" to quit) ? ');
      ReadLn(target);
      ClrScr;
      GotoXY(1,1);
      if target <> '*'
        then
          Begin
            Fix_Path(target);
            filepath := target;
            Reading := False;
            ClrScr;
            Get_File
          End { if target <> * }
    End; { Sub Proc List_Actual }

  Procedure List_Data;
    var i    : integer;
    target,s : Str255;

    Begin
      Locate12;
      Write('Enter disk # (1-9999) to be listed ("*" to quit) ? ');
      ReadLn(target);
      UpperCase(target);
      ClrScr;
      GotoXY(1,1);
      if target <> '*'
        then
          Begin
            i := 1;
            Pad_Left(target,'0',4);
            Repeat { until i > entries or choice = * }
              if target = copy(files[i],13,4)
                then
                  Begin
                    s := copy(files[i],13,4);
                    Strip_Z(s);
                    Pad_Left(s,' ',4);
                    Write(s,' ',copy(files[i],1,12),'  ');
                    Check_Pos
                  End; { if target = }
              i := i + 1
            Until (i > entries) or (choice = '*');
            choice := ' ';
            if i > entries then AtEnd
          End { if target <> '*' }
    End; { Sub Proc List_Data }

  Begin{ Proc List_Records Main }
    Locate12;
    Write('List an ');
    TextColor(fore_hi + blink);
    Write('A');
    TextColor(Fore);
    Write('ctual Disk Directory, the ');
    TextColor(fore_hi + blink);
    Write('D');
    TextColor(fore);
    Write('ata Record, or ');
    TextColor(fore_hi + blink);
    Write('Q');
    TextColor(fore);
    Write('uit ? ');
    Repeat
      Repeat Until KeyPressed;
      Read(kbd,ch);
      ch := UpCase(ch)
    Until pos(ch,'ADQ*') > 0;
    Case ch of
      'A' : List_Actual;
      'D' : List_Data
    End { Case of ch }
  End; { Proc List_Records }

Procedure Write_Label;
  const
    titlel = '_____________________________________________';

  var
    i,count,count_t, tb, te           : integer;
    horiz_line, tmp_line, t_line      : string[74];
    target, tm, dt, dy, targ_b,targ_e,
    old_target, mask, titles          : Str255;
    numerous, alpha, exit_flag,
    match, title                      : boolean;

  Procedure Print_label(target_to_print : Str255);
    Begin
      i := 1;
      Pad_Left(target_to_print,'0',4);
      TimDat(tm,dt,dy);
      WriteLn(Lst,cpi16,horiz_line);
      tm := '| Disk #' + target_to_print + '. ' + dt;
      if title then tm := tm + '. ' + titles;
      Pad_Right(tm,#32,73);
      tm := tm + '|';
      WriteLn(Lst,tm);
      WriteLn(Lst,t_line);
      count := 2;
      tmp_line := '| ';
      Repeat { until i > entries }
        if (target_to_print = copy(files[i],13,4))
          or
           (sort_flag and (copy(files[i],1,4) = target_to_print))
          then
            Begin
              exit_flag := KeyPressed;
              if exit_flag then Exit;
              if sort_flag
                then
                  tmp_line := tmp_line + copy(files[i],5,12) + '  '
                else
                  tmp_line := tmp_line + copy(files[i],1,12) + '  ';
              if length(tmp_line) > 70
                then
                  Begin
                    exit_flag := KeyPressed;
                    if exit_flag then Exit;
                    tmp_line := tmp_line + ' |';
                    WriteLn(Lst,tmp_line);
                    tmp_line := '| ';
                    count :=  count + 1
                  End { if length(tmp_line) }
            End; { if target_to_print }
        i := i + 1
      Until i > entries;
      while count < 26 do
        Begin
          exit_flag := KeyPressed;
          if exit_flag then Exit;
          while (length(tmp_line) < 72) do tmp_line := tmp_line + ' ';
          tmp_line := tmp_line + ' |';
          WriteLn(Lst,tmp_line);
          count := count + 1;
          tmp_line := '| '
        End; { while count }
      WriteLn(Lst,horiz_line);
      for i := 1 to 5 do WriteLn(Lst)
    End; { Sub Proc Print_label }

  Begin { Write_label Main code }
    target := ' '; { intialize it }
    title := False;
    horiz_line := '+';
    for i := 1 to 72 do horiz_line := horiz_line + '-';
    horiz_line := horiz_line + '+';
    t_line := '|' + copy(horiz_line,2,72) + '|';
    Locate12;
    Write('Do you want to write more than one label (Y/N) ? ');
    numerous := Yes;
    if not numerous
      then
        Begin
          Locate12;
          Write('Write a Label for which disk (1-9999, "*" to quit) ? ');
          ReadLn(target);
          UpperCase(target);
          Locate12;
          Write('Do you want to TITLE the label for Disk #',target,' (Y/N) ? ');
          title := Yes;
          if title
            then
              Begin
                Locate12;
                WriteLn('       ',titlel);
                Write  ('Title: ');
                ReadLn(Titles);
                Titles := copy(titles,1,45)
              End; { if title }
          Locate12;
          Cursor(Off);
          Write('Printing Label .....');
          if target = '*'
            then
              Exit
            else
              print_label(target)
        End { if not numerous }
      else
        Begin
          if Target = '*' then Exit;
          locate12;
          Write('Will you be using labels that contain letters AND numbers (Y/N) ? ');
          alpha := Yes;
          if alpha
            then
              Begin
                Cursor(off);
                locate12;
                Write('Please wait ... ');
                Sort_by_Num;
                locate12;
                WriteLn('Enter disk mask. DOS wildcards, "?" and "*", are supported.');
                WriteLn('Examples: MKC1 ... MKC9 = MKC?, MKC1 ... MK99 = MK?? or MK*');
                WriteLn('Enter a single "*" to quit.');
                Write('Mask: ');
                ReadLn(mask);
                if mask = '*'then Exit;
                Pad_Right(mask,'?',4);
                uppercase(mask);
                if pos('*',mask) > 0
                  then
                    for x := pos('*',mask) to length(mask) do
                      mask[x] := '?';
                locate12;
                WriteLn('Printing all "',mask,'" labels. Press any key to abort ...');
                WriteLn;
                old_target := ' ';
                cursor(off);
                for x := 1 to entries do
                  Begin
                    if copy(files[x],1,4) <> Old_target
                      then
                        Begin
                          match := True;
                          for y := 1 to 4 do
                            Begin
                              if mask[y] <> '?'
                                then
                                  if files[x][y] <> mask[y]
                                    then
                                      Begin
                                        match := False;
                                        y := 4
                                      End { if files }
                            End; { for y := }
                          if match
                            then
                              Begin
                                target := copy(files[x],1,4);
                                old_target := target;
                                GotoXY(1,WhereY);
                                Write('Writing Label for Disk ',target);
                                print_label(target);
                                if exit_flag
                                  then
                                    Begin
                                      WriteLn;
                                      WriteLn;
                                      Exit
                                    End { if Exit }
                              End { if match }
                        End { if copy }
                  End; { for x := }
                WriteLn;
                WriteLn
              End { if alpha }
            else
              Begin
                ok := False;
                Repeat { until Ok }
                  locate12;
                  Write('Enter beginning disk number (1-9999, "*" to quit) ? ');
                  ReadLn(targ_b);
                  if targ_b = '*' then Exit;
                  WriteLn;
                  Write('Enter ending disk number (1-9999, "*" to quit) ? ');
                  ReadLn(targ_e);
                  if targ_e = '*' then Exit;
                  val(targ_b,tb,x);
                  val(targ_e,te,y);
                  Ok := (x + y = 0)
                Until Ok;
                locate12;
                Cursor(off);
                Writeln('Press any key to abort printing ...');
                WriteLn;
                for count_t := tb to te do
                  Begin
                    GotoXY(1,WhereY);
                    Write('Writing Label for Disk ',target);
                    Str(count_t,target);
                    print_label(target);
                    if exit_flag then Exit
                  End { for count }
              End { else if alpha }
        End { else if not numerous }
  End; { Proc Write_Label }

Procedure Do_It; { Essentially the main loop }
  Begin
    Get_Cursor;
    Cursor(Off);
    Init;
    Read_Data_From_Disk;
    Repeat { Until Choice = Q, *, or Esc }
      if Sort_Flag then Sort_By_Num;
      ClrScr;
      Cursor(Off);
      ShowMenu;
      Repeat { Until a valid choice is selected }
        Repeat Until KeyPressed;
        Read(kbd,choice);
        choice := UpCase(choice)
      Until pos(choice,'ABCDFLPQW*' + #27) > 0;
      Cursor(On);
      Case choice of
        'A' : Add;
        'B' : Backup;
        'C' : Configure;
        'D' : Zap;
        'F' : Find;
        'L' : List_Records;
        'P' : Print_List;
        'W' : Write_Label
      End { Case of Choice }
    Until (choice = #27) or (choice = 'Q') or (choice = '*');
    Set_Cursor(Start_Line,End_Line);
    ClrScr;
  End; { Proc Do_It }

Begin       {     ╒═════════════════════════════════════════╕     }
  Do_It     {     │                  Main                   │     }
End.        {     ╘═════════════════════════════════════════╛     }