home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / vi_si_on / bimodem.inc < prev    next >
Text File  |  1991-04-05  |  38KB  |  1,303 lines
  1. procedure load_protos;
  2. var tp:protorec;
  3.     ct:integer;
  4.     ft:file of protorec;
  5.     bd,cb:sstr;
  6.     tsc:string[150];
  7.  
  8.     procedure LoadProt(Var TempPro:ArProtoRec; Var Num:Integer);
  9.     Var C:Char;
  10.     Begin
  11.      Num:=0;
  12.      Repeat
  13.        Inc(Num);
  14.        Read(Ft,Tp);
  15.        TempPro[Num]:=Tp;
  16.        Tsc:='';
  17.        Ct:=0;
  18.        While Ct<>Length(Tp.Cline) do
  19.          Begin
  20.            Inc(Ct);
  21.            If Tp.Cline[Ct]<>'%' then Tsc:=Tsc+Tp.Cline[Ct]
  22.            Else if Ct<Length(Tp.Cline) then
  23.              Begin
  24.                Inc(Ct);
  25.                C:=Tp.Cline[Ct];
  26.                Case C of
  27.                  '1':Tsc:=Tsc+Strr(ConfigSet.UseCo);
  28.                  '2':Tsc:=Tsc+bd;
  29.                  '3':Tsc:=Tsc+cb;
  30.                  '4':Tsc:=Tsc+ConfigSet.DszLog;
  31.                End;
  32.              End;
  33.            End;
  34.            TempPro[Num].Cline:=Tsc;
  35.          Until Eof(Ft);
  36.        Close(Ft);
  37.      End;
  38.  
  39.     Begin
  40.     if baudrate=38400 then bd:='38400' else bd:=strr(baudrate);
  41.     if connectbaud=38400 then cb:='38400' else cb:=strr(connectbaud);
  42.     if exist(configset.forumdi+'D_Prot.Dat') then begin
  43.       assign(ft,configset.forumdi+'D_Prot.Dat');
  44.       reset(ft);
  45.       loadprot(dproto,totaldownpro);
  46.     End;
  47.   if exist(configset.forumdi+'U_PROT.DAT') then begin
  48.      assign(ft,configset.forumdi+'U_Prot.Dat');
  49.      reset(ft);
  50.      LoadProt(Uproto,totalupro);
  51. end;
  52. end;
  53.  
  54. function protocaseselection(send:boolean):integer;
  55. var a:mstr;
  56.     i,total:integer;
  57.     K:Char;
  58.     exp:mstr;
  59. begin
  60.   exp:='Download';
  61.   if not send then exp:='Upload';
  62.   total:=totaldownpro;
  63.   if not send then total:=totalupro;
  64.   clearscr;
  65.   writehdr('ViSiON '+exp+' Protocols');
  66.   i:=1;
  67.   if total=0 then begin writeln(^M^R'No Protocols Exist!'); exit; end;
  68.   a:='';
  69.   while i<=total do begin
  70.     if send then begin
  71.     write(^P'['^R+dproto[i].key+^P'] ');
  72.     tab(dproto[i].desc,35);
  73.     a:=a+dproto[i].key;
  74.     end else begin
  75.     write(^P'['^R+uproto[i].key+^P'] ');
  76.     tab(uproto[i].desc,35);
  77.     a:=a+uproto[i].key;
  78.     end;
  79.     if (i div 2) = (i/2) then writeln;
  80.     inc(i);
  81.   end;
  82.   writestr(^M^M^P'Selection [CR/Abort] :');
  83.   if input='' then begin
  84.      protocaseselection:=0;
  85.      exit;
  86.   end;
  87.   k:=upcase(input[1]);
  88.   protocaseselection:=pos(k,a);
  89. end;
  90.  
  91. procedure pointcom(name:mstr;pts:integer);
  92. var u:userrec;
  93.     i:integer;
  94. begin
  95.   if not configset.pointcomp then exit;
  96.   writeln(^M^S'Giving '^R,name,' ',pts,^S' File Points!'^M);
  97.   i:=lookupuser(name);
  98.   if i=0 then exit;
  99.   seek(ufile,i);
  100.   read(ufile,u);
  101.   u.udpoints:=u.udpoints+pts;
  102.   seek(ufile,i);
  103.   write(ufile,u);
  104. end;
  105.  
  106. Function protocolxfer(send,crcmode,ymodem:Boolean;Protocol:Integer;fn:lstr):Integer;
  107.    var TimeAtXfer:longint;
  108.  
  109.  
  110.   Procedure Then_Charge;
  111.     Var a,b,c,d,FN1,Sn:String[255];
  112.       cnt,longerthen,junk:Integer;
  113.       Trans:Char;
  114.       CPS,ttt,CompleteBytes,Errors:sstr;
  115.       num3,Num1,num2,Tr1,Tr2:longint;
  116.       FF:Text;
  117.       F2f:file of byte;
  118.     Begin
  119.       protocolxfer:=2;
  120.       if not exist(configset.dszlog) then exit;
  121.       protocolxfer:=0;
  122.       delay(2000);
  123.      writestr(^M^P'Press '^S'[Return]:');
  124.      d:=configset.dszlog;
  125.       Assign(ff,d);
  126.       Reset(ff);
  127.       If Not EoF(ff) Then Begin
  128.         fn1:='';
  129.         ReadLn(ff,c);
  130.         Trans:=c[1];
  131.         longerthen:=0;
  132.         if c[9]<>' ' then longerthen:=1;
  133.         CompleteBytes:=copy (c,3,6+longerthen);
  134.         CPS:=copy (c,20+longerthen,4);
  135.         if cps[1]=' ' then begin
  136.         ttt:=copy(cps,2,3);
  137.         cps:=ttt;
  138.         end;
  139.         Errors:=copy (c,29+longerthen,3);
  140.         textclose(ff);
  141.         Delete(c,1,50+longerthen);
  142.         While (c[1]<>' ') Do Begin
  143.         fn1:=fn1+c[1];Delete(c,1,1);End;While (c[1]=' ') Do Delete(c,1,1);
  144.         sn:=c;
  145.         tr1:=1;
  146.         if connectbaud<>0 then tr1:=(connectbaud div 10);
  147.         Tr2:=TimeAtXfer*tr1;
  148.         WriteLn('Code-> ',trans,' Filename -> ',fn1,' Sn# -> ',completebytes,' Cps -> ',cps);
  149.         trans:=UpCase(trans);    protocolxfer:=0;
  150.         If match('E',trans) Or match('L',trans) Then protocolxfer:=2;
  151.          if protocol<>9 then begin
  152.          assign (f2f,fn);
  153.        if exist (fn) then begin
  154.           reset(f2f);
  155.            num2:=filesize(f2f);close(f2f); end else num2:=1;
  156.           if num2=0 then num2:=1;
  157.            while (length(CompleteBytes)>0) and (completebytes[1]=' ') do
  158.                  delete (completebytes,1,1);
  159.            val(completebytes,num1,Junk);
  160.            num1:=num1*100;
  161.            if num1=0 then num1:=1;
  162.            num3:=num1 div num2; if send then begin
  163.            Writeln (^M'Percent complete=',strlong(num3),'%');
  164.            if num3=100 then protocolxfer:=0;
  165.            if (num3>93) and (num3<100) or (match(trans,'Q')) then begin
  166.             protocolxfer:=0;
  167.             leechzmodem(fn1);
  168.             end;
  169.            end;
  170.            end;
  171.             val(completebytes,num1,Junk);
  172.            addszlog(cps,fn1,send,num1);
  173.            if send then urec.dnkay:=urec.dnkay+(num1 div 1024) else
  174.            if not match(trans,'E') or match(trans,'L') then
  175.             urec.upkay:=urec.upkay+(num1 div 1024);
  176.                         writeurec;
  177.         If Not send Then If match(trans,'E') Or match(Trans,'L') Then
  178.           If exist(fn) Then Begin
  179.             Assign(Ff,fn);
  180.             Erase(Ff);
  181.           End;
  182.       End;
  183.  
  184.     End;
  185.  
  186.  
  187.   Procedure ExecDsz;
  188.     Var a,b,tmnt:anystr;
  189.       ff:File;
  190.       cnt:Integer;
  191.       Tota,X,Y,Z:longint;
  192.     Begin
  193.       b:=configset.dszlog;
  194.         Assign(ff,b);
  195.         If exist(b) Then Erase(ff);
  196.       x:=timepart(now);
  197.       clrscr;
  198.       ansicolor(15);
  199.       write(usr,urec.handle+' is ');
  200.       if send then write(usr,'downloading -') else write(usr,'uploading -');
  201.       writeln(usr,fn);
  202.       bottomline;
  203.    if not send then exec(uproto[protocol].exename,uproto[protocol].cline+' '+fn);
  204.    if send then exec(dproto[protocol].exename,dproto[protocol].cline+' '+fn);
  205.       y:=timepart(now);
  206.       z:=y-x;if z<0 then z:=z+65535;
  207.       TimeAtXfer:=z;
  208.       GoToXY(1,23);
  209.       WriteLn(Usr,^M^M^M);
  210.     End;
  211.  
  212.   Begin
  213.    protocolxfer:=2;
  214.      starttimer(numminsxfer);
  215.        execdsz;
  216.         protocolxfer:=2;
  217.         Then_Charge;
  218.         stoptimer(numminsxfer);
  219.        writestatus;
  220.     starttimer(numminsused);
  221.   End;
  222.  
  223. Function batch_download(Protocol,AllTheFiles:Integer;batchdown:batchlist):Integer;
  224.   Var Count:longint;
  225.  
  226.  
  227.    Procedure findetcharge(The:lstr);
  228.     Var cnt,oldn:Integer;
  229.       ud:udrec;
  230.       c:string[255];
  231.     Begin
  232.     urec.downloads:=urec.downloads+1;
  233.       For cnt:=1 To AllTheFiles Do Begin
  234.         c:=batchdown[cnt].wholefilename;
  235.         if match(the,c) then begin
  236.         pointcom(batchdown[cnt].by,batchdown[cnt].points);
  237.         count:=count+batchdown[cnt].points;
  238.         oldn:=curarea;
  239.         setarea(batchdown[cnt].area,false);
  240.         seek(udfile,batchdown[cnt].filenum-1);
  241.         read(udfile,ud);
  242.         inc(ud.downloaded);
  243.         seek(udfile,batchdown[cnt].filenum-1);
  244.         write(udfile,ud);
  245.         setarea(oldn,false);
  246.         end Else
  247.           If match(c,the) Then count:=count+batchdown[cnt].points;
  248.       End;
  249.     End;
  250.  
  251.  
  252.   Procedure Then_Charge;
  253.     Var c,fn:String[255];
  254.       cnt,longerthen,junk:Integer;
  255.       cps,krad:sstr;
  256.       Trans:Char;
  257.       FF:Text;
  258.       CompleteBytes,sn:longint;
  259.     Begin
  260.       batch_download:=0;
  261.       If Not exist(configset.dszlog) Then exit;
  262.       delay(2300);
  263.       Assign(ff,configset.dszlog);
  264.       Reset(ff);
  265.  
  266.       Repeat
  267.         If Not EoF(ff) Then Begin
  268.           fn:='';
  269.           ReadLn(ff,c);
  270.           longerthen:=0;
  271.           Trans:=c[1];
  272.           if c[9]<>' ' then longerthen:=1;
  273.           krad:=copy (c,3,6+longerthen);
  274.           cps:=copy(c,20+longerthen,4);
  275.           while (length(krad)>0) and (krad[1]=' ') do delete (krad,1,1);
  276.           val (Krad,completebytes,junk);
  277.           Delete(c,1,50+longerthen);
  278.           While (c[1]<>' ') Do Begin
  279.           fn:=fn+c[1];Delete(c,1,1);End;While (c[1]=' ') Do Delete(c,1,1);
  280.           sn:=completebytes;
  281.           WriteLn('Code-> ',trans,' Filename -> ',fn,' Sn# -> ',sn);
  282.           trans:=UpCase(trans);
  283.           Writelog (15,1,' Code:'+trans+' FN:'+fn);
  284.           If match(trans,'Q') or match(trans,'R') Or match(TRans,'Z') Or match(Trans,'S') Then
  285.           begin
  286.           findetCharge(fn);
  287.           addszlog(cps,fn,true,sn);
  288.           urec.dnkay:=urec.dnkay+(sn div 1024);
  289.           end;
  290.         End;
  291.       Until EoF(ff);textclose(ff);
  292.       batch_download:=count;
  293.     End;
  294.  
  295.  
  296.   Procedure ExecDsz;
  297.     Var a,b:anystr;
  298.     tmnt:anystr;
  299.       qq:File;
  300.       cnt:Integer;
  301.       ttt:lstr;
  302.     Begin
  303.      b:=configset.dszlog;
  304.       Assign(qq,b);
  305.       If exist(b) Then Erase(qq);
  306.      if protocol=5 then begin
  307.      if baudrate=38400 then tmnt:='38400' else tmnt:=strr(baudrate);
  308.      a:='p'+strr(configset.useco)+' s'+tmnt+' hf f- l'+configset.dszlog;
  309.      a:=a+' m- n+ w- x+ e'+strr(connectbaud)+' S ';
  310.      end else begin
  311.       if baudrate=38400 then tmnt:='38400' else tmnt:=strr(baudrate);
  312.       a:='port '+strr(configset.useco)+' speed '+tmnt+' est len '+strr(connectbaud)+' ha slow s';
  313.       If protocol=1 Then a:=a+'b -k ';
  314.       If protocol=2 Then a:=a+'z  ';
  315.       If protocol=3 Then a:=a+'b -g ';
  316.       If protocol=4 Then a:=a+'z -w -m ';
  317.       if protocol=6 then a:=a+'z -m ';
  318.       end;
  319.       getdir(0,ttt); if ttt[length(ttt)]<>'\' then ttt:=ttt+'\';
  320.       a:=a+'@'+ttt+'filelist.';
  321.       clrscr;ansicolor(15);
  322.       writeln(usr,urec.handle+' is batch x-ferring');
  323.       bottomline;
  324.       if protocol=5 then exec('Puma.Exe',a)
  325.       else exec('dsz.com',a);
  326.       GoToXY(1,23);WriteLn(Usr,^M^M^M);
  327.     End;
  328.  
  329.   Procedure make_list;
  330.     Var tf:Text;
  331.       cnt,a:Integer;
  332.       d,e:anystr;
  333.     Begin
  334.       d:='FILELIST.';
  335.       Assign(tf,d);
  336.       Rewrite(tf);
  337.       For cnt:=1 To AllTheFiles Do Begin
  338.         d:=batchdown[cnt].wholefilename;
  339.         WriteLn(tf,d);
  340.       End;
  341.       textclose(tf);
  342.     End;
  343.  
  344.   Begin
  345.   starttimer(numminsxfer);
  346.     count:=0;
  347.     batch_download:=0;
  348.     make_list;
  349.     execdsz;
  350.     delay(1500);
  351.     then_charge;
  352.     stoptimer(numminsxfer);
  353.     writestatus;
  354.     starttimer(numminsused);
  355.   End;
  356.  
  357.  
  358. function okudratio:boolean;
  359. var x3:integer;
  360.         slarvdod:boolean;
  361. begin
  362.   okudratio:=false;
  363.   slarvdod:=false;
  364.   if urec.udratio=0 then slarvdod:=true;
  365.     x3:=ratio(urec.uploads,urec.downloads);
  366.     if (ulvl>=configset.exemptpc) or (x3>urec.udratio) then slarvdod:=true;
  367.   okudratio:=slarvdod;
  368. end;
  369.  
  370.   Function getapath:lstr;
  371.     Var q,r:Integer;
  372.       f:File;
  373.       b:Boolean;
  374.       p:lstr;
  375.     Begin
  376.       getapath:=area.xmodemdir;
  377.       If ulvl<configset.sysopleve Then exit;
  378.       Repeat
  379.         writestr('Upload path [CR for '+^S+area.xmodemdir+^P+']:');
  380.         If hungupon Then exit;
  381.         If Length(Input)=0 Then Input:=area.xmodemdir;
  382.         p:=Input;
  383.         If Input[Length(p)]<>'\' Then p:=p+'\';
  384.         b:=True;
  385.         Assign(f,p+'CON');
  386.         Reset(f);
  387.         q:=IOResult;
  388.         Close(f);
  389.         r:=IOResult;
  390.         If q<>0 Then Begin
  391.           writestr('  Path doesn''t exist!  Create it? *');
  392.           b:=yes;
  393.           If b Then Begin
  394.             MkDir(Copy(p,1,Length(p)-1));
  395.             q:=IOResult;
  396.             b:=q=0;
  397.             If b
  398.             Then writestr('Directory created')
  399.             Else writestr('Unable to create directory')
  400.           End
  401.         End
  402.       Until b;
  403.       getapath:=p
  404.     End;
  405.  
  406. function okudk:boolean;
  407. var x3:integer;
  408.         slarvdod:boolean;
  409. begin
  410. slarvdod:=false;
  411. okudk:=false;
  412. if urec.udratio=0 then slarvdod:=false;
  413. x3:=ratio(urec.upkay,urec.dnkay);
  414. if (x3>=urec.udkratio) or (ulvl>=configset.exemptpc) then slarvdod:=true;
  415. okudk:=slarvdod;
  416. end;
  417.  
  418.  
  419.  
  420.  
  421. Procedure AppendBimodem(dirr:char; sendp,getdir:lstr);
  422.  
  423. var BISEX:file of birec;
  424.     HOMO,FAG:birec;
  425.     DUDE:bistuff absolute homo;
  426.     krad,cnt:integer;
  427.     new:boolean;
  428.  
  429. begin
  430.     FillChar(homo,sizeof(homo),0);
  431.     FillChar(dude,sizeof(dude),' ');
  432. close(bisex);
  433. assign (bisex,'vision.pth');
  434. new:=exist('vision.pth');
  435. if not new then rewrite(bisex) else reset(bisex);
  436. cnt:=filesize(bisex);
  437.      homo.cmdstr:=dirr;
  438.   for cnt:=1 to length(sendp) do    homo.sourcepath[cnt]:=sendp[cnt];
  439.   for cnt:=1 to length(getdir) do   homo.destpath[cnt]:=getdir[cnt];
  440.   homo.REFRESH:='N';
  441.   homo.REPLACE:='N';
  442.   homo.VERIFY:='N';
  443.   homo.DELETE:='N';
  444.   homo.DELETEABORT:='N';
  445.   homo.DIROVERRIDE:='N';
  446.   homo.INCLUDEDIRO:='N';
  447. inc(bpos);
  448. seek (bisex,bpos);
  449. write (bisex,homo);
  450. close(bisex);
  451. end;
  452.  
  453.  procedure killbimodem;
  454.   var bisex:file of birec;
  455.   begin
  456.    assign (bisex,'vision.pth');
  457.    if exist('vision.pth') then erase(bisex);
  458.    bpos:=-1;
  459.   end;
  460.  
  461.  
  462.   Function batchupload(Protocol:Integer):Integer;
  463.     Var Count:longint;
  464.  
  465.     Procedure find_and_charge(The:lstr);
  466.       Var cnt:Integer;
  467.       Begin
  468.         inc(filesinbatch);
  469.         cnt:=filesinbatch;
  470.         batchdown[cnt].wholefilename:=the;
  471.         batchdown[cnt].points:=0;
  472.         batchdown[cnt].mins:=0;
  473.       End;
  474.  
  475.     Procedure Then_Charge;
  476.       Var a,b,c,d,fn,sn:String[255];
  477.         cnt,longerthen,junk:Integer;
  478.         Trans:Char;
  479.         FF,qq:Text;
  480.         krad,cps:sstr;
  481.         tpp:lstr;
  482.         Completebytes:longint;
  483.       Begin
  484.         filesinbatch:=0;
  485.  
  486.         batchupload:=0;
  487.         d:=configset.dszlog;
  488.         If Not exist(d) Then exit;
  489.         batchupload:=0;
  490.         Assign(ff,d);
  491.         Reset(ff);
  492.         Repeat
  493.           If Not EoF(ff) Then Begin
  494.             fn:='';
  495.             ReadLn(ff,c);
  496.             Trans:=c[1];
  497.             longerthen:=0;
  498.             if c[9]<>' ' then longerthen:=1;
  499.             cps:=copy(c,20+longerthen,4);
  500.             krad:=copy(c,3,6+longerthen);
  501.             while (length(krad)>0) and (krad[1]=' ')  do delete (krad,1,1);
  502.             val (krad,completebytes,junk);
  503.  
  504.             Delete(c,1,50+longerthen);
  505.             While (c[1]<>' ') Do Begin
  506.         if c[1]='/' then c[1]:='\';
  507.             fn:=fn+c[1];Delete(c,1,1);End;While (c[1]=' ') Do Delete(c,1,1);
  508.             sn:=c;
  509.             if protocol=5 then begin
  510.                tpp:=area.xmodemdir+fn;
  511.                fn:=tpp;
  512.             end;
  513.             WriteLn('Code-> ',trans,' Filename -> ',fn,' Sn# -> ',sn);
  514.             trans:=UpCase(trans);
  515.             if (trans='Z') or (trans='R') or (Trans='S') then begin
  516.              urec.upkay:=urec.upkay+(completebytes div 1024);
  517.              addszlog(cps,fn,false,completebytes);
  518.             writeurec;
  519.             end;
  520.             Writelog(15,2,'Code:'+trans+' fN:'+fn);
  521.             If (trans='R') Or (TRans='Z') Or (Trans='S') Then find_and_Charge(fn) Else
  522.               If exist(fn) Then Begin
  523.               Assign(qq,fn);Erase(qq);End;
  524.           End;
  525.         Until EoF(ff);textclose(ff);
  526.         batchupload:=1;
  527.       End;
  528.  
  529.  
  530.     Procedure ExecDsz;
  531.       Var a,b:anystr;
  532.         tmnt:anystr;
  533.         qq:File;
  534.         cnt:Integer;
  535.       Begin
  536.         b:=configset.dszlog;
  537.         Assign(qq,b);
  538.         If exist(b) Then Erase(qq);
  539.  
  540.  if protocol=5 then begin
  541.     if baudrate=38400 then tmnt:='38400' else tmnt:=strr(baudrate);
  542.         a:='p'+strr(configset.useco)+' s'+tmnt+' hf f- l'+configset.dszlog;
  543.         a:=a+' m- n+ w- x+ e'+strlong(connectbaud)+' R ';
  544.         end else begin
  545.         if baudrate=38400 then tmnt:='38400' else tmnt:=strr(baudrate);
  546.  
  547.         a:='port '+Strr(configset.useco)+' speed '+tmnt+' est len '+strlong(connectbaud)+' ha slow r';
  548.         If protocol=1 Then a:=a+'b -k ';
  549.         If protocol=2 Then a:=a+'z ';
  550.         If protocol=3 Then a:=a+'b -g ';
  551.         If protocol=4 Then a:=a+'z -w ';
  552.  end;
  553.         b:=area.xmodemdir;
  554.         cnt:=Length(b);Delete(b,cnt,1);
  555.         b[3]:='\';
  556.  
  557.         a:=a+b;
  558.         if protocol=5 then a:=a+'\';
  559.         starttimer(numminsxfer);
  560.  
  561.     clrscr;
  562.     ansicolor(15);
  563.     writeln(usr,urec.handle+' is batch uploading.');
  564.     bottomline;
  565.      if protocol=5 then
  566.      Exec('puma.exe',a)
  567.       else begin
  568.      exec('dsz.com',a);end;
  569.         stoptimer(numminsxfer);
  570.         GoToXY(1,23);WriteLn(Usr,^M^M^M);
  571.       End;
  572.  
  573.  
  574.     Begin
  575.       count:=0;
  576.       filesinbatch:=0;
  577.       execdsz;
  578.       batchupload:=0;
  579.         Then_Charge;
  580.     End;
  581.  
  582. Function BICHARGE(allthefiles:integer;batchdown:batchlist):Integer;
  583.   Var Count:longint;
  584.  
  585.   Procedure findetcharge(The:lstr);
  586.     Var cnt:Integer;
  587.          a, b, c    :anystr;
  588.     Begin
  589.       For cnt:=1 To AllTheFiles Do Begin
  590.         c:=batchdown[cnt].wholefilename;
  591.         If match(the,c) Then count:=count+batchdown[cnt].points Else
  592.           If match(c,the) Then count:=count+batchdown[cnt].points;
  593.       End;
  594.     End;
  595.  
  596.  
  597.   Procedure Then_Charge;
  598.     Var a,b:String[255];
  599.       cnt:Integer;
  600.       krad:sstr;
  601.       c,d:String[80];
  602.       Trans:Char;
  603.       FN,sn:String[80];
  604.       FF:Text;
  605.       CompleteBytes:longint;
  606.       Junk:integer;
  607.     Begin
  608.       bicharge:=0;
  609.       If Not exist('bimodem.log') Then exit;
  610.       bicharge:=0;
  611.       d:='bimodem.log';
  612.       Assign(ff,d);
  613.       Reset(ff);
  614.  
  615.       Repeat
  616.         If Not EoF(ff) Then Begin
  617.           fn:='';
  618.           ReadLn(ff,c);
  619.           Trans:=c[12];
  620.           krad:=copy (c,3,6);
  621.  
  622.           fn:=copy (c,43,length(c));
  623.           while ( ((pos(c,'/')>0) or (pos(c,':')>0 ))) do delete (fn,1,1);
  624.           Writeln (' Code:'+trans+' FN:'+fn);
  625.  
  626.           If (Trans='S') Then findetCharge(fn);
  627.  
  628.         End;
  629.  
  630.       Until EoF(ff);
  631.       textclose(ff);
  632.       bicharge:=count;
  633.     End;
  634.  
  635.  
  636.   Begin
  637.  
  638.     count:=0;
  639.     bicharge:=0;
  640.     then_charge;
  641.   End;
  642.  
  643.   Procedure beepbeep(ok:Integer);
  644.     Begin
  645.       Delay(500);
  646.       Write(^B^M);
  647.       Case ok Of
  648.         0:Write('Done');
  649.         1:Write('Error Recovery');
  650.         2:Write('Aborted')
  651.       End;
  652.       WriteLn('!'^G^G^M)
  653.     End;
  654.  
  655.   Function unsigned(i:Integer):Real;
  656.     Begin
  657.       If i>=0
  658.       Then unsigned:=i
  659.       Else unsigned:=65536.0+i
  660.     End;
  661.  
  662.   Procedure writefreespace(path:lstr);
  663.     Var drive:Byte;
  664.       r:registers;
  665.       csize,free,total:Real;
  666.     Begin
  667.       r.ah:=$36;
  668.       r.dl:=Ord(UpCase(path[1]))-64;
  669.       Intr($21,r);
  670.       If r.ax=-1 Then Begin
  671.         WriteLn('Invalid drive');
  672.         exit
  673.       End;
  674.       csize:=unsigned(r.ax)*unsigned(r.cx);
  675.       free:=csize*unsigned(r.bx);
  676.       total:=csize*unsigned(r.dx);
  677.       if free < 1024*1024 then
  678.          Write (^S, free/1024:0:0 , ^R'KB out of ' )
  679.       else
  680.          Write (^S, free/(1024*1024):0:0 , ^R'MB out of ' ) ;
  681.       if total < 1024*1024 then
  682.          WriteLn (^S, total/1024:0:0 ,^R+'KB' )
  683.       else
  684.          WriteLn (^S, total/(1024*1024):0:0 , ^R'MB' ) ;
  685.       If free/1024<100.0 Then WriteLn(^G^S'*** Danger! Limited file space left!');
  686.     End;
  687.  
  688.   function enoughfree(path:lstr):boolean;
  689.   var drive:byte;
  690.       r:registers;
  691.       csize,free,total:real;
  692.       kenny:boolean;
  693.       temp2:longint;
  694.   begin
  695.   kenny:=false;
  696.   r.ah:=$36;
  697.   r.dl:=ord(upcase(path[1]))-64;
  698.   intr($21,r);
  699.   if r.ax=-1 then begin
  700.     writeln('Invalid Drive!');
  701.     enoughfree:=kenny;
  702.     exit;
  703.   end;
  704.   csize:=unsigned(r.ax)*unsigned(r.cx);
  705.   free:=csize*unsigned(r.bx);
  706.   temp2:=trunc(free/1024);
  707.   if temp2>configset.minfreesp then kenny:=true;
  708.   enoughfree:=kenny;
  709.   if not kenny then begin
  710.      writeln(^M^S'Sorry, there is not enough free space on the hard drive for this upload.');
  711.      writeln(^S'Please notify the SysOp. Thank you.');
  712.   end;
  713.   end;
  714.  
  715.   Procedure seekafile(n:Integer);
  716.     Begin
  717.       Seek(afile,n-1)
  718.     End;
  719.  
  720.   Function numareas:Integer;
  721.     Begin
  722.       numareas:=FileSize(afile)
  723.     End;
  724.  
  725.   Procedure seekudfile(n:Integer);
  726.     Begin
  727.       Seek(udfile,n-1)
  728.     End;
  729.  
  730.   Function numuds:Integer;
  731.     Begin
  732.       numuds:=FileSize(udfile)
  733.     End;
  734.  
  735.   Procedure assignud;
  736.    Var M:Mstr;
  737.     Begin
  738.       Close(udfile);
  739.       m:=ConfigSet.ForumDi+'AREA'+Strr(CurArea);
  740.       If CurrentConference<>1 then M:=M+'.'+Strr(CurrentConference);
  741.       Assign(udfile,m);
  742.     End;
  743.  
  744.   Function sponsoron:Boolean;
  745.     Begin
  746.       sponsoron:=match(area.sponsor,unam) Or issysop
  747.     End;
  748.  
  749.   Function PCRatio:Boolean;
  750.      var  x3:integer;
  751.      SlarvDodE:Boolean;
  752.         Begin
  753.             pcratio:=False;
  754.             slarvdode:=False;
  755.             If urec.pcratio=0 Then slarvdode:=True;
  756.             If slarvdode=True Then Else slarvdode:=False;
  757.             x3:=ratio(urec.nbu,urec.numon);
  758.             If  (x3>=urec.pcratio) Then slarvdode:=True else slarvdode:=false;
  759.      If sponsoron Or (ulvl>=configset.exemptpc)
  760.                 Then
  761.                      slarvdode:=True;
  762.             pcratio:=slarvdode;
  763.     End;
  764.  
  765.     Procedure yourudstats;
  766.      var somestuff:longint;
  767.              udr:integer;
  768.         Begin
  769.             mens:=true;
  770.             nobreak:=false;
  771.             dontstop:=true;
  772.             clearscr;
  773.             ansicolor(urec.statusboxcolor);
  774.  
  775. clearscr;
  776. writeln (^O'                   ╒════════════════════════════════════╕');
  777. writeln (^O'                   │'^A'       File Transfer Section!       '^O'│');
  778. writeln (^O'                   ╘════════════════════════════════════╛');
  779. writeln;
  780. writeln (^O'        ╒═══════════════════════════╤══════════════════════════════╕');
  781. writeln (^O'        │ '^F'Uploads   '^P':               '^O'│  '^F'U/D Ratio   '^P':               '^O'│');
  782. writeln (^O'        │ '^F'Downloads '^P':               '^O'│  '^F'File Points '^P':               '^O'│');
  783. writeln (^O'        ╘═══════════════════════════╧══════════════════════════════╛');
  784. printxy(6,23,strr(urec.uploads)+' ('+strlong(urec.upkay)+'k)');
  785. printxy(7,23,strr(urec.downloads)+' ('+strlong(urec.dnkay)+'k)');
  786. percent_whoa(urec.uploads,urec.downloads,54,6);
  787. printxy(7,54,strr(urec.udpoints)+^M);
  788. WriteLn;
  789. writeln (^O'        ╒═══════════════════════════╤══════════════════════════════╕');
  790. writeln (^O'        │ '^F'Posts    '^P':               '^O' │ '^F'File Xfer Level '^P':            '^O'│');
  791. writeln (^O'        │ '^F'# Calls  '^P':               '^O' │ '^F'Minimum Ratio   '^P':            '^O'│');
  792. writeln (^O'        │ '^F'Your PCR '^P':               '^O' │ '^F'New Files       '^P':            '^O'│');
  793. writeln (^O'        ╘═══════════════════════════╧══════════════════════════════╛');
  794. writeln;
  795. WriteLn;
  796. end;
  797.  
  798. procedure yourpcrstats;
  799. var x1,x2,x3:integer; y1,y2,y3:real;
  800.     as:real; newfilez:integer; baud,rate:string;
  801. begin
  802.      printxy (10,22,strr(urec.nbu));
  803.      printxy (11,22,strr(urec.numon));
  804.           x1:=urec.nbu;
  805.           x2:=urec.numon;
  806.           if x1<1 then x1:=1;
  807.           if x2<1 then x2:=1;
  808.           y1:=int(x1);
  809.           y2:=int(x2);
  810.           y1:=y1;
  811.           y2:=y2;
  812.           y3:=y1/y2;
  813.           y3:=y3*100;
  814.           x3:=trunc(y3);
  815.      printxy (12,22,strr(x3)+'%');
  816.      printxy (10,58,strr(urec.udlevel));
  817.      printxy (11,58,strr(urec.udkratio));
  818.      newfilez:=(gnuf-urec.lastfiles);
  819.      if newfilez<1 then printxy (12,58,'None'^M) else begin;
  820.        printxy (12,58,strr(newfilez)+^M);
  821.      end;
  822.      urec.statcolor:=11;
  823.      WriteLn;
  824.      WriteLn(^O'        ╒══════════════════════════════════════════════════════════╕');
  825.      Writeln(^O'        │'^U'                 ■                     ■                  '^O'│');
  826.      WriteLn(^O'        ╘══════════════════════════════════════════════════════════╛');
  827.      If Ulvl>ConfigSet.ExemptPc then printxy(15,11,^A'PCR'^P': '^S'Exempt')
  828.      else If Not PCRatio then Printxy(15,11,^A'PCR'^P': '^S'Bad!') else PrintXy(15,11,^A'PCR'^P': '^S'Passed');
  829.      printxy (15,35,timestr(now));
  830.      printxy (15,55,datestr(now));
  831.      Goxy (1,17);
  832.      urec.statcolor:=10;
  833. end;
  834.  
  835. Procedure LameNoansi;
  836. var somestuff:longint;
  837. Begin
  838. WriteLn(^S'[ File Status ]'^M);
  839. Write(^P'File Lvl : '^S+Strr(Urec.UdLevel)+^M);
  840. Write(^P'File Pts : '^S+Strr(Urec.UDPoints)+^M);
  841. Write(^P'Uploads  : '^S+Strr(Urec.Uploads)+^M);
  842. Write(^P'Downloads: '^S+Strr(Urec.Downloads)+^M);
  843. WRite(^P'Ratio    : '^S+Strr(Ratio(Urec.Uploads,Urec.Downloads))+^M);
  844. Write(^P'Minimum  : '^S+Strr(Urec.Udratio)+^M);
  845. somestuff:=gnuf-confilesa;
  846. Write(^P'New Files: '^S);
  847. if somestuff>0 then writeLn(somestuff) else writeln('None');
  848. end;
  849.  
  850.   procedure yourudstatus;
  851.   begin
  852.    If ansigraphics in urec.config then begin
  853.     If exist(configset.textfiledi+'FILESTAT.ANS') then Begin
  854.       Printfile(configset.textfiledi+'FILESTAT.ANS');
  855.       Goxy(1,22);
  856.       WriteStr(^R'Press '^P'['^A'Enter'^P']:*');
  857.     End Else Begin
  858.      yourudstats;
  859.      yourpcrstats;
  860.      goxy(1,17);
  861.    end;
  862.   End Else LameNoAnsi;
  863.   End;
  864.  
  865. (*    boxit(1,1,31,3);
  866.             FuckXy(2,3,^P'Your '^F'Upload/Download'^P' Status');
  867.             ansicolor(urec.statusboxcolor);
  868.             boxit(2,50,29,13);
  869.             FuckXy(3,57,^S'[ File Status ]'^M);
  870.             FuckXy(4,52,^P'File Lvl : '^S+Strr(Urec.UdLevel)+^M);
  871.             FuckXy(5,52,^P'File Pts : '^S+Strr(Urec.UDPoints)+^M);
  872.             FuckXy(6,52,^P'Uploads  : '^S+Strr(Urec.Uploads)+^M);
  873.             FuckXy(7,52,^P'Downloads: '^S+Strr(Urec.Downloads)+^M);
  874.             FuckXy(8,52,^P'Ratio    : '^S+Strr(Ratio(Urec.Uploads,Urec.Downloads))+^M);
  875.             FuckXy(9,52,^P'Minimum  : '^S+Strr(Urec.Udratio)+^M);
  876.             FuckXy(10,52,^P'Status   : '^S);
  877.             if ulvl>configset.exemptpc then writeLn('Exempt') else
  878.              if okudratio then writeln('Passed') else writeLn('Bad!');
  879.             fuckxy(11,52,^P'New Files: '^S);
  880.             somestuff:=gnuf-confilesa;
  881.             if somestuff>0 then writeLn(somestuff) else writeln('None');
  882.             ansicolor(urec.statusboxcolor);
  883.             boxit(12,35,29,8);
  884.             FuckXy(13,40,^S'[ K-Byte Status ]'^M);
  885.             FuckXy(14,50,'             ');
  886.             FuckXy(14,39,^P'Uploaded  : '^S+Strlong(Urec.UpKay)+^M);
  887.             FuckXy(15,37,^P'Downloaded: '^S+StrLong(Urec.DnKay)+^M);
  888.             FuckXy(16,37,^P'Ratio     : '^S+Strr(Ratio(Urec.UpKay,Urec.DnKay))+^M);
  889.             FuckXy(17,37,^P'Minimum   : '^S+Strr(Urec.UdkRatio)+^M);
  890.             FuckXy(18,37,^P'Status    : '^S);
  891.             If Ulvl>ConfigSet.ExemptPc then writeln('Exempt') else
  892.                  if okudk then writeln('Passed') else writeln('Bad!');
  893.             Ansicolor(Urec.StatusBoxColor);
  894.             Boxit(6,10,29,9);
  895.             FuckXy(7,14,^S'[ Post/Call Ratio ]'^M);
  896.             fuckxy(12,35,'   ');
  897.             fuckxy(13,35,' ');
  898.             FuckXy(8,12,^P'Posts    : '^S+Strr(Urec.Nbu)+^M);
  899.             FuckXy(9,12,^P'Calls    : '^S+Strr(Urec.NumOn)+^M);
  900.             FuckXy(10,12,^P'Ratio    : '^S+Strr(Ratio(Urec.Nbu,Urec.NumOn))+^M);
  901.             FuckXy(11,12,^P'Minimum  : '^S+Strr(Urec.PCRatio)+^M);
  902.             FuckXy(12,12,^P'Status   : '^S);
  903.             If Ulvl>ConfigSet.ExemptPc then WriteLn('Exempt')
  904.                 else If Not PCRatio then WriteLn('Bad!') else WriteLn('Passed');
  905.             FuckXy(13,12,^P'New Msgs : '^S);
  906.             SomeStuff:=Gnup-conpostsa;
  907.             If SomeStuff>0 then WriteLn(SomeStuff) Else WriteLn('None');
  908.                 clearbreak;
  909.                 fuckxy(21,1,'');
  910.             end; *)
  911.  
  912.  
  913. procedure modarea;
  914. var a:arearec;
  915.     tmp:sstr;
  916.     tt:char;
  917.     Q:integer;
  918. begin
  919. a:=area;
  920. repeat;
  921. clearscr;
  922. writehdr('Modify Area');
  923. writeln(^P'A. Name       : '+a.name);
  924. writeln(^P'B. Sponser    : '+a.sponsor);
  925. write(^P'C. Upload Here: ');if a.uploadhere then writeln('Yes') else writeln('No');
  926. write(^P'D. Dload Here : ');if a.downloadhere then writeln('Yes') else writeln('No');
  927. Writeln(^P'E. Area Pass  : '+a.pass);
  928. write(^P'F. Access Flag: ');if a.conference=0 then writeln('None') else writeln(a.conference);
  929. writeln(^P'G. Level      : ',a.level);
  930. writeln(^P'H. Directory  : '+a.xmodemdir);
  931. writestr(^M^R'Command or [Q] to exit : [Q]: *');
  932. if input='' then input:='Q';
  933. tt:=upcase(input[1]);
  934. case upcase(tt) of
  935.  'A':begin
  936.     writestr(^M^R'Enter the new file area name: *');
  937.     if input='' then input:=a.name;
  938.     a.name:=input;
  939.     end;
  940.  'B':begin
  941.       writestr(^M^R'Enter the new sponsor: *');
  942.       if input='' then input:=a.sponsor;
  943.       a.sponsor:=input;
  944.    end;
  945.  'C':begin
  946.      writestr(^M^R'Allow uploads here? *');
  947.      a.uploadhere:=yes;
  948.      end;
  949.  'D':begin
  950.      writestr(^M^R'Allow downloads here? *');
  951.      a.downloadhere:=yes;
  952.      end;
  953.  'E':begin
  954.     writestr(^M^R'File Area Password [N=None] : *');
  955.     if input='' then input:=a.pass;
  956.     if match(input,'N') then input:='';
  957.     a.pass:=input;
  958.     end;
  959.  'F':begin
  960.     writestr(^M^R'Access Flag (1-30) [0] : *');
  961.     if input='' then input:='0';
  962.     a.conference:=valu(input);
  963.     end;
  964.  'G':begin
  965.      writestr(^M^R'Access Level [Ret=No Change] : *');
  966.      if input='' then input:=strr(a.level);
  967.      a.level:=valu(input);
  968.      end;
  969.  'H':begin
  970.       writeln;
  971.       a.xmodemdir:=getapath;
  972.     end;
  973.     end
  974. until (tt='Q') or (tt='q') or hungupon;
  975. area:=a;
  976. reset(afile);
  977. seek(afile,curarea-1);
  978. write(afile,a);
  979. end;
  980.  
  981. procedure doheader;
  982.  begin
  983.   clearscr;
  984.   writeln(^R'['^S'File Section'^R'] ['^S,area.name,^R'] ['^S,curarea,^R']');
  985.   if not (ansigraphics in urec.config) then begin
  986.       tab('#.',4);
  987.       tab('Filename',14);
  988.       tab('Cost',7);
  989.       tab('Filesize',10);
  990.       WriteLn(' Description'^M^M); end else
  991. begin
  992. ANSiCOLOR(15);
  993. writeln ('▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄');ANSiCOLOR(7);
  994. write ('█'); ColorFB(1,7);
  995. Write (' #.                ViSiON v0.82 Configurable File Listings                   ');
  996. ANSiCOLOR(7); WriteLn('█'); ANSicolor(8);
  997. writeln ('▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀');
  998. end;
  999. nobreak:=false;
  1000. dontstop:=false;
  1001. end;
  1002.  
  1003. procedure doextended;
  1004. begin
  1005.   clearscr;
  1006.   writeln(^U'Extended File Listing of '^R'['^S,area.name,^R'] ['^S,curarea,^R']');
  1007.   if not (ansigraphics in urec.config) then begin write('  ');
  1008.    tab('#.',4);
  1009.    tab('Filename',16);
  1010.    tab('Cost',9);
  1011.    tab('Date Sent',12);
  1012.    Writeln('Times DL''ed  Sent By'); end else
  1013.    begin
  1014.     ANSicolor(15);
  1015.     writeln ('▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄');
  1016.     ANSicolor(7); write ('█');ColorFB(1,7);
  1017.     Write (' #.    Filename    Points  Date Sent Times DLed   Sent By                    ');
  1018.     ansicolor(7); WRiteLn('█');ansicolor(8);
  1019.     writeln ('▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀');
  1020.  
  1021. end;
  1022. nobreak:=false;
  1023. dontstop:=false;
  1024. end;
  1025.  
  1026.  
  1027.   Function makearea:Boolean;
  1028.     Var num,n:Integer;
  1029.       a:arearec;
  1030.     Begin
  1031.       makearea:=False;
  1032.       num:=numareas+1;
  1033.       n:=numareas;
  1034.       writestr(^R'Create area '+^S+strr(num)+^P+' '^F'['^S'N'^F']'^R'? *');
  1035.       If yes Then Begin
  1036.         writestr(^R'Area name'^A':');
  1037.         If Length(Input)=0 Then exit;
  1038.         a.name:=Input;
  1039.          writestr(^R'Access Flag '^F'('^S'1-30'^F') ['^S'0/None'^F'] ['^S'0'^F']'^A':');
  1040.           If Length(Input)=0 Then Input:='0';
  1041.           a.conference:=valu(Input);
  1042.            writestr(^R'Access Level for area'^A':*');
  1043.             a.level:=valu(Input);
  1044.                 writestr(^R'Upload Here? '^F'['^S'Y'^F']'^A':');
  1045.         if input='' then input:='Y';
  1046.         if yes or (input='Y') then a.uploadhere:=true else a.uploadhere:=false;
  1047.         writestr(^R'Download here? '^F'['^S'Y'^F']'^A':');
  1048.         if input='' then input:='Y';
  1049.         if yes or (input='Y') then a.downloadhere:=true else a.downloadhere:=false;
  1050.         writestr(^R'Entry Password '^F'['^S'N/None'^F']'^A' :');
  1051.         if input='N' then input:='';
  1052.         If Length(Input)=0 Then Input:='' else input:=upstring(input);
  1053.         a.pass:=input;
  1054.         writestr(^R'CoSysop Of This File Section '^F'['+^S+unam+^F+']'^A':');
  1055.         If Length(Input)=0 Then Input:=unam;
  1056.         a.sponsor:=Input;
  1057.         a.xmodemdir:=getapath;
  1058.         seekafile(num);
  1059.         Write(afile,a);
  1060.         area:=a;
  1061.         curarea:=num;
  1062.         assignud;
  1063.         Rewrite(udfile);
  1064.         WriteLn('Area created');
  1065.         makearea:=True;
  1066.         writelog(15,4,a.name)
  1067.       End
  1068.     End;
  1069.  
  1070.   Function allowed_in_area(where:arearec):Boolean;
  1071.     Var c:Boolean;
  1072.     Begin
  1073.       c:=False;
  1074.         If (where.conference=0 ) Then
  1075.           If (where.level<=urec.udlevel) Then
  1076.           c:=True;
  1077.         If (where.conference>0) Then
  1078.           If (urec.confset[where.conference]>0) Then c:=True;
  1079.       Allowed_In_Area:=c;
  1080.     End;
  1081.  
  1082.   Procedure setarea(n:Integer; Showit:boolean);
  1083.     Var c:Boolean;
  1084.     Procedure nosucharea;
  1085.       Begin
  1086.         WriteLn(^B'No such area: ',n,'!')
  1087.       End;
  1088.  
  1089.     Begin
  1090.       curarea:=n;
  1091.       If (n>numareas) Or (n<1) Then Begin
  1092.         nosucharea;
  1093.         If issysop
  1094.         Then If makearea
  1095.           Then setarea(curarea,true)
  1096.           Else  setarea(1,true)
  1097.         Else setarea(1,true);
  1098.       End;
  1099.       seekafile(n);
  1100.       Read(afile,area);
  1101.       If Not(allowed_in_area(area))
  1102.       Then If curarea=1
  1103.         Then error('User can''t access first area','','')
  1104.         Else
  1105.           Begin
  1106.             nosucharea;
  1107.             setarea(1,true);
  1108.             exit
  1109.           End;
  1110.         close(udfile);
  1111.       assignud;
  1112.       Close(udfile);
  1113.       Reset(udfile);
  1114.       If IOResult<>0 Then Rewrite(udfile);
  1115.      if local or not showit then else begin
  1116.      if (curarea>1) and (area.pass<>'') then begin
  1117.         Writestr (^R'Entry Password'^A':');
  1118.         if match (area.pass,input)=false then setarea(1,true);
  1119.      end; End;
  1120.       If Showit then WriteLn(^B^R'Current Area  ['^S,curarea:2,^r'] '^S,area.name,^R,^M);
  1121.      end;
  1122.  
  1123.   Procedure listareas;
  1124.     Var a:arearec;
  1125.       cnt:Integer;
  1126.     Begin
  1127.     clearscr; writehdr(' File Areas ');
  1128.     writeln(^R'╒═════════════════════════════════════════════════════════════════╕');
  1129.     writeln(^R'│ '^S' #     File Area Name                          Level/Conference'^R' │');
  1130.     writeln(^R'╞═════════════════════════════════════════════════════════════════╡');
  1131.       seekafile(1);
  1132.       For cnt:=1 To numareas Do Begin
  1133.         Read(afile,a);
  1134.         If allowed_in_area(a)
  1135.         Then begin
  1136.         write(^R'│  ');
  1137.         tab(^A+strr(cnt),4);
  1138.         write('  ');
  1139.         tab(^P+a.name,42);
  1140.         write('  ');
  1141.         if (a.conference>0) then tab(^R+'Conference '^U+strr(a.conference),17)
  1142.           else tab(^U+strr(a.level),16);
  1143.           writeln(^R'│');
  1144.         If break Then exit
  1145.       End;
  1146.     end;
  1147.     writeln(^R'╘═════════════════════════════════════════════════════════════════╛');
  1148.   end;
  1149.  
  1150.   Function getareanum:Integer;
  1151.     Var areastr:sstr;
  1152.       areanum:Integer;
  1153.     Begin
  1154.       getareanum:=0;
  1155.       If Length(Input)>1
  1156.       Then areastr:=Copy(Input,2,255)
  1157.       Else begin
  1158.       listareas;
  1159.         Repeat
  1160.           writestr(^M^R'File Area '^P'['^A'?'^U'/'^A'Relist'^P']:');
  1161.           If Input='?' Then listareas Else areastr:=Input
  1162.         Until (Input<>'?') Or hungupon;
  1163.         end;
  1164.       If Length(areastr)=0 Then exit;
  1165.       areanum:=valu(areastr);
  1166.       If (areanum>0) And (areanum<=numareas)
  1167.       Then getareanum:=areanum
  1168.       Else Begin
  1169.         writestr('No such area!');
  1170.         If issysop Then If makearea Then getareanum:=numareas
  1171.       End
  1172.     End;
  1173.  
  1174.   Procedure getarea;
  1175.     Var areanum:Integer;
  1176.     Begin
  1177.       areanum:=getareanum;
  1178.       If areanum<>0 Then setarea(areanum,true)
  1179.     End;
  1180.  
  1181.   Function getfname(path:lstr;name:mstr):lstr;
  1182.     Var l:lstr;
  1183.     Begin
  1184.       l:=path;
  1185.       If Length(l)<>0 Then
  1186.         If Not(l[Length(l)] In [':','\']) Then
  1187.           l:=l+'\';
  1188.       l:=l+name;
  1189.   getfname:=l
  1190.     End;
  1191.  
  1192.   Procedure getpathname(fname:lstr;Var path:lstr;Var name:sstr);
  1193.     Var
  1194.         _Name: NameStr;
  1195.         _Ext : ExtStr ;
  1196.     Begin
  1197.       FSplit(fname,path,_name,_ext);
  1198.       name := _name + _ext ;
  1199.     End;
  1200.  
  1201.  function candownload(Fsz:longint;pts:integer ):boolean;
  1202.  Var t1,t2:longint;
  1203.      Dl:boolean;
  1204.   begin
  1205.   dl:=false;
  1206.   if issysop then candownload:=true;
  1207.   if issysop then exit;
  1208.   if connectbaud=0 then t1:=(2400*timeleft*6) else  t1:=(connectbaud*timeleft*6);
  1209.   if (t1>=fsz) or (urec.udpoints>=pts)  then dl:=true;
  1210.   if (t1>=fsz) and configset.leechwee then dl:=true;
  1211.   candownload:=dl;
  1212.   end;
  1213.  
  1214.   Procedure listfile(n:Integer;extended:Boolean);
  1215.     Var ud:udrec;
  1216.       q:sstr;
  1217.      path, Filez:anystr; _Name:namestr; _Ext: Extstr;
  1218.       Sze:longint;
  1219.       ofline:boolean;
  1220.  
  1221.     Begin
  1222.       seekudfile(n);
  1223.       Read(udfile,ud);
  1224.         Filez:=getfname(ud.path,ud.filename);
  1225.         ofline:=(exist(filez))=false;
  1226.         write(' ');
  1227.         FSplit(ud.filename,path,_name,_ext);
  1228.         write(^P);
  1229.         tab(strr(n)+'.',4);
  1230.  
  1231.       path:=upcase(_name[1]);
  1232.       _name[1]:=path[1];write(^U);
  1233.       If urec.use1 or (extended) then Begin
  1234.       ansicolor(10);
  1235.       tab(upstring(_Name),8);
  1236.       end;
  1237.  
  1238.       if urec.use2 or (extended) then Begin
  1239.       ansicolor(2);
  1240.       write(upstring(_ext):4,'  ');
  1241.       end;
  1242.  
  1243.       If urec.use3 or (extended) then Begin
  1244.       write(^R);
  1245.        if (ud.sendto='') then
  1246.        If ud.newfile
  1247.       Then Write(' New      ')
  1248.       Else If ud.specialfile
  1249.         Then Write(' Ask      ')
  1250.         Else If (ud.points>0)  and (not configset.leechwee)
  1251.           Then Write(ud.points:4 , '      ')
  1252.           Else Write(' Free     ')
  1253.       else begin ansicolor(4);
  1254.        if match(ud.sendto,urec.handle) then write(' Take     ')
  1255.         else write(' Priv     ');
  1256.         end;
  1257.        end;
  1258.  
  1259.       if urec.use4 and not (extended) then Begin
  1260.       ansicolor(13); if not extended then begin
  1261.      if not exist(ud.path+ud.filename) then tab('[Offline]',10) Else begin
  1262.        sze:=ud.filesize; if sze<1024 then
  1263.        sze:=1025;
  1264.        Write(strlong(sze div 1024)+'k':9,' ');
  1265.       end;
  1266.       end;
  1267.       end;
  1268.  
  1269.       If urec.use5 and not (extended) then Begin
  1270.       Ansicolor(14);
  1271.       write(^U); if ud.descrip='' then ud.descrip:='- No Description Given -';
  1272. (*      Write(' ',copy(ud.descrip,1,39)); *)
  1273.       tab(' '+ud.descrip,39);
  1274.       end;
  1275. (*      end; *)
  1276.  
  1277.       If break Then exit;
  1278.       If urec.use6 or (extended) then Begin
  1279.       tab(datestr(ud.when),13);
  1280.       end;
  1281.  
  1282.       write(^U);
  1283.       If urec.use7 or (extended) then Begin
  1284.       tab(strlong(ud.downloaded),6);
  1285.       end;
  1286.  
  1287.       if urec.use8 or (extended) then Begin
  1288.       ansicolor(14);
  1289.       Write(ud.sentby)
  1290.       end;
  1291.       WriteLn;
  1292.     End;
  1293.  
  1294.  
  1295.   Function nofiles:Boolean;
  1296.     Begin
  1297.       If numuds=0 Then Begin
  1298.         nofiles:=True;
  1299.         writeln(^M'Sorry, no files.')
  1300.       End Else nofiles:=False
  1301.     End;
  1302.  
  1303.