home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PC_DISK.ZIP / PC-DISK4.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-07-31  |  29.4 KB  |  958 lines

  1. Program pc_disk4;
  2. {$C-}
  3. { types and vars req'd for disk space and dir procedures }
  4. {This is a modification of PC-DISK that allows it to read files created
  5. by SDIR and AX to get the comment information it needs for its catalog.}
  6.  
  7. Const
  8.   blink_yes    = true;
  9.   blink_no     = false;
  10.   yes_no       : set of char = ['Y','y','N','n'];
  11.   max_records  = 1000;
  12. Type
  13.   names        = string[80];
  14.   regpack      = record
  15.                    ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
  16.                  end;
  17.   mem_ptr      = ^pointer_type;
  18.   pointer_type = array [1..2] of integer;
  19.   fname_type   = string[11];
  20.   memo_type    = string[33];
  21.   word         = array [1..2] of char;
  22.   cat_type     = record
  23.                    vol_record : integer;
  24.                    fil        : string[11];
  25.                    sizelo     : word;
  26.                    sizehi     : word;
  27.                    time       : word;
  28.                    date       : word;
  29.                    memo       : string[33];
  30.                  end;
  31.   temp_type     = record
  32.                    fil        : string[11];
  33.                    sizelo     : word;
  34.                    sizehi     : word;
  35.                    time       : word;
  36.                    date       : word;
  37.                    memo       : string[33];
  38.                  end;
  39.   string14     = string[14];
  40.  
  41. Var
  42.   R                             : regpack;
  43.   pointer,dta,fcb_addr          : mem_ptr;
  44.   asciiz,filez                  : string[32];  {string input for dir scan}
  45.   fname,volume                  : fname_type;
  46.   bts                           : real;
  47.   x, i, y, q, e, w, check_num,
  48.   drv, crt_reg,
  49.   cat_num, vol_num              : Integer;
  50.   ok, done, found, changed      : Boolean;
  51.   ch, ch2,ch1, default_drive,
  52.   auto_load, cnf_drive          : Char;
  53.   catfile                       : file of cat_type;
  54.   one_memo                      : memo_type;
  55.   cat_array                     : array [1..max_records] of cat_type;
  56.   vol_array                     : array [1..100] of fname_type;
  57.   temp_array                    : array [1..100] of temp_type;
  58.   catname                       : string[14];
  59.   cnf                           : text;
  60.   dta_area                      : array [1..130] of byte;
  61.   fcb                           : array [-7..36] of char;
  62.   temp                          : string[11];
  63.   z, t4, t1, t2, t3, vol_min, vol_max  : integer;
  64.  
  65. {---------------------  Procedures  -----------------------------}
  66. procedure set_fcb; forward;
  67.  
  68. procedure keycontinue;
  69. var
  70.   ch : char;
  71.   x  : integer;
  72. begin
  73.   write (' Tap any key for more ');
  74.   read (kbd,ch);
  75.   for x := 1 to 22 do write (chr(8));
  76.   clreol;
  77. end;
  78.  
  79. procedure screen_off;
  80. begin
  81.   crt_reg := $c;
  82.   port[$3d4] := crt_reg;
  83.   z := port[$3d5];
  84.   port[$3d4] := crt_reg;
  85.   port[$3d5] := $8;
  86. end;
  87.  
  88. procedure screen_on;
  89. begin
  90.   port[$3d4] := crt_reg;
  91.   port[$3d5] := z;
  92. end;
  93.  
  94. procedure log_new_drive(ch:char);
  95. begin
  96.   drv := ord(ch) - ord('A');
  97.   r.dx := drv;
  98.   r.ax := $e shl 8;            { Log a new drive as the default }
  99.   msdos(R);
  100. end;
  101.  
  102. procedure read_config;
  103. begin
  104.   assign (cnf , 'pc-disk.cnf');
  105.   {$I-}
  106.   reset (cnf);
  107.   {$I+}
  108.   ok := (ioresult = 0);
  109.   if ok then
  110.     begin
  111.       readln (cnf, default_drive);
  112.       readln (cnf, catname);
  113.       readln (cnf, auto_load);
  114.       readln (cnf, cnf_drive);
  115.       close (cnf);
  116.     end
  117.   else
  118.     begin
  119.       catname := 'Catalog.Dat';
  120.       default_drive := 'A';
  121.       auto_load := 'Y';
  122.       cnf_drive := 'B';
  123.     end;
  124.   drv := ord(default_drive) - ord('A');
  125.   r.dx := drv;
  126.   r.ax := $e shl 8;            { Log cnf drive as the default }
  127.   msdos(R);
  128. end;
  129.  
  130. Procedure drawbox_ibm (x1,y1,x2,y2,FG,BG : Integer; boxname : names; blnk : boolean);
  131. Begin
  132.   window (x1,y1,x2,y1+1);
  133.   textbackground(BG);
  134.   GotoXY(1,1);
  135.   x := x2-x1;
  136.   if length(boxname) > x then boxname[0] := chr(x-4);
  137.   textcolor(FG);
  138.   Write('╒');
  139.   if blnk then textcolor(FG + blink) else textcolor(fg);
  140.   write (boxname);
  141.   textcolor(FG);
  142.   for q := x1+length(boxname)+1 to x2-1 do Write('═');
  143.   Write('╕');
  144.   for q := 2 to y2-y1 do
  145.     Begin
  146.       window (x1,y1,x2,y1+q+1);
  147.       GotoXY(1,q); Write('│');
  148.       if blnk then clreol;
  149.       GotoXY(x2-x1+1,q); Write('│');
  150.     end;
  151.   Window(x1,y1,x2,y2+1);
  152.   gotoXY(1,y2-y1+1);
  153.   Write('╘');
  154.   for q := x1+1 to x2-1 do Write('═');
  155.   Write('╛');
  156. end;
  157.  
  158. Procedure drawbox (x1,y1,x2,y2,FG,BG : Integer; boxname : Names; blnk : boolean);
  159. Begin
  160.   Drawbox_IBM (x1,y1,x2,y2,FG,BG,boxname,blnk);
  161.   Window (x1+1,y1+1,x2-1,y2-1);
  162.   Clrscr;
  163. end;
  164.  
  165. procedure write_config(default_drive, auto_load, cnf_drive:char; catname:string14);
  166. begin
  167.   write ('     Saving to ',cnf_drive + ':PC-Disk.Cnf . One moment please..');
  168.   assign (cnf, cnf_drive + ':PC-Disk.cnf');
  169.   rewrite (cnf);
  170.   writeln (cnf, default_drive);
  171.   writeln (cnf, catname);
  172.   writeln (cnf, auto_load);
  173.   writeln (cnf, cnf_drive);
  174.   close (cnf);
  175. end;
  176.  
  177. procedure load_catalog;
  178. begin
  179.   cat_num := 0;
  180.   drawbox (40,15,78,23,lightcyan,black,'[ Catalog Load ]',blink_no);
  181.   writeln;
  182.   writeln ('Loading from file ',catname);
  183.   set_fcb;
  184.   assign (catfile, catname);
  185.   {$I-}
  186.   reset (catfile);
  187.   {$I+}
  188.   ok := (ioresult=0);
  189.   if not ok then
  190.     begin
  191.       rewrite (catfile);
  192.       writeln ('File not found, Creating a new one. ');
  193.     end
  194.   else
  195.     begin
  196.       cat_num := 0;
  197.       vol_num := 0;
  198.       while (not eof(catfile)) and (cat_num < max_records + 1) do
  199.         begin
  200.           cat_num := cat_num + 1;
  201.           read (catfile, cat_array[cat_num]);
  202.           if cat_array[cat_num].vol_record > vol_num then
  203.             begin
  204.               writeln ('Invalid record found and discarded.');
  205.               cat_num := cat_num - 1;
  206.             end
  207.           else
  208.             if cat_array[cat_num].vol_record = -1 then   { vol label record }
  209.               begin
  210.                 vol_num := vol_num + 1;
  211.                 vol_array[vol_num] := cat_array[cat_num].fil;
  212.               end;
  213.         end;
  214.       writeln;
  215.       writeln (cat_num,' file entries loaded, ',max_records - cat_num,' empty.');
  216.       writeln (vol_num,' volume entries loaded, ',100-vol_num,' empty.');
  217.     end;
  218.   close (catfile);
  219. end;
  220.  
  221. procedure save_catalog;
  222. begin
  223.   drawbox (40,15,78,23,lightcyan,black,'[ Catalog Save ]',blink_no);
  224.   writeln;
  225.   writeln ('Saving to file ',catname);
  226.   set_fcb;
  227.   close (catfile);
  228.   assign (catfile, catname);
  229.   rewrite (catfile);
  230.   x := 0;
  231.   if cat_num = 0 then
  232.     writeln ('No entries to save, aborted.')
  233.   else
  234.     begin
  235.       while x < cat_num do
  236.         begin
  237.           x := x + 1;
  238.           write (catfile, cat_array[x]);
  239.         end;
  240.     end;
  241.   close (catfile);
  242.   writeln;
  243.   writeln (x,' entries saved, ',max_records-x,' empty.');
  244.   changed := false;
  245. end;
  246.  
  247. Procedure big_exit;
  248. begin
  249.   if changed then
  250.     begin
  251.       drawbox (20,10,60,16,white,red,'[ Warning! ]',blink_yes);
  252.       writeln;
  253.       writeln ('Catalog has been changed and not Saved!');
  254.       write ('Do you want to Save [Y/N] ? ');
  255.       repeat read (kbd,ch); until ch in yes_no;
  256.       if upcase(ch) = 'Y' then
  257.         save_catalog;
  258.     end;
  259.   textbackground(black);
  260.   textcolor(yellow);
  261.   window (1,1,80,25);
  262.   for x := 10 downto 1 do
  263.     for y := 2 downto 1 do
  264.       begin
  265.         window (x+y-1,x+4,82-x-y,25-x);
  266.         clrscr;
  267.         delay (5);
  268.       end;
  269.   gotoxy (29,12);
  270.   write ('PC-Disk has Completed.');
  271.   halt;
  272. end;
  273.  
  274. procedure configure;
  275. var
  276.   temp_drive, temp_load, temp_cnf : char;
  277.   temp_catname : string14;
  278. begin
  279.   drawbox (4,6,77,24,lightblue,black,'[ Configuration ]',blink_no);
  280.   writeln;
  281.   writeln ('  Current defaults:');
  282.   writeln;
  283.   gotoxy (5,4); write ('Data Drive [A-F]   > ',default_drive);
  284.   gotoxy (5,6); write ('Catalog Filename   > ',catname);
  285.   gotoxy (61,6);write ('see note 1');
  286.   gotoxy (5,8); write ('Auto Load  [Y/N]   > ',auto_load);
  287.   gotoxy (5,10);write ('Config Drive [A-F] > ',cnf_drive);
  288.   textcolor (lightgreen);
  289.   gotoxy (5,16); writeln ('Note 1 - Please include drive specifier when entering the filename');
  290.                  write   ('             so the catalog file will always reside on the same drive.');
  291.   textcolor (lightcyan);
  292.   gotoxy (28,4); repeat
  293.                    read (kbd,temp_drive);
  294.                    temp_drive := upcase(temp_drive);
  295.                  until temp_drive in ['A'..'F',#13];
  296.                  write (temp_drive);
  297.                  if temp_drive = #13 then temp_drive := default_drive;
  298.   gotoxy (42,6); buflen := 14; readln (temp_catname);
  299.                  if temp_catname = '' then temp_catname := catname;
  300.   gotoxy (28,8); repeat
  301.                    read (kbd,temp_load);
  302.                    temp_load := upcase(temp_load);
  303.                  until temp_load in ['Y','N',#13];
  304.                  write (temp_load);
  305.                  if temp_load = #13 then temp_load := auto_load;
  306.   gotoxy (28,10); repeat
  307.                     read (kbd,temp_cnf);
  308.                     temp_cnf := upcase(temp_cnf);
  309.                   until temp_cnf in ['A'..'F',#13];
  310.                   write (temp_cnf);
  311.                   if temp_cnf = #13 then temp_cnf := cnf_drive;
  312.   gotoxy (5,12); write (' Save to Configuration file ? ');
  313.                  repeat
  314.                    read (kbd,ch);
  315.                  until ch in yes_no;
  316.                  writeln (ch);
  317.   if upcase(ch) = 'Y' then
  318.     write_config(temp_drive, temp_load, temp_cnf, temp_catname);
  319.   log_new_drive(temp_drive);
  320.   default_drive := temp_drive;
  321.   cnf_drive := temp_cnf;
  322.   auto_load := temp_load;
  323.   catname := temp_catname;
  324. end;
  325.  
  326. procedure set_dta;
  327. begin
  328. {-- Set DTA address --}
  329.   pointer := addr(dta_area);
  330.   r.ds := seg(pointer^);
  331.   r.dx := ofs(pointer^);
  332.   r.ax := $1A shl 8;
  333.   MsDos(R);
  334. end;
  335.  
  336. procedure get_dta;
  337. begin
  338. {-- Get DTA address in ES:BX --}
  339.   r.ax := 0;
  340.   r.es := 0;
  341.   r.bx := 0;
  342.   r.ax := $2F shl 8;
  343.   MsDos(R);
  344.   dta := ptr(r.es,r.bx);
  345. end;
  346.  
  347. procedure set_fcb;
  348. begin
  349. {-- Set up an unopened FCB --}
  350.   for x := -7 to 36 do fcb[x] := #0;
  351.   fcb[-7] := #255;
  352.   fcb[-1] := #0;
  353.   filez := '*.*' + #0;
  354.   pointer := addr(filez[1]);
  355.   r.ds := seg(pointer^);
  356.   r.si := ofs(pointer^);
  357.   pointer := addr(fcb[0]);
  358.   r.es := seg(pointer^);
  359.   r.di := ofs(pointer^);
  360.   r.ax := $29 shl 8;
  361.   msdos(R);
  362.   set_dta;
  363.   get_dta;
  364. end;
  365.  
  366. procedure msdos12;
  367. begin
  368.   set_dta;
  369.   pointer := addr(fcb[-7]);
  370.   r.ds := seg(pointer^);
  371.   r.dx := ofs(pointer^);
  372.   r.ax := $12 shl 8;         { go after the next matching entry }
  373.   msdos(R);
  374. end;
  375.  
  376. procedure msdos11(x : integer);
  377. begin
  378.   set_fcb;
  379.   fcb[-7] := #255;
  380.   fcb[-1] := chr(x);
  381.   pointer := addr(fcb[-7]);
  382.   r.ds := seg(pointer^);
  383.   r.dx := ofs(pointer^);
  384.   r.ax := $11 shl 8;
  385.   msdos(R);
  386. end;
  387.  
  388. Procedure init;
  389. Begin
  390.   screen_off;
  391.   done := False;
  392.   changed := false;
  393.   cat_num := 0;
  394.   vol_num := 0;
  395.   drv := 0;
  396.   Window (1,1,80,25);
  397.   ClrScr;
  398.   drawbox(1,1,80,13,green,black,'',blink_no);
  399.   textcolor(yellow);
  400.   writeln (' PC-Disk represents many long hours of work.  Please help fight the high');
  401.   writeln (' cost of computer software by supporting the  FREEWARE  concept. If you');
  402.   writeln (' find this program of value, a small contribution of $35 would be greatly');
  403.   writeln (' appreciated.  In any case, please share this program with others.  No other');
  404.   writeln (' retribution may be accepted for PC-Disk except by The Forbin Project.');
  405.   writeln (' Send all comments and contributions to:');
  406.   writeln ('                           The Forbin Project');
  407.   writeln ('                           c/o John Friel III');
  408.   writeln ('                           715 Walnut Street');
  409.   writeln ('                           Cedar Falls, Iowa  50613');
  410.   write   ('           PC-Disk (c) The Forbin Project and John Friel III');
  411.   gotoxy (1,1);
  412.   screen_on;
  413.   read (kbd,ch);
  414. end;
  415.  
  416. procedure show_dta(x1,y1 : integer);
  417. var
  418.  t1,t2,d1,d2,hour,minutes,seconds,dd,mm,yy : integer;
  419.  bytes : real;
  420. begin
  421.   for x := 8 to 15 do
  422.     write(chr(mem[x1:y1+x]));
  423.   write (' ');
  424.   for x := 16 to 18 do
  425.     write(chr(mem[x1:y1+x]));
  426.   write (' ');
  427.   t1 := mem[x1:y1+30];
  428.   t2 := mem[x1:y1+31];
  429.   d1 := mem[x1:y1+32];
  430.   d2 := mem[x1:y1+33];
  431.   bytes := mem[x1:y1+37]*256.0;
  432.   bytes := bytes + mem[x1:y1+36];
  433.   bytes := bytes + mem[x1:y1+38] * 65536.0;
  434.   write (bytes:6:0,' ');
  435.   hour := (t2 and 249) shr 3;
  436.   if hour > 12 then hour := hour - 12;
  437.   minutes := ((t2 and 7) shl 3) + ((t1 and 224) shr 5);
  438.   write (hour:2,':');
  439.   if minutes < 10 then write ('0');
  440.   write (minutes);
  441.   mm := ((d2 and 1) shl 3) + ((d1 and 224) shr 5);
  442.   dd := (d1 and 31);
  443.   yy := 80 + ((d2 and 255) shr 1);
  444.   write ('  ');
  445.   if mm < 10 then write ('0'); write (mm,'-');
  446.   if dd < 10 then write ('0'); write (dd,'-');
  447.   write (yy:2);
  448. end;
  449.  
  450. function free_space(drive_letter : char) : integer;
  451. var
  452.   dl : integer;
  453. begin
  454.   drive_letter := upcase(drive_letter);
  455.   case drive_letter of
  456.     'A'..'E'  : dl := ord(drive_letter)-ord('A')+1;
  457.   else
  458.     dl := 0;
  459.   end;
  460.   r.ax :=$36 shl 8;          { disk free space }
  461.   r.dx := dl;
  462.   MsDos(R);
  463.   free_space := r.bx  { r.bx is the free space in Kbytes }
  464. end;
  465.  
  466. procedure get_vol;
  467. begin
  468.   volume := '';
  469.   msdos11(8);
  470.   if (r.ax and 255) = 0 then
  471.     begin
  472.       for x := 8 to 18 do
  473.         volume := volume + chr(mem[seg(dta^):ofs(dta^)+x]);
  474.       writeln ('Volume is ',volume);
  475.     end
  476.   else
  477.     writeln ('Disk has no Volume Label!  Aborted.');
  478. end;
  479.  
  480. procedure dir2;
  481. var
  482.   x : integer;
  483.   bytes : real;
  484. begin
  485.   drawbox (1,5,39,24,white,black,'[ Dir ]',blink_yes);
  486.   textcolor(lightgray);
  487.   x := 2;
  488.   writeln ('Place disk in drive ',default_drive);
  489.   write (' and press any key ');
  490.   read (kbd,ch);
  491.   writeln;
  492.   get_vol;
  493.   writeln;
  494.   set_fcb;
  495.   msdos11(3);
  496.   if (r.ax and 255) = 0 then
  497.     begin
  498.       while (r.ax and 255) = 0 do
  499.         begin
  500.           x := x + 1;
  501.           write (' ');
  502.           show_dta (seg(dta^),ofs(dta^));
  503.           writeln;
  504.           if x/17 = int(x/17) then keycontinue;
  505.           msdos12;
  506.         end
  507.     end
  508.   else
  509.     writeln ('Disk is Empty!');
  510.   bytes := free_space(default_drive) * 1024.0;
  511.   writeln ('    Free space = ',bytes:6:0,' bytes');
  512.   write ('Press any key to continue');
  513.   read (kbd,ch);
  514. end;
  515.  
  516. {$Ipc-disk4.inc}
  517.  
  518. function upcase33(strng : memo_type) : memo_type;
  519. var
  520.   temp : memo_type;
  521.   x : integer;
  522. begin
  523.   temp := '';
  524.   for x := 1 to length(strng) do
  525.     temp := temp + upcase(strng[x]);
  526.   upcase33 := temp;
  527. end;
  528.  
  529. procedure scan_comments;
  530. var
  531.   scanner : string[33];
  532.   bytes : real;
  533.   t1,t2,d1,d2,hour,minutes,mm,dd,yy,y : integer;
  534. begin
  535.   drawbox (7,6,60,10,lightcyan,black,'[ Scan Memos ]',blink_no);
  536.   y := 0;
  537.   writeln ('Enter string to scan for  [1-33 characters]');
  538.   writeln ('_________________________________');
  539.   gotoxy (1,2);
  540.   buflen := 33;
  541.   readln (scanner);
  542.   drawbox (1,1,80,24,cyan,black,
  543.   '[Vol Label] [Filename ] [Size] [Tm] [ Date ] [------------  Memo  -----------]',blink_no);
  544.   scanner := upcase33(scanner);
  545.   for x := 1 to cat_num do
  546.     if cat_array[x].vol_record = -1 then
  547.       volume := cat_array[x].fil
  548.     else
  549.       begin
  550.       if pos(scanner, upcase33(cat_array[x].memo)) > 0 then
  551.         begin
  552.           y := y + 1;
  553.           write (volume:11);
  554.           write (' ',cat_array[x].fil:11);
  555.           bytes := ord(cat_array[x].sizelo[2]) * 256.0;
  556.           bytes := bytes + ord(cat_array[x].sizelo[1]);
  557.           bytes := bytes + ord(cat_array[x].sizehi[1]) * 65536.0;
  558.           write (' ',bytes:6:0);
  559.           t1 := ord(cat_array[x].time[1]);
  560.           t2 := ord(cat_array[x].time[2]);
  561.           d1 := ord(cat_array[x].date[1]);
  562.           d2 := ord(cat_array[x].date[2]);
  563.           hour := (t2 and 249) shr 3;
  564.           if hour = 0 then
  565.             write (' 00')
  566.           else
  567.             if hour < 10 then
  568.               write (' 0',hour)
  569.             else
  570.               write (' ',hour);
  571.           minutes := ((t2 and 7) shl 3) + ((t1 and 224) shr 5);
  572.           if minutes < 10 then write ('0');
  573.           write (minutes);
  574.           mm := ((d2 and 1) shl 3) + ((d1 and 224) shr 5);
  575.           dd := (d1 and 31);
  576.           yy := 80 + ((d2 and 255) shr 1);
  577.           write (' ');
  578.           if mm < 10 then write ('0'); write (mm,'-');
  579.           if dd < 10 then write ('0'); write (dd,'-');
  580.           write (yy:2);
  581.           write (' ',cat_array[x].memo);
  582.           if length(cat_array[x].memo) < 33 then writeln;
  583.           if y/21 = int(y/21) then keycontinue;
  584.         end;
  585.       end;
  586.   writeln;
  587.   write ('End of catalog. Press any key to continue');
  588.   read (kbd,ch);
  589. end;
  590.  
  591. function upcase11(strng : fname_type) : fname_type;
  592. var
  593.   temp : fname_type;
  594.   x : integer;
  595. begin
  596.   temp := '';
  597.   for x := 1 to length(strng) do
  598.     temp := temp + upcase(strng[x]);
  599.   upcase11 := temp;
  600. end;
  601.  
  602. procedure scan_files;
  603. var
  604.   scanner : string[11];
  605.   bytes : real;
  606.   t1,t2,d1,d2,hour,minutes,mm,dd,yy,y: integer;
  607. begin
  608.   drawbox (7,6,60,10,lightcyan,black,'[ Scan Filenames ]',blink_no);
  609.   y := 0;
  610.   writeln ('Enter string to scan for  [1-11 characters]');
  611.   writeln ('___________');
  612.   gotoxy (1,2);
  613.   buflen := 11;
  614.   readln (scanner);
  615.   drawbox (1,1,80,24,cyan,black,
  616.   '[Vol Label] [Filename ] [Size] [Tm] [ Date ] [------------  Memo  -----------]',blink_no);
  617.   scanner := upcase11(scanner);
  618.   for x := 1 to cat_num do
  619.     if cat_array[x].vol_record = -1 then
  620.       volume := cat_array[x].fil
  621.     else
  622.       begin
  623.       if pos(scanner, upcase11(cat_array[x].fil)) > 0 then
  624.         begin
  625.           y := y + 1;
  626.           write (volume:11);
  627.           write (' ',cat_array[x].fil:11);
  628.           bytes := ord(cat_array[x].sizelo[2]) * 256.0;
  629.           bytes := bytes + ord(cat_array[x].sizelo[1]);
  630.           bytes := bytes + ord(cat_array[x].sizehi[1]) * 65536.0;
  631.           write (' ',bytes:6:0);
  632.           t1 := ord(cat_array[x].time[1]);
  633.           t2 := ord(cat_array[x].time[2]);
  634.           d1 := ord(cat_array[x].date[1]);
  635.           d2 := ord(cat_array[x].date[2]);
  636.           hour := (t2 and 249) shr 3;
  637.           if hour = 0 then
  638.             write (' 00')
  639.           else
  640.             if hour < 10 then
  641.               write (' 0',hour)
  642.             else
  643.               write (' ',hour);
  644.           minutes := ((t2 and 7) shl 3) + ((t1 and 224) shr 5);
  645.           if minutes < 10 then write ('0');
  646.           write (minutes);
  647.           mm := ((d2 and 1) shl 3) + ((d1 and 224) shr 5);
  648.           dd := (d1 and 31);
  649.           yy := 80 + ((d2 and 255) shr 1);
  650.           write (' ');
  651.           if mm < 10 then write ('0'); write (mm,'-');
  652.           if dd < 10 then write ('0'); write (dd,'-');
  653.           write (yy:2);
  654.           write (' ',cat_array[x].memo);
  655.           if length(cat_array[x].memo) < 33 then writeln;
  656.           if y/21 = int(y/21) then keycontinue;
  657.         end;
  658.       end;
  659.   writeln;
  660.   write ('End of catalog. Press any key to continue');
  661.   read (kbd,ch);
  662. end;
  663.  
  664. procedure vol_disk;
  665. var
  666.   newvol : fname_type;
  667. begin
  668.   drawbox (3,15,55,20,lightgreen,black,'[ Volume Disk ]',blink_no);
  669.   volume := '';
  670.   msdos11(8);
  671.   if (r.ax and 255) = 0 then
  672.     begin
  673.       for x := 8 to 18 do
  674.         volume := volume + chr(mem[seg(dta^):ofs(dta^)+x]);
  675.       writeln ('Current Volume is ',volume);
  676.       write ('Are you sure you want to change ? ');
  677.       repeat read (kbd,ch); until ch in yes_no;
  678.       if upcase(ch) = 'Y' then
  679.         begin
  680.           writeln;
  681.           write ('Enter new Volume Label >');
  682.           buflen := 11;
  683.           readln (newvol);
  684.           for x := length(newvol) to 11 do newvol := newvol + ' ';
  685.           for x := 17 to 28 do fcb[x] := newvol[x-16];
  686.           pointer := addr(fcb[-7]);
  687.           r.ds := seg(pointer^);
  688.           r.dx := ofs(pointer^);
  689.           r.ax := $17 shl 8;
  690.           msdos(R);
  691.         end
  692.     end
  693.   else
  694.     begin
  695.       write ('Enter new Volume Label >');
  696.       buflen := 11;
  697.       readln (newvol);
  698.       for x := length(newvol) to 11 do newvol := newvol + ' ';
  699.       for x := 1 to 11 do fcb[x] := newvol[x];
  700.       pointer := addr(fcb[-7]);
  701.       r.ds := seg(pointer^);
  702.       r.dx := ofs(pointer^);
  703.       r.ax := $16 shl 8;
  704.       msdos(R);
  705.     end;
  706. end;
  707.  
  708. procedure scan_submenu;
  709. begin
  710.   drawbox(1,5,80,9,lightred,black,'[ Scan Sub-Menu ]',blink_no);
  711.   writeln ;
  712.   write ('  1) Filenames   2) Memos   3) Exit   Your choice ? ');
  713.   repeat
  714.     read (kbd,ch);
  715.   until ch in ['1'..'3'];
  716.   case ch of
  717.     '1' : scan_files;
  718.     '2' : scan_comments;
  719.   end;
  720. end;
  721.  
  722. procedure delete_volume;
  723. var
  724.   vnum : integer;
  725. begin
  726.   drawbox (2,5,78,24,white,black,'[ Delete Volume ]',blink_yes);
  727.   writeln (' Select the volume to be deleted by entering the number');
  728.   writeln (' associated with the Volume Label.');
  729.   for x := 1 to vol_num do
  730.     write (' ',x:2,')',vol_array[x]:11);
  731.   writeln;
  732.   repeat
  733.     write ('Enter volume number :');
  734.     readln (vnum);
  735.   until (vnum > 0) and (vnum <= vol_num);
  736.   writeln;
  737.   write ('Delete volume ',vol_array[vnum],' [Y/N] ? ');
  738.   repeat read (kbd,ch); until ch in yes_no;
  739.   if upcase(ch) = 'Y' then
  740.     begin
  741.       writeln ('Deleting volume ',vol_array[vnum]);
  742.       vol_min := 0;
  743.       vol_max := 0;
  744.       t2 := 0;  { count files found on disk }
  745.       for x := 1 to cat_num  do
  746.         if (cat_array[x].vol_record = vnum) and (vol_min = 0) then
  747.           vol_min := x - 1
  748.         else
  749.           if (vol_min <> 0 ) and (vol_max = 0) and (cat_array[x].vol_record <> vnum) then
  750.             vol_max := x - 1 ;
  751.       if vol_max = 0 then vol_max := cat_num;
  752.       t1 := vol_max - vol_min + 1;
  753.       for x := (vol_max + t2-t1 + 1) to (cat_num + t2 - t1) do
  754.         cat_array[x] := cat_array[x -(t2-t1)];
  755.       if vnum = vol_num then
  756.         cat_num := vol_min - 1
  757.       else
  758.         cat_num := x;
  759.       { now renumber the cat_array }
  760.       vol_num := 0;
  761.       for x := 1 to cat_num do
  762.         begin
  763.           if cat_array[x].vol_record = -1 then
  764.             begin
  765.               vol_num := vol_num + 1;
  766.               vol_array[vol_num] := cat_array[x].fil;
  767.             end
  768.           else
  769.             cat_array[x].vol_record := vol_num;
  770.         end;
  771.     end
  772.   else
  773.     writeln ('Aborted.');
  774.   write (' Press any key to continue ');
  775.   read(kbd,ch);
  776. end;
  777.  
  778. procedure show_catalog;
  779. begin
  780.   drawbox (1,5,30,24,white,black,'show',blink_no);
  781.   for x := 1 to cat_num do
  782.    begin
  783.     writeln (x,' ',cat_array[x].vol_record,' ',cat_array[x].fil);
  784.     if x/17 = int(x/17) then keycontinue;
  785.    end;
  786.   read (kbd,ch);
  787. end;
  788.  
  789. procedure Help_tutor;
  790. begin
  791.   drawbox (10,7,73,20,white,black,'[ Help Tutorial ]',blink_no);
  792.   gotoxy (1,1);
  793.   textcolor (white);
  794.   writeln ('                  System Requirements');
  795.   textcolor (lightcyan);
  796.   writeln (' PC-Disk needs at least 128K of ram, DOS 2.0 or higher,');
  797.   writeln (' and at least one disk drive.  Two drives or the use of');
  798.   writeln (' a RamDrive is recommended.');
  799.   writeln;
  800.   keycontinue;
  801.   clrscr;
  802.   textcolor (white);
  803.   writeln ('                     Load Catalog');
  804.   textcolor (lightcyan);
  805.   writeln (' This is used to load the catalog file into memory.  If');
  806.   writeln (' you don''t have a catalog file, this will also create');
  807.   writeln (' one for you.  It is a good idea to have the catalog');
  808.   writeln (' loaded for you every time you start the program. ');
  809.   writeln;
  810.   keycontinue;
  811.   clrscr;
  812.   textcolor (white);
  813.   writeln ('                       Disk Dir');
  814.   textcolor (lightcyan);
  815.   writeln (' This shows you the same information as if you issued');
  816.   writeln (' a "DIR /P" command from the DOS prompt. One addition');
  817.   writeln (' has been made.  PC-Disk asks you to place a disk in');
  818.   writeln (' the default Data drive and press any key.  This way');
  819.   writeln (' you can swap disks, get a "DIR" and never leave the');
  820.   writeln (' program!  The default Data drive is set in the config-');
  821.   writeln (' uration menu.');
  822.   writeln;
  823.   keycontinue;
  824.   clrscr;
  825.   textcolor (white);
  826.   writeln ('                     Update Catalog');
  827.   textcolor (lightcyan);
  828.   writeln (' PC-Disk prompts you to put a disk in the Data drive and');
  829.   writeln (' press any key.  It then checks to see if the disk had a');
  830.   writeln (' Volume Label.  PC-Disk requires the disk to have one so');
  831.   writeln (' you can reference your files by Volume name.  If the Label');
  832.   writeln (' is found, it is displayed on the screen.  Then a check is');
  833.   writeln (' made to see if you are updating the catalog or adding a ');
  834.   writeln (' new disk.  Should the disk already be cataloged, each file');
  835.   writeln (' is displayed with the previously entered memo and you are');
  836.   writeln;
  837.   keycontinue;
  838.   clrscr;
  839.   writeln (' asked if you want to replace the memo.  Answer "Y" or "N".');
  840.   writeln (' If you answered "Y", you are then prompted for the new');
  841.   writeln (' memo.  A "N" response goes to the next file on the disk.');
  842.   writeln (' If the disk being updated is new to the catalog, every file');
  843.   writeln (' will be displayed and you will be prompted by "Memo >" in');
  844.   writeln (' which to enter a memo.  The memo field is optional, but ');
  845.   writeln (' comes in handy when you want to use the scan feature of PC-');
  846.   writeln (' Disk.  When all files have been replied to, PC-Disk then');
  847.   writeln (' updates the catalog in MEMORY.');
  848.   writeln;
  849.   keycontinue;
  850.   clrscr;
  851.   textcolor (white);
  852.   writeln ('                     Save Catalog');
  853.   textcolor (lightcyan);
  854.   writeln (' Does just what it implies.  It saves the catalog that is');
  855.   writeln (' currently in memory to the catalog disk file.  If you make');
  856.   writeln (' any changes to the catalog, you MUST save it before you');
  857.   writeln (' exit or all the changes are lost.');
  858.   writeln;
  859.   keycontinue;
  860.   clrscr;
  861.   textcolor (white);
  862.   writeln ('                     Scan Catalog');
  863.   textcolor (lightcyan);
  864.   writeln (' This option brings up a sub-menu that asks you which field');
  865.   writeln (' you want to scan.  After selecting Filenames or Memos, an-');
  866.   writeln (' other window opens up prompting for the scan string.  File');
  867.   writeln (' names are stored without the "." between the name and the');
  868.   writeln (' suffix, so don''t enter a "." when scanning filenames!  Now');
  869.   writeln (' PC-Disk uses the whole screen to show all the matching ');
  870.   writeln (' entries complete with the directory information and memos.');
  871.   writeln;
  872.   keycontinue;
  873.   clrscr;
  874.   textcolor (white);
  875.   writeln ('                     Delete Volume');
  876.   textcolor (lightcyan);
  877.   writeln (' PC-Disk numbers all of the Volume Labels and asks you to');
  878.   writeln (' choose which one you want to delete.  It then asks you');
  879.   writeln (' again if you are sure you want to do this.  A response of');
  880.   writeln (' "N" aborts the delete and you then return to the main ');
  881.   writeln (' menu.  Should you delete the wrong volume, remember - you');
  882.   writeln (' can reload the catalog from disk with option 1. (doing ');
  883.   writeln (' this would also negate any updates not saved to disk');
  884.   writeln (' during the current session... beware.)');
  885.   writeln;
  886.   keycontinue;
  887.   clrscr;
  888.   textcolor (white);
  889.   writeln ('                 Add/Change Volume Label');
  890.   textcolor (lightcyan);
  891.   writeln (' This is so you can add or change a Volume Label on any');
  892.   writeln (' disk.  PC-Disk requires a Volume Label for update.  If');
  893.   writeln (' a disk is already labeled, the old label is shown and');
  894.   writeln (' you are asked if you really want to re-label it.  If it');
  895.   writeln (' is a disk without a label, you are prompted to enter the');
  896.   writeln (' new label.  Viola! A labeled disk!');
  897.   writeln;
  898.   keycontinue;
  899.   clrscr;
  900.   textcolor (white);
  901.   writeln ('                 Configuration');
  902.   textcolor (lightcyan);
  903.   writeln (' Four prompts here.  The first one is the Data Drive.  Its');
  904.   writeln (' drive you want to use for swapping disks during updates.');
  905.   writeln (' The second prompt is the Catalog Filename.  This can be');
  906.   writeln (' any valid DOS filename.  Please include a drive specifier');
  907.   writeln (' with it unless you have a one-disk system.  Third is the');
  908.   writeln (' Auto Load prompt.  This tells PC-Disk wether or not to');
  909.   writeln (' load the Catalog file automatically on start-up. And last');
  910.   writeln (' is the drive to store this Configuration to.  It should');
  911.   writeln (' be the same drive as this program is stored on.');
  912.   writeln;
  913.   keycontinue;
  914. end;
  915.  
  916. procedure options;
  917. begin
  918.   repeat
  919.     Drawbox (1,1,80,4,brown,black,'',blink_yes);
  920.     textcolor(lightgreen);
  921.     Writeln ('                          PC-Disk  Version 1.21 ');
  922.     Write   ('               (c) The Forbin Project  23 September 1984');
  923.     drawbox(1,5,80,15,yellow,black,'[ Main Menu ]',blink_no);
  924.     writeln;
  925.     writeln ('  Options:    0) Help Tutorial             5) Scan Catalog in Memory');
  926.     writeln ('              1) Load Catalog from Disk    6) Delete Volume in Memory');
  927.     writeln ('              2) Disk Dir                  7) Add/Change Volume Label');
  928.     writeln ('              3) Update Catalog in Memory  8) Configuration');
  929.     writeln ('              4) Save Catalog to Disk      9) Exit PC-Disk');
  930.     writeln;
  931.     write   ('                    Your choice ');
  932.     gotoxy (33,8);
  933.     repeat
  934.       read (kbd,ch);
  935.     until ch in ['0'..'9','-'];
  936.     case ch of
  937.       '0' :  Help_tutor;
  938.       '1' :  Load_catalog;
  939.       '2' :  dir2;
  940.       '3' :  update_disk;
  941.       '4' :  save_catalog;
  942.       '5' :  scan_submenu;
  943.       '6' :  delete_volume;
  944.       '7' :  vol_disk;
  945.       '8' :  configure;
  946.       '9' :  big_exit;
  947.       '-' :  show_catalog;
  948.     end; { case }
  949.   until done;
  950. end;
  951.  
  952. begin
  953.   read_config;
  954.   init;
  955.   if auto_load = 'Y' then load_catalog;
  956.   options;
  957.   halt;
  958. end.