{$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
  unit filexfer;

  Interface

  uses crt,dos,
  subs3,gentypes,configrt,modem,statret,gensubs,subs1,subs2,windows,
  userret,mainr1,mainr2,overret1,mycomman,init,mainmenu;

  Procedure udsection;

  Implementation

Procedure udsection;

  procedure listarchive;forward;
  Procedure download(autoselect:Integer;FILE_Override:Lstr;Point_Override:integer );Forward;
  Procedure add_to_batch(autoselect:Integer;File_Override:lstr; Point_Override:integer);Forward;
  procedure setarea(n:integer;showit:boolean);forward;

  type batchrec=record
       filename:sstr;
       path:string[50];
       by:mstr;
       points,mins:integer;
       size:longint;
       wholefilename:lstr;
       area,filenum:integer;
  end;

  arprotorec=array[1..30] of protorec;

  batchlist=array[1..50] of batchrec;

  Var ud:udrec;
    area:arearec;
    curarea:Integer;
    Batchdown:batchlist;
    filesinbatch:Integer;
    BPOS:integer;
    dproto:arprotorec;
    uproto:arprotorec;
    totalupro:integer;
    totaldownpro:integer;

type BIREC=record
  CMDSTR:char;
  REFRESH:char;
  REPLACE:char;
  VERIFY:CHAR;
  DELETE:CHAR;
  DELETEABORT:CHAR;
  DIROVERRIDE:char;
  INCLUDEDIRO:char;
  SOURCEPATH:array [1..80] of char;
  Destpath  :array [1..80] of char;
  Description:array [1..80] of char;
end;

type bistuff=record
     shit: array [1..298] of char;
     end;

 Procedure AutoUploadGrant(Var Ud:Udrec);
 Var Te,Spoo:Integer;
 Begin
   If ConfigSet.AutoUls>0 then
     Begin
       Ud.Points:=(Ud.FileSize Div Configset.AutoULS);
       Ud.NewFile:=False;
       WriteLn(^S'Granting you '^A,((ud.points * configset.uploadfacto) div  100)
               ,^S' file points.');
       Urec.UdPoints:=Urec.UdPoints+ ((ud.points * configset.uploadfacto) div 100);
     End;
 End;

 function abletodoanything(ud:Udrec):Boolean;
 Var C:Boolean;
 Begin
 C:=True;
 If ud.newfile and not issysop then
    Begin
      WriteLn(^S'Sorry, that is a [NEW] file and must be validated first!');
      C:=False;
    End;
 If Ud.SpecialFIle and not IsSysop then
    Begin
      WriteLn(^S'Sorry, that is a Special file and you must have permission!');
      C:=False;
    End;
 If not Exist(Ud.Path+Ud.FileName) then
   Begin
     WriteLn(^S'Sorry, that file is [OFFLINE] and requires special permission.');
     C:=False;
   End;
 AbleToDoAnything:=C;
End;

 {$I Bimodem.inc}

  Procedure listfiles(extended:Boolean);
    Var cnt,max,r1,r2,kn:Integer;
        T:Char;
    Const extendedstr:Array[false..true] Of String[9]=('','');
    Begin
      If nofiles Then exit;
      writehdr(extendedstr[extended]+'File List');
      max:=numuds;
      thereare(max,'file','files');
      parserange(max,r1,r2);
      If r1=0 Then exit;
      Write(^S); if not extended then doheader else doextended;
      kn:=0;
      For cnt:=r1 To r2 Do Begin
        listfile(cnt,extended);
        If break Then exit;
        inc(kn);
        if kn=20 then repeat
        kn:=0;
         writestr(^M^P'['^A'File Listings '^P'- '^S+area.name+^P'] - ['^F'?/Help'^P'] '^A':*');
         if input='' then input:='N';
         T:=UpCase(Input[1]);
         Case T of
           '+':Add_To_Batch(0,'',0);
           'D':DownLoad(0,'',0);
           'V':ListArchive;
           'Q':Exit;
           'N':DoHeader;
           '?':listinghelp;
         End;
         until match(input,'N') or hungupon;
      End
    End;


  Function getfilenum(t:mstr):Integer;
    Var n,s:Integer;
    Begin
      getfilenum:=0;
      If Length(Input)>1 Then Input:=Copy(Input,2,255) Else
        Repeat
          writestr(^R'File name/number to '+^S+t+^R' [?=List]:');
          If hungupon Or (Length(Input)=0) Then exit;
          If Input='?' Then Begin
            listfiles(False);
            Input:=''
          End
        Until Input<>'';
      Val(Input,n,s);
      If s<>0 Then Begin
        n:=searchforfile(Input);
        If n=0 Then Begin
          WriteLn(^S'File not found.');
          exit
        End
      End;
      If (n<1) Or (n>numuds)
      Then WriteLn(^P'File number out of range!')
      Else getfilenum:=n
    End;

  Procedure addfile(ud:udrec);
    Begin
      seekudfile(numuds+1);
      Write(udfile,ud)
    End;

  Procedure getfsize(Var ud:udrec);
    Var df:File Of Byte;
    Begin
      ud.filesize:=-1;
      Assign(df,getfname(ud.path,ud.filename));
      Reset(df);
      If IOResult<>0 Then exit;
      ud.filesize:=FileSize(df);
      Close(df)
    End;

  Function wildcardmatch(w,f:sstr):Boolean;
    Var a,b:sstr;

    Procedure transform(t:sstr;Var q:sstr);
      Var p:Integer;

      Procedure filluntil(k:Char;n:Integer);
        Begin
          While Length(q)<n Do q:=q+k
        End;

      Procedure dopart(mx:Integer);
        Var k:Char;
        Begin
          Repeat
            If p>Length(t)
            Then k:='.'
            Else k:=t[p];
            inc(p);
            Case k Of
              '.' :Begin
                     filluntil(' ',mx);
                     exit
                   End;
              '*' :filluntil('?',mx);
            Else If Length(q)<mx Then q:=q+k
            End
          Until 0=1
        End;

      Begin
        p:=1;
        q:='';
        dopart(8);
        dopart(11)
      End;

    Function theymatch:Boolean;
      Var cnt:Integer;
      Begin
        theymatch:=False;
        For cnt:=1 To 11 Do
          If (a[cnt]<>'?') And (b[cnt]<>'?') And
          (UpCase(a[cnt])<>UpCase(b[cnt])) Then exit;
        theymatch:=True
      End;

    Begin
      transform(w,a);
      transform(f,b);
      wildcardmatch:=theymatch
    End;

  Const beenaborted:Boolean=False;

  Function aborted:Boolean;
    Begin
      If beenaborted Then Begin
        aborted:=True;
        exit
      End;
      aborted:=xpressed Or hungupon;
      If xpressed Then Begin
        beenaborted:=True;
        WriteLn(^B'Newscan abort')
      End
    End;

  {$I filexf2.inc}
  Procedure newscan;
    Var cnt:Integer;
      u:udrec;
      kn:integer;
      first:Boolean;
      done:Boolean;
      T:Char;
    Begin
      done:=False;
      Repeat
        first:=False;
        beenaborted:=False; kn:=0;
        For cnt:=1 To FileSize(udfile) Do Begin
          If aborted Then exit;
          seekudfile(cnt);
          Read(udfile,u);
          if kn=20 then repeat
          writestr(^M^P'['^A'File Newscanning '^P'- '^S+area.name+^P'] - ['^F'?/Help'^P'] '^A':*');
          if input='' then input:='N';
          kn:=0;
          T:=UpCase(Input[1]);
          Case T of
            '+':Add_To_Batch(0,'',0);
            'D':Download(0,'',0);
            'V':ListArchive;
            'Q':Begin
                 BeenAborted:=True;
                 Done:=True;
                 WriteLn(^M'Newscan Aborted!');
                 setarea(1,true);
                 exit;
               end;
            'N':DoHeader;
            '?':newscanhelp;
          End;
          until match(input,'N') or hungupon;
          If (u.whenrated>laston) Or (u.when>laston)
          Then Begin
            inc(kn);
            If Not first Then Begin
              doheader;
            first:=True;End;
            listfile(cnt,False);
          End;
        End;
        If first Then Begin
          writestr(^M^P'['^A'File Newscanning '^P'- '^S+area.name+^P'] - ['^F'?/Help'^P'] '^A':*');
          If Input='' Then Input:='N';
          t:=UpCase(Input[1]);
           Case T of
             'A':Done:=False;
             '+':Add_To_Batch(0,'',0);
             'D':download(0,'',0);
             'Q':begin
                 beenaborteD:=true;
                 done:=true;
               end;
            'V':listarchive;
            '?':newscanhelp;
          End;
          if pos(T,'A+DQV?')=0 then done:=True;
        End;
        If Not first Then done:=True;
      Until done;
    End;



        Procedure removefile(n:Integer; gock:boolean);
                Var cnt,un:Integer;
                                u:userrec;

                procedure AskDeleteQuery;
                Begin
                        WriteStr(^M^P'Remove from '+Ud.SentBy+'s Status? *');
                        If Not Yes then Exit;
                        Un:=LookUpUser(Ud.SentBy);
                        If Un=-1 then WriteLn(^M'User Disappeared!');
                        If Un=-1 then Exit;
                        Seek(Ufile,Un);
                        Read(Ufile,U);
                        U.Uploads:=U.Uploads-1;
                        U.UdPoints:=U.UdPoints-(Ud.Points*ConfigSet.UploadFacto);
                        U.UpKay:=U.UpKay-(Ud.FileSize Div 1024);
                        Seek(Ufile,Un);
                        Write(Ufile,U);
                End;

                Begin
                        seekudfile(n);
                        read(udfile,ud);
                        if gock then askdeletequery;
                        For cnt:=n To numuds-1 Do Begin
                                seekudfile(cnt+1);
                                Read(udfile,ud);
                                seekudfile(cnt);
                                Write(udfile,ud)
                        End;
                        seekudfile(numuds);
                        Truncate(udfile)
                End;

  Procedure displayfile(Var ffinfo:searchrec);
    Var a:Integer;
    Begin
      a:=ffinfo.attr;
      If (a And 8)=8 Then exit;
      tab(ffinfo.name,13);
      If (a And 16)=16
      Then Write('Directory')
      Else Write(ffinfo.size);
      If (a And 1)=1 Then Write(' [read-only]');
      If (a And 2)=2 Then Write(' [hidden]');
      If (a And 4)=4 Then Write(' [system]');
      WriteLn
    End;

  Function defaultdrive:Byte;
    Var r:registers;
    Begin
      r.ah:=$19;
      Intr($21,r);
      defaultdrive:=r.al+1
    End;

  Procedure directory;
    Var r:registers;
      ffinfo:searchrec;
      tpath:anystr;
      b:Byte;
      cnt:Integer;
    Begin
      tpath:=area.xmodemdir;
      If tpath[Length(tpath)]<>'\' Then tpath:=tpath+'\';
      tpath:=tpath+'*.*';
      writestr('Path/wildcard [CR for '+^S+tpath+^P+']:');
      WriteLn(^M);
      If Length(Input)<>0 Then tpath:=Input;
      writelog(16,10,tpath);
      findfirst(Chr(defaultdrive+64)+':\*.*',8,ffinfo);
      If doserror<>0
      Then WriteLn('No volume label'^M)
      Else WriteLn('Volume label: ',ffinfo.name,^M);
      findfirst(tpath,$17,ffinfo);
      If doserror<>0 Then WriteLn('No files found.') Else Begin
        cnt:=0;
        While doserror=0 Do Begin
          inc(cnt);
          If Not break Then displayfile(ffinfo);
          findnext(ffinfo)
        End;
        WriteLn(^B^M'Total files: ',cnt)
      End;
      Write('Free disk space: ');
      writefreespace(tpath)
    End;

    Function OKRatiosAnd(Ud:Udrec):Boolean;
    Var C:Boolean;
      Procedure SeaError(M:Lstr);
      Begin
        C:=False;
        WriteLn(^S,M);
      End;

    Begin
    C:=True;
      If Not Area.DownLoadHere then
          SeaError('You may not download in this area!');
      If Not OkUdRatio and C then seaerror('Your Upload/Download Ratio is out of wack! Upload First!');
      If Not OkUdK and C then
            SeaError('Your Upload/Download K Ratio is out of wack! Upload First!');
      If (Ud.SendTo<>'') and Not Match(Ud.Sendto,Urec.Handle) and C then
            SeaError('This file is Not for you!');
      If (Ud.Pass<>'') and C then
         Begin
           WriteStr(^M^S'Password Protected file!'^M^M^P'Password:');
           If not Match(Input,Ud.Pass) then
             SeaError('Wrong Password');
           End;
      OkRatiosAnd:=C;
    End;



    Procedure download(autoselect:Integer;FILE_Override:Lstr;Point_Override:integer );

    Var totaltime:sstr;
      timewhilebeing:integer;
      fsize:longint;
      proto,num,mins:Integer;
      ud:udrec;
      shit:integer;
      joe:longint;
      zmodem,fname:lstr;
      ymodem:Boolean;
      b:Integer;
      f:File;
    Begin
if file_override='' then begin
      If Not allowxfer Then exit;
      If nofiles Then exit;
      If autoselect=0
      Then num:=getfilenum('download')
      Else num:=autoselect;
      If num=0 Then exit;
      WriteLn;
      seekudfile(num);
      Read(udfile,ud);
      if file_OverRide='' then if Not OkRatiosAnd(Ud) then Exit;
      end else ud.points:=point_override;
      If (Not sponsoron) And (ud.points>urec.udpoints) and (not configset.leechwee)
      Then Begin
        WriteLn(^P'That file requires '^S,ud.points,^P' points.');
        exit
      End;
      If (File_override='') and Not AbleToDoAnything(Ud) then Exit;
      if file_override='' then fname:=getfname(ud.path,ud.filename) else
          fname:=file_override;
      If tempsysop Then Begin
        ulvl:=regularlevel;
        tempsysop:=False;
        writeurec;
        bottomline
      End;
      ymodem:=False;
      proto:=protocaseselection(true);
      if proto=0 then exit;
      Assign(f,fname);
      Reset(f);
      iocode:=IOResult;
      If iocode<>0 Then
        Begin
          fileerror('DOWNLOAD',fname);
          exit
        End;
      fsize:=FileSize(f);
      Close(f);
      totaltime:=minstr(fsize);
      mins:=valu(Copy(totaltime,1,Pos(':',totaltime)-1));
      If ((mins>timeleft) And (Not sponsoron)) Then Begin
        writestr(^S'Insufficient time for transfer!');
        exit
      End;
      If (mins-5>timetillevent) Then Begin
        writestr(^S'You may not transfer right before the event occurs.');
        exit
      End;
      If (vt52 in urec.config) or (ansigraphics In urec.config) Then Begin
      clearscr;
      printxy(4,1,'');End;
      bottomline;
      Writehdr('File Download');
      if file_override='' then begin
      WriteLn(^R'Filename:         '^S,upstring(ud.filename));
      WriteLn(^R'Uploaded by:      '^S,ud.sentby);
      WriteLn(^R'Times downloaded: '^S,ud.downloaded);
      If ymodem Then fsize:=(fsize+7) Div 8;
      Write(^R'Cost (pts.):      '^S);
      if (ud.points>0) and (not configset.leechwee) then writeln(ud.points) else
      writeln('Free');
      joe:=fsize*128;
      WriteLn(^R'Bytes to send :   '^S,strlong(joe));
      WriteLn(^R'Approx. Time :    '^S,totaltime);
      WriteLn(^R'Current Time Left:'^S,timeleft);
      end;
      WriteLn(^M^M^S'Press ['^A'Ctrl-X'^S'] many times to abort'^B);
      Delay(2500);   clrscr;
      timewhilebeing:=timeleft;
      b:=protocolxfer(True,False,ymodem,proto,fname);
      beepbeep(b);
      If (b=0) Or (b=1) Then Begin
        writelog(15,1,fname);
        inc(urec.downloads);
        if file_override='' then begin
        inc(ud.downloaded);
        seekudfile(num);
        Write(udfile,ud);
        end;
        delay(2000);
        if file_override='' then
        pointcom(ud.sentby,ud.points);
        nosound;
  if file_override='' then else      ud.points:=Point_override;
        If (ud.points>0) and (not configset.leechwee) Then Begin
          WriteLn(^M^M^R'Your File Points --> '^S,urec.udpoints);
          WriteLn(^R'File Xfer Charge --> '^S,ud.points);
          WriteLn(^B^P'                     -----');
if sponsoron then
          Writeln(^B^S'No Charge for Sysop>');
       if not sponsoron then urec.udpoints:=urec.udpoints-ud.points;
          WriteLn(^R'Your new total ----> '^S,urec.udpoints);
        End;
        writeurec;
      End
    End;

  Procedure upload;
    Var ud:udrec;
      ok,crcmode,ymodem:Boolean;
      proto,b:Integer;
      zmodem,fn:lstr;
      start_time : integer ;
      tmp1,tmp2:anystr;
      _name:namestr;
      _ext:extstr;

    Begin
          if area.uploadhere<>true then writeln (^S'You can not upload to this area!');
      if area.uploadhere<>true then exit;
      If Not allowxfer Then exit;
      If (timetillevent<30) Then Begin
        writestr(
        'Uploads are not allowed within 30 minutes of Events!');
        exit
      End;
      ok:=False;
      boxfile;
      If ansigraphics in urec.config then Goxy(26,2); writefreespace(area.xmodemdir);
      if not enoughfree(area.xmodemdir) then exit;
      WriteLn;
      Repeat
        If ansigraphics in urec.config then Goxy(6,4);
        writestr(^S'File Name          :');
        If Length(Input)=0 Then exit;
        If Not validfname(Input) Then Begin
          Printxy(4,26,^S'Invalid filename!'^M^M^M^M^M^M);
          exit
        End;
        ud.filename:=upstring(Input);
        ud.path:=area.xmodemdir;
        fn:=getfname(ud.path,ud.filename);
        If hungupon Then exit;
        If exist(fn)
        Then Printxy(4,26,^S'Filename already exists!'^M^M^M^M)
        Else ok:=True
      Until ok;
      ymodem:=False;
      If ansigraphics in urec.config then Goxy(27,5) Else Write('Password :');
      buflen:=20;
      WriteStr('*');
      If input>'' then ud.pass:=input;
      If ansigraphics in urec.config then begin
      Goxy(13,6);
      WriteStr('*');
      end;
      If ansigraphics in urec.config then Goxy(8,8) Else Write('Description:');
      BufLen:=40;
      writestr('*');
      ud.descrip:=Input;
      If ansigraphics in urec.config then Goxy(29,9) Else Write('Private For:');
      WriteStr('*');
      if input>'' then ud.sendto:=input;
      proto:=protocaseselection(false);
      if proto=0 then exit;
      clearscr;
      bottomline;
      Writehdr(Ud.filename+' Upload');
      WriteLn(^S'Receive ready.'^R' Press [Ctrl-X] many times to Abort!');
      If tempsysop Then Begin
        ulvl:=regularlevel;
        tempsysop:=False;
        writeurec;
        bottomline
      End;
      start_time := timeleft ;clrscr;
      delay(2500);
      b:=protocolxfer(False,crcmode,ymodem,proto,fn);
      beepbeep(b);
      If b=0 Then Begin
        writelog(15,2,ud.filename);
        ud.sentby:=unam;
        ud.when:=now;
        ud.whenrated:=now;
        ud.points:=0;
        ud.sendto:='';
        ud.downloaded:=0;
        ud.newfile:=True;
        ud.specialfile:=False;
        ud.downloaded:=0;
        ud.pass:='';
        ud.path:=area.xmodemdir;
        tmp1:=ud.path;
        tmp2:=ud.filename;
        addzipcomment(tmp1+tmp2,tmp1,tmp2);
          WriteLn('Thanks for the upload');
        getfsize(ud);
        AutoUploadGrant(Ud);
        addfile(ud);
        inc(urec.uploads);
        inc(newuploads);
        inc(gnuf);
        settimeleft(start_time+(((start_time-timeleft)*configset.timepercentbac) div 100));
      End;
    End;

  Procedure clear_batchdown;
                Begin
                        filesinbatch:=0;
                        fillchar(BatchDown,SizeOf(BatchDown),0);
                End;

  Function batchtotaltime:longint;
    Var cnt:Integer;
      Time:Integer;
    Begin
      time:=0;
      If filesinbatch>0 Then Begin
        For cnt:=1 To filesinbatch Do Begin
          time:=time+batchdown[cnt].mins;
        End;
        batchtotaltime:=time;
      End Else batchtotaltime:=0;
    End;

  Function totalpoints:longint;
    Var cnt:Integer;
      points:Integer;
    Begin
      points:=0;
    &nbs