home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 153.img / TELES.ZIP / FILESC.PAS < prev    next >
Pascal/Delphi Source File  |  1988-07-24  |  39KB  |  1,393 lines
  1. {$R-}    {Range checking off}
  2. { $B+}    {Boolean complete evaluation on}
  3. {$S+}    {Stack checking on}
  4. {$I+}    {I/O checking on}
  5. {$N-}    {No numeric coprocessor}
  6. {$V-}
  7.  
  8. Unit FileSc;
  9.  
  10. Interface
  11.  
  12. Uses
  13.   Crt,
  14.   Dos,
  15.   Common,
  16.   Turbo3,
  17.   Unit1,
  18.   Unit0,
  19.   UnitX;
  20.  
  21. function dcs:boolean;
  22. procedure idl;
  23. procedure newfiles(b:integer; var abort:boolean);
  24. procedure dlbatch;
  25. procedure lfii;
  26. procedure iul;
  27. procedure unlisted_download(i:astr);
  28. procedure term;
  29. procedure dir(cd,x:astr; all,tf:boolean);
  30. procedure dirf(tf:boolean);
  31. procedure searchb(b:integer; fn:astr; var abort:boolean);
  32. procedure searchbd(b:integer; ts:astr; var abort:boolean);
  33. procedure search;
  34. procedure searchd;
  35. procedure nf;
  36. procedure sort;
  37. procedure yourfileinfo;
  38. procedure listfiles;
  39. procedure remove;
  40. procedure move;
  41. procedure editfiles;
  42. procedure setdirs;
  43. procedure pointdate;
  44. procedure listboards(z:astr);
  45.  
  46. Implementation
  47.  
  48. var
  49.   Zmodem:boolean;
  50.   Fpneed:integer;
  51.  
  52. procedure ansig(x:integer; y:integer);
  53. begin
  54.   pr1(#27+'['+cstr(y)+';'+cstr(x)+'H');
  55.   gotoxy(x,y);
  56. end;
  57.  
  58.  
  59. procedure freebytes;
  60. var r:real; regs:registers;
  61. begin
  62.   regs.dx:=0;
  63.   regs.ax:=$36*256;
  64.   MsDos(regs);
  65.   r:=(regs.ax)*(regs.bx)*(regs.cx);
  66.   prompt(cstrr(r,10)+' Bytes');
  67. end;
  68.  
  69. function dcs:boolean;
  70. begin
  71.   dcs:=cs or (thisuser.dsl>=200);
  72. end;
  73.  
  74. function stripname(i:astr):astr;
  75. var i1:astr; n:integer;
  76.   function nextn:integer;
  77.   var n:integer;
  78.   begin
  79.     n:=pos(':',i1);
  80.     if n=0 then
  81.       n:=pos('\',i1);
  82.     if n=0 then
  83.       n:=pos('/',i1);
  84.     nextn:=n;
  85.   end;
  86. begin
  87.   i1:=i;
  88.   while nextn<>0 do
  89.     i1:=copy(i1,nextn+1,80);
  90.   stripname:=i1;
  91. end;
  92.  
  93. function tcheck(s:real; i:integer):boolean;
  94. var r:real;
  95. begin
  96.   r:=timer-s;
  97.   if r<0.0 then r:=r+86400.0;
  98.   if (r<0.0) or (r>32760.0) then r:=32766.0;
  99.   if trunc(r)>i then tcheck:=false else tcheck:=true;
  100. end;
  101.  
  102. function tchk(s:real; i:real):boolean;
  103. var r:real;
  104. begin
  105.   r:=timer;
  106.   if r<s then r:=r+86400.0;
  107.   if (r-s)>i then tchk:=false else tchk:=true;
  108. end;
  109.  
  110. function uc(s:astr):astr;
  111. var x:astr; i:integer;
  112. begin
  113.   x:=s;
  114.   for i:=1 to length(s) do
  115.     x[i]:=upcase(x[i]);
  116.   uc:=x;
  117. end;
  118.  
  119. procedure ymbadd(fn:astr);
  120. var t1,t2:real; f:file; inte:integer;
  121. begin
  122.   nl;
  123.   assign(f,fn); {$I-} reset(f,1024); {$I+}
  124.   if ioresult<>0 then
  125.     print('File doesn''t exist')
  126.   else begin
  127.     inte:=value(spd); if inte=0 then inte:=1200;
  128.     t1:=(filesize(f))*12960.0/inte;
  129.     close(f);
  130.     t2:=ymbtt+t1;
  131.     if t2>nsl then
  132.       print('Not enough time left in queue.')
  133.     else
  134.       if ymodemfiles=20 then
  135.         print('Too many files in queue.')
  136.       else
  137.         begin
  138.         ymodemfiles:=ymodemfiles+1;
  139.         ymbary[ymodemfiles].fn:=fn;
  140.         ymbary[ymodemfiles].tt:=t1;
  141.         ymbtt:=t2;
  142.         print('File added to batch queue.');
  143.         print('Batch - Files: '+cstr(ymodemfiles)+'  Time: '+ctim(ymbtt));
  144.       end;
  145.   end;
  146.   nl;
  147. end;
  148.  
  149. procedure ymbdel(n:integer);
  150. var c:integer;
  151. begin
  152.   if (n<=ymodemfiles) and (n>0) then begin
  153.     ymbtt:=ymbtt-ymbary[n].tt;
  154.     if n=ymodemfiles then
  155.       ymodemfiles:=ymodemfiles-1
  156.     else begin
  157.       for c:=n to ymodemfiles-1 do begin
  158.         ymbary[c].fn:=ymbary[c+1].fn;
  159.         ymbary[c].tt:=ymbary[c+1].tt;
  160.       end;
  161.       ymodemfiles:=ymodemfiles-1;
  162.     end;
  163.   end;
  164. end;
  165.  
  166. {$I DLP1.PAS}
  167.  
  168. function exist(fn:astr):boolean;
  169. var f:file;
  170. begin
  171.   assign(f,fn);
  172.   {$I-} reset(f); {$I+}
  173.   if ioresult=0 then begin close(f); exist:=true end else exist:=false;
  174. end;
  175.  
  176. function align(fn:astr):astr;
  177. var f,e,t:astr; c,c1:integer;
  178. begin
  179.   c:=pos('.',fn);
  180.   if c=0 then begin
  181.     f:=fn; e:='   ';
  182.   end else begin
  183.     f:=copy(fn,1,c-1); e:=copy(fn,c+1,3);
  184.   end;
  185.   while length(f)<8 do f:=f+' ';
  186.   while length(e)<3 do e:=e+' ';
  187.   if length(f)>8 then f:=copy(f,1,8);
  188.   if length(e)>3 then e:=copy(e,1,3);
  189.   c:=pos('*',f); if c<>0 then for c1:=c to 8 do f[c1]:='?';
  190.   c:=pos('*',e); if c<>0 then for c1:=c to 3 do e[c1]:='?';
  191.   c:=pos(' ',f); if c<>0 then for c1:=c to 8 do f[c1]:=' ';
  192.   c:=pos(' ',e); if c<>0 then for c1:=c to 3 do e[c1]:=' ';
  193.   align:=f+'.'+e;
  194. end;
  195.  
  196. function fit(f1,f2:astr):boolean;
  197. var tf:boolean; c:integer;
  198. begin
  199.   tf:=true;
  200.   for c:=1 to 12 do
  201.     if (f1[c]<>f2[c]) and (f1[c]<>'?') then tf:=false;
  202.   fit:=tf;
  203. end;
  204.  
  205. procedure fiscan(var pl:integer);
  206. var f:ulfrec;
  207. begin
  208.   assign(ulff,systat.gfilepath+uboards[FILEBOARD].filename+'.DIR');
  209.   {$I-} reset(ulff); {$I+}
  210.   if ioresult<>0 then begin
  211.     rewrite(ulff);
  212.     f.blocks:=0;
  213.     write(ulff,f);
  214.   end;
  215.   seek(ulff,0);
  216.   read(ulff,f);
  217.   pl:=f.blocks;
  218.   bnp:=false;
  219. end;
  220.  
  221. procedure recno(fn:astr; var pl,rn:integer);
  222. var c:integer;
  223.     f:ulfrec;
  224. begin
  225.   fn:=align(fn);
  226.   fiscan(pl); rn:=0; c:=1;
  227.   while (c<=pl) and (rn=0) do begin
  228.     seek(ulff,c); read(ulff,f);
  229.     if pos('.',f.filename)<>9 then begin
  230.       f.filename:=align(f.filename);
  231.       seek(ulff,c); write(ulff,f);
  232.     end;
  233.     if fit(fn,f.filename) then rn:=c;
  234.     c:=c+1;
  235.   end;
  236.   lrn:=rn;
  237.   lfn:=fn;
  238. end;
  239.  
  240. procedure nrecno(fn:astr; var pl,rn:integer);
  241. var c:integer;
  242.     f:ulfrec;
  243. begin
  244.   rn:=0;
  245.   if (lrn<pl) and (lrn>=0) then begin
  246.     c:=lrn+1;
  247.     while (c<=pl) and (rn=0) do begin
  248.       seek(ulff,c); read(ulff,f);
  249.       if pos('.',f.filename)<>9 then begin
  250.         f.filename:=align(f.filename);
  251.         seek(ulff,c); write(ulff,f);
  252.       end;
  253.       if fit(lfn,f.filename) then rn:=c;
  254.       c:=c+1;
  255.     end;
  256.     lrn:=rn;
  257.   end;
  258. end;
  259.  
  260. procedure pbn(var abort:boolean);
  261. var i,i1:astr; next:boolean;
  262. begin
  263.   if not bnp then begin
  264.     nl;
  265.     i:=#3+#3+uboards[FILEBOARD].name+' '+#3+#2+'#'+#3+#4+cstr(FILEBOARD);
  266.     i1:=#3+#0+'---'; while length(i1)<length(i) do i1:=i1+'-';
  267.     nl; nl;
  268.     printacr(i,abort,next);
  269.     printacr(i1,abort,next);
  270.     nl;
  271.     cl(7); print('Filename     Blks Pts Description');
  272.   end;
  273.   bnp:=true;
  274. end;
  275.  
  276. procedure dlx(f1:ulfrec; rn:integer; var abort:boolean);
  277. var inte,pl,c:integer; ok,tl:boolean; u:userrec; rl:real; i,ii:astr; Z:INTEGER;
  278. begin
  279.     nl; nl;
  280.     if okansi then begin
  281.       cl(2);prompt('─────────────────────────');
  282.       for z:=1 to (length(f1.description)-13) do
  283.          prompt('─');
  284.       cl(1);
  285.     end;
  286.     nl;
  287.     prompt('Filename   : ');cl(3);print('"'+f1.filename+'"');
  288.     prompt('Description: ');cl(3);print(f1.description);
  289.     prompt('# of blocks: ');cl(5);print(cstr(f1.blocks)+'-'+cstr((f1.blocks+7)div 8));
  290.     prompt('Aprox. time: ');cl(5);print(ctim(rte*f1.blocks));
  291.     reset(uf); seek(uf,f1.owner); read(uf,u); close(uf);
  292.     prompt('U/L''d by   : ');cl(4);print(u.name+' #'+cstr(f1.owner));
  293.     prompt('U/L''d on   : ');cl(4);print(f1.date);
  294.     prompt('Times D/L''d: ');cl(4);print(cstr(f1.nacc));
  295.     prompt('File points: ');cl(4); if (f1.filepoints<>999) and (f1.filepoints<>-1) then
  296.     print(cstr(f1.filepoints)) else begin
  297.     if f1.filepoints=999 then
  298.       begin cl(8); print('<New>'); end else
  299.     begin
  300.       cl(9); print('Ask (Request File)');
  301.     end;
  302.     end;
  303.     if okansi then begin
  304.       cl(2);prompt('─────────────────────────');
  305.          for z:=1 to (length(f1.description)-13) do
  306.          prompt('─');
  307.       cl(1);
  308.     end;
  309.     nl; nl;
  310.     ft:=f1.ft;
  311.     if ft<>255 then print('File type: '+cstr(ft));
  312.     if timer<timeon then timeon:=timeon-24.0*60*60;
  313.     tl:=(nsl>(rte*f1.blocks));
  314.     fpneed:=f1.filepoints;
  315.     if f1.filepoints<>-1 then begin
  316.     if thisuser.filepoints>=f1.filepoints then begin
  317.     if tl then begin
  318.       if exist(uboards[FILEBOARD].dlpath+f1.filename) then begin
  319.         send1(uboards[FILEBOARD].dlpath+f1.filename,ok,abort);
  320.         if ok then begin
  321.           f1.nacc:=f1.nacc+1;
  322.           seek(ulff,rn);
  323.           write(ulff,f1);
  324.         end;
  325.       end else print('File isn''t really there!');
  326.     end else print('Not enough time left to download');
  327.     end else
  328.       if f1.filepoints>998 then print('You can''t download UNVALIDATED files.') else
  329.       print('You don''t have enough file points to download this file.');
  330.     end else print('This is a REQUEST file -- Ask '+systat.sysopfirst+' '+systat.sysoplast+' for it.');
  331. end;
  332.  
  333. procedure dl(fn:astr);
  334. var pl,rn:integer; f:ulfrec; abort:boolean;
  335. begin
  336.   recno(fn,pl,rn); abort:=false;
  337.   if rn=0 then print('File not found.') else begin
  338.     while (rn<>0) and (not abort) and (not hangup) do begin
  339.       seek(ulff,rn); read(ulff,f); dlx(f,rn,abort);
  340.       nrecno(fn,pl,rn);
  341.     end;
  342.   end;
  343.   close(ulff);
  344. end;
  345.  
  346.   procedure copyfile(srcname,destname:astr);
  347. var buffer: array[1..16384] of byte;
  348.     dfs,nrec:integer;
  349.     src, dest: file;
  350.  
  351.     procedure dodate;
  352.     var r:registers; od,ot,ha:integer;
  353.     begin
  354.       srcname:=srcname+#0;
  355.       destname:=destname+#0;
  356.       with r do begin
  357.         ax:=$3d00; ds:=seg(srcname[1]); dx:=ofs(srcname[1]); msdos(Dos.Registers(r));
  358.         ha:=ax; bx:=ha; ax:=$5700; msdos(Dos.Registers(r));
  359.         od:=dx; ot:=cx; bx:=ha; ax:=$3e00; msdos(Dos.Registers(r));
  360.         ax:=$3d02; ds:=seg(destname[1]); dx:=ofs(destname[1]); msdos(Dos.Registers(r));
  361.         ha:=ax; bx:=ha; ax:=$5701; cx:=ot; dx:=od; msdos(Dos.Registers(r));
  362.         ax:=$3e00; bx:=ha; msdos(Dos.Registers(r));
  363.       end;
  364.     end;
  365.  
  366. begin
  367.   assign(src,srcname); reset(src,1);
  368.   if destname[2]=':' then dfs:=freek(ord(destname[1])-ord('@')) else dfs:=freek(0);
  369.   if trunc(longfilesize(src)/1024.0)+1>=dfs then begin
  370.     print('Disk full.');
  371.     close(src);
  372.   end else begin
  373.     assign(dest,destname); rewrite(dest,1);
  374.     nl; print('Copying...');
  375.     repeat
  376.       blockread(src,buffer,16384,nrec);
  377.       blockwrite(dest,buffer,nrec);
  378.     until nrec<16384;
  379.     close(dest);
  380.     close(src);
  381.     dodate;
  382.   end;
  383. end;
  384.  
  385. procedure dl1(n:integer);
  386. var f1:ulfrec; abort:boolean;
  387. begin
  388.   nl; nl;
  389.   seek(ulff,n); read(ulff,f1);
  390.   dlx(f1,n,abort);
  391.   nl;
  392. end;
  393.  
  394. procedure ul(fn:astr);
  395. var x,pl,c,cc,ob,np:integer; f,f1:ulfrec; uls,ok:boolean; fi:file of byte;
  396. begin
  397.  if freek(ord(uboards[FILEBOARD].dlpath[1])-ord('@'))>100 then begin
  398.   uls:=incom;
  399.   ob:=FILEBOARD;
  400.   ok:=true; fn:=align(fn);
  401.   if (fn[1]=' ') or (fn[10]=' ') then ok:=false;
  402.   for x:=1 to length(fn) do
  403.     if not (fn[x] in ['0'..'9','A'..'Z','.',' ','-']) then ok:=false;
  404.   np:=0; for x:=1 to length(fn) do if fn[x]='.' then np:=np+1;
  405.   if np<>1 then ok:=false;
  406.   if ok then
  407.     if incom then
  408.       if exist(uboards[FILEBOARD].dlpath+fn) then
  409.         if dcs then begin
  410.           print('There already is one.');
  411.           ynq('Do it anyways? ');
  412.           ok:=yn;
  413.           uls:=false;
  414.         end else
  415.           ok:=false
  416.       else
  417.         ok:=true
  418.     else
  419.       ok:=exist(uboards[FILEBOARD].dlpath+fn)
  420.   else print('Illegal filename.');
  421.   if (not incom) then
  422.     if ok then print('Am using the file in '+uboards[FILEBOARD].dlpath)
  423.     else begin print('To put in a file from keyboard, it must already be');
  424.                print('present in the dloads directory.'); end;
  425.   nl; nl;
  426.   if ok and incom and uls then begin
  427.     assign(fi,uboards[FILEBOARD].dlpath+fn); {$I-} rewrite(fi); {$I+}
  428.     if ioresult<>0 then begin
  429.       {$I-} close(fi); {$I+} cc:=ioresult;
  430.       ok:=false;
  431.     end else begin close(fi); erase(fi); end;
  432.   end;
  433.   if not ok then print('Can''t use that filename, sorry.') else begin
  434.     fiscan(pl);
  435.     if pl>=uboards[FILEBOARD].maxfiles then print('This directory is full.') else begin
  436.       ynq('Upload "'+fn+'" ? ');
  437.       if yn then begin ok:=true;
  438.         nl; print('Enter a single "\" in front of the description if it');
  439.         print('for the Sysop.');nl;
  440.         print('Please enter a one line description.'); prt(':');
  441.         inputl(f.description,60);
  442.         if (f.description[1]='\') or (rvalidate in thisuser.ac) then begin
  443.           FILEBOARD:=0;
  444.           close(ulff);
  445.           fiscan(pl);
  446.         end;
  447.         if f.description[1]='\' then f.description:=copy(f.description,2,80);
  448.         ok:=true; ft:=255;
  449.         if uls then receive1(uboards[FILEBOARD].dlpath+fn,ok);
  450.         nl; nl;
  451.         if not ok then print('Not saved.') else begin
  452.           f.filename:=fn;
  453.           f.owner:=usernum;
  454.           f.date:=date;
  455.           f.daten:=daynum(date);
  456.           for x:=1 to 17 do f.res[x]:=0;
  457.           f.ft:=ft;
  458.           f.nacc:=0;
  459.           assign(fi,uboards[FILEBOARD].dlpath+fn);
  460.           {$I-} reset(fi); {$I+}
  461.           if ioresult=0 then begin
  462.             f.filepoints:=999;
  463.             f.blocks:=trunc((longfilesize(fi)+127.0)/128.0);
  464.             close(fi);
  465.             for x:=pl downto 1 do begin
  466.               seek(ulff,x); read(ulff,f1);
  467.               seek(ulff,x+1); write(ulff,f1);
  468.             end;
  469.             seek(ulff,1);
  470.             write(ulff,f);
  471.             seek(ulff,0); read(ulff,f); f.blocks:=pl+1;
  472.             seek(ulff,0); write(ulff,f);
  473.             sysoplog('Uploaded "'+fn+'" on '+uboards[FILEBOARD].name);
  474.             print('File successfully uploaded.');nl;cl(3);
  475.             {print('Download credits granted.');}
  476.           end else begin
  477.             print('System Error.  Not saved.');
  478.             sysoplog('Error uploading "'+fn+'"');
  479.           end;
  480.         end;
  481.       end;
  482.     end;
  483.     close(ulff); FILEBOARD:=ob;
  484.   end;
  485.   nl; nl;
  486.   end else begin
  487.     nl; nl; print('Sorry, not enough disk space.');
  488.     nl;
  489.   end;
  490. end;
  491.  
  492. procedure idl;
  493. var i:astr; down:boolean;
  494. begin
  495.   down:=true;
  496.   if systat.dllowtime<>systat.dlhitime then begin
  497.     if systat.dlhitime>systat.dllowtime then begin
  498.       if (timer<=(systat.dllowtime*60.0)) or (timer>=(systat.dlhitime*60.0))
  499.         then down:=false;
  500.     end else begin
  501.       if (timer<=(systat.dllowtime*60.0)) and (timer>=(systat.dlhitime*60.0))
  502.         then down:=false;
  503.     end;
  504.   end;
  505.   if spd='300' then begin
  506.     if systat.b300dllowtime<>systat.b300dlhitime then begin
  507.       if systat.b300dlhitime>systat.b300dllowtime then begin
  508.         if (timer<=(systat.b300dllowtime*60.0)) or (timer>=(systat.b300dlhitime*60.0))
  509.           then down:=false;
  510.       end else begin
  511.         if (timer<=(systat.b300dllowtime*60.0)) and (timer>=(systat.b300dlhitime*60.0))
  512.           then down:=false;
  513.       end;
  514.     end;
  515.   end;
  516.   if not down then printfile(systat.gfilepath+'dlhours.msg');
  517.   if down then begin
  518.     nl; print('You have '+cstr(thisuser.filepoints)+' file points.');
  519.     nl; print('Download -'); nl; prt('Enter filename: '); mpl(12); input(i,12);
  520.     dl(i);
  521.     nl; nl;
  522.   end;
  523. end;
  524.  
  525. procedure iul;
  526. var i:astr;
  527. begin
  528.   nl; nl; print('Upload -'); nl; prt('Enter filename: '); mpl(12); input(i,12);
  529.   ul(i);
  530.   nl;
  531. end;
  532.  
  533. procedure setdta;
  534. var r:registers;
  535. begin
  536.   r.ds:=seg(dta[1]);
  537.   r.dx:=ofs(dta[1]);
  538.   r.ax:=$1a00;
  539.   msdos(Dos.Registers(r));
  540. end;
  541.  
  542. function vdir(var d:astr):boolean;
  543. begin
  544.   if d[length(d)]='\' then d:=copy(d,1,length(d)-1);
  545.   vdir:=true;
  546. end;
  547.  
  548. procedure fix(var fn:astr);
  549. var i,i1:astr; c1,c2:integer; ok:boolean;
  550. begin
  551.   if vdir(fn) then fn:=fn+'\';
  552.   c1:=pos('\',fn); ok:=true;
  553. (*  if c1<>0 then begin
  554.     i:=copy(fn,1,c1-1);
  555.     fn:=copy(fn,c1+1,15);
  556.     if not vdir(i) then ok:=false;
  557.   end else i:='';*)
  558.   if i='' then i:=uboards[FILEBOARD].dlpath;
  559.   if fn='' then fn:='*.*';
  560.   fn:=i+'\'+align(fn);
  561. (*  if (pos('.MSG',fn)=0) and (pos('.TXT',fn)=0) and (pos('?',fn)=0) and (not so) then ok:=false;*)
  562.   if not ok then fn:='';
  563. end;
  564.  
  565. procedure ffile(fn:astr);
  566. var r:registers; c:integer;
  567. begin
  568.   for c:=0 to 80 do dta[c]:=#0;
  569.   setdta;
  570.   filenamef:=fn+#0;
  571.   r.ds := seg(filenamef[1]);
  572.   r.dx := ofs(filenamef[1]);
  573.   r.ax := $4e00;
  574.   r.cx := 0;
  575.   msdos(Dos.Registers(r));
  576.   if r.ax=0 then found:=true else found:=false;
  577. end;
  578.  
  579. procedure nfile;
  580. var r:registers;
  581. begin
  582.   r.ax:=$4f00;
  583.   msdos(Dos.Registers(r));
  584.   if r.ax=0 then found:=true else found:=false;
  585. end;
  586.  
  587. function fname:astr;
  588. var i1:astr; c1:integer;
  589. begin
  590.   i1:=''; c1:=31;
  591.   while (dta[c1]<>#0) and (c1<44) do begin i1:=i1+dta[c1]; c1:=c1+1; end;
  592.   fname:=i1;
  593. end;
  594.  
  595. function ti(i:integer):astr;
  596. var i1:astr;
  597. begin
  598.   str(i,i1);
  599.   if length(i1)=1 then i1:='0'+i1;
  600.   ti:=i1;
  601. end;
  602.  
  603. function info:astr;
  604. var res,i1,f,e:astr; c1,c2:integer; rl:real;
  605. begin
  606.   i1:=fname;
  607.   if (ord(dta[22]) and $10)=$10 then begin
  608.     res:=i1;
  609.     while length(res)<13 do res:=res+' ';
  610.     res:=res+'<DIR>   ';
  611.     e:='';
  612.   end else begin
  613.     c1:=pos('.',i1);
  614.     if c1=0 then begin
  615.       res:=i1;
  616.       while length(res)<12 do res:=res+' ';
  617.     end else begin
  618.       f:=copy(i1,1,c1-1); e:=copy(i1,c1+1,3);
  619.       while length(f)<8 do f:=f+' ';
  620.       while length(e)<3 do e:=e+' ';
  621.       res:=f+' '+e;
  622.     end;
  623.     rl:=0;
  624.     for c1:=30 downto 27 do
  625.       rl:=(rl*$100)+ord(dta[c1]);
  626.     i1:=cstrr(rl,10);
  627.   while length(i1)<9 do i1:=' '+i1;
  628.     res:=res+i1;
  629.   end;
  630.   c1:=ord(dta[26])*$100+ord(dta[25]);
  631.   i1:=cstr((c1 shr 5) mod 16); if i1[0]=#1 then i1:=' '+i1;
  632.   i1:=i1+'-'+ti(c1 mod 32)+'-'+ti(80+(c1 shr 9));
  633.   res:=res+'  '+i1+'  ';
  634.   c1:=ord(dta[24])*$100+ord(dta[23]);
  635.   c2:=(c1 shr 11);
  636.   if (c2<12) then f:='a' else begin f:='p'; c2:=c2-12; end;
  637.   if c2=0 then c2:=12;
  638.   i1:=cstr(c2); if i1[0]=#1 then i1:=' '+i1;
  639.   res:=res+i1+':'+ti((c1 shr 5) mod 64)+f;
  640.   info:=res;
  641. end;
  642.  
  643. procedure dir(cd,x:astr; all,tf:boolean);
  644. var
  645.   abort,next:boolean;
  646.   x1,xx:astr; dfs,kk:integer;
  647. begin
  648.   cd:=uboards[FILEBOARD].dlpath;
  649.   nl;print('Directory of '+copy(cd,1,length(cd)-1));
  650.   xx:='';kk:=0;
  651.   ffile(cd+x);
  652.   nl; abort:=false;
  653.   while found and not abort do begin
  654.     x1:=align(fname);
  655.   if tf then
  656.     printacr(info,abort,next)
  657.       else
  658.         begin
  659.           kk:=kk+1;if kk=5 then xx:=xx+x1 else xx:=xx+x1+'    ';
  660.           if kk=5 then begin printacr(xx,abort,next);kk:=0;xx:='';end;
  661.         end;
  662.     nfile;
  663.   end;
  664.   if (not found) and (kk>0) and (kk<6) then printacr(xx,abort,next);
  665.   if cd[2]=':' then dfs:=freek(ord(cd[1])-ord('@')) else dfs:=freek(0);
  666.   nl; printacr('  Free space = '+#3+#3+cstr(dfs)+#3+#1+'k',abort,next);
  667. end;
  668.  
  669. procedure dirf(tf:boolean);
  670. begin
  671.   all:=false;
  672.   if not (vdir(ix[2]) or (ix[2]='')) and so then all:=true;
  673.   fix(ix[2]);
  674. (*  c1:=pos('\',ix[2]);
  675.   s1:=copy(ix[2],1,c1-1);
  676.   s2:=copy(ix[2],c1+1,12);
  677.   if s1='' then s1:=uboards[FILEBOARD].dlpath; *)
  678.   s1:=uboards[FILEBOARD].dlpath;
  679.   s2:='*.*';
  680.   nl; dir(s1,s2,all,tf);
  681. end;
  682.  
  683. procedure gfn(var fn:astr);
  684. begin
  685.   nl;
  686.   print('<CR>=all files');
  687.   prt('File mask: '); input(fn,12);
  688.   if fn='' then fn:='*.*';
  689.   fn:=align(fn);
  690. end;
  691.  
  692. function aln(i:astr; n:integer):astr;
  693. begin
  694.   while length(i)<n do i:=' '+i;
  695.   aln:=i;
  696. end;
  697.  
  698. procedure pfn(f:ulfrec; var abort,next:boolean);
  699. var i:astr;
  700.   begin
  701.   i:=#3+#3+f.filename+#3+#2+':'+#3+#4+aln(cstr(f.blocks),4)+#3+#2+':';
  702.   if (f.filepoints<>999) and (f.filepoints<>-1) then i:=i+#3+#4+aln(cstr(f.filepoints),3) else begin
  703.     if f.filepoints=999 then i:=i+#3+#8+'New';
  704.     if f.filepoints=-1 then i:=i+#3+#9+'Ask';
  705.   end;
  706.   i:=i+#3+#2+':'+#3+#5+copy(f.description,1,55); if length(f.description)>55 then i:=i+#3+#3+'+';
  707.   printacr(i,abort,next);
  708. end;
  709.  
  710. procedure searchb(b:integer; fn:astr; var abort:boolean);
  711. var oldboard,pl,rn:integer; f:ulfrec;
  712. begin
  713.   oldboard:=FILEBOARD; FILEBOARD:=b;
  714.   recno(fn,pl,rn);
  715.   while (rn<=pl) and (not abort) and (not hangup) and (rn<>0) do begin
  716.     seek(ulff,rn); read(ulff,f);
  717.     pbn(abort);
  718.     pfn(f,abort,next);
  719.     nrecno(fn,pl,rn);
  720.   end;
  721.   close(ulff);
  722.   FILEBOARD:=oldboard;
  723. end;
  724.  
  725. procedure searchbd(b:integer; ts:astr; var abort:boolean);
  726. var oldboard,pl,rn:integer; f:ulfrec; next:boolean;
  727. begin
  728.   oldboard:=FILEBOARD; FILEBOARD:=b; fiscan(pl);
  729.   rn:=1;
  730.   while (rn<=pl) and (not abort) and (not hangup) do begin
  731.     seek(ulff,rn); read(ulff,f);
  732.     if pos(ts,uc(f.description))<>0 then begin
  733.       pbn(abort);
  734.       pfn(f,abort,next);
  735.     end;
  736.     rn:=rn+1;
  737.   end;
  738.   close(ulff);
  739.   FILEBOARD:=oldboard;
  740. end;
  741.  
  742. procedure search;
  743. var fn:astr; bn:integer; abort:boolean;
  744. begin
  745.   nl; nl; print('Search all directories.');
  746.   gfn(fn);
  747.   bn:=0; abort:=false;
  748.   while (not abort) and (bn<=maxulb) and (not hangup) do begin
  749.     if (thisuser.dsl>=uboards[bn].dsl) and (thisuser.age>=uboards[bn].agereq)
  750.     and (uboards[bn].ar='@') or (uboards[bn].ar in thisuser.ar)
  751.          then
  752.      searchb(bn,fn,abort);
  753.     bn:=bn+1;
  754.   end;
  755. end;
  756.  
  757. procedure searchd;
  758. var fn:astr; bn:integer; abort:boolean;
  759. begin
  760.   nl; nl; print('Find a description -'); nl;
  761.   print('Enter what to search description for.');
  762.    abort:=false;
  763.   prt(': '); input(fn,20);
  764.   if fn<>'' then begin
  765.     nl; print('Searching for "'+fn+'"'); nl;
  766.     ynq('Search all directories? ');
  767.     if yn then begin
  768.       bn:=0;
  769.       while (not abort) and (bn<=maxulb) and (not hangup) do begin
  770.       if (thisuser.dsl>=uboards[bn].dsl) and (thisuser.age>=uboards[bn].agereq)
  771.       and (uboards[bn].ar='@') or (uboards[bn].ar in thisuser.ar)
  772.            then
  773.          searchbd(bn,fn,abort);
  774.         bn:=bn+1;
  775.       end;
  776.     end else searchbd(FILEBOARD,fn,abort);
  777.   end;
  778. end;
  779.  
  780. procedure newfiles(b:integer; var abort:boolean);
  781. var oldboard,pl,rn,ldn:integer; f:ulfrec; next:boolean;
  782. begin
  783.   oldboard:=FILEBOARD; FILEBOARD:=b; fiscan(pl);
  784.   ldn:=daynum(ldat);
  785.   rn:=1;
  786.   while (rn<=pl) and (not abort) and (not hangup) do begin
  787.     seek(ulff,rn); read(ulff,f);
  788.     if f.daten>=ldn then begin
  789.       pbn(abort);
  790.       pfn(f,abort,next);
  791.     end;
  792.     rn:=rn+1;
  793.   end;
  794.   close(ulff);
  795.   FILEBOARD:=oldboard;
  796. end;
  797.  
  798. procedure nf;
  799. var bn:integer; abort:boolean;
  800. begin
  801.   nl; print('Search for new files.'); nl;
  802.   ynq('Search all directories? ');
  803.   if yn then begin
  804.     bn:=0; abort:=false;
  805.     while (not abort) and (bn<=maxulb) and (not hangup) do begin
  806.       if (thisuser.dsl>=uboards[bn].dsl) and (bn in thisuser.dlnscn) and
  807.       (thisuser.age>=uboards[bn].agereq) and (uboards[bn].ar='@')
  808.       and (uboards[bn].key<>'%')
  809.       or (uboards[bn].ar in thisuser.ar) then newfiles(bn,abort);
  810.       bn:=bn+1;
  811.     end;
  812.   end else newfiles(FILEBOARD,abort);
  813. end;
  814.  
  815. procedure deleteff(rn:integer; var pl:integer);
  816. var f:ulfrec; i:integer;
  817. begin
  818.   if (rn<=pl) and (rn>0) then begin
  819.     pl:=pl-1;
  820.     for i:=rn to pl do begin
  821.       seek(ulff,i+1); read(ulff,f);
  822.       seek(ulff,i); write(ulff,f);
  823.     end;
  824.     seek(ulff,0); f.blocks:=pl; write(ulff,f);
  825.   end;
  826. end;
  827.  
  828. function gtr(f,f1:ulfrec):boolean;
  829. begin
  830.   if sortbd and (f1.daten<>f.daten) then
  831.     if f1.daten<f.daten then
  832.       gtr:=false
  833.     else
  834.       gtr:=true
  835.   else
  836.     if f1.filename>f.filename then
  837.       gtr:=false
  838.     else
  839.       gtr:=true;
  840. end;
  841.  
  842. procedure sortd(c:integer);
  843. var oldboard,trn,srn,i,i1,pl:integer; f,f1:ulfrec;
  844. begin
  845.   oldboard:=FILEBOARD; FILEBOARD:=c; fiscan(pl);
  846.   nl; print('Sorting '+uboards[FILEBOARD].name);
  847.   for i:=1 to pl-1 do begin
  848.     seek(ulff,i); read(ulff,f); trn:=i;
  849.     for i1:=i+1 to pl do begin
  850.       seek(ulff,i1); read(ulff,f1);
  851.       if gtr(f,f1) then begin
  852.         f:=f1; trn:=i1;
  853.       end;
  854.     end;
  855.     seek(ulff,i); read(ulff,f1); seek(ulff,i);
  856.     write(ulff,f); seek(ulff,trn); write(ulff,f1);
  857.   end;
  858.   close(ulff);
  859.   FILEBOARD:=oldboard;
  860. end;
  861.  
  862. procedure sort;
  863. var bn:integer;
  864. begin
  865.   nl; nl; ynq('Sort by date? '); if yn then sortbd:=true else sortbd:=false;
  866.   nl; ynq('Sort all boards? ');
  867.   if yn then
  868.     for bn:=0 to maxulb do
  869.       sortd(bn)
  870.   else
  871.     sortd(FILEBOARD);
  872. end;
  873.  
  874. procedure yourfileinfo;
  875. begin
  876.   if okansi then begin
  877.     cls;
  878.     nl;
  879.     cl(0); print('  File points: ');
  880.     cl(0); print('      Your SL: ');
  881.     cl(0); print('     Your DSL: ');
  882.     cl(0); print('    You D/L''d: ');
  883.     cl(0); print('    You U/L''d: ');
  884.     cl(5); ansig(16,2); prompt(cstr(thisuser.filepoints));
  885.     cl(5); ansig(16,3); prompt(cstr(thisuser.sl));
  886.     cl(5); ansig(16,4); prompt(cstr(thisuser.dsl));
  887.     cl(5); ansig(16,5); prompt(cstr(thisuser.dk)+'K in '+cstr(thisuser.downloads)+' files');
  888.     cl(5); ansig(16,6); prompt(cstr(thisuser.uk)+'K in '+cstr(thisuser.uploads)+' files');
  889.   end else begin
  890.   nl; nl;
  891.   print('File pts  : '+cstr(thisuser.filepoints));
  892.   print('Your SL   : '+cstr(thisuser.sl));
  893.   print('Your DSL  : '+cstr(thisuser.dsl));
  894.   print('You D/L''d : '+cstr(thisuser.dk)+'K in '+cstr(thisuser.downloads)+' files');
  895.   print('You U/L''d : '+cstr(thisuser.uk)+'K in '+cstr(thisuser.uploads)+' files');
  896.   end;
  897. end;
  898.  
  899. procedure listfiles;
  900. var abort:boolean; fn:astr;
  901. begin
  902.   nl; nl; print('List files.');
  903.   gfn(fn); abort:=false;
  904.   searchb(FILEBOARD,fn,abort);
  905. end;
  906.  
  907. procedure listf(n:integer; var abort:boolean);
  908. var f:ulfrec; i,i1:astr; next:boolean;
  909. begin
  910.   seek(ulff,n); read(ulff,f);
  911.   i:=#3+#4+cstr(n); while length(i)<5 do i:=' '+i;
  912.   i:=i+#3+#2+': '+#3+#3+f.filename;
  913.   while length(i)<24 do i:=i+' ';
  914.   i1:=cstr(f.blocks); while length(i1)<5 do i1:=' '+i1; i:=i+i1;
  915.   i:=i+'  '+f.date+'  '; i1:=cstr(f.owner); while length(i1)<3 do i1:=' '+i1;
  916.   i:=i+i1;
  917.   printacr(i,abort,next);
  918. end;
  919.  
  920. {$I dlp2.pas}
  921.  
  922. procedure local_input1(var i:astr; ml:integer; tf:boolean);
  923. var cp:integer;
  924.     cc:char;
  925.     r:real;
  926. begin
  927.   cp:=1;
  928.   repeat
  929.     cc:=readkey;
  930.     if not tf then cc:=upcase(cc);
  931.     if (cc>=' ') and (cc<chr(127)) then
  932.       if cp<=ml then begin
  933.       i[cp]:=cc;
  934.       cp:=cp+1;
  935.       write(cc);
  936.     end else else case ord(cc) of
  937.       8:if cp>1 then begin
  938.                cc:=chr(8);
  939.                write(cc);write(' '); write(cc);
  940.                cp:=cp-1;
  941.              end;
  942.       21,24:while cp<>1 do begin
  943.                cp:=cp-1;
  944.                write(#8);write(' ');write(#8);
  945.              end;
  946.       end;
  947.   until (cc=#13) or (cc=#14);
  948.   i[0]:=chr(cp-1);
  949.   writeln;
  950. end;
  951.  
  952. procedure local_input(var i:astr; ml:integer);  (* Input uppercase only *)
  953. begin
  954.   local_input1(i,ml,false);
  955. end;
  956.  
  957. procedure local_inputl(var i:astr; ml:integer);   (* Input lower & upper case *)
  958. begin
  959.   local_input1(i,ml,true);
  960. end;
  961.  
  962. procedure term;
  963. var c:char; done,bac,eco,LFEEDS:boolean;
  964.     hs:byte;
  965.     ns:array[1..9] of pnr;
  966.     fil:file of pnr;
  967.     lnd,i:integer;
  968.     maxs:byte;
  969.     rl:real;
  970.     r:registers;
  971.  
  972. procedure ul;
  973. var dok,abort:boolean; i:astr; f:file;
  974. begin
  975.   writeln; writeln; ft:=255;
  976.   prompt('Send file: ');
  977.   input(i,70);
  978.   assign(f,i);
  979.   {$I-} reset(f); {$I+}
  980.   if ioresult=0 then begin
  981.     close(f);
  982.     send1(i,dok,abort);
  983.   end else print('File not found.');
  984.   incom:=false;
  985.   hangup:=false;
  986.   outcom:=false;
  987.   writeln;
  988. end;
  989.  
  990. procedure dl;
  991. var dok:boolean; i:astr; f:file;
  992. begin
  993.   writeln; writeln; ft:=255;
  994.   prompt('Receive file: ');
  995.   input(i,70);
  996.   assign(f,i);
  997.   {$I-} reset(f); {$I+}
  998.   if ioresult<>0 then begin
  999.     {$I-} rewrite(f); {$I+}
  1000.     if ioresult=0 then begin
  1001.       close(f);
  1002.       dok:=true;
  1003.     end else begin
  1004.       dok:=false;
  1005.       print('Illegal filename.');
  1006.     end;
  1007.   end else begin
  1008.     close(f);
  1009.     print(#7+'File already exists.');
  1010.     prompt('Overwrite? ');
  1011.     dok:=yn;
  1012.   end;
  1013.   if dok then
  1014.     receive1(i,dok);
  1015.   hangup:=false;
  1016.   incom:=false;
  1017.   outcom:=false;
  1018. end;
  1019.  
  1020.   procedure pc(s:astr);
  1021.   var i:integer;
  1022.   begin
  1023.     s:=s+chr(13);
  1024.     for i:=1 to length(s) do o1(s[i]);
  1025.   end;
  1026.  
  1027.   procedure cs(hs:byte);
  1028.   begin
  1029.     writeln;
  1030.     case hs of
  1031.       0:begin
  1032.           set_baud(300);
  1033.           tc(1);write('--- ');tc(3);write('300 BAUD ');tc(1);writeln('---');
  1034.         end;
  1035.       1:begin
  1036.           set_baud(1200);
  1037.           tc(1);write('=== ');tc(3);write('1200 BAUD');tc(1);writeln(' ===');
  1038.         end;
  1039.       2:begin
  1040.           set_baud(2400);
  1041.           tc(1);write('=-=');tc(3);write(' 2400 BAUD ');tc(1);writeln('=-=');
  1042.         end;
  1043.       3:begin
  1044.           set_baud(4800);
  1045.           tc(1);write('=*=');tc(3);write(' 4800 BAUD ');tc(1);write('=*=');
  1046.         end;
  1047.       4:begin
  1048.           set_baud(9600);
  1049.           tc(1);write('*=*');tc(3);write(' 9600 BAUD ');tc(1);write('*=*');
  1050.         end;
  1051.       end;
  1052.     writeln;
  1053.   end;
  1054.  
  1055.   procedure tab(x:integer);
  1056.   begin
  1057.     while wherex<x do write(' ');
  1058.   end;
  1059.  
  1060.   procedure dial;
  1061.   var i:integer; done:boolean; c:char; s:astr;
  1062.   begin
  1063.     done:=false;
  1064.     repeat
  1065.       writeln;
  1066.       tc(10);
  1067.       write('Dial: ');tc(11);write('1-9,M,Q,? : ');tc(2);
  1068.       repeat
  1069.         read(kbd,c); c:=upcase(c);
  1070.       until c in ['1'..'9','M','Q','?'];
  1071.       writeln(c); writeln;
  1072.       if c='Q' then begin done:=true; writeln; writeln('Back in term mode.'); writeln; end;
  1073.       if c='?' then begin
  1074.         clrscr;
  1075.         tc(15);writeln('N NAME                                      NUMBER         SPD');
  1076.         tc(9);writeln('─ ────────────────────────────────────────  ─────────────  ────');
  1077.         for i:=1 to 9 do begin
  1078.           tc(11);write(i,' ');tc(14);
  1079.           WRITE(ns[i].name); tab(45); tc(15);write(ns[i].number); tc(3);tab(60);
  1080.           case ns[i].hs of
  1081.             0:writeln(' 300');
  1082.             1:writeln('1200');
  1083.             2:writeln('2400');
  1084.           end;
  1085.         end;
  1086.       end;
  1087.       if c='M' then begin
  1088.         write('Which (1-9) ? ');
  1089.         repeat
  1090.           read(kbd,c);
  1091.         until c in ['1'..'9',#13];
  1092.         if c in ['1'..'9'] then begin
  1093.           i:=value(c);
  1094.           clrscr;
  1095.           writeln('Number: ',i);
  1096.           writeln;
  1097.           tc(14);writeln('Old Name: ',ns[i].name);
  1098.           tc(11);write('New Name: ');MPL(40); inputl(s,40);
  1099.           if s<>'' then ns[i].name:=s;
  1100.           writeln;
  1101.           tc(14);writeln('Old Number: ',ns[i].number);
  1102.           tc(11);write('New Number: '); MPL(40);input(s,14);
  1103.           if s<>'' then ns[i].number:=s;
  1104.           writeln;
  1105.           tc(14);write('Old Speed: ');
  1106.           case ns[i].hs of
  1107.             0:writeln(' 300');
  1108.             1:writeln('1200');
  1109.             2:writeln('2400');
  1110.           end;
  1111.           writeln;tc(11);
  1112.           writeln('0 =  300');
  1113.           if maxs>0 then writeln('1 = 1200');
  1114.           if maxs>1 then writeln('2 = 2400');
  1115.           write('New speed? '); read(kbd,c); if (c<'0') or (c>'2') then c:=#0;
  1116.           writeln(c); writeln;
  1117.           if (value(''+c)<=maxs) and (c<>#0)  then ns[i].hs:=value(''+c);
  1118.           reset(fil); seek(fil,i-1); write(fil,ns[i]); close(fil);
  1119.           c:=' ';
  1120.         end;
  1121.       end;
  1122.       if c in ['1'..'9'] then begin
  1123.         done:=true;
  1124.         i:=value(c);
  1125.         clrscr; lnd:=i;
  1126.         hs:=ns[i].hs; cs(hs);
  1127.         tc(14);writeln('Dialing: ',ns[i].name);tc(11);
  1128.         writeln('At     : ',ns[i].number);
  1129.         writeln;
  1130.         pc('ATDT'+ns[i].number);
  1131.       end;
  1132.     until done;
  1133.   end;
  1134.  
  1135.   function cdet:boolean;
  1136.   begin
  1137.     cdet:=((port[base+6] and 128)<>0)
  1138.   end;
  1139.  
  1140.   procedure hang;
  1141.   var rl:real;
  1142.   begin
  1143.     dump;
  1144.     term_ready(false); rl:=timer;
  1145.     while cdet and (abs(timer-rl)<1.5) do;
  1146.     term_ready(true);
  1147.   end;
  1148.  
  1149.   procedure redial;
  1150.   var c:char; done:boolean; try:integer; rl,rl1,rl2:real; int:integer; i,i1:astr;
  1151.   begin
  1152.     clrscr; try:=0;
  1153.     hs:=ns[lnd].hs; cs(hs); rl:=timer;
  1154.     pc('ATM0Q0V0E0S7=16');
  1155.     tc(14);writeln('Re-Dialing: ',ns[lnd].name);tc(11);
  1156.     writeln('At        : ',ns[lnd].number);
  1157.     writeln('Try       : 0');
  1158.     writeln('Time      : 00:00');
  1159.     writeln; writeln('Hit <ESC> to abort'); done:=false;
  1160.     delay(500); dump;
  1161.     repeat
  1162.       pc('ATDT'+ns[lnd].number);
  1163.       try:=try+1;
  1164.       gotoxy(13,6); writeln(try);
  1165.       rl1:=timer; if rl1<rl then rl:=rl+24.0*3600.0;
  1166.       rl2:=abs(rl1-rl); if rl2>32000 then rl2:=32000;
  1167.       int:=trunc(rl2);
  1168.       i:=cstr(int div 60);
  1169.       if length(i)=1 then i:='0'+i;
  1170.       i1:=cstr(int mod 60);
  1171.       if length(i1)=1 then i1:='0'+i1;
  1172.       i:=i+':'+i1;
  1173.       gotoxy(13,7); writeln(i); dump;
  1174.       while (not done) and (not commpressed) do begin
  1175.         if keypressed then begin
  1176.           read(kbd,c); if c=#27 then begin done:=true; o1('A'); end;
  1177.         end;
  1178.       end;
  1179.       delay(100);
  1180.       if cdet then done:=true else dump;
  1181.     until done;
  1182.     if cdet then for try:=1 to 6 do begin
  1183.       sound(1200); delay(200); nosound; delay(100);
  1184.     end else begin
  1185.       delay(500); pc('ATM1Q0V1E1S7=30');
  1186.     end;
  1187.     gotoxy(1,14); writeln; writeln('Back in term mode...');
  1188.   end;
  1189.  
  1190. procedure help;
  1191.   var x,y,c:integer;
  1192.   begin
  1193.     x:=wherex; y:=wherey;
  1194.     tc(4);
  1195.     for c:=1 to 12 do begin
  1196.       gotoxy(42,c); write(#$b3);
  1197.     end;
  1198.     gotoxy(42,13); write(#$c0);
  1199.     while wherex<>1 do write(#$c4);
  1200.     window(43,1,80,12); clrscr;
  1201.     window(45,1,80,12); gotoxy(1,1);
  1202.     tc(15);
  1203.     writeln('Alt-B = backspacing toggle');
  1204.     writeln('Alt-C = clear screen');
  1205.     writeln('Alt-D = dial number');
  1206.     writeln('Alt-E = echo toggle');
  1207.     writeln('Alt-H = hang up phone');
  1208.     writeln('Alt-Q = redial last number');
  1209.     writeln('Alt-S = speed toggle');
  1210.     writeln('Alt-X = exit');
  1211.     writeln('Alt-L = line feeds toggle');
  1212.     writeln('Alt-R = Shell to DOS');
  1213.     writeln('PgUp  = send file from dloads');
  1214.     write('PgDn  = receive file into dloads');
  1215.     window(1,1,80,25); gotoxy(x,y); tc(3);
  1216.   end;
  1217.  
  1218. procedure om(ch:char);
  1219.   begin
  1220.     r.ax:=$0200;
  1221.     r.dx:=ord(ch);
  1222.     msdos(r);
  1223.   end;
  1224.  
  1225. procedure pp(s:astr);
  1226.   var i:integer;
  1227.   begin
  1228.     for i:=1 to length(s) do
  1229.       if s[i]='{' then o1(#13) else o1(s[i]);
  1230.   end;
  1231.  
  1232. var geei,geez,golly,len:integer; geeg,xx:astr;
  1233. begin
  1234.   window(1,1,80,25);
  1235.   LFEEDS:=FALSE;
  1236.   clrscr; lnd:=0; eco:=false;
  1237.   if systat.maxbaud=300 then maxs:=0;
  1238.   if systat.maxbaud=1200 then maxs:=1;
  1239.   if systat.maxbaud=2400 then maxs:=2;
  1240.   if systat.maxbaud=4800 then maxs:=3;
  1241.   if systat.maxbaud=9600 then maxs:=4;
  1242.   assign(fil,systat.gfilepath+'numbers.dat');
  1243.   reset(fil);
  1244.   for i:=1 to 9 do read(fil,ns[i]);
  1245.   close(fil); tc(1);
  1246.      writeln('┌────────────────────────────────┐');
  1247.       write('│ ');tc(11);write('Telegard Mini-Term Version 1.4');
  1248.       tc(1);writeln(' │');
  1249.       writeln('└────────────────────────────────┘'); writeln;
  1250.      tc(10);write('  Press ');tc(11);WRITE('[');tc(14);WRITE('HOME');
  1251.   tc(11);WRITE(']');tc(10);WRITELN(' for help');
  1252.   writeln;
  1253.   hs:=maxs; cs(hs); bac:=false;
  1254.   done:=false;
  1255.   pc('ATQ0V1E1S2=43M1S11=50');
  1256.   rl:=timer;
  1257.   repeat
  1258.     if commpressed then begin
  1259.       c:=cinkey;
  1260.       IF (C=CHR(13)) AND (LFEEDS) THEN WRITELN;
  1261.       if c=chr(12) then clrscr else
  1262.         if c=chr(8) then begin
  1263.           om(c);
  1264.           if bac then begin
  1265.             om(' '); om(#8);
  1266.           end;
  1267.         end
  1268.       else
  1269.         if c<>chr(0) then om(c);
  1270.     end else begin
  1271.       if timer<rl then rl:=rl-24.0*3600.0;
  1272.       if timer-rl>10.0*60.0 then done:=true;
  1273.     end;
  1274.     if keypressed then begin
  1275.       read(kbd,c);
  1276.       if c=chr(27) then
  1277.         if keypressed then begin
  1278.           read(kbd,c); case ord(c) of
  1279.             48:begin bac:=not bac; writeln; writeln;
  1280.                  if bac then writeln('-Destructive-') else writeln('=Non-Destructive=');
  1281.                  writeln; writeln;
  1282.                end;
  1283.             44:begin
  1284.                  clrscr;
  1285.                  gotoxy(27,12); returna:=true;
  1286.                  write('Returning to WFC & Answering Phone'); done:=true;
  1287.                end;
  1288.             45:begin
  1289.                  clrscr; gotoxy(32,12); returna:=false;
  1290.                  write('Returning to WFC ...'); done:=true; end;
  1291.             59..67:begin geei:=(ord(c)-58);pp(SYSTAT.SYSOPMACRO[GEEI]);END;
  1292.             68:begin
  1293.                 nl;nl;
  1294.                 clrscr;
  1295.                 for geei:=1 to 9 do begin
  1296.                   tc(11);
  1297.                   write(cstr(geei)+'] '); tc(9);
  1298.                   if systat.sysopmacro[geei]='' then systat.sysopmacro[geei]:='[Blank]';
  1299.                   writeln(systat.sysopmacro[geei]);
  1300.                 end;
  1301.                 tc(14); writeln;
  1302.                 write('Change which macro? '); local_input(xx,1); geez:=value(xx);
  1303.                 if geez in [1..9] then begin
  1304.                   writeln; writeln('Enter macro now, "{"=<CR>');
  1305.                   writeln;tc(9);write(':');tc(11);
  1306.                   readln(geeg);systat.sysopmacro[geez]:=geeg;writeln;writeln;
  1307.                 end;
  1308.               end;
  1309.             31:begin hs:=hs+1; if hs>maxs then hs:=0; cs(hs); end;
  1310.             32:dial;
  1311.             38:begin WRITELN;WRITELN;if lfeeds then BEGIN
  1312.                 WRITELN('=- LINE FEEDS OFF -=');LFEEDS:=FALSE;END ELSE BEGIN
  1313.                 WRITELN('-= LINE FEEDS ON =-');LFEEDS:=TRUE;END;WRITELN;WRITELN;END;
  1314.             16:if (lnd>0) and (lnd<10) then redial;
  1315.             19:SysopShell;
  1316.             35:begin writeln; writeln('Hanging up...'); writeln; hang; hang; hang; hang; end;
  1317.             73:ul;
  1318.             75:if okansi then pp(#27+'[D');
  1319.             77:if okansi then pp(#27+'[C');
  1320.             72:if okansi then pp(#27+'[A');
  1321.             80:if okansi then pp(#27+'[B');
  1322.             27:pp(#27);
  1323.             81:dl;
  1324.             71:help;
  1325.             46:clrscr;
  1326.             18:begin eco:=not eco; writeln; writeln;
  1327.                  if eco then writeln('-= ECHO ON =-') else writeln('=- ECHO OFF -=');
  1328.                  writeln; writeln;
  1329.                end;
  1330.           end;
  1331.         end else
  1332.           om(c)
  1333.       else begin o1(c); if eco then om(c); end;
  1334.     rl:=timer;
  1335.     end;
  1336.   until done;
  1337.   hang; delay(1000); pc('ATS0=0Q0V0E0M0S2=1S7=30'); delay(100); dump;
  1338. end;
  1339.  
  1340. procedure lfi(fn:astr; var abort:boolean);
  1341. var next:boolean; i1,i2:astr;
  1342. begin
  1343.   if exist(uboards[FILEBOARD].dlpath+fn) and (not abort) then
  1344.     if (pos('.ARC',fn)<>0) or (pos('.LBR',fn)<>0) then begin
  1345.       nl;
  1346.       i1:=align(fn); i2:=''; while length(i1)>length(i2) do i2:=i2+'-';
  1347.       printacr(i1,abort,next);
  1348.       printacr(i2,abort,next);
  1349.       nl;
  1350.       if not abort then begin
  1351.         if pos('.ARC',fn)<>0 then arcl(uboards[FILEBOARD].dlpath+fn,abort);
  1352.         if pos('.LBR',fn)<>0 then lbrl(uboards[FILEBOARD].dlpath+fn,abort);
  1353.       end;
  1354.       nl;
  1355.     end;
  1356. end;
  1357.  
  1358. procedure lfin(rn:integer; var abort:boolean);
  1359. var f:ulfrec;
  1360. begin
  1361.   seek(ulff,rn); read(ulff,f); lfi(f.filename,abort);
  1362. end;
  1363.  
  1364. procedure lfii;
  1365. var fn:astr; pl,rn:integer; abort:boolean;
  1366. begin
  1367.   nl; print('Enter file to list interior files of');
  1368.   prt(': '); mpl(12); input(fn,12);
  1369.   recno(fn,pl,rn);
  1370.   abort:=false;
  1371.   if rn=0 then print('File not found.') else begin
  1372.     while (rn<>0) and (not abort) do begin
  1373.       lfin(rn,abort);
  1374.       nrecno(fn,pl,rn);
  1375.     end;
  1376.   end;
  1377.   close(ulff);
  1378. end;
  1379.  
  1380. Procedure Unlisted_Download(i:astr);
  1381. var dok,abort:boolean; f:file;
  1382. begin
  1383.   ft:=255;
  1384.   assign(f,i);
  1385.   {$I-} reset(f); {$I+}
  1386.   if ioresult=0 then begin
  1387.     close(f);
  1388.     send1(i,dok,abort);
  1389.   end else print('File not found.');
  1390. end;
  1391.  
  1392. END.
  1393.