home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FAQ-S.ZIP / FILE2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-05-04  |  23.9 KB  |  717 lines
  1. var ud:udrec;
  2.     curarea:integer;
  3.     offliney,vcr:boolean;
  4.     validprotos:set of char;
  5.     xtype:char;
  6.  
  7.   procedure beepbeep (ok:integer);
  8.   begin
  9.     delay (500);
  10.     write (^B^M);
  11.     case ok of
  12.       0:write ('Xfer completed!');
  13.       1:write ('Xfer Aborted just before EOF!');
  14.       2:write ('Xfer Aborted!')
  15.     end;
  16.     writeln (^G^M)
  17.   end;
  18.  
  19.   procedure seekafile (n:integer);
  20.   begin
  21.     seek (afile,n-1)
  22.   end;
  23.  
  24.   function numareas:integer;
  25.   begin
  26.     numareas:=filesize (afile)
  27.   end;
  28.  
  29.   procedure seekudfile (n:integer);
  30.   begin
  31.     seek (udfile,n-1)
  32.   end;
  33.  
  34.   function numuds:integer;
  35.   begin
  36.     numuds:=filesize (udfile)
  37.   end;
  38.  
  39.   procedure assignud;
  40.   begin
  41.     {close (udfile);}
  42.     assign (udfile,datadir+'AREA'+strr(curarea)+'.'+strr(conn));
  43.     close (udfile);
  44.   end;
  45.  
  46.  {procedure openudfile;
  47.   var n:integer;
  48.   begin
  49.     n:=ioresult;
  50.     assignud;
  51.     reset (udfile);
  52.     if ioresult<>0 then begin
  53.       close (udfile);
  54.       n:=ioresult;
  55.       rewrite (udfile)
  56.     end
  57.   end;}
  58.  
  59.   function sponsoron:boolean;
  60.   begin
  61.     sponsoron:=match(area.sponsor,unam) or issysop
  62.   end;
  63.  
  64.   function getapath:lstr;
  65.   begin
  66.    getapath:=area.xmodemdir;
  67.    getapath:=getpath (area.xmodemdir);
  68.   end;
  69.  
  70.   {function makearea:boolean;
  71.   var num,n:integer;
  72.       a:arearec;
  73.   begin
  74.     makearea:=false;
  75.     num:=numareas+1;
  76.     n:=numareas;
  77.     writestr ('Create Area '+strr(num)+'? [y/n]: *');
  78.     if yes then begin
  79.       writestr ('Area Name: &');
  80.       if length(input)=0 then exit;
  81.       a.name:=input;
  82.       writestr ('Access Level:');
  83.       if length(input)=0 then exit;
  84.       a.level:=valu(input);
  85.       writestr ('Sponsor [CR/'+unam+']:');
  86.       if length(input)=0 then input:=unam;
  87.       a.sponsor:=input;
  88.       writestr ('Entry Password [CR/None]:');
  89.       if length(input)=0 then a.areapw:='' else
  90.       a.areapw:=input;
  91.       writestr ('Able to Upload into this area? [CR/Yes]:');
  92.       if (length(input)=0) or (upcase(input[1])='Y') then
  93.       a.upload:=true else a.upload:=false;
  94.       writestr ('Able to Download from this area? [CR/Yes]:');
  95.       if (length(input)=0) or (upcase(input[1])='Y') then
  96.       a.download:=true else a.download:=false;
  97.       a.xmodemdir:=getapath;
  98.       seekafile (num);
  99.       write (afile,a);
  100.       area:=a;
  101.       curarea:=num;
  102.       assignud;
  103.       rewrite (udfile);
  104.       writeln ('Area created');
  105.       makearea:=true;
  106.       writelog (15,4,a.name)
  107.     end;
  108.   end;}
  109.  
  110.   Function makearea:Boolean;
  111.     Var num,n:Integer;
  112.       a:arearec;
  113.     Begin
  114.       makearea:=False;
  115.       num:=numareas+1;
  116.       n:=numareas;
  117.       writestr('Create area '+^S+strr(num)+^P+'? [y/N]: *');
  118.       If yes Then Begin
  119.         if ansigraphics in urec.config then begin
  120.         clearscr;
  121.         WriteLn(^R'         ┌────────────'^P'['^S' FAQ File Area Installation '^P']'^R'───────────┐');
  122.         WriteLn(^R'         │                                                     │');
  123.         WriteLn(^R'         │                                                     │');
  124.         WriteLn(^R'         │                                                     │');
  125.         WriteLn(^R'         │                                                     │');
  126.         WriteLn(^R'         │                                                     │');
  127.         WriteLn(^R'         │                                                     │');
  128.         WriteLn(^R'         │                                                     │');
  129.        {WriteLn(^R'         │                                                     │');
  130.         WriteLn(^R'         │                                                     │');}
  131.         WriteLn(^R'         └─────────────────────────────────────────────────────┘');
  132.         PrintXy(12,8,^P'Upload Path');
  133.         PrintXy(12,7,^P'Co-SysOp/Sponsor ['^S+unam+^P']: ');
  134.         PrintXy(12,6,^P'Area Password ['^S'CR/None'^P']: ');
  135.         PrintXy(12,5,^P'Allow Downloads? ['^S'N'^P']: ');
  136.         PrintXy(12,4,^P'Allow Uploads? ['^S'N'^P']: ');
  137.         {PrintXy(12,5,^P'Group List File Name ['^S'CR/None'^P']: ');}
  138.         PrintXy(12,3,^P'Access Level: ');
  139.         {PrintXy(12,3,^P'['^S'G'^P']roup, ['^S'L'^P']evel or ['^S'B'^P']oth access ['^S'L'^P']:');}
  140.         PrintXy(12,2,^P'Area Name: ');
  141.         movexy(12,2);
  142.         writestr(^P'Area Name:');
  143.         If Length(Input)=0 Then exit;
  144.         a.name:=Input;
  145.         {ANSiGoToXy(12,3);
  146.          writestr(^P'['^S'G'^P']roup, ['^S'L'^P']evel or ['^S'B'^P']oth access ['^S'L'^P']:');
  147.           If Length(Input)=0 Then Input:='L';
  148.           a.ARea_type:=UpCase(Input[1]);
  149.          if not (a.area_type in [ 'L' ,'B' , 'G' ] ) then
  150.            A.Area_Type := 'L' ;
  151.          if (a.area_type in ['G' , 'B'] )Then
  152.           Begin
  153.           ANSiGoToXy(12,5);
  154.         writestr(^P'Group List File Name ['^S'CR/None'^P']:');
  155.         If Length(Input)=0 Then Input:='None';
  156.         a.File_List:=Input;
  157.           End
  158.          Else
  159.            A.File_List:='None' ;
  160.          if (a.area_type in ['L' , 'B'] )Then}
  161.           Begin
  162.           movexy(12,3);
  163.             writestr(^P'Access Level: *');
  164.             If Length(Input)=0 Then exit;
  165.             a.level:=valu(Input);
  166.           End
  167.         {Else
  168.           a.level := 0};
  169.           movexy(12,4);
  170.                 writestr(^P'Allow Uploads? ['^S'Y'^P']: *');
  171.         if yes then begin a.upload:=true; printxy (32,4,^U+'Yes') end
  172.         else begin a.upload:=false; printxy (32,4,^U+'No '); end;
  173.         movexy(12,5);
  174.         writestr(^P'Allow Downloads? ['^S'Y'^P']: *');
  175.         if yes then begin a.download:=true; printxy (34,5,^U+'Yes') end
  176.         else begin a.download:=false; printxy (34,5,^U+'No '); end;
  177.         if num>1 then begin
  178.                 movexy(12,6);
  179.             writestr(^P'Area Password ['^S'CR/None'^P']: *');
  180.             if input='N' then a.areapw:='' else
  181.                 If Length(Input)=0 Then a.areapw:='' else
  182.                     if Length(input)>0 then a.areapw:=upstring(input);
  183.         end else a.areapw:='';
  184.         movexy (12,7);
  185.         writestr(^P'Co-SysOp/Sponsor ['^S+unam+^P']: *');
  186.         If Length(Input)=0 Then Input:=unam;
  187.         a.sponsor:=Input;
  188.         movexy (12,8);
  189.         a.xmodemdir:=getapath; end else begin
  190.       writestr ('Area Name: &');
  191.       if length(input)=0 then exit;
  192.       a.name:=input;
  193.       writestr ('Access Level:');
  194.       if length(input)=0 then exit;
  195.       a.level:=valu(input);
  196.       writestr ('Sponsor [CR/'+unam+']:');
  197.       if length(input)=0 then input:=unam;
  198.       a.sponsor:=input;
  199.       writestr ('Entry Password [CR/None]:');
  200.       if length(input)=0 then a.areapw:='' else
  201.       a.areapw:=input;
  202.       writestr ('Able to Upload into this area? [CR/Yes]:');
  203.       if (length(input)=0) or (upcase(input[1])='Y') then
  204.       a.upload:=true else a.upload:=false;
  205.       writestr ('Able to Download from this area? [CR/Yes]:');
  206.       if (length(input)=0) or (upcase(input[1])='Y') then
  207.       a.download:=true else a.download:=false;
  208.       a.xmodemdir:=getapath;
  209.         end;
  210.         seekafile(num);
  211.         Write(afile,a);
  212.         area:=a;
  213.         curarea:=num;
  214.         assignud;
  215.         Rewrite(udfile);
  216.         WriteLn(^M^M^R'Area Created');
  217.         makearea:=True;
  218.         writelog(15,4,a.name)
  219.       End
  220.     End;
  221.  
  222.   procedure setarea (n:integer);
  223.   var t:text;
  224.       l:string;
  225.  
  226.     procedure nosucharea;
  227.     begin
  228.       writeln (^B'Invalid File Area!')
  229.     end;
  230.  
  231.   begin
  232.     curarea:=n;
  233.     if (n>numareas) or (n<1) then begin
  234.       nosucharea;
  235.       if issysop
  236.         then if makearea
  237.           then setarea (curarea)
  238.           else setarea (1)
  239.         else setarea (1);
  240.       exit
  241.     end;
  242.     seekafile (n);
  243.     read (afile,area);
  244.   { if area.usegroup then begin
  245.       assign (t,datadir+area.groupfn);
  246.       reset (t);
  247.       repeat
  248.         readln (t,l);
  249.         write ('Please Wait.');
  250.       until (eof(t)) or (match(l,unam));
  251.       write ('Uh Huh.');
  252.       if (match(unam,l)) then setarea (curarea)
  253.       else nosucharea;
  254.     end else  }
  255.     if (urec.udlevel<area.level) and (not issysop)
  256.       then if curarea=1
  257.         then error ('User can''t access first area','','')
  258.         else
  259.           begin
  260.             nosucharea;
  261.             setarea (1);
  262.             exit
  263.           end;
  264.      if length(area.areapw)>0 then begin
  265.      writeln;
  266.      writestr ('[Entry Password]: *');
  267.      if length(input)=0 then begin setarea(1); end;
  268.      if not match(input,area.areapw) then begin setarea (1); end;
  269.     end;
  270.     assignud;
  271.     close (t);
  272.     close (udfile);
  273.     reset (udfile);
  274.     if ioresult<>0 then rewrite (udfile);
  275.     {writeln (^R^M'Area: '^S,area.name,^R' ['^S,curarea,^R']');
  276.     if sponsoron then writeln (^R'['^S'%'^R']:Xfer Sponsor Commands');
  277.     writeln;}
  278.   end;
  279.  
  280.   procedure setarea2 (n:integer);
  281.   var t:text;
  282.       l:string;
  283.  
  284.     procedure nosucharea;
  285.     begin
  286.       writeln (^B'Invalid File Area!')
  287.     end;
  288.  
  289.   begin
  290.     curarea:=n;
  291.     if (n>numareas) or (n<1) then begin
  292.       nosucharea;
  293.       if issysop
  294.         then if makearea
  295.           then setarea2 (curarea)
  296.           else setarea2 (1)
  297.         else setarea2 (1);
  298.       exit
  299.     end;
  300.     seekafile (n);
  301.     read (afile,area);
  302.   { if area.usegroup then begin
  303.       assign (t,datadir+area.groupfn);
  304.       reset (t);
  305.       repeat
  306.         readln (t,l);
  307.         write ('Please Wait.');
  308.       until (eof(t)) or (match(l,unam));
  309.       write ('Uh Huh.');
  310.       if (match(unam,l)) then setarea2 (curarea)
  311.       else nosucharea;
  312.     end else  }
  313.     if (urec.udlevel<area.level) and (not issysop)
  314.       then if curarea=1
  315.         then error ('User can''t access first area','','')
  316.         else
  317.           begin
  318.             nosucharea;
  319.             setarea2 (1);
  320.             exit
  321.           end;
  322.      if length(area.areapw)>0 then begin
  323.      writeln;
  324.      writestr ('[Entry Password]:');
  325.      if length(input)=0 then exit;
  326.      if not match(input,area.areapw) then begin exit; exit; end;
  327.     end;
  328.     assignud;
  329.     close (t);
  330.     reset (udfile);
  331.     if ioresult<>0 then rewrite (udfile);
  332.     writeln (^B^M'Area: '^S,area.name,^R' ['^S,curarea,^R']');
  333.     if sponsoron then writeln (^R'['^S'%'^R']:Xfer Sponsor Commands');
  334.     writeln;
  335.   end;
  336.  
  337.   procedure spacelen(le:byte);
  338.    var aaa:byte;
  339.    begin
  340.     for aaa:=1 to le do
  341.     write(' ');
  342.    end;
  343.  
  344.   procedure linelen(le:byte);
  345.    var aaa:byte;
  346.    begin
  347.     for aaa:=1 to le do
  348.     write('─');
  349.    end;
  350.  
  351.  Procedure toplinearea;
  352.    begin
  353.    if asciigraphics in urec.config then begin
  354.    writeln (^R'┌───┬───────────────────────────────────────┬───────┬─────┬─────┐');
  355.    writeln (^R'│ '^S'#'^R' │ '^S'Area Name'^R'                             │ '^S'Level'^R' │ '^S'U/L'^R' │ '
  356.    +^S'D/L'^R' │');
  357.    writeln (^R'├───┼───────────────────────────────────────┼───────┼─────┼─────┤');
  358.    end else begin
  359.    writeln (^R'+---+---------------------------------------+-------+-----+-----+');
  360.    writeln (^R'| '^S'#'^R' | '^S'Area Name'^R'                             | '^S'Level'^R' | '^S'U/L'^R' | '
  361.    +^S'D/L'^R' |');
  362.    writeln (^R'|---|---------------------------------------|-------|-----|-----|');
  363.     end;
  364.    end;
  365.  
  366.  Procedure bottomlinearea;
  367.  begin
  368.    if asciigraphics in urec.config then
  369.    writeln (^R'└───┴───────────────────────────────────────┴───────┴─────┴─────┘')
  370.    else
  371.    writeln (^R'+---+---------------------------------------+-------+-----+-----+');
  372.  end;
  373.  
  374.  procedure listareas;
  375.  
  376.   var a:arearec;
  377.       c,k:integer;
  378.       cnt:integer;
  379.   begin
  380.    k:=0;
  381.    if exist (textfiledir+'Filearea.'+strr(conn)) then
  382.    printfile (textfiledir+'Filearea.'+strr(conn)) else
  383.    begin
  384.     writehdr ('File Area List');
  385.     seekafile (1);
  386.     toplinearea;
  387.     for cnt:=1 to numareas do begin
  388.       read (afile,a);
  389.       if a.level<=urec.udlevel
  390.         then begin
  391.         if asciigraphics in urec.config then
  392.         write (^R'│'^S,cnt) else write (^R'|'^S,cnt);
  393.         spacelen(3-length(strr(cnt)));
  394.         if asciigraphics in urec.config then
  395.         write (^R'│ '^S,a.name,^R) else write (^R'| '^S,a.name,^R);
  396.         spacelen(38-length(a.name));
  397.         if asciigraphics in urec.config then
  398.         write (^R'│'^S,a.level,^R) else write(^R'|'^S,a.level,^R);
  399.         spacelen(7-length(strr(a.level)));
  400.     if a.upload then
  401.         if asciigraphics in urec.config then
  402.         write(^R'│ '^S'Yes ') else write(^R'| '^S'Yes ')
  403.      else
  404.      if asciigraphics in urec.config then
  405.         write(^R'│ '^S'No  ') else write(^R'| '^S'Yes ');
  406.       if a.download then
  407.         if asciigraphics in urec.config then
  408.         writeLn(^R'│ '^S'Yes'^R' │') else writeln(^R'| '^S'Yes'^R' |')
  409.      else
  410.         if asciigraphics in urec.config then
  411.         writeLn(^R'│ '^S'No'^R'  │') else writeln(^R'| '^S'No'^R'  |')
  412.        end;
  413.       if break then exit
  414.     end;
  415.    end;
  416.  bottomlinearea;
  417. {}writeln;{}
  418.   end;
  419.  
  420.   function getareanum:integer;
  421.   var areastr:sstr;
  422.       areanum:integer;
  423.   begin
  424.     getareanum:=0;
  425.     if length(input)>1
  426.       then areastr:=copy(input,2,255)
  427.       else begin
  428.         repeat
  429.           writestr ({^M}'Area Number [?/List]:');
  430.           if input='?' then listareas else areastr:=input
  431.         until (input<>'?') or hungupon;
  432.       end;
  433.     if length(areastr)=0 then exit;
  434.     areanum:=valu(areastr);
  435.     if (areanum>0) and (areanum<=numareas)
  436.       then getareanum:=areanum
  437.       else begin
  438.         writestr ('No such area!');
  439.         if issysop then if makearea then getareanum:=numareas
  440.       end;
  441.   end;
  442.  
  443.   procedure getarea;
  444.   var areanum:integer;
  445.   begin
  446.     areanum:=getareanum;
  447.     if areanum<>0 then setarea (areanum);
  448.   end;
  449.  
  450.   function getfname (path:lstr; name:mstr):lstr;
  451.   var l:lstr;
  452.   begin
  453.     l:=path;
  454.     if length(l)<>0
  455.       then if not (l[length(l)] in [':','\'])
  456.         then l:=l+'\';
  457.     l:=l+name;
  458.     getfname:=l
  459.   end;
  460.  
  461.  Procedure topfileline;
  462.  begin;
  463.     if not (ffname in urec.filelister) and not (ffext in urec.filelister) and
  464.     not (ffsize in urec.filelister) and not (ffpoints in urec.filelister) and
  465.     not (ffuploader in urec.filelister) and not (ffuploaded in urec.filelister) and
  466.     not (ffdown in urec.filelister) and not (fffulnam in urec.filelister) and
  467.     not (ffofwhat in urec.filelister) then begin
  468.     urec.filelister:=urec.filelister+[ffname];
  469.     urec.filelister:=urec.filelister+[ffext];
  470.     urec.filelister:=urec.filelister+[ffsize];
  471.     urec.filelister:=urec.filelister+[ffpoints];
  472.     urec.filelister:=urec.filelister+[fffulnam];
  473.     urec.filelister:=urec.filelister+[ffofwhat];
  474.     writeurec;
  475.     end;
  476.    if asciigraphics in urec.config then begin
  477.    write   (^S'#   ');
  478.    if ffname in urec.filelister then write ('Filename ');
  479.    if ffext in urec.filelister then write ('Ext ');
  480.    if ffsize in urec.filelister then write ('Size      ');
  481.    if ffpoints in urec.filelister then write ('Cost ');
  482.    if ffuploader in urec.filelister then write ('Uploader     ');
  483.    if ffuploaded in urec.filelister then write ('Uploaded ');
  484.    if ffdown in urec.filelister then write ('Dl  ');
  485.    if fffulnam in urec.filelister then write ('Program Description         ');
  486.    if ffofwhat in urec.filelister then write ('Disk  ');
  487.    writeln;
  488.    writeln (^R'───────────────────────────────────────────────────────────────────────────────');
  489.    end else begin
  490.    write   (^S'#    ');
  491.    if ffname in urec.filelister then write ('Filename ');
  492.    if ffext in urec.filelister then write ('Ext ');
  493.    if ffsize in urec.filelister then write ('Size      ');
  494.    if ffpoints in urec.filelister then write ('Cost ');
  495.    if ffuploader in urec.filelister then write ('Uploader     ');
  496.    if ffuploaded in urec.filelister then write ('Date U/L ');
  497.    if ffdown in urec.filelister then write ('Dl  ');
  498.    if fffulnam in urec.filelister then write ('Program Description        ');
  499.    if ffofwhat in urec.filelister then write ('Disk  ');
  500.    writeln;
  501.    writeln (^R'-------------------------------------------------------------------------------');
  502.   end;
  503.  end;
  504.  
  505.  Procedure bottomfileline;
  506.  begin
  507.    if asciigraphics in urec.config then
  508.    writeln (^R'───────────────────────────────────────────────────────────────────────────────')
  509.    else
  510.    writeln (^R'-------------------------------------------------------------------------------');
  511.  end;
  512.  
  513. procedure yourpcrstats;
  514. var xx:real; x1:string[30];
  515. begin
  516.      if urec.numon>0 then xx:=(urec.nbu div urec.numon) * 100 else
  517.      xx:=0.00;
  518.      printxy(30,8,streal(xx)+'%');
  519.      printxy(30,9,strr(urec.nbu));
  520.      if urec.numon>0 then printxy(30,10,strr(urec.numon)) else
  521.      printxy(30,10,strr(0));
  522. end;
  523.  
  524. procedure yourudstatus;
  525. var cnt,newfilez:integer; blah:integer; udr:real;
  526. begin
  527. if exist (textfiledir+'XferStat.Ans') or
  528. exist (textfiledir+'XferStat.Asc') or exist (textfiledir+'XferStat.')
  529. then begin show_all_info(textfiledir+'XferStat',getlastcaller,cnt);
  530. end else begin
  531. clrscr; gotoxy(1,1);
  532. if (ansigraphics in urec.config) then write (#27+'[2J') else write (^L);
  533. if asciigraphics in urec.config then begin
  534. writeln(^P'┌─────────────┬───────────────────┐');
  535. writeln(^P'│ '^R'File Level'^P': │                   │┌────────────────────────────────────┐');
  536. writeln(^P'│ '^R'File Points'^P':│                   ││                                    │');
  537. writeln(^P'│ '^R'Uploads'^P':    │                   │├────────────────────────────────────┤');
  538. writeln(^P'│ '^R'Downloads'^P':  │                   ││ '^R'Operation Hrs'^P':                     │');
  539. writeln(^P'│ '^R'New Files'^P':  │                   │└────────────────────────────────────┘');
  540. writeln(^P'└─────────────┼─────────────┬─────┴─────────────┐');
  541. writeln(^P'              │ '^R'P'^P'/'^R'C Ratio'^P':  │                   │');
  542. writeln(^P'              │ '^R'Posts'^P':      │                   │');
  543. writeln(^P'              │ '^R'# Calls'^P':    │                   │');
  544. writeln(^P'              │ '^R'U'^P'/'^R'D Ratio'^P':  │                   │');
  545. writeln(^P'              │ '^R'Your Rating'^P':│                   │');
  546. writeln(^P'              │ '^R'Average CPS'^P':│                   │');
  547. writeln(^P'              └─────────────┴───────────────────┘');
  548. printxy(16,2,^S+strr(urec.udlevel));
  549. printxy(16,3,^S+strr(urec.udpoints));
  550. printxy(16,4,strr(urec.uploads)+^P+' ['+^S+streal(urec.upk/1024)+'k'^P']');
  551. printxy(16,5,strr(urec.downloads)+^P+' ['+^S+streal(urec.downk/1024)+'k'^P']');
  552. newfilez:=(ups-urec.lastups);
  553. if newfilez<1 then printxy(16,6,^S'None') else begin;
  554.                     printxy(16,6,^S+strr(newfilez));
  555.                                     urec.lastups:=ups;
  556.                                     end;
  557. yourpcrstats;
  558. if urec.downloads > 0 then udr:=(urec.uploads div urec.downloads)*100 else
  559.                     udr:=(urec.uploads)*100;
  560. printxy(30,11,^S+streal(udr)+'%');
  561. if useqr then begin
  562.               calcqr;
  563.           printxy(30,12,^S+strr(qr));
  564.           end else printxy(30,12,^S+'Not used.');
  565. printxy(30,13,^S+strr(urec.averagecps));
  566. printxy(38,3,^S+'Transfer Area');
  567. if (xmodemopentime = xmodemclosetime) then printxy(53,5,^S'Always!') else
  568.   printxy(53,5,^S+xmodemopentime+^R+' to '+^S+xmodemclosetime);
  569. urec.averagecps:=baudrate div 10;
  570. end else begin
  571. writeln(^P'+-------------+-------------------+');
  572. writeln(^P'| '^R'File Level'^P': |                   |+------------------------------------+');
  573. writeln(^P'| '^R'File Points'^P':|                   ||                                    |');
  574. writeln(^P'| '^R'Uploads'^P':    |                   |+------------------------------------|');
  575. writeln(^P'| '^R'Downloads'^P':  |                   || '^R'Operation Hrs'^P':                     |');
  576. writeln(^P'| '^R'New Files'^P':  |                   |+------------------------------------+');
  577. writeln(^P'+-------------+-------------+-----+-------------+');
  578. writeln(^P'              | '^R'P'^P'/'^R'C Ratio'^P':  |                   |');
  579. writeln(^P'              | '^R'Posts'^P':      |                   |');
  580. writeln(^P'              | '^R'# Calls'^P':    |                   |');
  581. writeln(^P'              | '^R'U'^P'/'^R'D Ratio'^P':  |                   |');
  582. writeln(^P'              | '^R'Your Rating'^P':|                   |');
  583. writeln(^P'              | '^R'Average CPS'^P':|                   |');
  584. writeln(^P'              +-------------+-------------------+');
  585. printxy(16,2,^S+strr(urec.udlevel));
  586. printxy(16,3,^S+strr(urec.udpoints));
  587. printxy(16,4,strr(urec.uploads)+^P+' ['+^S+streal(urec.upk/1024)+'k'^P']');
  588. printxy(16,5,strr(urec.downloads)+^P+' ['+^S+streal(urec.downk/1024)+'k'^P']');
  589. newfilez:=(ups-urec.lastups);
  590. if newfilez<1 then printxy(16,6,^S'None') else begin;
  591.                     printxy(16,6,^S+strr(newfilez));
  592.                                     urec.lastups:=ups;
  593.                                     end;
  594. yourpcrstats;
  595. if urec.downloads > 0 then udr:=(urec.uploads div urec.downloads)*100 else
  596.                     udr:=(urec.uploads)*100;
  597. printxy(30,11,^S+streal(udr));
  598. if useqr then begin
  599.               calcqr;
  600.           printxy(30,12,^S+strr(qr));
  601.           end else printxy(30,12,^S+'Not used.');
  602. printxy(30,13,^S+strr(urec.averagecps));
  603. printxy(38,3,^S+'Transfer Area');
  604. if (xmodemopentime = xmodemclosetime) then printxy(53,5,^S'Always!') else
  605.   printxy(53,5,^S+xmodemopentime+^R+' to '+^S+xmodemclosetime);
  606.  urec.averagecps:=baudrate div 10;
  607.   end;
  608. movexy (1,15);
  609.  end;
  610. pause;
  611. writeln (^M);
  612. end;
  613.  
  614.   procedure getfsize (var ud:udrec);
  615.   var df:file of byte;
  616.   begin
  617.     ud.filesize:=-1;
  618.     assign (df,getfname(ud.path,ud.filename));
  619.     reset (df);
  620.     if ioresult<>0 then exit;
  621.     ud.filesize:=filesize(df);
  622.     close(df);
  623.   end;
  624.  
  625.   procedure addfile (ud:udrec);
  626.   begin
  627.     seekudfile (numuds+1);
  628.     write (udfile,ud);
  629.   end;
  630.  
  631.   procedure getconpw;
  632.   begin
  633.       if (length(confxpw[1])>0) and (conn=1) and not (issysop) then begin
  634.         echodot:=true;
  635.         writestr (^M^P'['^R'Conference #1 Password'^P']: *');
  636.         echodot:=false;
  637.         if not (match(input,confxpw[1])) then begin exit; exit; end;
  638.       end;
  639.       if (length(confxpw[2])>0) and (conn=2) and not (issysop) then begin
  640.         echodot:=true;
  641.         writestr (^M^P'['^R'Conference #2 Password'^P']: *');
  642.         echodot:=false;
  643.         if not (match(input,confxpw[2])) then begin exit; exit; end;
  644.       end;
  645.       if (length(confxpw[3])>0) and (conn=3) and not (issysop) then begin
  646.         echodot:=true;
  647.         writestr (^M^P'['^R'Conference #3 Password'^P']: *');
  648.         echodot:=false;
  649.         if not (match(input,confxpw[3])) then begin exit; exit; end;
  650.       end;
  651.       if (length(confxpw[4])>0) and (conn=4) and not (issysop) then begin
  652.         echodot:=true;
  653.         writestr (^M^P'['^R'Conference #4 Password'^P']: *');
  654.         echodot:=false;
  655.         if not (match(input,confxpw[4])) then begin exit; exit; end;
  656.       end;
  657.       if (length(confxpw[5])>0) and (conn=5) and not (issysop) then begin
  658.         echodot:=true;
  659.         writestr (^M^P'['^R'Conference #5 Password'^P']: *');
  660.         echodot:=false;
  661.         if not (match(input,confxpw[5])) then begin exit; exit; end;
  662.       end;
  663.   end;
  664.  
  665.  procedure pointreassign;
  666.  var c:char;
  667.  
  668.  procedure assignp;
  669.  var i,cnt:integer;
  670.        udd:udrec;
  671.  begin
  672.  for i:=1 to numuds do begin
  673.  seekudfile (i);
  674.  read (udfile,udd);
  675.  getfsize(udd);
  676.  if udd.filesize=-1 then writestr ('Warning:  Can''t open file!');
  677.  if not (udd.filesize=-1) then
  678.  udd.points:=(udd.filesize div pointvalue div 1024);
  679.  tab (^S+strr(i),4);
  680.  tab (^S+udd.filename,13);
  681.  tab (^S+strlong(udd.filesize),10);
  682.  writeln;
  683.  writeln (^R'Cost set to '^S+strr(udd.points)+^R' points.');
  684.  seekudfile (i);
  685.  write (udfile,udd);
  686.  assignud;
  687.  end;
  688.  end;
  689.  
  690.  procedure assignps;
  691.  var i,cnt:integer;
  692.          a:arearec;
  693.  begin
  694.  cnt:=curarea;
  695.  for i:=1 to numareas do begin
  696.  seekafile (i);
  697.  read (afile,a);
  698.  writeln (^R'Area #'^S+strr(i));
  699.  assignp;
  700.  end;
  701.  curarea:=cnt;
  702.  end;
  703.  
  704.  begin
  705.  writehdr ('Point Re-Assign');
  706.  repeat
  707.  buflen:=1;
  708.  writestr (^S'T'^R'his Area  '^S'A'^R'll Areas  '^S'Q'^R'uit'^P': '^U'*');
  709.  c:=upcase(input[1]);
  710.  if (length(c)<1) or (c='Q') then exit;
  711.  case c of
  712.  'T':assignp;
  713.  'A':assignps;
  714.  end;
  715.  until (length(c)>0);
  716.  end;
  717.