home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FAQ-S.ZIP / LISTSAVE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-10-20  |  4.2 KB  |  149 lines
  1.   procedure listfile (n:integer; extended:boolean);
  2.  
  3.   var ud       :udrec;
  4.       q,xy     :sstr;
  5.       a        :string;
  6.       b        :string;
  7.       c        :string;
  8.       ed       :string;
  9.       desc     :string;
  10.       lamedata :string[1];
  11.       up1      :byte;
  12.       dah      :boolean;
  13.   begin
  14.     seekudfile (n);
  15.     read (udfile,ud);
  16.     if asciigraphics in urec.config then
  17.     write (^R'│'^S+strr(n)+^R) else write(^R'|'^S+strr(n)+^R);
  18.     spacelen(3-length(strr(n)));
  19.     if asciigraphics in urec.config then
  20.     write (^R'│ ') else write(^R'| ');
  21.     write(^S+UPSTRING(ud.filename));
  22.     spacelen(13-length(ud.filename));
  23.     if asciigraphics in urec.config then
  24.     write (^R'│'^S) else write(^R'|'^S);
  25.     desc:=ud.programname;
  26.     dah:=false;
  27.     if ud.newfile
  28.       then write (^P'['^S'New'^P']   ')
  29.       else if ud.specialfile
  30.         then write (^P'['^S'Ask'^P']   ')
  31.         else if ud.points>0
  32.           then tab (strr(ud.points),8)
  33.           else write (^P'['^S'Free'^P']  ');
  34.     if asciigraphics in urec.config then
  35.     write (^R'│') else write(^R'|');
  36. if exist (getfname(ud.path,ud.filename)) then begin
  37. write(^S,strlong(ud.filesize));
  38. spacelen(11-length(strlong(ud.filesize)));
  39. if asciigraphics in urec.config then
  40. write (^R'│') else write(^R'|');
  41. end;
  42. if not exist (getfname(ud.path,ud.filename)) then begin
  43.      write (^P'['^S'Offline'^P']'^R'  ');
  44.      if asciigraphics in urec.config then write(^R'│') else write(^R'|');
  45. end;
  46.   {if length(ud.descrip)<=2 then begin
  47.     write (^P'['^S' No Description '^P']');
  48.     spacelen(19);
  49.     if asciigraphics in urec.config then
  50.     writeLn(^R'│') else writeln(^R'|');
  51.     end;
  52.    if length(ud.descrip)>38 then begin
  53.  repeat
  54.    up1:=37;
  55.  repeat
  56.    dec(up1);
  57.    lamedata:=copy(desc,up1,1);
  58.  
  59.  if (lamedata=' ') and (dah=true) and (length(desc)>38) then begin
  60.   inc(cn);
  61.   if asciigraphics in urec.config then
  62.   write (^R'│   │              │        │           │') else
  63.   write (^R'|   |              |        |           |');
  64.   write(^S+copy(desc,1,up1));
  65.   spacelen(37-length(copy(desc,1,up1)));
  66.   if asciigraphics in urec.config then
  67.   writeln(^R'│') else writeln(^R'|');
  68.   delete(desc,1,up1);
  69.  end;
  70.  
  71.  if (lamedata=' ') and (dah=false) then begin
  72.    inc(cn);
  73.    write(^s,copy(desc,1,up1));
  74.    spacelen(37-length(copy(desc,1,up1)));
  75.    if asciigraphics in urec.config then
  76.    writeln(^R,'│') else writeln(^R,'|');
  77.    delete(desc,1,up1);
  78.    dah:=true
  79.  end;
  80.  
  81.  until (lamedata=' ')
  82.  until (length(desc)<=37);
  83.  end;
  84. if length(ud.descrip)>38 then begin
  85.  if asciigraphics in urec.config then
  86.  write (^R'│   │              │        │           │') else
  87.  write (^R'|   |              |        |           |');
  88. end;
  89. if length(desc)>2 then begin
  90.  write(^S+desc);
  91.  spacelen(37-length(desc));
  92.  writeln(^R'│');}
  93.     write (^R' ');
  94.     write (^S+ud.programname);
  95.     spacelen(27-length(ud.programname));
  96.     if asciigraphics in urec.config then
  97.     write (^R'│ ') else write (^R'| ');
  98.     xy:=^S+strr(ud.disknum)+^R'/'^S+strr(ud.totaldisk);
  99.     tab (xy,10);
  100.     if asciigraphics in urec.config then
  101.     writeln(^R'│') else writeln(^R'|');
  102.  if cn>19{18} then cn:=19{18};
  103.   {end;}
  104.  end;
  105.  
  106.   function nofiles:boolean;
  107.   begin
  108.     if numuds=0 then begin
  109.       nofiles:=true;
  110.       writestr (^M'Sorry, no files!')
  111.     end else nofiles:=false;
  112.   end;
  113.  
  114.   Function capfir(inString:STRING):STRING;
  115.  begin
  116.    capfir:=upcase(inString[1]);
  117.  end;
  118.  
  119.   procedure listfiles (extended:boolean);
  120.   var cnt,max,r1,r2:integer;
  121.       non:boolean;
  122.   begin
  123.     if nofiles then exit;
  124.     clearscr;
  125.     cn:=0;
  126.     non:=false;
  127.     max:=numuds;
  128.     thereare (max,'File','Files');
  129.     parserange (max,r1,r2);
  130.     if r1=0 then exit;
  131.    writeln;
  132.    topfileline;
  133.     for cnt:=r1 to r2 do begin
  134.      inc(cn);
  135.        if (cn>=19{18}) and (non=false) then
  136.      begin
  137.       bottomfileline;
  138.       cn:=0;
  139.       writestr(^P'File Listings Comamnds ['^S'Q/'^R'Quit'^P' - '^S'N/'^R'Non-stop'^P']'^S': '^U'*');
  140.       if capfir(input)='Q' then exit;
  141.       if capfir(input)='N' then non:=true;
  142.       topfileline;
  143.      end;
  144.       listfile (cnt,extended);
  145.       if break then exit
  146.     end;
  147.   bottomfileline;
  148.   end;
  149.