{PICS0D.INC Pascal Integrated Communications System Overlays} { 6/4/87 Version 1.6 Copyright 1987 by Les Archambault} overlay procedure SendFile(var xfrname:filename; var XfrFile:untype_file ;remaining:integer;sendmode:char;var ok_to_send:boolean); const maxerr = 10; var CRCmode,KMDmode,timeout,firstime: boolean; bt,cancel: byte; ch: char; mm, ss, time_on, time_left, i, vv,recs,tot_errcnt, krecs,xrecs,block, errcnt,bufsize,bufblocks,kblocks: integer; arc_size:real; file_buf:buf_ptr; hdr_array:array[1..27] of byte absolute hdr; procedure Read_Arc_Block; { read a block from the archive file } begin if EOF(arc_file) then endfile := TRUE else begin {$I-} BlockRead(arc_file, arcbuf, 1); {$I+} endfile:=(ioresult<>0); end; arcptr := 1 end; function Get_Arc_Ch : byte; { read 1 character from the archive file } begin if endfile then Get_Arc_Ch := 0 else begin Get_Arc_Ch := arcbuf[arcptr]; if arcptr = 128 then Read_Arc_Block else arcptr := arcptr + 1 end end; begin {sendfile} new(file_buf); cancel:=0; OK:=true; KMDmode:=false; firstime:=true; setsect(setdrv,setusr); if sendmode<>'B' then begin setsect(HomDrv,HomUsr); timer(time_on, time_left); send_time(remaining, mm, ss); setsect(setdrv,setusr); if mm > time_left then begin writeln(USR, 'Insufficient time remaining.'); OK := FALSE end; end; if OK then begin errcnt := 0; tot_errcnt:=0; recs:=1; block := 1; xrecs:=0; krecs:=0; if sendmode<>'B' then begin kblocks:=remaining div 8; if remaining mod 8<>0 then kblocks:=succ(kblocks); writeln(USR, XfrName, ' contains ', remaining, ' records.'); for i:=1 to length(XfrName) do write(usr,' '); writeln(usr,' ',kblocks,' 1K blocks.'); writeln(USR, 'Send time: ', mm, ' minutes ',ss, ' seconds at ', rate, ' bps.'); writeln(USR, 'To cancel, type several CTL-X.'); if in_arc then begin writeln(usr,'Arc file members are sent compressed.'); writeln(usr,'Remember to name your file with an .ARC suffix.'); end; writeln(USR, 'Ready to send...'); end; if (sendmode='K') or (sendmode='B') then KMDmode:=true; repeat bt := (GetByte(10, timeout) and $7F); CRCmode := ((bt=ord('C')) or (bt=ord('c'))); if CRCmode then begin if cancel>0 then cancel:=0; bt:=(getbyte(1,timeout) and $7F); if (sendmode<>'K') and (sendmode<>'B') then KMDmode:=((bt=ord('K')) or (bt=ord('k'))); if KMDmode and (remaining>=8) then begin writeln('1K protocol'); bufblocks:=8; bufsize:=1024; krecs:=remaining div 8; xrecs:=remaining mod 8; end else begin KMDmode:=false; bufblocks:=1; bufsize:=128; end; writeln('CRC mode.'); errcnt := 0 end else if bt = ord(NAK) then begin if cancel>0 then cancel:=0; writeln('Checksum mode.'); errcnt := 0; bufsize:=128; bufblocks:=1; end else if bt = ord(CAN) then begin errcnt:=succ(errcnt); cancel:=succ(cancel); if cancel>=2 then errcnt := maxerr end else {timeout or another char} begin if cancel>0 then cancel:=0; errcnt := succ(errcnt); end; until (errcnt = 0) or (errcnt >= maxerr); while ch_carck and ch_inprdy do bt:=ch_inp; {eat garbage} if KMDmode then remaining:=krecs; if in_arc then arc_size:=Long_to_Real(hdr.size)+29.0; while (remaining > 0) and (errcnt < maxerr) do begin if (not in_arc) then blockread(XfrFile, file_buf^, bufblocks) else begin if (block=1) and firstime then begin firstime:=false; file_buf^[1]:=26; {archive id byte} file_buf^[2]:=hdrver; for i:=1 to sizeof(heads) do file_buf^[i+2]:=hdr_array[i]; if arc_size>=bufsize-29 then begin for i:=30 to bufsize do file_buf^[i]:=get_arc_ch; arc_size:=arc_size-bufsize; end else begin for i:=1 to trunc(arc_size) do file_buf^[i]:=get_arc_ch; file_buf^[trunc(arc_size)+1]:=26; file_buf^[trunc(arc_size)+2]:=0; end; end else begin if arc_size>=bufsize then begin for i:=1 to bufsize do file_buf^[i]:=get_arc_ch; arc_size:=arc_size-bufsize; end else begin for i:=1 to trunc(arc_size) do file_buf^[i]:=get_arc_ch; file_buf^[trunc(arc_size)+1]:=26; file_buf^[trunc(arc_size)+2]:=0; end; end; end; remaining := pred(remaining); vv := 0; if CRCmode then begin for i := 1 to bufsize do updcrc(vv, file_buf^[i]); updcrc(vv, 0); updcrc(vv, 0); end else for i := 1 to bufsize do vv := vv + file_buf^[i]; repeat if (KMDmode) and (bufsize>128) then PutByte(ord(STX)) else PutByte(ord(SOH)); PutByte(lo(block)); PutByte(not lo(block)); for i := 1 to bufsize do PutByte(file_buf^[i]); if CRCmode then PutByte(hi(vv)); PutByte(lo(vv)); repeat bt := (GetByte(10, timeout) and $7F); if bt = ord(ACK) then begin if cancel>0 then cancel:=0; if (KMDmode) and (bufsize>128) then begin write(CR, 'Sent Records: ',recs,'-',recs+7); recs:=recs+8; end else begin if KMDmode then begin write(cr); ClrEol; end; write(CR, 'Sent Record: ', recs); { Local display of what is happening } recs:=succ(recs); end; block := succ(block) mod 256; errcnt := 0; end else if (bt = ord(NAK)) or timeout then begin if cancel>0 then cancel:=0; if bt = ord(NAK) then write(' ++ NAK received') else write(' ++ Timeout'); errcnt := succ(errcnt); tot_errcnt:=succ(tot_errcnt); writeln(' - error ', errcnt, ' ++') end else if bt = ord(CAN) then begin errcnt:=succ(errcnt); cancel:=succ(cancel); if cancel>=2 then errcnt:=maxerr; end; ch := GetChar; { Monitor local console } until (bt in [ord(ACK), ord(NAK)]) or (errcnt>=maxerr) or timeout; until (errcnt = 0) or (errcnt >= maxerr); If (KMDmode) and (bufsize>128) and (tot_errcnt>(maxerr div 2)) and (tot_errcnt<255) then begin xrecs:=(remaining * 8)+xrecs; remaining:=0; {set up to change back to 128 bytes} tot_errcnt:=255; {prevent second use of this routine} end; if (KMDmode) and (remaining=0) and (xrecs>0) then begin bufblocks:=1; {switch back to 128 block size} bufsize:=128; remaining:=xrecs; xrecs:=0; end; end; {while errors less than max and more to send} writeln; OK := (errcnt = 0); if OK then begin repeat PutByte(ord(EOT)); if ord(ACK) = (GetByte(6, timeout) and $7F) then errcnt := 0 else errcnt := succ(errcnt) until (errcnt = 0) or (errcnt >= maxerr); OK := (errcnt = 0); if sendmode<>'B' then begin if OK then begin writeln(USR, 'Transfer complete.'); if (not clock) then for i:=1 to mm do begin tick_a_min; hour_count:=hour_count+10.0; end; end else writeln(USR, 'End of file not acknowledged.') end; end else begin if sendmode<>'B' then writeln(USR, 'Transfer cancelled.'); putbyte(ord(CAN)); putbyte(ord(CAN)); end; end; if (not ok) then ok_to_send:=false; dispose(file_buf); end; Overlay procedure Test_Download_Ratio(var ok_to_send:boolean ;sendmode:char;fnum:integer); var i,x:integer; begin if (up_down_ratio>0) and (ok_to_send) then begin x:=user_rec.download; if sendmode='B' then x:=x+Fnum; if x=0 then x:=1; i:=user_rec.upload+1; if ((i*up_down_ratio) div x)<2 then begin writeln(usr); writeln(usr,'System allows ',up_down_ratio,' downloads/upload.'); writeln(usr,'You are close to that limit with ',user_rec.download, ' Downloads and ',user_rec.upload,' Uploads.'); if sendmode='B' then Writeln(usr,'Batch transfer will add ',fnum,' to your downloads.'); writeln(usr); end; if ((i*up_down_ratio) div x)<1 then begin ok_to_send:=false; writeln(usr); writeln(usr,'Unable to send files until some uploads are received.'); writeln(usr); end; end; end; {end of PICS0D.INC }