{ PICS2C.INC - Pascal Integrated Communications System File Send Routines }
{ 5/25/87 vers 1.6 Copyright 1987 by Les Archambault}

overlay procedure SendXmodem(sendmode:char);
{ Send a file using Xmodem protocol }
  var
    OK,Ok_to_send: boolean;
    this: FilePtr;
    XfrName: FileName;
    XfrFile: untype_file;
    i,x,mm,ss,size,fnum,tot_size:integer;
    fnames:fname_array;
    fsize:array[1..20] of integer;
    name_buf:record_array;
    tot_send_time,ch_size:real;

procedure Send_a_File;
  var Arc_Recs,Recs128:integer;
  begin
      if in_library then this := LibBase
      else if in_arc then this:=ArcBase
      else this := DirBase;
    while (this <> nil) and (XfrName <> compress_fn(this^.fname)) do
      this := this^.next;
    if this <> nil
      then
        begin
          setsect(homdrv,homusr);
          log(5, XfrName);
          setsect(setdrv,setusr);
          if in_library
            then
              begin
                seek(libr_file, this^.index);
                setsect(homdrv,homusr);
                SendFile(xfrname,libr_file, this^.fsize,sendmode,ok_to_send);
              end
            else
            if in_arc then
              begin
                setsect(HomDrv,HomUsr);
                Position_Arcfile(xfrname,ok_to_send);
                Arc_recs:=trunc((Long_to_Real(hdr.size)+31.0)/128.0);
                if frac((Long_to_Real(hdr.size)+31.0)/128.0)>0 then
                  Arc_recs:=succ(Arc_recs);
                if ok_to_send then
                  begin
                    setsect(HomDrv,HomUsr);
                    SendFile(XfrName,Arc_File,Arc_Recs,Sendmode,ok_to_send);
                  end;
              end
            else
              begin
                Assign(XfrFile, XfrName);
                Reset(XfrFile);
                Recs128:=filesize(XfrFile);
                setsect(homdrv,homusr);
                SendFile(xfrname,XfrFile, Recs128,sendmode,ok_to_send);
                Close(XfrFile)
              end;
          SetSect(HomDrv, HomUsr);
          if OK_to_send then
            begin
              log(7, '');
              user_rec.download := succ(user_rec.download);
            end
          else log(8, '');
        end
      else
        begin
          writeln(USR, XfrName, ' not found.');
          ok_to_send:=false;
        end;
  end;

begin { SendXmodem }
 if (not test_bit(user_rec.flags,1)) and (maxavail>1024) then
  begin
    Ok_to_send:=true;
    if (sendmode='B') and ((in_library) or (in_arc))then
      begin
        writeln(usr,'No batch mode inside library/arc file.');
        ok_to_send:=false;
        writeln(usr);
      end;
    If (sendmode='B') and (not in_library) and (not in_arc)
    and (ok_to_send) then
      begin
       fnum:=0;  {total number of files to send}
       Writeln(usr);
       Writeln(usr,'Batch Mode enabled.');
       log(5,'BATCH');
       repeat
        xfrname:=prompt('Filenames (wildcards ok)',80,'ES');
        If (xfrname<>' ') and (ok_to_send) then
          begin
            This:=dirbase;
            xfrname:=expand_filename(xfrname);
            while (this<>nil) and (ok_to_send) do
              begin
                if fnum>20 then ok_to_send:=false;
                if (equal_names(xfrname,this^.fname)) and ok_to_send then
                  begin
                    fnum:=succ(fnum);
                    fnames[fnum]:=compress_fn(this^.fname);
                    fsize[fnum]:=this^.fsize;
                  end;
                this:=this^.next;
              end;
          end;     {xfrname<>' ' and ok to send}
       until (xfrname=' ') or (not mult_cmds) or (not ok_to_send) or (not online);
       if (not online) then ok_to_send:=false;
       if (fnum>0) and (fnum<21) and (ok_to_send) then
          begin
            tot_size:=0;  tot_send_time:=0;
            for i:=1 to fnum do
              begin
                size:=fsize[i] shr 3;  {divide by 8 recs / K}
                if fsize[i] mod 8<>0 then size:=succ(size);
                if odd(size) then size:=succ(size);
                tot_size:=tot_size+size;
                tot_send_time:=tot_send_time+(fsize[i] * 23.0 / rate);
              end;
            mm:= trunc(tot_send_time);
            ss:=round(60.0 * frac(tot_send_time));
            Writeln(usr);
            Writeln(usr,'Total xfer time ',mm,' minutes ',ss,' secs. at ',rate,' baud.');
            Writeln(usr,fnum,' File(s) require ',tot_size,'K (2K blocks).');
            Writeln(usr,'Abort with Ctrl X if space not available.');
            Writeln(usr,'Ready to Send...');
            Writeln(usr);
            Timer(time_on,time_left);
            If time_left<mm then
              begin
                Writeln(usr,'Not enough time for transfer.');
                ok_to_send:=false;
              end;
          end       {fnum>0 and fnum<26}
       else         {no filenames or too many files}
          begin
            ok_to_send:=false;
            if fnum>20 then Writeln(usr,'Max. of 20 Files.')
            else writeln(usr,'No files found...Aborting.');
          end;
       setsect(homdrv,homusr);
       If ok_to_send then test_download_ratio(ok_to_send,sendmode,fnum);
       While (ok_to_send) and (fnum>0) and (fnames[fnum]<>'') do  {build name record}
         begin
           xfrname:=fnames[fnum];
           for i:=1 to length(xfrname) do name_buf[i]:=ord(xfrname[i]);
           i:=succ(i);
           name_buf[i]:=0;                     {end of filename}
           ch_size:=fsize[fnum] * 128.0;
           str(ch_size:8:0,st);
           i:=succ(i);
           for x:=1 to length(st) do
             begin
               if st[x]<>' ' then
                 begin
                   name_buf[i]:=ord(st[x]);
                   i:=succ(i);
                 end;
             end;
           name_buf[i]:=ord(' ');               {terminate record size}
           for x:=i+1 to 128 do name_buf[x]:=0;   {fill out record}
           name_buf[127]:=lo(fsize[fnum]);
           name_buf[128]:=hi(fsize[fnum]);
           if (fnum>0) and (ok_to_send) then
             begin
               writeln;
               writeln('Sending ',xfrname);
               send_name(name_buf,ok_to_send);
               if ok_to_send then send_a_file;
               if ok_to_send then update_newin(xfrname);
             end;
           fnum:=pred(fnum);
           if (fnum=0) and (ok_to_send) then
             begin
               fillchar(name_buf,sizeof(name_buf),chr(0));
               send_name(name_buf,ok_to_send);
               if (ok_to_send) and (not clock) then
                for i:=1 to trunc(tot_send_time) do
                  begin
                    tick_a_min;
                    hour_count:=hour_count+10.0;
                  end;
             end;
         end; {ok to send, fnum>0 and fnames<>''}
         setsect(homdrv,homusr);
         writeln(usr);
         if ok_to_send then
           begin
             log(7,'BATCH');
             writeln(usr,'Batch Transfer Complete.');
           end
         else
           begin
             log(8,'BATCH');
             writeln(usr,'Aborting Batch Transfer.');
           end;
      end     {sendmode=B and not in library and ok to send}
    else
    if (Ok_to_send) and (sendmode<>'B') then
      begin
        setsect(homdrv,homusr);
        test_download_ratio(ok_to_send,sendmode,fnum);
        if ok_to_send then
          begin
            XfrName := prompt('File name', 12, 'ES');
            if xfrname<>' ' then xfrname:=correct_fn(xfrname)
            else xfrname:='';
            if XfrName <> '' then Send_a_file;
            if (ok_to_send) and (xfrname<>'') then update_newin(xfrname);
          end;
      end;
 end   {not restricted}
 else
   begin
     writeln(usr);
     if maxavail<1024 then write(usr,'Memory problem ');
     Writeln(usr,'Unable to send files.');
     writeln(usr);
   end;
end;    {Send Xmodem}

{end of PICS2c.inc }