home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 341.img / TCS161S.ZIP / FILEXFER.PAS < prev    next >
Pascal/Delphi Source File  |  1989-12-26  |  56KB  |  2,037 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,O+ }
  2. {$M 65500,0,0 }
  3.  
  4. unit filexfer;
  5.  
  6. interface
  7.  
  8. uses crt,dos,overlay,
  9.      gentypes,configrt,modem,statret,gensubs,subs1,subs2,windows,
  10.      userret,mainr1,mainr2,overret1,protocol,mainmenu,subs3,textret;
  11.  
  12.  
  13. procedure udsection;
  14. var cn:byte;
  15. implementation
  16.  
  17. procedure udsection;
  18. {$I file2}
  19.  
  20.   function findprot(rors,prot:char):boolean;
  21.   var bonzo:file of protorec; sod:boolean;
  22.  
  23.   begin
  24.        sod:=false;
  25.        assign(bonzo,forumdir+'PROT_'+rors+'.DAT');
  26.        reset(bonzo);
  27.        while not(eof(bonzo)) and not(sod) do
  28.              begin
  29.                   read(bonzo,protrec);
  30.                   if protrec.letter=upcase(prot) then sod:=true;
  31.              end;
  32.        findprot:=sod;
  33.        prprog:=protrec.progname;
  34.        prcomm:=protrec.commfmt;
  35.        prdesc:=protrec.desc;
  36.        close(bonzo);
  37.   end;
  38.  
  39.  
  40. procedure xtendedlist;
  41. var num:integer;
  42.     ud:udrec;
  43. begin
  44.   writestr ('[Enter File Number to List Extended Descrip]: *');
  45.   num:=valu(input);
  46.   if num>numuds then exit;
  47.   if num<1 then exit;
  48.   seekudfile (num);
  49.   read (udfile,ud);
  50.   writeln (^U'═════════════════════════════════════════════════════════════════════════════');
  51.   writeln (^S,ud.extdesc);
  52.   writeln (^U'═════════════════════════════════════════════════════════════════════════════');
  53. end;
  54.  
  55. procedure whoup;
  56.  
  57. procedure toplinewho;
  58.  begin
  59.   writeln('┌───┬───────────────┬──────────────────────────────┬────────┬────────────┐');
  60.   writeln('│ '^U'#'^R' │   '^U'Filename'^R'    │        '^U'Uploaded by'^R'           │ '^U'Points'^R' │ '+
  61.           ^U'Downloaded'^R' │');
  62.   writeln('├───┼───────────────┼──────────────────────────────┼────────┼────────────┤');
  63.  end;
  64.  
  65. procedure botlinewho;
  66.  begin
  67.   writeln(^R'└───┴───────────────┴──────────────────────────────┴────────┴────────────┘');
  68.  end;
  69.   var ud :udrec;
  70.       cnt:integer;
  71.   begin
  72.   toplinewho;
  73.   for cnt:=1 to numuds do
  74.    begin
  75.      seekudfile (cnt);
  76.      read (udfile,ud);
  77.      write (^R'│ '^S,strr(cnt));
  78.      spacelen(2-length(strr(cnt)));
  79.      write (^R'│ '^S,ud.filename);
  80.      spacelen(14-length(ud.filename));
  81.      write (^R'│ '^S,ud.sentby);
  82.      spacelen(29-length(ud.sentby));
  83.      write (^R'│ '^S,ud.points);
  84.     spacelen(7-length(strr(ud.points)));
  85.      write (^R'│ '^S,ud.downloaded);
  86.      spacelen(11-length(strr(ud.downloaded)));
  87.      writeln (^R'│');
  88.    end;
  89.   botlinewho;
  90.   end;
  91.  
  92.   function searchforfile (f:sstr):integer;
  93.   var ud:udrec;
  94.       cnt:integer;
  95.   begin
  96.     for cnt:=1 to numuds do begin
  97.       seekudfile (cnt);
  98.       read (udfile,ud);
  99.       if match(ud.filename,f) then begin
  100.         searchforfile:=cnt;
  101.         exit
  102.       end
  103.     end;
  104.     searchforfile:=0
  105.   end;
  106.  
  107.   function getfilenum (t:mstr):integer;
  108.   var n,s:integer;
  109.   begin
  110.     getfilenum:=0;
  111.     if length(input)>1 then input:=copy(input,2,255) else
  112.       repeat
  113.         writestr ('File Name/Number to '+t+' [?/List]:');
  114.         if hungupon or (length(input)=0) then exit;
  115.         if input='?' then begin
  116.           listfiles (false);
  117.           input:=''
  118.         end
  119.       until input<>'';
  120.     val (input,n,s);
  121.     if s<>0 then begin
  122.       n:=searchforfile(input);
  123.       if n=0 then begin
  124.         writeln ('File not found.');
  125.         exit
  126.       end
  127.     end;
  128.     if (n<1) or (n>numuds)
  129.       then writeln ('File number out of range!')
  130.       else getfilenum:=n
  131.   end;
  132.  
  133.   procedure addfile (ud:udrec);
  134.   begin
  135.     seekudfile (numuds+1);
  136.     write (udfile,ud)
  137.   end;
  138.  
  139.   procedure getfsize (var ud:udrec);
  140.   var df:file of byte;
  141.   begin
  142.     ud.filesize:=-1;
  143.     assign (df,getfname(ud.path,ud.filename));
  144.     reset (df);
  145.     if ioresult<>0 then exit;
  146.     ud.filesize:=filesize(df);
  147.     close(df)
  148.   end;
  149.  
  150.   const beenaborted:boolean=false;
  151.  
  152.   function aborted:boolean;
  153.   begin
  154.     if beenaborted then begin
  155.       aborted:=true;
  156.       exit
  157.     end;
  158.     aborted:=xpressed or hungupon;
  159.     if xpressed then begin
  160.       beenaborted:=true;
  161.       writeln (^B'File newscan aborted!')
  162.     end
  163.   end;
  164.  
  165.   procedure getstring (t:lstr; var m);
  166.   var q:lstr absolute m;
  167.       mm:lstr;
  168.   begin
  169.     writeln ('Old ',t,': ',q);
  170.     writestr ('Enter new '+t+' [CR/no change]: &');
  171.     mm:=input;
  172.     if length(mm)<>0 then q:=mm;
  173.     writeln
  174.   end;
  175.  
  176.   procedure getstringgg (t:lstr; var m);
  177.   var q:lstr absolute m;
  178.       mm:lstr;
  179.   begin
  180.     writeln ('Old ',t,': ',q);
  181.     writestr ('Enter new '+t+' [CR/no change, "!" to erase]:');
  182.     mm:=input;
  183.     if length(mm)<>0 then q:=mm;
  184.     if mm='!' then q:='';
  185.     writeln
  186.   end;
  187.  
  188.   procedure getint (t:lstr; var i:integer);
  189.   var s:sstr;
  190.   begin
  191.     s:=strr(i);
  192.     getstring (t,s);
  193.     i:=valu(s)
  194.   end;
  195.  
  196.   procedure getboo (t:lstr; var b:boolean);
  197.   var s:sstr;
  198.   begin
  199.     s:=yesno (b);
  200.     getstring (t,s);
  201.     b:=upcase(s[1])='Y'
  202.   end;
  203.  
  204.   procedure removefile (n:integer);
  205.   var cnt:integer;
  206.   begin
  207.     for cnt:=n to numuds-1 do begin
  208.       seekudfile (cnt+1);
  209.       read (udfile,ud);
  210.       seekudfile (cnt);
  211.       write (udfile,ud)
  212.     end;
  213.     seekudfile (numuds);
  214.     truncate (udfile)
  215.   end;
  216.  
  217.   procedure displayfile (var ffinfo:searchrec);
  218.   var a:integer;
  219.   begin
  220.     a:=ffinfo.attr;
  221.     if (a and 8)=8 then exit;
  222.     tab (ffinfo.name,13);
  223.     if (a and 16)=16
  224.       then write ('Directory')
  225.       else write (ffinfo.size);
  226.     if (a and 1)=1 then write (^S' [',^P,'read-only',^S,']'^R);
  227.     if (a and 2)=2 then write (^S' [',^P,'hidden',^S,']'^R);
  228.     if (a and 4)=4 then write (^S' [',^P,'system',^S,']'^R);
  229.     writeln
  230.   end;
  231.  
  232.   function defaultdrive:byte;
  233.   var r:registers;
  234.   begin
  235.     r.ah:=$19;
  236.     intr ($21,r);
  237.     defaultdrive:=r.al+1
  238.   end;
  239.  
  240.   procedure directory;
  241.   var r:registers;
  242.       ffinfo:searchrec;
  243.       tpath:anystr;
  244.       b:byte;
  245.       cnt:integer;
  246.   begin
  247.     { getdir (defaultdrive,tpath); }
  248.     tpath:=area.xmodemdir;
  249.     if tpath[length(tpath)]<>'\' then tpath:=tpath+'\';
  250.     tpath:=tpath+'*.*';
  251.     writestr ('Path/Wildcard [CR/'+tpath+']:');
  252.     writeln (^M);
  253.     if length(input)<>0 then tpath:=input;
  254.     writelog (16,10,tpath);
  255.     findfirst (chr(defaultdrive+64)+':\*.*',8,ffinfo);
  256.     if doserror<>0
  257.       then writeln ('No volume label'^M)
  258.       else writeln ('Volume label: ',ffinfo.name,^M);
  259.     findfirst (tpath,$17,ffinfo);
  260.     if doserror<>0 then writeln ('No files found.') else begin
  261.       cnt:=0;
  262.       while doserror=0 do begin
  263.         cnt:=cnt+1;
  264.         if not break then displayfile (ffinfo);
  265.         findnext (ffinfo)
  266.       end;
  267.       writeln (^B^M'Total Files: ',cnt)
  268.     end;
  269.     write ('Free Disk Space: ');
  270.     writefreespace (tpath)
  271.   end;
  272.  
  273.   procedure listarchive (int:integer);
  274.   var n:integer;
  275.       ud:udrec;
  276.       f:file of byte;
  277.       fname:lstr;
  278.       b,p:byte;
  279.       sg:boolean;
  280.       size:longint;
  281.       sussuh:sstr;
  282.       ock:char;
  283.  
  284.     function getsize:longint;
  285.     var x:longint;
  286.         b:array [1..4] of byte absolute x;
  287.         cnt:integer;
  288.     begin
  289.       for cnt:=1 to 4 do read (f,b[cnt]);
  290.       getsize:=x
  291.     end;
  292.  
  293.     procedure badarchive;
  294.     begin
  295.       writeln (^M'That file isn''t an archive!');
  296.       close (f);
  297.       exit
  298.     end;
  299.  
  300.   begin
  301.     if nofiles then exit;
  302.     if int<1 then begin
  303.      n:=getfilenum('List');
  304.      if n=0 then exit;
  305.     end else n:=int;
  306.     seekudfile (n);
  307.     read (udfile,ud);
  308.     fname:=getfname(ud.path,ud.filename);
  309.     assign (f,fname);
  310.     reset (f);
  311.     iocode:=ioresult;
  312.     if iocode<>0 then begin
  313.       fileerror ('LISTARCHIVE',fname);
  314.       exit
  315.     end;
  316.     if filesize(f)<32 then begin
  317.       badarchive;
  318.       exit
  319.     end;
  320.     p:=pos ('.',ud.filename);
  321.     sussuh:=copy (ud.filename,p+1,3);
  322.     sussuh:=upstring(sussuh);
  323.     close (f);
  324.     writehdr ('ARC/PAK/ZIP File List');
  325.     writeln;
  326.     write (^R'Archive Type: '^S);
  327.     if sussuh='ARC' then writeln ('PKARC/PKPAK') else
  328.     if sussuh='PAK' then writeln ('PAK') else
  329.     if sussuh='ZIP' then writeln ('PKZIP') else
  330.     if sussuh='LZH' then writeln ('LHARC') else
  331.     if (sussuh<>'ARC') and (sussuh<>'PAK') and (sussuh<>'ZIP') and
  332.        (sussuh<>'LZH') then begin
  333.      writeln ('Unknown!');
  334.      writeln;
  335.      writeln (^R'This file does not seem to be an archive of the ARC, PAK, or ZIP type.');
  336.      writestr ('Would you care to manually select the archive type [y/n]? *');
  337.      if yes then repeat
  338.       writeln (^R'[1]: PKARC/PKPAK');
  339.       writeln (^R'[2]: PAK');
  340.       writeln (^R'[3]: PKZIP');
  341.       writeln (^R'[4]: LHARC');
  342.       writeln (^R'[Q]: Quit');
  343.       writeln;
  344.       writestr ('Selection:');
  345.       ock:=upcase(input[1]);
  346.       if ock='1' then sussuh:='ARC' else
  347.       if ock='2' then sussuh:='PAK' else
  348.       if ock='3' then sussuh:='ZIP' else
  349.       if ock='4' then sussuh:='LZH';
  350.      until ock in ['Q','1','2','3'];
  351.     end;
  352.     writeln;
  353.     writeln ('Please hold...');
  354.     writeln;
  355.     if sussuh='ARC' then arcview (fname) else
  356.     if sussuh='PAK' then pakview (fname) else
  357.     if sussuh='ZIP' then zipview (fname) else
  358.     if sussuh='LZH' then lharcview (fname);
  359.   end;
  360.  
  361. procedure requestfile;
  362. var t:text;
  363.     me:message;
  364.     m:mailrec;
  365. begin
  366.   if hungupon then exit;
  367.   writestr (^M^J+'Filename to Request: *');
  368.   if length(input)=0 then exit;
  369.   writeln (^M^J+'Enter a Message regarding the File Request:');
  370.   delay (1000);
  371.   titlestr:='File Request: '+input;
  372.   sendstr:='Sysop';
  373.   m.line:=editor (me,false,'File Request: '+input);
  374.   sendstr:='';
  375.   if m.line<0 then exit;
  376.   m.anon:=false;
  377.   m.title:=titlestr;
  378.   m.sentby:=unam;
  379.   m.when:=now;
  380.   addfeedback (m);
  381. end;
  382.  
  383.   procedure download (autoselect:integer);
  384.   var totaltime:sstr;
  385.       num,fsize,actualsize,mins,secs,i,b,dsziactualsize,realtime:integer;
  386.       ud:udrec;
  387.       fname,tcsrulez,protop,byteblok:lstr;
  388.       ymodem,okselect:boolean;
  389.       f:file;
  390.       m:sstr;
  391.       extrnproto:char; resp:char; byewhendone:boolean;
  392.       n:text;
  393.       ok:boolean;
  394.   begin
  395.     if not allowxfer then exit;
  396.     if nofiles then exit;
  397.     if percent (urec.uploads,urec.downloads)<udratio then begin
  398.       writeln ('Your Upload/Download ratio is too low!   Upload some files!');
  399.       exit;
  400.     end;
  401.     if useqr then begin
  402.      calcqr;
  403.      if (qr<qrlimit) and (ulvl<qrexempt) then begin
  404.       writeln ('Your Quality Rating is '^S+strr(qr)+^R'.');
  405.       writeln ('That exceeds the limit of '^S+strr(qrlimit)+^R'!');
  406.       writeln ('You must get a better QR before you can download.');
  407.       exit;
  408.      end;
  409.      end;
  410.     if (area.download=false) then begin
  411.      writeln;
  412.      writeln ('Sorry, downloading is not allowed from this area!');
  413.      writeln;
  414.      exit;
  415.     end;
  416.     if autoselect=0
  417.       then num:=getfilenum('download')
  418.       else num:=autoselect;
  419.     if num=0 then exit;
  420.     writeln;
  421.     seekudfile (num);
  422.     read (udfile,ud);
  423.     ok:=checkok (ud);
  424.     if not ok then exit;
  425.     ymodem:=false;
  426.     extrnproto:=' ';
  427.     listprotocols(0);
  428.     if hungupon then exit;
  429.     writestr('Protocol [CR/'+^S+urec.defproto+^P+']:'+^R+' &');
  430.     if hungupon then exit;
  431.     if length(input)=0 then extrnproto:=urec.defproto else extrnproto:=upcase(input[1]);
  432.  
  433.     okselect:=findprot('S',extrnproto);
  434.     if not okselect then exit;
  435.  
  436.     fname:=getfname(ud.path,ud.filename);
  437.  
  438.     assign (f,fname);
  439.     reset (f);
  440.     iocode:=ioresult;
  441.     if iocode<>0 then
  442.       begin
  443.       writeln; writeln('ERROR: Unable to locate file ',fname);
  444.         fileerror ('DOWNLOAD',fname);
  445.         exit
  446.       end;
  447.  
  448.     fsize:=filesize(f);
  449.     actualsize:=fsize;
  450.     close (f);
  451.     totaltime:=minstr(fsize);
  452.     mins:=valu(copy(totaltime,1,pos(':',totaltime)-1));
  453.     secs:=valu(copy(totaltime,pos(':',totaltime)+1,2));
  454.     realtime:=mins;
  455.     if secs<>0 then realtime:=mins+(secs div 60);
  456.     if mins=0 then mins:=1;
  457.     if ((mins>timeleft) and (not sponsoron)) then begin
  458.       writestr ('Sorry, you don''t have enough time left!');
  459.       mins:=-5;
  460.       exit
  461.     end;
  462.     if (mins-5>timetillevent) then begin
  463.       writestr ('Sorry, the timed event is coming up too soon!');
  464.       mins:=-5;
  465.       exit
  466.     end;
  467. writeln;
  468.  
  469.         askaboutbye;
  470.     if answer='A' then exit;
  471.     wipedszlog;
  472.  
  473.     if (ansigraphics in urec.config) then write (#27+'[2J') else write (^L);
  474.     writeln (^B);
  475.     writeln (^R'┌─────────────────────────────────────────┐');
  476.     write (^R'│ '^S'Filename:       '^S);
  477.     tab (ud.filename,24);
  478.     writeln (^R'│');
  479.     write (^R'│ '^S'Uploaded by:    '^S);
  480.     tab (ud.sentby,24);
  481.     writeln (^R'│');
  482.     write (^R'│ '^S'Downloaded:     '^S);
  483.     tcsrulez:='';
  484.     tcsrulez:=strr(ud.downloaded)+' time';
  485.     if (ud.downloaded<>1) then tcsrulez:=tcsrulez+'s';
  486.     tab (tcsrulez,24);
  487.     writeln (^R'│');
  488.     if ymodem then fsize:=(fsize+7) div 8;
  489.     if fsize=0 then fsize:=1;
  490.     write (^R'│ '^S'Bytes to send:  '^S);
  491.     byteblok:=^S+strlong(ud.filesize)+^R+' bytes';
  492.     tab (byteblok,26);
  493.     writeln (^R'│');
  494.     write (^R'│ '^S'Transfer Time:  '^S);
  495.     tab (totaltime,24);
  496.     writeln (^R'│');
  497.     writeln (^R'├─────────────────────────────────────────┤');
  498.     writeln (^R'│    Hit ['^S'Ctrl X'^R'] a few times to Abort    │');
  499.     writeln (^R'└─────────────────────────────────────────┘');
  500.     writeln;
  501.       b:=doext ('S',extrnproto,ud.path,ud.filename,baudrate,usecom);
  502.       if b<>0 then b:=2;
  503.       modeminlock:=false;
  504.       beepbeep (b);
  505.  
  506.       xtype:=checkdszlog (getfname(ud.path,ud.filename));
  507.       if (upcase(xtype)='Q') then
  508.        begin
  509.        possiblelzm (ud.points);
  510.        b:=2;
  511.        end;
  512.  
  513.       if (b=0) or (b=1) then begin
  514.       writelog (15,1,fname);
  515.       ud.downloaded:=ud.downloaded+1;
  516.       urec.downloads:=urec.downloads+1;
  517.       urec.udpoints:=urec.udpoints-ud.points;
  518.       urec.downk:=urec.downk+ud.filesize;
  519.       seekudfile (num);
  520.       write (udfile,ud);
  521.       showhisstats;
  522.       writeurec
  523.     end;
  524.    if answer='H' then forcehangup:=true;
  525.   end;
  526.  
  527.   procedure typefile;
  528.   var num:integer;
  529.       ud:udrec;
  530.       fname:lstr;
  531.       f:text;
  532.       k:char;
  533.   begin
  534.     if nofiles then exit;
  535.     num:=getfilenum('type');
  536.     if num=0 then exit;
  537.     writeln;
  538.     seekudfile (num);
  539.     read (udfile,ud);
  540.     if (not sponsoron) and (ud.points>urec.udpoints) then begin
  541.       writeln ('Sorry, that file requires ',ud.points,' points.');
  542.       exit
  543.     end;
  544.     if (ud.newfile) and (not sponsoron) then begin
  545.       writeln ('Sorry, that is a new file and must be validated.');
  546.       exit
  547.     end;
  548.     if (ud.specialfile) and (not sponsoron) then begin
  549.       writeln ('Sorry, downloading that file requires special permission.');
  550.       exit
  551.     end;
  552.     if (length(ud.dlpw)>0) and (filepw) then begin
  553.      writeln;
  554.      writestr ('File Password:');
  555.      if length(input)=0 then exit else
  556.      if not match(input,ud.dlpw) then exit;
  557.     end;
  558.     if tempsysop then begin
  559.       ulvl:=regularlevel;
  560.       tempsysop:=false;
  561.       writeurec;
  562.       bottomline
  563.     end;
  564.     fname:=getfname(ud.path,ud.filename);
  565.     assign (f,fname);
  566.     reset (f);
  567.     iocode:=ioresult;
  568.     if iocode<>0 then
  569.       begin
  570.         fileerror ('TYPEFILE',fname);
  571.         exit
  572.       end;
  573.     writeln (^B^M'Filename:       '^S,ud.filename);
  574.     writeln ('Uploaded by:    '^S,ud.sentby);
  575.     if (ud.points>0) and (not sponsoron) then begin
  576.       write (^B^M'NOTE: When the transfer begins, you ',
  577.                ^M'      will be charged ',ud.points,' point');
  578.       if ud.points<>1 then write ('s');
  579.       writeln ('!')
  580.     end;
  581.     writeln (^B^M'Press any key to begin the transfer,',
  582.                ^M'or [Ctrl-X] to abort...'^M);
  583.     k:=waitforchar;
  584.     if (k=^X) or (upcase(k)='X') then begin
  585.       textclose (f);
  586.       writeln (^B^M'Aborted!');
  587.       exit
  588.     end;
  589.     while not (eof(f) or break) do begin
  590.       read (f,k);
  591.       if k=^M then writeln else if k<>^J then write (k)
  592.     end;
  593.     textclose (f);
  594.     if (ud.points>0) and (not sponsoron) then begin
  595.       urec.udpoints:=urec.udpoints-ud.points;
  596.       writeln (^B'You now have ',
  597.                numthings (urec.udpoints,'point','points'),'.')
  598.     end;
  599.     writeurec
  600.   end;
  601.  
  602.  
  603.  
  604.   procedure processfile(fn,todir:lstr);
  605.   var fn1:lstr; util:integer;
  606.   begin
  607.     write(^P'  processing...');
  608.     util:=pos('.',fn);
  609.     if util=0 then fn1:=fn else fn1:=copy(fn,1,util-1);
  610.  
  611. exec(getenv('COMSPEC'),' /C PROCESS.BAT '+fn+' '+todir+' '+fn1);
  612.   end;
  613.  
  614.  
  615.   procedure upload;
  616.   var ud:udrec;
  617.       ok,crcmode,ymodem,extdone,cool:boolean;
  618.       i,b,granted,ultime:integer;
  619.       dah:real;
  620.       fn,protop,tran:lstr;
  621.       extrnproto:char;
  622.       e1,e2,e3:lstr;
  623.       f:file;
  624.       time:string;
  625.   var process:boolean; dir1:lstr;
  626.   begin
  627.     if not allowxfer then exit;
  628.     if timetillevent<30 then begin
  629.       writestr (
  630.    'Sorry, uploads are not allowed within one half hour of the timed event!');
  631.       exit
  632.     end;
  633.     if area.upload=false then begin
  634.      writeln;
  635.      writeln ('Sorry, uploading is not allowed into this area!');
  636.      writeln;
  637.      exit;
  638.     end;
  639.     ok:=false;
  640.     write ('Free Disk Space: ');
  641.     writefreespace (area.xmodemdir);
  642.     writeln;
  643.     repeat
  644.      writestr ('Upload Filename:');
  645.      if length(input)=0 then exit;
  646.      if not validfname(input) then begin
  647.       writeln ('Invalid filename!');
  648.       exit
  649.      end;
  650.      ud.filename:=input;
  651.      ud.path:=area.xmodemdir;
  652.      fn:=getfname(ud.path,ud.filename);
  653.      if hungupon then exit;
  654.      if exist(fn) then writeln ('File already exists!') else ok:=true
  655.     until ok;
  656.     if filepw then begin
  657.      buflen:=30;
  658.      writestr ('File Password [CR/None]: &');
  659.      if length(input)=0 then ud.dlpw:='' else ud.dlpw:=input;
  660.     end else
  661.     ud.dlpw:='';
  662.     buflen:=45;
  663.     writestr ('Description of Upload: &');
  664.     ud.descrip:=input;
  665.     ud.extdesc:=getextdesc;
  666.  
  667.     buflen:=40;
  668.     if ups>32765 then ups:=0;
  669.     inc(ups);
  670.     ud.sentby:=unam;
  671.     ud.when:=now;
  672.     ud.whenrated:=now;
  673.     ud.points:=0;
  674.     ud.downloaded:=0;
  675.     ud.newfile:=true;
  676.     ud.specialfile:=false;
  677.  
  678.     crcmode:=false;
  679.     ymodem:=false;
  680.     extrnproto:='N';
  681.     listprotocols (1);
  682.     if hungupon then exit;
  683.     protop:=^P+'Protocol [CR/'+^S+urec.defproto+^P+']:'+^R+' &';
  684.     writestr (protop);
  685.     if hungupon then exit;
  686.     tran:=input;
  687.     if length(tran)=0 then extrnproto:=urec.defproto else
  688.                       extrnproto:=upcase(tran[1]);
  689.     cool:=findprot('R',extrnproto);
  690.     if not cool then exit;
  691.  
  692.     askaboutbye;
  693.     if answer='A' then exit;
  694.  
  695.     ultime:=timer;
  696.     if tempsysop then begin
  697.       ulvl:=regularlevel;
  698.       tempsysop:=false;
  699.       writeurec;
  700.       bottomline
  701.     end;
  702.       begin
  703.       wipedszlog;
  704.       b:=doext ('R',extrnproto,ud.path,ud.filename,baudrate,usecom);
  705.       modeminlock:=false;
  706.       modemoutlock:=false;
  707.       beepbeep (b)
  708.     end;
  709.     if b>=1 then begin
  710.       if exist (fn) then begin
  711.        assign(f,fn);
  712.        erase (f);
  713.       end;
  714.      exit;
  715.     end;
  716.     if b=0 then begin
  717.  
  718.     getfsize(ud); addfile(ud);
  719.     inc(urec.uploads);
  720.  
  721.     urec.upk:=urec.upk+ud.filesize;
  722.     newuploads:=newuploads+1;
  723.     writeurec;
  724.     end;
  725.      if (ulpercent>0) and (not aborted) then begin
  726.     { endtime:=timer;
  727.       if endtime<starttime then endtime:=endtime+1440;
  728.       xfertimecredit:=(endtime-starttime);
  729.       writeln;
  730.       granted:=xfertimecredit;
  731.       granted:=granted*(ulpercent div 100);
  732.       settimeleft (timeleft+granted);
  733.       str (timeleft,time); }
  734.       ultime:=timer-ultime;
  735.       if ultime<0 then ultime:=ultime+1440;
  736.       granted:=ultime*(ulpercent div 100);
  737.       writeln (^R'Granting upload time compensation of '^S+strr(granted)+^R' minutes.');
  738.       urec.timetoday:=urec.timetoday+granted;
  739.       writeurec;
  740.      end;
  741.     showhisstats;
  742.   end;
  743.  
  744.   procedure searchfile;
  745.   var cnt,cntt,totalcnt:integer;
  746.       searchall:boolean;
  747.       wildcard:sstr;
  748.       a:arearec;
  749.       stext:anystr;
  750.  
  751.     procedure searcharea;
  752.     var cnt,knt:integer; needbox:boolean;
  753.         u:udrec;
  754.     begin
  755.       knt:=0; needbox:=true;
  756.       for cnt:=1 to numuds do begin
  757.         seekudfile (cnt);
  758.         read (udfile,u);
  759.     if wildcardmatch (wildcard,u.filename) then begin
  760.       if needbox then begin
  761.                 topfileline;
  762.                 needbox:=false;
  763.               end;
  764.           listfile (cnt,false);
  765.       inc(knt); inc(totalcnt);
  766.         end;
  767.         if xpressed then exit
  768.       end;
  769.       if not needbox then begin
  770.             bottomfileline;
  771.             writeln(^S+strr(knt)+^P' files found.'^R);
  772.             writeln;
  773.             end;
  774.     end;
  775.  
  776.     procedure totalmatch;
  777.     begin
  778.     writeln; write(^S+strr(totalcnt)+^R+' matches found.');
  779.     end;
  780.  
  781.     procedure searchareatext (t:anystr);
  782.     var cnt,knt:integer;
  783.     u:udrec;
  784.     b,needbox:boolean;
  785.     begin
  786.       needbox:=true; knt:=0;
  787.       for cnt:=1 to numuds do begin
  788.         b:=false;
  789.         seekudfile (cnt);
  790.         read (udfile,u);
  791.        if pos(upstring(t),upstring(u.filename))>0 then b:=true;
  792.         if pos(upstring(t),upstring(u.extdesc))>0 then b:=true;
  793.         if pos(upstring(t),upstring(u.descrip))>0 then b:=true;
  794.     if b then begin
  795.             if needbox then topfileline;
  796.             listfile (cnt,false);
  797.             needbox:=false;
  798.             inc(knt); inc(totalcnt);
  799.           end;
  800.         if xpressed then exit;
  801.       end;
  802.       if not needbox then begin
  803.             bottomfileline;
  804.             writeln(^S+strr(knt)+^P+' files found.'^R);
  805.             writeln;
  806.              end;
  807.     end;
  808.  
  809.  
  810.   begin
  811.     writeln;
  812.     totalcnt:=0;
  813.     writestr ('Look in all areas '^S'[y/n]'^R'? *');
  814.     searchall:=yes;
  815.     writeln;
  816.     begin
  817.      writestr (^R'Enter '^P'TEXT'^R' to search for:');
  818.      writeln;
  819.      if length(input)=0 then exit;
  820.      stext:=input;
  821.      if not searchall then begin
  822.        writeln(^P'Looking for "'^S+stext+^P'" in current area...');
  823.        searchareatext(stext);
  824.        totalmatch;
  825.        exit;
  826.        end;
  827.      for cntt:=1 to numareas do begin
  828.        seekafile (cntt);
  829.        read (afile,a);
  830.        if urec.udlevel>=a.level then begin
  831.      setarea (cntt);
  832.      writeln;
  833.      writeln(^R'Searching for "'^S+stext+^R'" in ['^P,cntt,^R'] '+^S+area.name+^R'...');
  834.      searchareatext (stext);
  835.      if xpressed then exit;
  836.      end;
  837.      end;
  838.      totalmatch;
  839.  
  840.     end
  841.   end;
  842.  
  843.  
  844.   procedure addresidentfile (fname:lstr);
  845.   var ud:udrec;
  846.       ccr:lstr;
  847.   begin
  848.     getpathname (fname,ud.path,ud.filename);
  849.     if match(fname,'USERS') then begin
  850.      writelog (16,10,unam);
  851.      writeln (^G'SECURITY VIOLATION!  Paging Sysop.'^M);
  852.      exit;
  853.     end;
  854.     getfsize(ud);
  855.     if ud.filesize=-1 then begin
  856.      if not offliney then begin
  857.       writeln ('File can''t be opened!');
  858.       exit
  859.      end;
  860.     end;
  861.     writestr ('Point Value:');
  862.     if length(input)=0 then input:='0';
  863.     ud.points:=valu(input);
  864.     if ud.points<0 then ud.points:=0;
  865.     writestr ('Sent by [CR/'+unam+']: &');
  866.     if length(input)=0 then input:=unam;
  867.     ud.sentby:=input;
  868.     ud.when:=now;
  869.     ud.whenrated:=now;
  870.     ud.downloaded:=0;
  871.     writestr ('Description: &');
  872.     ud.descrip:=input;
  873.     ud.extdesc:=getextdesc;
  874.     if filepw then begin
  875.      buflen:=30;
  876.      writestr ('File Password [CR/None]: &');
  877.      if length(input)=0 then ud.dlpw:='' else
  878.      ud.dlpw:=input;
  879.     end else
  880.     ud.dlpw:='';
  881.     writestr ('Special Request only [Ask]? *');
  882.     ud.specialfile:=yes;
  883.     ud.newfile:=false;
  884.     addfile (ud);
  885.     ups:=ups+1;
  886.     urec.uploads:=urec.uploads+1;
  887.     if ud.filesize>-1 then
  888.     urec.upk:=urec.upk+ud.filesize;
  889.     writeurec;
  890.     writelog (16,8,fname)
  891.   end;
  892.  
  893.   procedure sysopadd;
  894.   var fn,fnm,fp:lstr;
  895.   begin
  896.     if ulvl<sysoplevel then begin
  897.       writeln
  898.         ('Sorry, you may not add resident files without true sysop access!');
  899.       exit
  900.     end;
  901.     writehdr ('Add Resident File');
  902.     writestr ('Filename:');
  903.     fnm:=input;
  904.     writestr ('Path of File [CR/'+area.xmodemdir+']:');
  905.     fp:=input;
  906.     if length(fp)=0 then fp:=area.xmodemdir;
  907.     if fp[length(fp)]<>'\' then fp:=fp+'\';
  908.     fn:=fp+fnm;
  909.     if exist(fn)
  910.       then
  911.         begin
  912.           writestr ('Confirm: '+fn+' [y/n]:');
  913.           if yes then addresidentfile (fn)
  914.         end
  915.       else begin
  916.        writeln ('File not found!');
  917.        if length(fn)=0 then exit;
  918.        writestr ('Add it as [Offline] (y/n)? *');
  919.        if yes then begin
  920.         offliney:=true;
  921.         addresidentfile (fn);
  922.         offliney:=false;
  923.        end else exit;
  924.      end;
  925.   end;
  926.  
  927.   procedure addmultiplefiles;
  928.   var spath,pathpart:lstr;
  929.       dummy:sstr;
  930.       f:file;
  931.       ffinfo:searchrec;
  932.   begin
  933.     if ulvl<sysoplevel then begin
  934.       writeln (
  935.         'Sorry, you may not add resident files without true sysop access!');
  936.       exit
  937.     end;
  938.     writehdr ('Add Resident Files By Wildcard');
  939.     writestr ('Search path/wildcard:');
  940.     if length(input)=0 then exit;
  941.     spath:=input;
  942.     if spath[length(spath)]='\' then dec(spath[0]);
  943.     assign (f,spath+'\con');
  944.     reset (f);
  945.     if ioresult=0 then begin
  946.       close (f);
  947.       spath:=spath+'\*.*'
  948.     end;
  949.     getpathname (spath,pathpart,dummy);
  950.     findfirst (spath,$17,ffinfo);
  951.     if doserror<>0
  952.       then writeln ('No files found!')
  953.       else
  954.         while doserror=0 do begin
  955.           writeln;
  956.           displayfile (ffinfo);
  957.           writestr ('Add this file [Y/N/X]? *');
  958.           if yes
  959.             then addresidentfile (getfname(pathpart,ffinfo.name))
  960.             else if (length(input)>0) and (upcase(input[1])='X')
  961.               then exit;
  962.           findnext (ffinfo)
  963.         end
  964.   end;
  965.  
  966.   procedure changef;
  967.   var n,q:integer;
  968.       ud:udrec;
  969.  
  970.     procedure showudrec (var ud:udrec);
  971.     var a,b,c:string;
  972.     begin
  973.       with ud do
  974.         writeln(^M^J'     Filename: '^S,ud.filename,
  975.                 ^M^J'         Path: '^S,ud.path,
  976.                 ^M^J'         Size: '^S,ud.filesize,
  977.                 ^M^J'       Points: '^S,ud.points,
  978.                 ^M^J'  Description: '^S,ud.descrip,
  979.                 ^M^J' # Downloaded: '^S,ud.downloaded,
  980.                 ^M^J'      Unrated: '^S,yesno(ud.newfile),
  981.                 ^M^J'  Special Ask: '^S,yesno(ud.specialfile),
  982.                 ^M^J'      Sent by: '^S,sentby,
  983.                 ^M^J'      Sent on: '^S,datestr(when),
  984.                 ^M^J'      Sent at: '^S,timestr(when));
  985.         if filepw then begin
  986.          write ('File Password: '^S);
  987.          if length(ud.dlpw)<1 then writeln ('NONE') else
  988.          writeln (ud.dlpw);
  989.         end;
  990.         writeln ('Extended Desc: '^S);
  991.     a:=copy (ud.extdesc,1,80);
  992.     ansicolor (urec.statcolor);
  993.     writeln (a);
  994.     if length(ud.extdesc)>80 then begin
  995.      b:=copy (ud.extdesc,81,80);
  996.      ansicolor (urec.statcolor);
  997.      writeln (b);
  998.     end;
  999.     if length(ud.extdesc)>160 then begin
  1000.      c:=copy (ud.extdesc,161,80);
  1001.      ansicolor (urec.statcolor);
  1002.      writeln (c);
  1003.     end;
  1004.     end;
  1005.  
  1006.   begin
  1007.     n:=getfilenum ('Change');
  1008.     if n=0 then exit;
  1009.     seekudfile (n);
  1010.     read (udfile,ud);
  1011.     writelog (16,4,ud.filename);
  1012.     showudrec (ud);
  1013.     repeat
  1014.       q:=menu ('File Change','FCHANGE','QUDSNFPVAE');
  1015.       case q of
  1016.         2:getstring ('Uploader',ud.sentby);
  1017.         3:begin
  1018.             nochain:=true;
  1019.             getstring ('Description',ud.descrip)
  1020.           end;
  1021.         4:getboo ('Special Request only',ud.specialfile);
  1022.         5:getboo ('New File (unrated)',ud.newfile);
  1023.         6:getstring ('Filename',ud.filename);
  1024.         7:getstring ('Path',ud.path);
  1025.         8:getint ('Point Value',ud.points);
  1026.         9:if (not filepw) then writeln ('File Passwords were not configured!')
  1027.           else getstringgg ('File Password',ud.dlpw);
  1028.         10:ud.extdesc:=getextdesc
  1029.       end
  1030.     until (q=1);
  1031.     getfsize(ud);
  1032.     if ud.filesize=-1 then writestr ('Warning:  Can''t open file!');
  1033.     seekudfile (n);
  1034.     write (udfile,ud)
  1035.   end;
  1036.  
  1037.   procedure deletef;
  1038.   var n,cnt,anarky:integer;
  1039.       fn:lstr;
  1040.       ud:udrec;
  1041.       f:file;
  1042.       floyd:userrec;
  1043.   begin
  1044.     n:=getfilenum ('Delete');
  1045.     if n=0 then exit;
  1046.     seekudfile (n);
  1047.     read (udfile,ud);
  1048.     fn:=getfname(ud.path,ud.filename);
  1049.     writelog (16,7,fn);
  1050.     writeln;
  1051.     writehdr ('Delete File');
  1052.     writeln (^R'Filename:    '^S,fn);
  1053.     writeln (^R'Size:        '^S,ud.filesize);
  1054.     writeln (^R'Description: '^S,ud.descrip);
  1055.     writeln (^R'Downloaded:  '^S,ud.downloaded);
  1056.     writeln (^R'Uploaded by: '^S,ud.sentby);
  1057.     writeln (^R);
  1058.     writestr ('Delete this [y/n]? *');
  1059.     if not yes then exit;
  1060.     removefile (n);
  1061.     if ups<1 then ups:=1;
  1062.     ups:=ups-1;
  1063.     if urec.lastups<1 then urec.lastups:=1;
  1064.     urec.lastups:=urec.lastups-1;
  1065.     writeurec;
  1066.     writestr ('Remove upload credits from uploader [y/n]? *');
  1067.     if yes then begin
  1068.      anarky:=lookupuser (ud.sentby);
  1069.      if anarky<>0 then begin
  1070.       writeurec;
  1071.       seek (ufile,anarky);
  1072.       read (ufile,floyd);
  1073.       floyd.uploads:=floyd.uploads-1;
  1074.       floyd.upk:=floyd.upk-ud.filesize;
  1075.       seek (ufile,anarky);
  1076.       write (ufile,floyd);
  1077.       readurec
  1078.      end;
  1079.     end;
  1080.     writestr ('Erase Disk File '+fn+' [y/n]? *');
  1081.     if not yes then exit;
  1082.     assign (f,fn);
  1083.     erase (f)
  1084.   end;
  1085.  
  1086.   procedure killarea;
  1087.   var a:arearec;
  1088.       cnt,n:integer;
  1089.       oldname,newname:sstr;
  1090.   begin
  1091.     writestr (^R'Delete Area #'^S+strr(curarea)+^R' ('^S+area.name+^R')? *');
  1092.     if not yes then exit;
  1093.     writelog (16,2,'');
  1094.     ups:=ups-numuds;
  1095.     urec.lastups:=urec.lastups-numuds;
  1096.     if ups<1 then ups:=1;
  1097.     if urec.lastups<1 then urec.lastups:=1;
  1098.     writeurec;
  1099.     close (udfile);
  1100.     oldname:='Area'+strr(curarea);
  1101.     assign (udfile,oldname);
  1102.     erase (udfile);
  1103.     for cnt:=curarea to numareas-1 do begin
  1104.       newname:=oldname;
  1105.       oldname:='Area'+strr(cnt+1);
  1106.       assign (udfile,oldname);
  1107.       rename (udfile,newname);
  1108.       n:=ioresult;
  1109.       seekafile (cnt+1);
  1110.       read (afile,a);
  1111.       seekafile (cnt);
  1112.       write (afile,a)
  1113.     end;
  1114.     seekafile (numareas);
  1115.     truncate (afile);
  1116.     setarea (1)
  1117.   end;
  1118.  
  1119.   procedure modarea;
  1120.   var a:arearec;
  1121.   begin
  1122.     a:=area;
  1123.     getstring ('Area Name',a.name);
  1124.     writelog (16,3,a.name);
  1125.     getint ('Access Level',a.level);
  1126.     writelog (16,11,strr(a.level));
  1127.     getstring ('Sponsor',a.sponsor);
  1128.     writelog (16,12,a.sponsor);
  1129.   { getstring ('Entry Password',a.areapw);
  1130.     writelog (16,18,a.areapw); }
  1131.     getboo ('Able to Upload into area',a.upload);
  1132.     getboo ('Able to Download from area',a.download);
  1133.     if issysop then begin
  1134.       a.xmodemdir:=getapath;
  1135.       writelog (16,13,a.xmodemdir)
  1136.     end;
  1137.     seekafile (curarea);
  1138.     write (afile,a);
  1139.     area:=a
  1140.   end;
  1141.  
  1142.   procedure sortarea;
  1143.   var temp,mark,cnt:integer;
  1144.       u1,u2:udrec;
  1145.   begin
  1146.     writehdr('Sort File Area'); writeln;
  1147.     writestr('Are you sure? '+^S+'[y/n]'+^P+':');
  1148.     if not yes then exit;
  1149.     writelog (16,6,'');
  1150.     mark:=numuds-1;
  1151.     repeat
  1152.       if mark<>0 then begin
  1153.         temp:=mark;
  1154.         mark:=0;
  1155.         for cnt:=1 to temp do begin
  1156.           seekudfile (cnt);
  1157.           read (udfile,u1);
  1158.           read (udfile,u2);
  1159.           if upstring(u1.filename)>upstring(u2.filename) then begin
  1160.             mark:=cnt;
  1161.             seekudfile (cnt);
  1162.             write (udfile,u2);
  1163.             write (udfile,u1)
  1164.           end
  1165.         end
  1166.       end
  1167.     until mark=0
  1168.   end;
  1169.  
  1170.   procedure movefile;
  1171.   var an,fn,oldn:integer;
  1172.       ud:udrec;
  1173.       pe:boolean; sz:real;
  1174.       lttp,laym,honkyshide,ocky:anystr;
  1175.       damn:file; drive:char; r:registers;
  1176.  
  1177.       function unsigned (i:integer):real;
  1178.       begin
  1179.         if i>=0 then unsigned:=i else unsigned:=65536.0+i
  1180.       end;
  1181.  
  1182.  
  1183.  
  1184.   begin
  1185.     oldn:=curarea;
  1186.     fn:=getfilenum ('Move');
  1187.     if fn=0 then exit;
  1188.     input:='';
  1189.     an:=getareanum;
  1190.     if an=0 then exit;
  1191.     writestr ('Physically move file to correct area [y/n]? *');
  1192.     if yes then pe:=true else pe:=false;
  1193.     seekudfile (fn);
  1194.     read (udfile,ud);
  1195.     writelog (16,5,ud.filename);
  1196.     laym:=getfname(ud.path,ud.filename);
  1197.     ocky:=ud.path;
  1198.     write('Moving...');
  1199.     setarea (an);
  1200.     if (not match(ud.path,area.xmodemdir)) and (pe) then begin
  1201.          ud.path:=area.xmodemdir;
  1202.          lttp:=getfname(ud.path,ud.filename);
  1203.          drive:=upcase(lttp[1]);
  1204.         r.ah:=$36; r.dl:=ord(drive)-64;
  1205.         intr($21,r);
  1206.         if r.ax=$ffff then begin
  1207.                 writeln;
  1208.                 writeln('Dest. Drive does not exist!');
  1209.                 exit;
  1210.                 end;
  1211.  
  1212.         sz:=unsigned(r.bx)*unsigned(r.ax)*unsigned(r.cx); writeln;
  1213.     writeln;
  1214. writeln('There are ',^S,streal(sz),^R,' bytes free on the '^S,drive,^R,' drive.');
  1215.         if sz<=ud.filesize then begin
  1216.         writeln;
  1217.     writeln('That is not enough space for this file.  You must clear up another');
  1218.     writeln(^S,streal(ud.filesize-sz),^R,' bytes to continue.');
  1219.         exit;
  1220.         end;
  1221.             write('Copying...');
  1222.          exec(getenv('COMSPEC'),'/C copy '+laym+' '+lttp+' >TCS!@#.$$$');
  1223.          honkyshide:=laym;
  1224.  
  1225.          assign(damn,honkyshide);
  1226.          if exist(honkyshide) then erase (damn) else begin
  1227.           ud.path:=ocky;
  1228.           writeln('ERROR: Unable to move file!');
  1229.           end;
  1230.     end;
  1231.     addfile (ud);
  1232.     setarea (oldn);
  1233.     removefile (fn);
  1234.     writeln('done.');
  1235.   end;
  1236.  
  1237.   procedure renamefile;
  1238.   var fn:integer;
  1239.       ud:udrec;
  1240.       f:file;
  1241.   begin
  1242.     fn:=getfilenum ('Rename');
  1243.     if fn=0 then exit;
  1244.     seekudfile (fn);
  1245.     read (udfile,ud);
  1246.     writestr ('Enter new Filename:');
  1247.     if match(input,ud.filename)
  1248.       then
  1249.         ud.filename:=input
  1250.       else if length(input)>0
  1251.         then if validfname(input)
  1252.           then if exist(getfname(ud.path,input))
  1253.             then
  1254.               writeln ('Name already in use!')
  1255.             else
  1256.               begin
  1257.                 assign (f,getfname(ud.path,ud.filename));
  1258.                 rename (f,getfname(ud.path,input));
  1259.                 if ioresult=0 then begin
  1260.                   ud.filename:=input;
  1261.                   writeln (^B^M'File renamed.')
  1262.                 end else writeln (^B^M'Unable to rename file!')
  1263.               end
  1264.           else writeln ('Invalid filename!');
  1265.     seekudfile (fn);
  1266.     write (udfile,ud)
  1267.   end;
  1268.  
  1269.   procedure listxmodem;
  1270.   var cnt:integer;
  1271.       u:userrec;
  1272.   begin
  1273.     seek (ufile,1);
  1274.     writeln ('Name                          Level Points'^M);
  1275.     for cnt:=1 to numusers do begin
  1276.       read (ufile,u);
  1277.       if u.handle<>'' then
  1278.         if u.udlevel>0 then begin
  1279.           tab (u.handle,30);
  1280.           tab (strr(u.udlevel),6);
  1281.           writeln (u.udpoints);
  1282.           if break then exit
  1283.         end
  1284.     end
  1285.   end;
  1286.  
  1287.   procedure reorderareas;
  1288.   var numa,cura,newa:integer;
  1289.       a1,a2:arearec;
  1290.       f1,f2:file;
  1291.       fn1,fn2:sstr;
  1292.   label exit;
  1293.   begin
  1294.     writelog (16,9,'');
  1295.     writehdr ('Re-order Areas');
  1296.     numa:=filesize (afile);
  1297.     writeln ('Number of Areas: ',numa);
  1298.     for cura:=0 to numa-2 do begin
  1299.       repeat
  1300.         writestr ('New Area #'+strr(cura+1)+' [?/List, CR/Quit]:');
  1301.         if length(input)=0 then goto exit;
  1302.         if input='?'
  1303.           then
  1304.             begin
  1305.               listareas;
  1306.               newa:=-1
  1307.             end
  1308.           else
  1309.             begin
  1310.               newa:=valu(input)-1;
  1311.               if (newa<0) or (newa>numa) then begin
  1312.                 writeln ('Not found!  Please re-enter...');
  1313.                 newa:=-1
  1314.               end
  1315.             end
  1316.       until (newa>=0);
  1317.       seek (afile,cura);
  1318.       read (afile,a1);
  1319.       seek (afile,newa);
  1320.       read (afile,a2);
  1321.       seek (afile,cura);
  1322.       write (afile,a2);
  1323.       seek (afile,newa);
  1324.       write (afile,a1);
  1325.       fn1:='Area';
  1326.       fn2:=fn1+strr(newa+1);
  1327.       fn1:=fn1+strr(cura+1);
  1328.       assign (f1,fn1);
  1329.       assign (f2,fn2);
  1330.       rename (f1,'Temp$$$$');
  1331.       rename (f2,fn1);
  1332.       rename (f1,fn2)
  1333.     end;
  1334.     exit:
  1335.     setarea (1)
  1336.   end;
  1337.  
  1338.   procedure newfiles;
  1339.   var a,fn,un:integer;
  1340.       ud:udrec;
  1341.       u:userrec;
  1342.       flag,aborted:boolean;
  1343.  
  1344.    procedure writeudrec;
  1345.     begin
  1346.       seekudfile (fn);
  1347.       write (udfile,ud)
  1348.     end;
  1349.  
  1350.     procedure ratefile (p:integer);
  1351.     var pp:integer;
  1352.     begin
  1353.       ud.points:=p;
  1354.       ud.newfile:=false;
  1355.       ud.whenrated:=now;
  1356.       writeudrec;
  1357.       p:=p*uploadfactor;
  1358.       if p>-2 then begin
  1359.         un:=lookupuser (ud.sentby);
  1360.         if un=0
  1361.           then writeln (ud.sentby,' has vanished!')
  1362.           else begin
  1363.             pp:=p;
  1364.             writestr (^P'Actually grant '^S+ud.sentby+^P' how many points ['^S+strr(p)+^P']:');
  1365.             if (length(input)=0) then pp:=p else pp:=valu(input);
  1366.             writeln ('Granting '^S+ud.sentby+' '+strr(pp)+^R' points.');
  1367.             if un=unum then writeurec;
  1368.             seek (ufile,un);
  1369.             read (ufile,u);
  1370.             u.udpoints:=u.udpoints+pp;
  1371.             seek (ufile,un);
  1372.             write (ufile,u);
  1373.             if un=unum then readurec
  1374.           end
  1375.       end
  1376.     end;
  1377.  
  1378.     procedure doarea;
  1379.     var i,advance:integer;
  1380.         done:boolean;
  1381.     begin
  1382.       fn:=1;
  1383.       advance:=0;
  1384.       while fn+advance<=numuds do begin
  1385.         fn:=fn+advance;
  1386.         advance:=1;
  1387.         seekudfile (fn);
  1388.         read (udfile,ud);
  1389.         if ud.newfile then begin
  1390.           flag:=false;
  1391.           done:=false;
  1392.           repeat
  1393.             writeln (^B^M'Filename:    ',ud.filename,
  1394.                        ^M'Path:        ',ud.path,
  1395.                        ^M'Sent by:     ',ud.sentby,
  1396.                        ^M'File size:   ',ud.filesize,
  1397.                        ^M'Description: ',ud.descrip);
  1398.             i:=menu ('File Newscan','NEWSCAN','Q#_CEDRM0');
  1399.             input:=' '+strr(fn);
  1400.             if i<0
  1401.               then
  1402.                 begin
  1403.                   ratefile (-i);
  1404.                   done:=true
  1405.                 end
  1406.               else
  1407.                 case i of
  1408.                   1:begin
  1409.                       aborted:=true;
  1410.                       exit
  1411.                     end;
  1412.                   3:done:=true;
  1413.                   4:begin
  1414.                       writestr ('Enter new Description:');
  1415.                       if length(input)>0 then ud.descrip:=input;
  1416.                       writeudrec
  1417.                     end;
  1418.                   5:begin
  1419.                       renamefile;
  1420.                       advance:=0
  1421.                     end;
  1422.                   6:begin
  1423.                       deletef;
  1424.                       advance:=0
  1425.                     end;
  1426.                   7:listarchive (fn);
  1427.                   8:begin
  1428.                       movefile;
  1429.                       advance:=0
  1430.                     end;
  1431.                   9:begin
  1432.                       ratefile (0);
  1433.                       done:=true
  1434.                     end
  1435.                 end
  1436.           until done or (advance=0)
  1437.         end
  1438.       end
  1439.     end;
  1440.  
  1441.   begin
  1442.     flag:=true;
  1443.     writelog (16,1,'');
  1444.     if issysop then begin
  1445.       writestr ('Scan all areas [y/n]? *');
  1446.       if yes then begin
  1447.         for a:=1 to numareas do begin
  1448.           setarea (a);
  1449.           aborted:=false;
  1450.           doarea;
  1451.           if aborted then exit
  1452.         end
  1453.       end else doarea
  1454.     end else doarea;
  1455.     if flag then writeln (^B'No new files.')
  1456.   end;
  1457.  
  1458.   procedure generatelist;
  1459.   var total,a,b,c,x,y,z:integer;
  1460.       list:text;
  1461.       yoo,ud:udrec;
  1462.       s:anystr;
  1463.       f:file;
  1464.       str1,str2:string;
  1465.   begin
  1466.    total:=0;
  1467.    writehdr ('Generate Master File List');
  1468.    writestr ('Make complete list of all files available [y/n]? *');
  1469.    if not yes then exit;
  1470.    if forumdir[length(forumdir)]<>'\' then forumdir:=forumdir+'\';
  1471.    assign (list,forumdir+'MASTER.LST');
  1472.    rewrite (list);
  1473.    writeln (list);
  1474.    writeln (list,'<<< Master File List created by TCS v'+ver+' for '+longname+' >>>');
  1475.    writeln (list);
  1476.    writeln (list,'Num. Filename     Description');
  1477.    writeln (list,'───────────────────────────────────────────────────────────────────────────────');
  1478.    for x:=1 to numareas do begin
  1479.     setarea (x);
  1480.     writeln (list);
  1481.     writeln (list,'Area: ',area.name,' [',curarea,']');
  1482.     writeln (list);
  1483.     for y:=1 to numuds do
  1484.     begin
  1485.      seekudfile (y);
  1486.      read (udfile,yoo);
  1487.      total:=total+1;
  1488.      write (list,strr(total)+'.');
  1489.      for a:=1 to 5-(length(strr(total)+'.')) do write (list,' ');
  1490.      write (list,yoo.filename);
  1491.      for b:=1 to 13-(length(yoo.filename)) do write (list,' ');
  1492.     if exist (getfname(yoo.path,yoo.filename)) then begin
  1493.      write (list,strlong(yoo.filesize));
  1494.      for c:=1 to 10-(length(strlong(yoo.filesize))) do write (list,' ');
  1495.     end else
  1496.     write (list,'[Offline] ');
  1497.     writeln (list,yoo.descrip);
  1498.     end;
  1499.    end;
  1500.    writeln (list);
  1501.    writeln (list,'>>> '+strr(total)+' Files Processed');
  1502.    writeln (list,'>>> List generated by TCS v'+ver);
  1503.    textclose (list);
  1504.    setarea (1);
  1505.    writeln;
  1506.    writeln ('Please wait while file is being Zipped up...');
  1507.    addtozip (area.xmodemdir+'ALLFILES.ZIP',forumdir+'MASTER.LST');
  1508.    writeln (usr);
  1509.    if not exist (area.xmodemdir+'ALLFILES.ZIP') then begin
  1510.     writeln ('Cannot locate temporary Zipfile '+area.xmodemdir+'ALLFILES.ZIP!');
  1511.     exit;
  1512.    end;
  1513.    writeln;
  1514.    ud.filename:='ALLFILES.ZIP';
  1515.    ud.path:=area.xmodemdir;
  1516.    ud.dlpw:='';
  1517.    ud.sentby:=unam;
  1518.    ud.when:=now;
  1519.    ud.whenrated:=now;
  1520.    ud.points:=0;
  1521.    ud.downloaded:=0;
  1522.    ud.newfile:=false;
  1523.    ud.specialfile:=false;
  1524.    ud.extdesc:='Master file list for '+longname;
  1525.    getfsize (ud);
  1526.    addfile (ud);
  1527.    writeln (^R'Downloading '^S+ud.filename+^R'...');
  1528.    download (numuds);
  1529.    removefile (numuds);
  1530.    assign (f,getfname(ud.path,ud.filename));
  1531.    erase (f);
  1532.    writelog (16,18,unam);
  1533.   end;
  1534.  
  1535.   procedure extractfile;
  1536.   var n:integer;
  1537.       ud,scratch:udrec;
  1538.       ok,done:boolean;
  1539.       effn,master,dir,sname,tempfn:anystr;
  1540.   begin
  1541.    n:=getfilenum ('Extract from');
  1542.    if n=0 then exit;
  1543.    seekudfile (n);
  1544.    read (udfile,ud);
  1545.    ok:=checkok (ud);
  1546.    if not ok then exit;
  1547.    writeln;
  1548.    writeln (^R'Archive Filename: '^S,ud.filename,^R);
  1549.    done:=false;
  1550.    repeat
  1551.     writeln;
  1552.     writeln (^R'Enter Filename to extract from Archive, or hit [V] to View.');
  1553.     writestr ('-> *');
  1554.     if length(input)=0 then exit;
  1555.     if upstring(input)='V' then listarchive (n) else
  1556.     done:=true;
  1557.    until done or hungupon;
  1558.    effn:=upstring(input);
  1559.    setarea (1);
  1560.    dir:=area.xmodemdir;
  1561.    if dir[length(dir)]<>'\' then dir:=dir+'\';
  1562.    if exist(effn) then begin
  1563.      writeln ('File Already Exists!');
  1564.      exit;
  1565.    end;
  1566.    master:=getfname (ud.path,ud.filename);
  1567.    extract (effn,master,dir);
  1568.    tempfn:=effn;
  1569.    effn:=getfname(dir,effn);
  1570.    if not exist (effn) then begin
  1571.     writeln (^G);
  1572.     writeln ('Error! Cannot find extracted file '+effn);
  1573.     writeln ('Please notify Sysop!');
  1574.     exit;
  1575.    end;
  1576.    writeln (usr);
  1577.    sname:=copy (tempfn,1,(pos ('.',tempfn)));
  1578.    writeln ('Please wait while file is being Zipped up...');
  1579.    addtozip (dir+sname+'ZIP',effn);
  1580.    writeln (usr);
  1581.    if not exist (dir+sname+'ZIP') then begin
  1582.     writeln ('Cannot locate temporary Zipfile '+dir+sname+'ZIP!');
  1583.     exit;
  1584.    end;
  1585.    scratch.filename:=sname+'ZIP';
  1586.    scratch.path:=dir;
  1587.    scratch.dlpw:='';
  1588.    scratch.sentby:=unam;
  1589.    scratch.when:=now;
  1590.    scratch.whenrated:=now;
  1591.    scratch.points:=1;
  1592.    scratch.downloaded:=0;
  1593.    scratch.newfile:=false;
  1594.    scratch.specialfile:=false;
  1595.    scratch.extdesc:='Temporary Zipfile for downloading by '+unam+' ONLY.';
  1596.    getfsize (scratch);
  1597.    addfile (scratch);
  1598.    writeln (^R'Downloading '^S+scratch.filename+^R'...');
  1599.    download (numuds);
  1600.    removefile (numuds);
  1601.    writelog (16,19,ud.filename);
  1602.   end;
  1603.  
  1604.  
  1605.   procedure renameallfiles;
  1606.   var e,c,w:sstr;
  1607.       i,yiyi:integer;
  1608.       u:udrec;
  1609.       f:lstr;
  1610.       bpb:boolean;
  1611.   begin
  1612.    writehdr ('Convert All File Extensions');
  1613.    writeln (^R'This is for if you are converting all your files to ZIP');
  1614.    writeln (^R'format, or are converting them all to PAK format, etc.');
  1615.    writeln (^R'Instead of you having to change the file extensions by hand');
  1616.    writeln (^R'this will do it for you.');
  1617.    writeln (^S'But you must do the actual file converting YOURSELF.');
  1618.    writeln (^R^B);
  1619.    writeln (^S'Enter Global File Extension (ie ZIP), or [CR] to exit: ');
  1620.    buflen:=3;
  1621.    writestr ('-> *');
  1622.    if length(input)=0 then exit;
  1623.    e:=input;
  1624.    writeln;
  1625.    bpb:=match (longname,'Beta Cygnus');
  1626.    if bpb then begin
  1627.     writeln ('Enter Global "Who Uploaded this File":');
  1628.     writestr ('-> &');
  1629.     w:=input;
  1630.    end;
  1631.    for i:=1 to filesize(udfile) do begin
  1632.     if aborted then exit;
  1633.     seekudfile (i);
  1634.     read (udfile,u);
  1635.     yiyi:=0;
  1636.     f:='';
  1637.     c:='';
  1638.     repeat
  1639.      yiyi:=yiyi+1;
  1640.      c:=copy (u.filename,yiyi,1);
  1641.      f:=f+c;
  1642.     until (c='.') or (yiyi=length(u.filename));
  1643.     writeln ('Pass Number:  ',i);
  1644.     u.filename:=f+e;
  1645.     writeln ('New Filename: ',u.filename);
  1646.     if (bpb) and (length(w)>0) then begin
  1647.      u.sentby:=w;
  1648.      writeln ('New Uploader: ',u.sentby);
  1649.     end;
  1650.     seekudfile (i);
  1651.     write (udfile,u);
  1652.    end
  1653.   end;
  1654.  
  1655.   procedure showinfo (n:integer);
  1656.   var ud:udrec;
  1657.   begin
  1658.    if n>numuds then exit;
  1659.    seekudfile (n);
  1660.    read (udfile,ud);
  1661.  
  1662.   end;
  1663.  
  1664.   procedure newscan;
  1665.   var cnt,aka,insane:integer;
  1666.       u:udrec;
  1667.       gnuwarez,done,non:boolean;
  1668.       c:char;
  1669.   begin
  1670.     vcr:=false;
  1671.     gnuwarez:=false;
  1672.     beenaborted:=false;
  1673.     aka:=0;
  1674.     cn:=0;
  1675.     non:=false;
  1676.  
  1677.     repeat
  1678.  
  1679.     cn:=0;
  1680.     non:=false;
  1681.     for cnt:=1 to filesize(udfile) do begin
  1682.       if aborted then exit;
  1683.       seekudfile (cnt);
  1684.       read (udfile,u);
  1685.       if (u.whenrated>laston) or (u.when>laston)
  1686.       then begin
  1687.       inc(cn);
  1688.       if (cn=18) and (non=false) then
  1689.       begin
  1690.        bottomfileline;
  1691.        cn:=0;
  1692.        writestr(^P'File Listings Commands ['^S'Q/'^R'Quit'^P']['^S'N/'^R'Non-stop'^P']['^S'CR/'^R'Continue'^P']: *');
  1693.        if capfir(input)='Q' then exit;
  1694.        if capfir(input)='N' then non:=true;
  1695.        topfileline;
  1696.  
  1697.       end;
  1698.  
  1699.          aka:=aka+1;
  1700.          if aka=1 then begin
  1701.           clearscr;
  1702.           write   (^R'╓');
  1703.           linelen (length(strr(curarea))+length(area.name)+12);
  1704.           writeln ('╖');
  1705.  
  1706.           writeln (^R'║   '^U'['^S,curarea,^U']  ['^S,area.name,^U']'^R'   ║');
  1707.           write   (^R'╙');
  1708.           linelen (length(strr(curarea))+length(area.name)+12);
  1709.           writeln ('╜');
  1710.           topfileline;
  1711.          end;
  1712.  
  1713.          listfile (cnt,false);
  1714.          gnuwarez:=true;
  1715.         end;
  1716.        end;
  1717.  
  1718.     if not gnuwarez then done:=true else done:=false;
  1719.     if gnuwarez then begin
  1720.      c:='N';
  1721.      bottomfileline;
  1722.      writeln;
  1723.      writestr (^P'File Newscan Command ['^S'?/Help'^P']['^S'CR/Next Area'^P']: *');
  1724.      if length(input)<1 then input:='N';
  1725.      c:=input[1];
  1726.      insane:=valu(input);
  1727.      c:=upcase(c);
  1728.      if (insane>0) and (insane<=numuds) then begin
  1729.       showinfo (insane);
  1730.       writeln;
  1731.       writestr ('Hit [Enter]:');
  1732.      end else
  1733.        c:=upcase(input[1]);
  1734.        if length(input)=0 then done:=true else
  1735.        case c of
  1736.         '?':begin
  1737.               writeln;
  1738.               writeln (^S'          -File Xfer Newscan Help-'^R^M);
  1739.               writeln ('[N]: Next File Area        [I]: More Info on a File ');
  1740.               writeln ('[A]: See Files Again       [V]: View a File (ZIP/ARC/PAK/LZH)');
  1741.               writeln ('[D]: Download a File       [+]: Add file to Batch');
  1742.               writeln ('[Q]: Quit Newscan');
  1743.               if sponsoron then begin
  1744.                writeln (^S'              -Sysop Commands- '^R);
  1745.                writeln ('[C]: Change a File         [!]: Validate all New Files');
  1746.                writeln ('[R]: Rename a File         [E]: Delete a File');
  1747.               end;
  1748.               writeln;
  1749.               aka:=0;
  1750.               writestr (^M'Hit [Enter] to continue.*');
  1751.               aka:=0;
  1752.             end;
  1753.         '+':begin
  1754.              writeln;
  1755.              addtobatch (0);
  1756.              writestr (^M'Hit [Enter] to continue.*');
  1757.              aka:=0;
  1758.             end;
  1759.         'D':begin
  1760.              writeln;
  1761.              download (0);
  1762.              writestr (^M'Hit [Enter] to continue.*');
  1763.              aka:=0;
  1764.             end;
  1765.         'A':begin
  1766.              done:=false;
  1767.              aka:=0;
  1768.             end;
  1769.         'V':begin
  1770.              writeln;
  1771.              listarchive (0);
  1772.              writestr (^M'Hit [Enter] to continue.*');
  1773.              aka:=0;
  1774.             end;
  1775.         'Q':begin
  1776.              vcr:=true;
  1777.              exit;
  1778.             end;
  1779.         'C':begin
  1780.              if not sponsoron then exit;
  1781.              changef;
  1782.              aka:=0;
  1783.             end;
  1784.         'R':begin
  1785.              if not sponsoron then exit;
  1786.              renamefile;
  1787.              aka:=0;
  1788.             end;
  1789.         'E':begin
  1790.              if not sponsoron then exit;
  1791.              deletef;
  1792.              aka:=0;
  1793.             end;
  1794.         '!':begin
  1795.              if not sponsoron then exit;
  1796.              newfiles;
  1797.              aka:=0;
  1798.             end;
  1799.         'I':begin
  1800.              writeln;
  1801.              fileinfo (0);
  1802.              aka:=0;
  1803.              writestr ('Hit [Enter] to continue.*');
  1804.             end;
  1805.         'N':done:=true;
  1806.        end;
  1807.       end;
  1808.     until done;
  1809.   end;
  1810.  
  1811.   procedure newscanall;
  1812.   var cnt:integer;
  1813.       a:arearec;
  1814.   begin
  1815.     writehdr ('Newscanning All Areas - Press [X] to Abort.');
  1816.     beenaborted:=false;
  1817.     if aborted then exit;
  1818.     for cnt:=1 to filesize(afile) do begin
  1819.       seekafile (cnt);
  1820.       read (afile,a);
  1821.       if urec.udlevel>=a.level then begin
  1822.         if aborted then exit;
  1823.         setarea (cnt);
  1824.         if aborted or vcr then exit;
  1825.         newscan
  1826.       end;
  1827.       if aborted then exit
  1828.     end;
  1829.    writeln (^B^M'Newscan complete!'^G);
  1830.   end;
  1831.  
  1832.   procedure yourudstatus;
  1833.   var newfilez:integer; blah:integer; udr:real;
  1834.  
  1835.   begin
  1836.   clrscr; gotoxy(1,1); write(#27+'[2J');
  1837. writeln('╒═══════════════════════════════════════════════════════════════════════╕');
  1838. writeln('│                                                    TCS Version '+ver+'   │');
  1839. writeln('╞═════════════╤═══════════════════╤══════════════╤══════════════════════╡');
  1840. writeln('│ File Level: │                   │ File Points: │                      │');
  1841. writeln('│ Uploads:    │                   │ Posts:       │                      │');
  1842. writeln('│ Downloads:  │                   │ Num Calls:   │                      │');
  1843. writeln('│ U/D Ratio:  │                   │ Your PCR:    │                      │');
  1844. writeln('╞═════════════╪═══════════════════╪══════════════╪══════════════════════╡');
  1845. writeln('│ New Files:  │                   │ Your QR:     │                      │');
  1846. writeln('╞═════════════╧═══════════════════╧══════════════╧══════════════════════╡');
  1847. writeln('│ Hours of Operation:                                                   │');
  1848. writeln('╘═══════════════════════════════════════════════════════════════════════╛');
  1849.  
  1850.  
  1851. printxy(3,2,^P+longname+^R+' Transfer Area');
  1852. if (xmodemopentime = xmodemclosetime) then printxy(23,11,^R'Always!') else
  1853.   printxy(23,11,^S+xmodemopentime+^R+' to '+^S+xmodemclosetime);
  1854. printxy(17,4,strr(urec.udlevel));
  1855. printxy(17,5,strr(urec.uploads)+^R+' ('+^S+streal(urec.upk/1024)+^R+'k)');
  1856. printxy(17,6,strr(urec.downloads)+^R+' ('+^S+streal(urec.downk/1024)+^R+'k)');
  1857. printxy(52,4,strr(urec.udpoints));
  1858. if useqr then begin
  1859.               calcqr;
  1860.           printxy(52,9,strr(qr));
  1861.           end else printxy(52,9,'Not used.');
  1862. newfilez:=(ups-urec.lastups);
  1863. if newfilez<1 then printxy(17,9,'None') else begin;
  1864.                     printxy(17,9,strr(newfilez));
  1865.                                     urec.lastups:=ups;
  1866.                                     end;
  1867. if urec.downloads > 0 then udr:=(urec.uploads div urec.downloads)*100 else
  1868.                     udr:=(urec.uploads)*100;
  1869.  
  1870. printxy(17,7,streal(udr));
  1871. end;
  1872.  
  1873. procedure yourpcrstats;
  1874. var xx:real; x1:string[30];
  1875. begin
  1876.      printxy(52,5,strr(urec.nbu));
  1877.      printxy(52,6,strr(urec.numon));
  1878.  
  1879.     xx:=(urec.nbu div urec.numon) * 100;
  1880.     printxy(52,7,streal(xx)+'%');
  1881. end;
  1882.  
  1883.   procedure yourudstats;
  1884.   begin
  1885.      clrscr;
  1886.      yourudstatus;
  1887.      yourpcrstats;
  1888.      movexy(1,13);
  1889.    end;
  1890.  
  1891.   procedure sysopcommands;
  1892.   var i:integer;
  1893.   begin
  1894.     if not sponsoron then begin
  1895.       reqlevel (sysoplevel);
  1896.       exit
  1897.  
  1898.  
  1899.     end;
  1900.     writelog (15,3,area.name);
  1901.     repeat
  1902.       i:=menu('File Sponsor','FSYSOP','A@CDF@G@KRNSMLO@QEW*@V');
  1903.       case i of
  1904.         1:sysopadd;
  1905.         2:changef;
  1906.         3:deletef;
  1907.         4:directory;
  1908.         5:;
  1909.         6:killarea;
  1910.         7:modarea;
  1911.         8:newfiles;
  1912.         9:sortarea;
  1913.         10:movefile;
  1914.         11:listxmodem;
  1915.         12:reorderareas;
  1916.         14:renamefile;
  1917.         15:addmultiplefiles;
  1918.         16:getarea;
  1919.         17:renameallfiles;
  1920.       end
  1921.     until hungupon or (i=13)
  1922.   end;
  1923.  
  1924.  
  1925. var i,c,kkk1,kkk2,oldarea:integer;
  1926.     a:arearec;
  1927.     ms:boolean;
  1928.     z:integer;
  1929.     x1,x2,x3:integer;
  1930.     y1,y2,y3:real;
  1931.     xferlist:text;
  1932.     temp:file;
  1933. label ok,exit;
  1934. begin
  1935.   vcr:=false;
  1936.   cursection:=udsysop;
  1937.   ms:=false;
  1938.   writehdr ('File Transfer Section');
  1939.   input:='';
  1940.   if exist ('BATCH.DAT') then begin
  1941.    assign (temp,'BATCH.DAT');
  1942.    erase (temp);
  1943.   end;
  1944.   assign (batfile,'BATCH.DAT');
  1945.   close (batfile);
  1946.   reset (batfile);
  1947.  
  1948.   if ioresult<>0 then rewrite (batfile);
  1949.   assign (afile,'Areadir');
  1950.   if exist ('Areadir')
  1951.     then
  1952.       begin
  1953.         reset (afile);
  1954.         if filesize (afile)>0 then goto ok
  1955.       end
  1956.     else rewrite (afile);
  1957.   writeln ('No transfer areas exist!');
  1958.   area.xmodemdir:=forumdir+'FILES\';
  1959.   if issysop
  1960.     then if makearea
  1961.       then goto ok;
  1962.   goto exit;
  1963.   ok:
  1964.   seekafile (1);
  1965.   read (afile,a);
  1966.   if urec.udlevel<a.level then begin
  1967.     writeln ('Sorry, you can''t access the first area!');
  1968.     goto exit
  1969.   end;
  1970.  
  1971.   x3:=percent(urec.nbu,urec.numon);
  1972.  
  1973.   yourudstats;
  1974.   setarea(1);
  1975.  
  1976.   if (x3<xferpcr) and (ulvl<pcrexempt) then goto exit;
  1977.  
  1978.   repeat
  1979.     if withintime (xmodemclosetime,xmodemopentime) then
  1980.       if not issysop then begin
  1981.       printxy(42,12,^S+'Transfer section closed.'+^R);
  1982.         goto exit
  1983.       end else if not ms then begin
  1984.         ms:=true
  1985.       end;
  1986.  
  1987.     write (^B^M^M^R,'Area: ',^S,area.name,^R' ['^S,curarea,^R']'^B);
  1988.     oldarea:=curarea;
  1989.     i:=menu('File Area Command','FILE','UDLFYA*SQ%NVHRWXTEGB+ZI');
  1990.     if hungupon then goto exit;                  {    ||    }
  1991.     case i of                                    {  fucked  }
  1992.       1:upload;
  1993.       2:download (0);
  1994.       3:listfiles (false);
  1995.       4:sendmailto (area.sponsor,false);
  1996.       5:yourudstats;
  1997.       6,7:getarea;
  1998.       8:begin;
  1999.         searchfile;
  2000.         setarea(oldarea);
  2001.     end;
  2002.       10:sysopcommands;
  2003.  
  2004.       11:begin;
  2005.         newscanall;
  2006.         setarea(oldarea);
  2007.      end;
  2008.       12:begin;
  2009.         newscan;
  2010.         setarea(oldarea);
  2011.      end;
  2012.       13:help ('Filexfer.HLP');
  2013.       14:listarchive (0);
  2014.       15:whoup;
  2015.       16:xtendedlist;
  2016.       17:typefile;
  2017.       18:requestfile;
  2018.       19:generatelist;
  2019.       20:batchmenu;
  2020.       21:addtobatch (0);
  2021.       22:extractfile;
  2022.       23:writeln(^M'Sorry, BiModem Not Allowed in TCS v'+ver+'.'^M);
  2023.     end
  2024.   until hungupon or (i=9);
  2025.   exit:
  2026.   close (afile);
  2027.   close (udfile);
  2028.   close (batfile);
  2029.   i:=ioresult;
  2030.   assign (xferlist,forumdir+'Xferlist.TCS');
  2031.   if exist (forumdir+'Xferlist.TCS') then erase (xferlist);
  2032. end;
  2033.  
  2034.  
  2035. begin
  2036. end.
  2037.