program tohex c c c Authors: E.F.Beadel, Jr., Manager c C.A.U.S.E. Instructional Computer Center c SUNY at Oswego c Oswego, NY 13126 c phone: 315/341-3055 c c and c c T.J.Weslowski, Instructor c Computer Science Department c SUNY at Oswego c Oswego, NY 13126 c c Date: 10-aug-83 c c************************************************************ c************************************************************ c c This program converts ANY disk file to a file of c hexidecimal characters replete with lines and line c numbers. This ascii hex file can then be transmitted c from one computer to another over normal terminal c transmission lines. c c The sister program, "TOBIN", will take the ascii hex c file created by this program and reconstruct the c original file. c c Therefor, these two programs afford a method of transmitting c ANY file between two computers over ascii transmission c lines. c c c This program must be compiled and linked with the c macro-11 program "BICB" as follows: c c FORTRAN TOHEX c MACRO BICB c LINK TOHEX,BICB c RUN TOHEX c c integer dada(256), cblk(5), filspc(39), deftyp(4), 1 fname(4), chan, lun, outfil(4), norec, 2 cptr,nrec,lnctr,lnyb,unyb,bicb,hex c c byte line(64), char(512), fname2(16) c c equivalence (dada(1),char(1)), (filspc(16), fname(1)), 1 (filspc(1),outfil(1)) c c data deftyp /3RSAV, 3RHEX, 3RLST, 3RFOO/ c c chan=2 type *,' = ' c c c Input to the prompt line issued by the next statement c is = c if(icsi(filspc, deftyp,,,0) .ne. 0) stop 'CSI error' norec = lookup(chan,fname) if(norec.lt.0) goto 2000 type *,' File length is ',norec,' block' c c Reconstruct file name c call r50asc(3,outfil,char) call trim(char) call concat(char,':',fname2,4) call r50asc(6,outfil(2),char) call trim(char) call concat(fname2,char,fname2,10) call concat(fname2,'.',fname2,11) call r50asc(3,outfil(4),char) call trim(char) call scopy(char,char,3) call concat(fname2,char,fname2,14) type 888,fname2 888 format(' DST file name is ',20a1) call assign(51,fname2,0,'new') c c c c Now the actual decoding process... c c lnctr=1 ! init line counter nrec=0 ! init the record counter c c 10 type *,'working on block ',nrec !process the file if(ireadw(256,dada,nrec,chan).lt.0) goto 1000 c c cptr=1 ! init output buffer pointer do 11 j=1,512 ! process the block unyb=bicb("17,char(j))/16 ! get upper nybble lnyb=bicb("360,char(j)) ! and lower nybble unyb=hex(unyb) ! convert to hex character lnyb=hex(lnyb) ! " line(cptr)=unyb !Save in output buffer line(cptr+1)=lnyb ! " cptr=cptr+2 ! Adjust buffer pointer. if(cptr .lt. 64) goto 11 ! Skip output if buffer not full write(51,52)lnctr,line ! Dump the buffer 52 format(i4,':',64a1) lnctr=lnctr+1 ! Adjust the pointers cptr=1 11 continue ! End of block nrec=nrec+1 goto 10 1000 call closec(chan) close (unit=51) call exit 2000 if(i.eq.-1) stop 'File already open' if(i.eq.-2) stop 'FNF' if(i.eq.-3) stop 'Device in use' if(i.eq.-4) stop 'TAPE DRIVE NOT AVAIL' call exit end integer function hex(arg) c c This function returns the hexidecimal character c of its argument. The argument must be a value c between 0 and 15 (one nybble). c byte arg if(arg .lt. 10) hex = arg + '0' if(arg .ge. 10) hex = arg -10 + 'A' return end