{ PICS2D.INC - Pascal Integrated Communications System } { 6/10/87 vers 1.6 Copyright 1987 by Les Archambault} overlay procedure RecvXmodem(mode:char); { Receive a file using Xmodem protocol } var filecount,i,recs,mm,ss,temdrv,temusr,free,size: integer; XfrName: FileName; abort_batch,in_conference:boolean; Fnames:fname_array; this:sectptr; Procedure Get_File(var xfrname:filename; var abort_batch:boolean;mode:char; in_conference:boolean); var i, block,mm,ss : integer; XfrFile: untype_file; this:SectPtr; file_exists:boolean; tr_time:real; Begin if XfrName <> '' then begin block:=1; file_exists:=false; while (length(XfrName) - pos('.', XfrName)) < 2 do XfrName := XfrName + '-'; setsect(homdrv,homusr); log(4, XfrName); this:=SectBase; OK:=true; writeln(usr); Writeln(usr,'Checking for duplicates.. wait..'); while (this<>nil) and OK do begin if (this^.sectname='SYSTEM') or (this^.SectAccs>=250) then this:=this^.next; if this<>nil then begin SetSect(this^.SectDrive,this^.SectUser); Assign(XfrFile, XfrName); {$I-} Reset(XfrFile) {$I+}; OK := (IOresult <> 0); close(XfrFile); this:=this^.next; end; end; if (not OK) then File_exists:=true; SetSect(RcvDrv, RcvUsr); if OK then begin {$I-} Rewrite(XfrFile) {$I+}; { Try to open file } OK := (IOresult = 0); if OK then begin setsect(homdrv,homusr); free:=diskfree(rcvdrv,rcvusr); if mode<>'B' then begin if in_conference then writeln(usr, Xfrname, ' will be received in the conference area.') else writeln(USR, XfrName, ' will be received in a private area.'); writeln(USR, free, 'k disk space available. Please cancel if file is too large.'); writeln(USR, 'To cancel, type CTL-X.'); writeln(USR, 'Ready to receive...'); end; RecvFile(xfrname,xfrfile,block,mode,abort_batch); if OK then OK := (FileSize(XfrFile) > 0); if OK then begin tr_time := filesize(xfrfile) * 23.5 / rate; mm := trunc(tr_time); extra_time := extra_time + mm; end; close(XfrFile); if OK then begin if not in_conference then begin SetSect(homdrv,homusr); {set up for loading overlay} hide_release(XfrName, private,rcvdrv,rcvusr); end; end else begin Erase(XfrFile); writeln(USR, 'Transfer cancelled. Incomplete file deleted.'); if mode='B' then abort_batch:=true; end; end {second OK} else begin writeln(USR, 'Cannot create ', XfrName, '.'); if mode='B' then abort_batch:=true; end; end {first OK} else begin Close(XfrFile); writeln(USR,'Thanks, but there is already a copy of ', XfrName, ' in the System.'); if mode='B' then abort_batch:=true; end; SetSect(HomDrv, HomUsr); if OK then begin log(7, ''); if (not clock) then for i:=1 to mm do begin tick_a_min; hour_count:=hour_count+10.0; end; user_rec.upload := succ(user_rec.upload); end else begin if file_exists then log(8, 'File Exists') else log(8,''); if mode='B' then abort_batch:=true; end; end; {xfrname<>''} end; begin { RecvXmodem } if (diskfree(rcvdrv,rcvusr)>maxfree_uplds) and (maxavail>1024) then begin filecount:=0; abort_batch:=false; xfrname:=' '; {set up} in_conference:=false; this:=sectbase; while (this<>nil) and (this^.sectname<>sectreq) do this:=this^.next; if this^.sectname=sectreq then begin i:=this^.sectconf; {conference number} in_conference:= test_bit(user_rec.conf_flags,i) end; if in_conference then begin TemDrv:=RcvDrv; TemUsr:=RcvUsr; {remember for later} RcvDrv:=setDrv; RcvUsr:=setUsr; end; if mode='B' then begin log(4,'BATCH'); free:=diskfree(rcvdrv,rcvusr); for i:=1 to 20 do fnames[i]:=''; {empty array} writeln(usr,'Batch Mode Enabled - ',free,'K space available'); writeln(usr,'Max. of 20 files may be transfered.'); writeln(usr,'Please cancel with CTRL X if space too small'); write(usr,'Files will be received in a '); if in_conference then writeln(usr,'conference area.') else writeln(usr,'private area.'); writeln(usr,'Descriptions will be requested at end of transfers'); writeln(usr,'Ready to Receive...'); while (not abort_batch) and (xfrname<>'') do begin free:=diskfree(rcvdrv,rcvusr); get_filename(xfrname,fnames,filecount,recs,size,abort_batch); if free'') and (not abort_batch) then begin writeln; writeln; writeln('Receiving ',xfrname); send_time(recs,mm,ss); st:=intstr(mm,3)+':'+intstr(ss,2); writeln('Contains ',recs,' records.'); writeln('Total Receive time ',mm,' minutes ',ss,' secs. at ',rate,' baud'); get_file(xfrname,abort_batch,mode,in_conference); end; if (filecount>20) and (not abort_batch) then begin writeln(usr,'20 file limit...'); abort_batch:=true; end; end; If Abort_batch then begin Writeln(usr,'Aborting Batch Transfer.'); PutByte(ord(CAN)); delay(1500); PutByte(ord(CAN)); log(8,'BATCH'); end else log(7,'BATCH'); writeln(usr); writeln(usr); filecount:=pred(filecount); {last empty filename record} setsect(homdrv,homusr); While (filecount>=1) and online do begin if fnames[filecount]<>'' then begin writeln(usr,'File: ',Fnames[filecount]); Get_description(Fnames[filecount]); filecount:=pred(filecount); end; end; if ok and (not abort_batch) then writeln(usr,'Thanks, ',user_rec.fn); if (setdrv=rcvdrv) and (setusr=rcvusr) then begin ReadDir(DirEntries,DirSpace,DirBase); New_Dir:=false; end; setsect(homdrv,homusr); end {END OF BATCH} else begin XfrName := prompt('File name', 12, 'ES'); if xfrname<>' ' then xfrname:=correct_fn(xfrname) else xfrname:=''; if xfrname<>'' then get_file(xfrname,abort_batch,mode,in_conference); if ok and (xfrname<>'')then begin writeln(usr); Writeln(usr,'Transfer Complete.'); setsect(homdrv,homusr); Get_description(xfrname); if (setdrv=rcvdrv) and (setusr=rcvusr) then begin ReadDir(direntries,dirspace,dirbase); new_dir:=false; end; Writeln(usr,'Thanks, ',user_rec.fn); end; end; if in_conference then begin RcvDrv:=TemDrv; RcvUsr:=TemUsr; in_conference:=false; end; end {got enough disk space} else begin writeln(usr); if maxavail<1024 then Writeln(usr,'Not enough memory for uploads.') else Writeln(usr,'Not enough disk space for uploads.'); writeln(usr); end; end; {end of PICS2d.inc }