home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FORUM25C.ZIP / TRANSFER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-26  |  26.9 KB  |  813 lines
  1. (* Note: This Code has the added External Protocols by Mr. Transistor & by  *)
  2. (* Spring King.  The original code is written by Ken Duda.  The new code is *)
  3. (* written by Spring King & Mr. Transistor.  There is 1 new feature in this *)
  4. (* version:  in an external protocal transfer, a time credit of 1/2 of the  *)
  5. (* time of the upload is given the user.  Ymodem & Xmodem use a different   *)
  6. (* formula, which can be modified in the file 'protocol.pas'.               *)
  7. (* This code is written to include the megalink and protocol too, but       *)
  8. (* but the menu selections 'M' is disabled because of a problem setting     *)
  9. (* the modem back up after using MegaLink.  If you are going to use Sealink *)
  10. (* you must have your modem setup as COM1 or else Sealink will NOT work.    *)
  11. (* Thanks to Omen Technologies (DSZ) and to whoever wrote Wxmodem, Sealink, *)
  12. (* and Megalink.                                                            *)
  13. (* Special thanks to Spring King, Mr. Transistor, and Ken Duda, the author  *)
  14. (* of Forum PC.                                                             *)
  15. (* call the Isengard BBS (312) 985-9699                                     *)
  16.  
  17. procedure batchdownload (typeoftransfer:char);
  18.  
  19.   function timeval (blocks:integer):real;
  20.   var min,sec:integer;
  21.       rsec:real;
  22.   begin
  23.   rsec:=1.38 * blocks * (1200/baudrate);
  24.   timeval:=rsec/60.0;
  25.   end;
  26.  
  27.   function checkfile(pointsleft:integer;num:integer):boolean;
  28.   var ud:udrec;
  29.   fname:lstr;
  30.   f:file;
  31.   begin
  32.     writeln;
  33.     if num=0 then
  34.      begin
  35.        checkfile:=false;
  36.        exit;
  37.      end;
  38.     seekudfile (num);
  39.     read (udfile,ud);
  40.     if (not sponsoron) and (ud.points>pointsleft) then begin
  41.       writeln ('Sorry, that file requires ',ud.points,' points.');
  42.       checkfile:=false;
  43.       exit
  44.     end;
  45.     if (ud.newfile) and (not sponsoron) then begin
  46.       writeln ('Sorry, that is a new file and must be validated.');
  47.       checkfile:=false;
  48.       exit
  49.     end;
  50.     if (ud.specialfile) and (not sponsoron) then begin
  51.       writeln ('Sorry, downloading that file requires special permission.');
  52.       checkfile:=false;
  53.       exit
  54.     end;
  55.     fname:=getfname(ud.path,ud.filename);
  56.     assign (f,fname);
  57.     reset (f);
  58.     close (f);
  59.     iocode:=ioresult;
  60.     if iocode<>0 then
  61.       begin
  62.         fileerror ('BATCH DOWNLOAD',fname);
  63.         checkfile:=false;
  64.         exit
  65.       end;
  66.     checkfile:=true;
  67.   end;
  68.  
  69.   procedure getfileinfo (var num:integer;var totalminsleft,realtime:real;
  70.     var mins,fsize,actualsize:integer;var sender:mstr;
  71.     var whensent,ratedwhen:longint;var nameoffile:sstr;var filepath:string;
  72.     var filepoints:integer;var filedescrip:lstr;var timesdownloaded:integer;
  73.     var isitnew,isitspecial:boolean);
  74.  
  75.   var ud:udrec;
  76.   f:file;
  77.   fname:lstr;
  78.   totaltime:sstr;
  79.   secs:integer;
  80.  
  81.   begin
  82.     seekudfile (num);
  83.     read (udfile,ud);
  84.     fname:=getfname (ud.path,ud.filename);
  85.     assign (f,fname);
  86.     reset (f);
  87.     fsize:=filesize(f);
  88.     actualsize:=fsize;
  89.     close (f);
  90.     totaltime:=minstr(fsize);
  91.     mins:=valu(copy(totaltime,1,pos(':',totaltime)-1));
  92.     secs:=valu(copy(totaltime,pos(':',totaltime)+1,2));
  93.     if secs<>0 then realtime:=mins+(secs/60)
  94.     else realtime:=mins;
  95.     if mins=0 then mins:=1;
  96.     if ((mins>totalminsleft) and (not sponsoron)) then begin
  97.       writestr ('Sorry, you don''t have enough time left!');
  98.       mins:=-5;
  99.       exit
  100.     end;
  101.     if (mins-5>timetillevent) then begin
  102.       writestr ('Sorry, the timed event is coming up too soon!');
  103.       mins:=-5;
  104.       exit
  105.     end;
  106.     writeln (^B^M'Filename:       '^S,ud.filename);
  107.     writeln ('Uploaded by:    '^S,ud.sentby);
  108.     write ('Downloaded:     '^S,ud.downloaded,' time');
  109.     if ud.downloaded=1 then writeln else writeln ('s');
  110.     fsize:=(fsize+7) div 8;
  111.     if fsize = 0 then fsize := 1;
  112.     writeln ('Blocks to send: '^S,fsize);
  113.     writeln ('Transfer time:  '^S,totaltime);
  114.     writeln;
  115.     sender:=ud.sentby;
  116.     whensent:=ud.when;
  117.     ratedwhen:=ud.whenrated;
  118.     nameoffile:=ud.filename;
  119.     filepath:=ud.path;
  120.     filepoints:=ud.points;
  121.     filedescrip:=ud.descrip;
  122.     timesdownloaded:=ud.downloaded;
  123.     isitnew:=ud.newfile;
  124.     isitspecial:=ud.specialfile;
  125.   end;
  126.  
  127.   procedure check1(var abort:boolean);
  128.         begin
  129.           writestr ('Abort this batch transfer? *');
  130.           if yes then abort:=true
  131.           else abort:=false;
  132.         end;
  133.  
  134.   procedure check2(var abort,readytostart:boolean);
  135.         begin
  136.  
  137.             abort:=false;
  138.             readytostart:=false;
  139.             writestr('Ready to start batch transfer? *');
  140.             input:=copy(input,1,1);
  141.             if input='Y' then readytostart:=true
  142.             else if input='y' then readytostart:=true;
  143.             if readytostart then exit
  144.             else
  145.             writeln;
  146.             check1 (abort);
  147.          end;
  148.  
  149.  
  150.   type textarray = array[1..9] of string;
  151.      numberarray = array[1..9] of integer;
  152.      realarray = array[1..9] of real;
  153.      sentbyarray = array[1..9] of mstr;
  154.      whenarray = array[1..9] of longint;
  155.      filenamearray = array[1..9] of sstr;
  156.      patharray = array[1..9] of string[50];
  157.      descriparray = array[1..9] of lstr;
  158.      booleanarray = array[1..9] of boolean;
  159.  
  160.   var   totalblocks,b,pointsleft,points,num,mins,fsize,totalbytes,actualsize,
  161.           filecounter,loopcounter,starttime,endtime,transfertime,estimatedtime:integer;
  162.   var   mins2,minsleft,timetotal:real;
  163.       name,fname:string;
  164.       f:file of byte;
  165.       dirsave,command_line,switches,blocks,minutes:lstr;
  166.       baudst,commst:mstr;
  167.       singlecharacter,batchxfer:char;
  168.       autohang,abort,readytostart:boolean;
  169.       fnames:textarray;
  170.       textname:textarray;
  171.       fsizes,NUMB,filepoints,timesdownloaded,areanumber:numberarray;
  172.       ftime:realarray;
  173.       sender:sentbyarray;
  174.       whensent,ratedwhen:whenarray;
  175.       nameoffile:filenamearray;
  176.       filepath:patharray;
  177.       filedescrip:descriparray;
  178.       isitnew,isitspecial:booleanarray;
  179.       batchfile:text;
  180.   begin
  181.     case typeoftransfer of
  182.       'B':batchxfer:='Y';
  183.       'Z':batchxfer:='Z';
  184.       else exit;
  185.       end;
  186.     writeln;
  187.     writeln (batchxfer,'Modem Batch Download Selected');
  188.     getdir (0, dirsave);   (* drive: 0 = cur. 1 = A: etc. - save cur. dir. *)
  189.     str (baudrate:3, baudst);  (* cnvt baud and comm port to strings *)
  190.     str (usecom:1, commst);
  191.     filecounter:=1;
  192.     pointsleft:=urec.udpoints;
  193.     minsleft:=timeleft;
  194.     totalbytes:=0;
  195.     readytostart:=false;
  196.     repeat
  197.       tab ('Points available: '^S+strr(pointsleft),24);
  198.       writeln (^R'Time available: '^S+strr(round(minsleft)));
  199.       estimatedtime:=timeleft-round(minsleft);
  200.       if estimatedtime<1 then estimatedtime:=0;
  201.       tab ('Total D/L Time: '^S+strr(estimatedtime),24);
  202.       writeln (^R'Batch file #: '^S,filecounter);
  203.       writeln;
  204.       num:=getfilenumbatch('Batch Download');
  205.       input:='';
  206.       if num=0 then if filecounter = 1 then
  207.        begin
  208.          check1(abort);
  209.          if abort then exit;
  210.        end;
  211.  
  212.       if num=0 then if filecounter >1 then if filecounter <10 then
  213.         begin
  214.          check2(abort,readytostart);
  215.          if abort then exit;
  216.          if readytostart then writeln(^M^J'Starting Batch Download.')
  217.         end;
  218.  
  219.       if not checkfile (pointsleft,num) then if filecounter =1 then exit;
  220.  
  221.       if checkfile (pointsleft,num) then
  222.        begin
  223.         if tempsysop then
  224.          begin
  225.            ulvl:=regularlevel;
  226.            tempsysop:=false;
  227.            writeurec;
  228.            bottomline
  229.          end;
  230.         getfileinfo(num,minsleft,mins2,mins,fsize,actualsize,sender[filecounter],
  231.         whensent[filecounter],ratedwhen[filecounter],nameoffile[filecounter],
  232.         filepath[filecounter],filepoints[filecounter],filedescrip[filecounter],
  233.         timesdownloaded[filecounter],isitnew[filecounter],
  234.         isitspecial[filecounter]);
  235.         areanumber[filecounter]:=curarea;
  236.         if (mins=-5) and (filecounter =1) then exit
  237.         else if mins=-5 then readytostart:=true;
  238.         if mins<>-5 then begin
  239.           if (filepoints[filecounter]>0) and (not sponsoron) then
  240.               pointsleft:=pointsleft-filepoints[filecounter];
  241.           fnames[filecounter]:=getfname(filepath[filecounter],nameoffile[filecounter]);
  242.           textname[filecounter]:=nameoffile[filecounter];
  243.           fsizes[filecounter]:=fsize;
  244.           totalbytes:=totalbytes+actualsize;
  245.           ftime[filecounter]:=mins2;
  246.           numb[filecounter]:=num;
  247.           minsleft:=minsleft-mins2;
  248.           filecounter:=filecounter+1;
  249.           if filecounter=10 then readytostart:=true
  250.         end;
  251.       end;
  252.   until readytostart;
  253.  
  254.   if readytostart then begin
  255.     assign (batchfile,'batch.xfr');
  256.     rewrite (batchfile);
  257.     loopcounter:=1;
  258.     timetotal:=0;
  259.     totalblocks:=0;
  260.     repeat
  261.       if fsizes[loopcounter]>1 then blocks:=' 1 K Blocks'
  262.       else blocks:='Block';
  263.       if ftime[loopcounter]>1.0 then minutes:=' minutes'
  264.       else minutes:='minute';
  265.       totalblocks:=totalblocks+fsizes[loopcounter];
  266.       timetotal:=timetotal+ftime[loopcounter];
  267.       writeln (batchfile,fnames[loopcounter]);
  268.       loopcounter:=loopcounter+1;
  269.     until loopcounter=filecounter;
  270.   textclose (batchfile);
  271.   loopcounter:=1;
  272.   if ansigraphics in urec.config then begin
  273.     writestr ('┌─────────────────────────────────────────────────────────────┐');
  274.     writestr ('│                  Batch Download Statistics                  │');
  275.     writestr ('├─────────────────────────────────────────────────────────────┤');
  276.     writestr ('│'^S' #  Filename        Kbytes    Time to d/l (minutes)'^R'          │');
  277.     writestr ('├─────────────────────────────────────────────────────────────┤');
  278.  
  279.  
  280.     end
  281.   else begin
  282.     writestr ('+-------------------------------------------------------------+');
  283.     writestr ('!                 Batch Download Statistics                   !');
  284.     writestr ('+-------------------------------------------------------------+');
  285.     writestr ('! #  Filename         Kbytes     Time to d/l (minutes)        !');
  286.     writestr ('+-------------------------------------------------------------+');
  287. end;
  288.   repeat
  289.     if ansigraphics in urec.config then begin
  290.        write (^R'│ '^S);
  291.        tab (strr(loopcounter),3);
  292.        tab (nameoffile[loopcounter],17);
  293.        tab (strr(round(fsizes[loopcounter])),11);
  294.        tab (minstr(round(fsizes[loopcounter]*8)),29);
  295.        writeln (^R'│');
  296.        end
  297.      else begin
  298.        write ('! ');
  299.        tab (strr(loopcounter),3);
  300.        tab (nameoffile[loopcounter],18);
  301.        tab (strr(round(fsizes[loopcounter])),12);
  302.        tab (minstr(round(fsizes[loopcounter]*8)),27);
  303.        writeln ('!');
  304.        end;
  305.      loopcounter:=loopcounter+1;
  306.   until loopcounter=filecounter;
  307.   if ansigraphics in urec.config then begin
  308.         writestr('├─────────────────────────────────────────────────────────────┤');
  309.         write (^R'│');
  310.         tab (^P+'Total Files:',14);
  311.         tab (^S+strr(filecounter-1),4);
  312.         tab (^P+'Total 1k blocks:',18);
  313.         tab (^S+strr(totalblocks),6);
  314.         tab (^P+'Apprx. d/l time:',18);
  315.         tab (^S+minstr(totalbytes-round((totalbytes * 0.1))),7);
  316.         writeln (^R'│');
  317.         writestr('└─────────────────────────────────────────────────────────────┘');
  318.         end
  319.   else begin
  320.         writestr('+-------------------------------------------------------------+');
  321.         write ('!');
  322.         tab ('Total Files:',13);
  323.         tab (strr(filecounter-1),3);
  324.         tab ('Total 1k blocks:',17);
  325.         tab (strr(totalblocks),5);
  326.         tab ('Apprx. d/l time:',17);
  327.         tab (minstr(totalbytes-round((totalbytes * 0.1))),6);
  328.         writeln ('!');
  329.         writestr('+-------------------------------------------------------------+');
  330.       end;
  331.   writeln;
  332.     writestr('Automatically DISCONNECT after the download? (y/N) *');
  333.     if yes then autohang:=true
  334.     else autohang:=false;
  335.     writeln;
  336.     writeln (batchxfer,'Modem Batch Download. [Ctrl-X][Ctrl-X][Enter] a few times to abort');
  337. {  switches:=' port '+commst+' speed '+baudst+' s'; }
  338.     switches:=' port '+commst+' speed '+baudst+' handshake both s';
  339.   if batchxfer='Y' then
  340.     switches:=switches+'b -k @'+dirsave+'\batch.xfr';
  341.   if batchxfer='Z' then
  342.     switches:=switches+'z @'+dirsave+'\batch.xfr';
  343.   command_line:='DSZ.COM';
  344.   starttime:=timer;
  345.   runext(b,command_line,switches);
  346.   endtime:=timer;
  347.   if endtime<starttime then endtime:=endtime+1440;
  348.   transfertime:=endtime-starttime;
  349.   if b=1 then b:=2;
  350.     beepbeep(b);
  351.     loopcounter:=1;
  352.     repeat
  353.       if transfertime-round(ftime[loopcounter])>0 then
  354.       begin
  355.         transfertime:=transfertime-round(ftime[loopcounter]);
  356.         writelog (15,5,textname[loopcounter]);
  357.         setareareset (areanumber[loopcounter]);
  358.         seekudfile(numb[loopcounter]);
  359.         fname:=getfname(filepath[loopcounter],nameoffile[loopcounter]);
  360.         assign (f,fname);
  361.         reset (f);
  362.         ud.sentby:=sender[loopcounter];
  363.         ud.when:=whensent[loopcounter];
  364.         ud.whenrated:=ratedwhen[loopcounter];
  365.         ud.filename:=nameoffile[loopcounter];
  366.         ud.path:=filepath[loopcounter];
  367.         ud.points:=filepoints[loopcounter];
  368.         ud.filesize:=filesize (f);
  369.         ud.descrip:=filedescrip[loopcounter];
  370.         ud.downloaded:=timesdownloaded[loopcounter]+1;
  371.         ud.newfile:=isitnew[loopcounter];
  372.         ud.specialfile:=isitspecial[loopcounter];
  373.         urec.downloads:=urec.downloads+1;
  374.         if (ud.points>0) and (not sponsoron) then
  375.          urec.udpoints:=urec.udpoints-ud.points;
  376.         write (udfile,ud);
  377.         writeurec;
  378.         close (f);
  379.         loopcounter:=loopcounter+1;
  380.        end
  381.       else loopcounter:=filecounter;
  382.       until loopcounter=filecounter;
  383.       writeln (^B'You now have ',numthings (urec.udpoints,'point','points'),' left in your account.');
  384.       chdir (dirsave);
  385.       if autohang then disconnect;
  386.   end;
  387. end;
  388.  
  389.  
  390. (* Note: The following builds a command line to invoke the various external *)
  391. (* protocols directly.  This should allow ERRORLEVEL to be returned cor-    *)
  392. (* rectly and allow externals to be used on a Multi-Tasking system.         *)
  393. (* DSZ returns ERRORLEVEL correctly but WXmodem does not.  - Mr. Transistor *)
  394. (* & Spring King.                                                           *)
  395.  
  396.   function doext (mode,proto:char;uddir,fn:lstr;baud,comm:integer):integer;
  397.   var cmdline,switches,dirsave,cddir:lstr;
  398.       baudst,commst:mstr;
  399.       retcd:integer;
  400.   begin
  401.     getdir (0, dirsave);   (* drive: 0 = cur. 1 = A: etc. - save cur. dir. *)
  402.     if uddir[length(uddir)]='\'
  403.      then
  404.       cddir:=copy(uddir,1,length(uddir)-1)
  405.      else
  406.       cddir:=uddir;
  407.     chdir (cddir);         (* cd to rcv/snd dir *)
  408.     str (baud:3, baudst);  (* cnvt baud and comm port to strings *)
  409.     str (comm:1, commst);
  410.     if mode='R' then begin        (* receive stuff *)
  411.       case proto of
  412.         'W':cmdline:=dirsave+'\WXMODEM.COM';
  413.         'M':cmdline:=dirsave+'\MEGALINK.COM';
  414.         'S':cmdline:=dirsave+'\CLINK.EXE';
  415.         'Z':cmdline:=dirsave+'\DSZ.EXE';
  416.         'J':cmdline:=dirsave+'\JModem.COM';
  417.       end
  418.     end;
  419.     if mode='R' then begin        (* receive stuff *)
  420.       case proto of
  421.         'W':switches:=' -b '+baudst+' -l com'+commst+' -p W -r -f '+fn+' -c';
  422.         'M':switches:=' PORT '+commst+' SPEED '+baudst+' RM';
  423.         'S':switches:=' R';
  424.         'Z':switches:=' port '+commst+' speed '+baudst+' rz '+cddir+'\'+fn;
  425.         'J':switches:=' R'+commst+' '+fn;
  426.       end;
  427.     end;
  428.     if mode='S' then begin        (* xmit stuff *)
  429.       case proto of
  430.         'W':cmdline:=dirsave+'\WXMODEM.COM';
  431.         'M':cmdline:=dirsave+'\MEGALINK.COM';
  432.         'S':cmdline:=dirsave+'\CLINK.EXE';
  433.         'J':cmdline:=dirsave+'\JModem.Com';
  434.       end
  435.     end;
  436.     if mode='S' then begin        (* xmit stuff *)
  437.       case proto of
  438.         'W':switches:=' -s -b '+baudst+' -l com'+commst+' -p y -f '+fn;
  439.         'M':switches:=' PORT '+commst+' SPEED '+baudst+' SM '+fn;
  440.         'S':switches:=' T '+fn;
  441.         'J':switches:=' R'+commst+' '+fn;
  442.       end
  443.     end;
  444.     runext (retcd, cmdline,switches);  (* actually do external call... *)
  445.     chdir (dirsave);             (* back from whence we came... *)
  446.     setparam(usecom,baudrate,parity);
  447.     doext:=retcd;
  448.   end;
  449.  
  450.  
  451.  
  452.  
  453. procedure download (autoselect:integer);
  454.   var totaltime:sstr;
  455.       num,fsize,mins:integer;
  456.       ud:udrec;
  457.       fname:lstr;
  458.       autohang,ymodem:boolean;
  459.       i,b:integer;
  460.       f:file;
  461.       extrnproto:char;
  462.   begin
  463.     if not allowxfer then exit;
  464.     if nofiles then exit;
  465.     ymodem:=false;
  466.     extrnproto:='N';
  467.     i:=menu('Protocol','PROTO','XYZBWSMQJ');
  468.     if hungupon then exit;
  469.     case i of
  470.       1:ymodem:=false;
  471.       2:ymodem:=true;
  472.       3:extrnproto:='Z';
  473.       4:extrnproto:='B';
  474.       5:extrnproto:='W';
  475.       6:extrnproto:='S';
  476.       7:extrnproto:='M';
  477.       8:exit;
  478.       9:extrnproto:='J';
  479.     end;
  480.     if (extrnproto ='B') or (extrnproto='Z') then
  481.       begin
  482.        batchdownload (extrnproto);
  483.        exit;
  484.       end;
  485.     if autoselect=0
  486.       then num:=getfilenum('download')
  487.       else num:=autoselect;
  488.     if num=0 then exit;
  489.     writeln;
  490.     seekudfile (num);
  491.     read (udfile,ud);
  492.     if (not sponsoron) and (ud.points>urec.udpoints) then begin
  493.       writeln ('Sorry, that file requires ',ud.points,' points.');
  494.       exit
  495.     end;
  496.     if (ud.newfile) and (not sponsoron) then begin
  497.       writeln ('Sorry, that is a new file and must be validated.');
  498.       exit
  499.     end;
  500.     if (ud.specialfile) and (not sponsoron) then begin
  501.       writeln ('Sorry, downloading that file requires special permission.');
  502.       exit
  503.     end;
  504.     if tempsysop then begin
  505.       ulvl:=regularlevel;
  506.       tempsysop:=false;
  507.       writeurec;
  508.       bottomline
  509.     end;
  510.  
  511. (*    if extrnproto='W' then
  512.  
  513. {If you want to re-enable WXmodem, then just remove the lines from the next}
  514. {   begin through to the next end, and the above if statement.}
  515.  
  516.     begin
  517.          writestr ('I am sorry, but WXmodem bombs when a filetransfer is aborted.');
  518.          writestr ('If the author fixes this error, then WXmodem will be re-enabled.');
  519.          writeln ('Transfer Aborted! '^G);
  520.          exit;
  521.     end;   *)
  522.     fname:=getfname(ud.path,ud.filename);
  523.     assign (f,fname);
  524.     reset (f);
  525.     iocode:=ioresult;
  526.     if iocode<>0 then
  527.       begin
  528.         fileerror ('DOWNLOAD',fname);
  529.         exit
  530.       end;
  531.     fsize:=filesize(f);
  532.     close (f);
  533.     totaltime:=minstr(fsize);
  534.     mins:=valu(copy(totaltime,1,pos(':',totaltime)-1));
  535.     if ((mins>timeleft) and (not sponsoron)) then begin
  536.       writestr ('Sorry, you don''t have enough time left!');
  537.       exit
  538.     end;
  539.     if (mins-5>timetillevent) then begin
  540.       writestr ('Sorry, the timed event is coming up too soon!');
  541.       exit
  542.     end;
  543.     writeln (^B^M'Filename:       '^S,ud.filename);
  544.     writeln ('Uploaded by:    '^S,ud.sentby);
  545.     write ('Downloaded:     '^S,ud.downloaded,' time');
  546.     if ud.downloaded=1 then writeln else writeln ('s');
  547.     if ymodem then fsize:=(fsize+7) div 8;
  548.     if fsize = 0 then fsize:= 1;
  549.     writeln ('Blocks to send: '^S,fsize);
  550.     writeln ('Transfer time:  '^S,totaltime);
  551.     writeln (^M'CRC use will be automatically selected');
  552.     writeln;
  553.     writestr('Automatically DISCONNECT after the download? (Y/N) *');
  554.     if upcase(input[1]) ='Y' then autohang:=true
  555.     else autohang:=false;
  556.     case extrnproto of
  557.          'S':tab ('Sealink',7);
  558.          'W':tab ('WXmodem',7);
  559.          'M':tab ('Megalink',8);
  560.          'J':tab ('JModem',6);
  561.     end;
  562.     if ymodem then write ('Ymodem') else if extrnproto='N' then
  563.        write ('Xmodem-CRC');
  564.     writeln (' transmit ready.  [Ctrl-X][Ctrl-X][Enter] a few times to abort');
  565.     if extrnproto='N' then begin
  566.       b:=protocolxfer (true,false,ymodem,fname);
  567.       beepbeep (b)
  568.     end;
  569.     if extrnproto<>'N' then begin
  570.       b:=doext('S',extrnproto,ud.path,ud.filename,baudrate,usecom);
  571.       if b<>0 then b:=2;
  572.       modeminlock:=false;
  573.       beepbeep (b)
  574.     end;
  575.     if (b=0) then begin
  576.       writelog (15,1,fname);
  577.       ud.downloaded:=ud.downloaded+1;
  578.       urec.downloads:=urec.downloads+1;
  579.       seekudfile (num);
  580.       write (udfile,ud);
  581.       if (ud.points>0) and (not sponsoron) then begin
  582.         urec.udpoints:=urec.udpoints-ud.points;
  583.         writeln (^B'You now have ',
  584.                  numthings (urec.udpoints,'point','points'),'.')
  585.       end;
  586.       writeurec
  587.     end;
  588.    if autohang then disconnect;
  589.   end;
  590.  
  591.   procedure typefile;
  592.   var num:integer;
  593.       ud:udrec;
  594.       fname:lstr;
  595.       f:text;
  596.       k:char;
  597.   begin
  598.     if nofiles then exit;
  599.     num:=getfilenum('type');
  600.     if num=0 then exit;
  601.     writeln;
  602.     seekudfile (num);
  603.     read (udfile,ud);
  604.     if (not sponsoron) and (ud.points>urec.udpoints) then begin
  605.       writeln ('Sorry, that file requires ',ud.points,' points.');
  606.       exit
  607.     end;
  608.     if (ud.newfile) and (not sponsoron) then begin
  609.       writeln ('Sorry, that is a new file and must be validated.');
  610.       exit
  611.     end;
  612.     if (ud.specialfile) and (not sponsoron) then begin
  613.       writeln ('Sorry, downloading that file requires special permission.');
  614.       exit
  615.     end;
  616.     if tempsysop then begin
  617.       ulvl:=regularlevel;
  618.       tempsysop:=false;
  619.       writeurec;
  620.       bottomline
  621.     end;
  622.     fname:=getfname(ud.path,ud.filename);
  623.     assign (f,fname);
  624.     reset (f);
  625.     iocode:=ioresult;
  626.     if iocode<>0 then
  627.       begin
  628.         fileerror ('TYPEFILE',fname);
  629.         exit
  630.       end;
  631.     writeln (^B^M'Filename:       '^S,ud.filename);
  632.     writeln ('Uploaded by:    '^S,ud.sentby);
  633.     if (ud.points>0) and (not sponsoron) then begin
  634.       write (^B^M'NOTE: When the transfer begins, you ',
  635.                ^M'      will be charged ',ud.points,' point');
  636.       if ud.points<>1 then write ('s');
  637.       writeln ('!')
  638.     end;
  639.     writeln (^B^M'Press any key to begin the transfer,',
  640.                ^M'or [Ctrl-X] to abort...'^M);
  641.     k:=waitforchar;
  642.     if (k=^X) or (upcase(k)='X') then begin
  643.       textclose (f);
  644.       writeln (^B^M'Aborted!');
  645.       exit
  646.     end;
  647.     while not (eof(f) or break) do begin
  648.       read (f,k);
  649.       if k=^M then writeln else if k<>^J then write (k)
  650.     end;
  651.     textclose (f);
  652.     if (ud.points>0) and (not sponsoron) then begin
  653.       urec.udpoints:=urec.udpoints-ud.points;
  654.       writeln (^B'You now have ',
  655.                numthings (urec.udpoints,'point','points'),'.')
  656.     end;
  657.     writeurec
  658.   end;
  659.  
  660.   procedure upload;
  661.   var ud:udrec;
  662.       ok,crcmode,ymodem:boolean;
  663.       i,b,starttime,endtime,transfertimecredit:integer;
  664.       dirsave,cddir,fn:lstr;
  665.       time:string;
  666.       extrnproto:char;
  667.       f:file;
  668.   begin
  669.     if not allowxfer then exit;
  670.     if timetillevent<30 then begin
  671.       writestr (
  672.    'Sorry, uploads are not allowed within one half hour of the timed event!');
  673.       exit
  674.     end;
  675.     ok:=false;
  676.     write ('Free disk space: ');
  677.     writefreespace (area.xmodemdir);
  678.     writeln;
  679.     repeat
  680.       writestr ('Target filename:');
  681.       if length(input)=0 then exit;
  682.       if not validfname(input) then begin
  683.         writeln ('Invalid filename!');
  684.         exit
  685.       end;
  686.       ud.filename:=input;
  687.       ud.path:=area.xmodemdir;
  688.       fn:=getfname(ud.path,ud.filename);
  689.       if hungupon then exit;
  690.       if exist(fn)
  691.         then writeln ('Sorry!  File exists!')
  692.         else ok:=true
  693.     until ok;
  694.     crcmode:=false;
  695.     ymodem:=false;
  696.     extrnproto:='N';
  697.     i:=menu('Protocol','PROTO','XYZWSMQJ');
  698.     if hungupon then exit;
  699.     case i of
  700.       1:ymodem:=false;
  701.       2:ymodem:=true;
  702.       3:extrnproto:='Z';
  703.       4:extrnproto:='W';
  704.       5:extrnproto:='S';
  705.       6:extrnproto:='M';
  706.       7:exit;
  707.       8:extrnproto := 'J';
  708.     end;
  709.  
  710. { If you want to re-enable WXmodem, then just remove the lines from the next
  711.   if statement through to the next end.}
  712. {    if extrnproto='W' then
  713.     begin
  714.          writestr ('I am sorry, but WXmodem bombs when a filetransfer is aborted.');
  715.          writestr ('If the author fixes this error, then WXmodem will be re-enabled.');
  716.          writeln ('Transfer Aborted! '^G);
  717.          exit;
  718.     end;   }
  719.  
  720.     if extrnproto='N' then if ymodem then crcmode:=true
  721.      else begin
  722.       writestr ('CRC Mode? *');
  723.       crcmode:=yes
  724.      end;
  725.     case extrnproto of
  726.          'S':tab ('Sea Link',8);
  727.          'Z':tab ('Zmodem',6);
  728.          'W':tab ('WXmodem',7);
  729.          'M':tab ('Megalink',8);
  730.          'B':tab ('Ymodem Batch',12);
  731.          'J':tab ('Jmodem',6);
  732.     end;
  733.     if ymodem then write ('Ymodem') else if extrnproto='N' then
  734.        write ('Xmodem');
  735.     if crcmode then write ('-CRC');
  736.     writeln (' receive ready.  [Ctrl-X][Ctrl-X][Enter] a few times to abort');
  737.     if tempsysop then begin
  738.       ulvl:=regularlevel;
  739.       tempsysop:=false;
  740.       writeurec;
  741.       bottomline
  742.     end;
  743.     starttime:=timer;
  744.     if extrnproto='N' then begin
  745.       b:=protocolxfer (false,crcmode,ymodem,fn);
  746.       beepbeep (b)
  747.     end
  748.     else begin
  749.       b:=doext('R',extrnproto,ud.path,ud.filename,baudrate,usecom);
  750.       endtime:=timer;
  751.       modeminlock:=false;
  752.       modemoutlock:=false;
  753.       if b<>0 then b:=2;
  754.       beepbeep (b)
  755.     end;
  756.     if b>=1 then
  757.        begin
  758.             if exist (fn) then
  759.             begin
  760.                assign(f, fn);
  761.                erase (f);
  762.             end;
  763.        exit;
  764.        end;
  765.     if b=0 then begin
  766.       buflen:=50;
  767.       writestr ('If your upload failed & Forum thinks otherwise, then please');
  768.       writestr ('enter ''BAD TRANSFER'' at the Description prompt.  Thanks.');
  769.       writeln;
  770.       writestr ('                       0        1         2         3         4         5');
  771.       writestr ('50 Characters Maximum! 1---!----0----!----0----!----0----!----0----!----0');
  772.       writestr ('Description of upload: &');
  773.       if input='BAD TRANSFER' then
  774.          begin
  775.               if exist(fn) then
  776.                 begin
  777.                    assign(f, fn);
  778.                    erase (f);
  779.                 end;
  780.               exit;
  781.          end;
  782.       writelog (15,2,fn);
  783.       ud.descrip:=input;
  784.       ud.sentby:=unam;
  785.       ud.when:=now;
  786.       ud.whenrated:=now;
  787.       ud.points:=0;
  788.       ud.downloaded:=0;
  789.       ud.newfile:=true;
  790.       ud.specialfile:=false;
  791.       ud.downloaded:=0;
  792.       writeln ('Thanks for uploading!');
  793.       if extrnproto<>'N' then
  794.       begin
  795.            if endtime<starttime then endtime:=endtime+1440;
  796.            transfertimecredit:=(endtime-starttime)div 2;
  797.            settimeleft(timeleft+transfertimecredit);
  798.            writeln;
  799.            str(transfertimecredit, time);
  800.            writeln('Upload time credit: ',time,' minutes.');
  801.       end;
  802.       str(timeleft, time);
  803.       writeln;
  804.       writeln('You now have ',time,' minutes left!');
  805.       getfsize (ud);
  806.       addfile (ud);
  807.       urec.uploads:=urec.uploads+1;
  808.       newuploads:=newuploads+1
  809.     end;
  810.   end;
  811.  
  812.  
  813.