{PICS2C1.INC Pascal Integrated Communications System} { 5/25/87 vers. 1.6 Copywright 1987 by Les Archambault} overlay procedure SendText; const bufsize = 128; bufblocks =1; var this: FilePtr; XfrName: FileName; XfrFile: untype_file; buffer:array[1..bufsize] of byte; procedure SendFile(var XfrFile: untype_file; remaining: integer); { Send a squeezed or ASCII file } const recognize = $FF76; DLE = $90; var EndOfFile, squeezed,page: boolean; i, x, BufferPtr, bpos, curin, repct, lastc, NoOfRecs, line_count: integer; FileType: String[3]; ErrMsg: StrPr; dnode: array [0..255, 0..1] of integer; function getc: integer; { Get an 8 bit value from the input buffer - read block if necessary } begin if BufferPtr > BufSize then begin NoOfRecs := min(BufBlocks, remaining); EndOfFile := (NoOfRecs = 0); if not EndOfFile then begin {$I-} BlockRead(XfrFile, Buffer, NoOfRecs) {$I+}; EndOfFile := (IOresult <> 0) end; remaining := remaining - NoOfRecs; BufferPtr := 1 end; getc := Buffer[BufferPtr]; BufferPtr := succ(BufferPtr) end; function getw: integer; { Get a 16 bit value from the input buffer } begin getw := getc + Swap(getc) end; procedure BuildTree; { Build decode tree } var i, CheckSum, numnodes: integer; begin ErrMsg := ''; if recognize = getw { Is it really a squeezed file? } then begin CheckSum := getw; { Get checksum } XfrName := ''; i := getc; { Build original file name } while i <> 0 do begin XfrName := XfrName + UpCase(chr(i)); i := getc end; numnodes := getw; { Get the number of nodes in tree } if (0 < numnodes) and (numnodes <= 256) then for i := 0 to pred(numnodes) do begin dnode[i, 0] := getw; dnode[i, 1] := getw; end else begin ErrMsg := 'Invalid decode tree size.'; squeezed := FALSE end end else squeezed := FALSE end; function gethuff: integer; { Get character coding } var i: integer; begin i := 0; repeat bpos := succ(bpos); if bpos > 7 then begin curin := getc; bpos := 0 end else curin := curin shr 1; i := dnode[i, curin and $0001] until i < 0; i := -succ(i); if i = 0 then gethuff := 26 else gethuff := i end; function getcr: integer; var c: integer; begin if repct > 0 then begin repct := pred(repct); getcr := lastc end else begin c := gethuff; if c = DLE then begin repct := gethuff; if repct = 0 then getcr := DLE else begin repct := repct - 2; getcr := lastc end end else begin getcr := c; lastc := c end end end; begin { SendFile } i := pos('.', XfrName); if i = 0 then FileType := '' else FileType := copy(XfrName, succ(i), length(XfrName)); squeezed := ('Q' = FileType[2]); repct := 0; bpos := 8; ErrMsg := ''; BufferPtr := MaxInt; { Force a read the first time } EndOfFile := FALSE; if remaining > 0 then begin if squeezed then BuildTree; i := pos('.', XfrName); if 0 = i then FileType := '' else FileType := copy(XfrName, succ(i), length(XfrName)); if (FileType = 'COM') or (FileType = 'OBJ') or (FileType[2]='Z') or (FileType = 'EXE') or (FileType = 'LBR') or (FileType='ARC') then ErrMsg := 'Xmodem protocol required for ".' + FileType + '" files.'; if ErrMsg = '' then begin page:=ask('Do you want page breaks'); line_count := 0; if squeezed then begin writeln(USR, ' ---> ', XfrName); x := getcr end else x := getc; while (not brk) and (not EndOfFile) and (x <> 26) do begin write(USR, chr(x)); if (user_rec.lines <> 99) and (chr(x) = LF) and (page) then begin line_count := succ(line_count); if line_count mod user_rec.lines = 0 then pause end; if squeezed then x := getcr else x := getc end end end else ErrMsg := 'Missing or empty input file.'; if ErrMsg <> '' then writeln(USR, ErrMsg) end; begin { SendText } if (not in_arc) then begin XfrName := correct_fn(prompt('File name', 12, 'ES')); if XfrName <> '' then begin if in_library then this := LibBase 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(6, XfrName); SetSect(SetDrv, SetUsr); if in_library then begin {$I-} seek(libr_file, this^.index) {$I+}; if IOresult = 0 then SendFile(libr_file, this^.fsize) end else begin Assign(XfrFile, XfrName); Reset(XfrFile); SendFile(XfrFile, FileSize(XfrFile)); Close(XfrFile) end; SetSect(HomDrv, HomUsr); log(7, '') end else writeln(USR, XfrName, ' not found.') end end {not in arc} else begin writeln(usr); writeln(usr,'Unable to type Arc file members.'); end; end; {end of PICS2C1.inc }