info-mac@utcsrgv.UUCP (info-mac) (06/27/84)
Date: 23 Jun 84 12:34:23 EDT
From: uw-beaver!jmh@BNL
Subject: binhex.bas
To: INFO-MAC@SUMEX-AIM
The following program will convert a MacWrite or MacPaint document
into hex format, and visa versa, facilitating the upload and download of
Paint and Write documents.
Joel M. Heller
-----------------------------
10 '" BinHex -- MS-BASIC Hex to binary/Binary to hex file
20 '" conversion program for the Apple Macintosh.
30 '"
40 '"ABSTRACT: Will take any NON-RESOURCE file on the Macintosh
50 '" and create a file containing a 2-byte hexadecimal text represen-
60 '" tation of each byte in the source file. This program (as well as
70 '" MS-BASIC) will NOT read the Resource fork of a file. It will,
80 '" however, read the DATA fork. This allows conversion and trans-
90 '" mission of MacWrite and MacPaint documents! We cannot, however
100 '" send application program, system files, or Font Mover documents.
110 '" WRITTEN BY WILLIAM B. DAVIS, JR.
120 '" 6904 Hopkins Road
130 '" Des Moines, Iowa 50322
140 '" (515)-276-9064 or (515) 276-2345 (both home #'s)
150 '" CompuServe PPN: [71505,410]
160 '" MCI Mail Id: WDAVIS
170 '" Version 1.0.0 - 16-April-1984
180 '" Copyright (C) 1984 William B. Davis, Jr.
190 '" Permission is hereby granted for personal, non-commercial
200 '" reproduction and use of this program, provided that this
210 '" notice is included in any copy.
220 '"
230 '" Certain portions of this program (lines 4000-5450) were written
240 '" by Dennis F. Brothers are are subject to the following notice:
250 '" Copyright (C) 1984 - Brothers Associates, Waylan MA
260 '" Permission is hereby granted for personal, non-commercial
270 '" reproduction and use of this program, provided that this
280 '" notice is included in any copy.
290 '
1000 CLEAR 10000:GOSUB 5000
1010 DEF FND1(X$)=INSTR("123456789ABCDEF",LEFT$(X$,1))
1020 DEF FND2(X$)=FND1(RIGHT$(X$,1))+16*FND1(RIGHT$(X$,2))
1030 CLS:WIDTH "SCRN:",80:PRINT
1040 CALL TEXTFONT(0):CALL TEXTSIZE(12)
1050 CALL TEXTMODE(1):CALL TEXTFACE(8)
1060 PRINT"BinHex -- Hex to binary/Binary to hex file conversion"
1070 PRINT
1080 CALL TEXTMODE(0):CALL TEXTFACE(32)
1090 PRINT " Enter (1) to convert a binary file to hex format"
1100 PRINT " Enter (2) to convert a hex file back to binary"
1110 PRINT:PRINT"Your choice";:CALL TEXTFACE(0)
1120 INPUT D
1130 IF D=0 THEN CLS:END
1140 ON D GOSUB 3000,2000
1150 GOTO 1030
1160 '
1170 '" Hex--->Binary conversion procedure
1180 '
2000 CLS
2010 PRINT "Hex to Binary":PRINT
2020 LINE INPUT"Enter name of HEX file to convert FROM (or RETURN):";HF$
2030 IF HF$="" THEN RETURN
2040 XX$=HF$:GOSUB 3500:IF NOT FILE.EXISTS THEN 2000
2050 LINE INPUT"Enter name of BINARY file to CREATE (or RETURN):";BF$
2060 IF BF$="" THEN 2000
2070 OPEN"I",1,HF$
2080 OPEN"O",2,BF$
2090 LINE INPUT #1,D$:'" Prime the pump....
2100 WHILE LEFT$(D$,1)<>"#" AND NOT EOF(1)
2110 LINE INPUT #1,D$
2120 WEND
2130 '" if we reach this point (1) we have found the header, of the form
2140 '" #TYPECRTR where TYPE is 4 byte type code & CRTR is 4 byte
2150 '" creator code; or (2) we have reached EOF of hex file.
2160 WHILE NOT EOF(1)
2170 TYPEAPPL$=MID$(D$,2,8)
2180 PRINT:PRINT "TYPE of new file is:";MID$(TYPEAPPL$,1,4)
2190 PRINT "CREATOR of new file is:";MID$(TYPEAPPL$,5,4)
2200 F$=BF$:GOSUB 4500:PRINT:PRINT"Converting.";
2210 WHILE NOT EOF(1)
2220 LINE INPUT #1,D$
2230 IF D$="" OR LEFT$(D$,1)="." THEN 2280
2240 FOR I=1 TO LEN(D$) STEP 2
2250 PRINT #2,CHR$(VAL("&H"+MID$(D$,I,2)));
2260 NEXT I
2270 PRINT".";
2280 WEND
2290 WEND
2300 CLOSE
2310 BEEP:PRINT:PRINT "File ";HF$;" converted to binary file ";BF$;"
2320 LINE INPUT" Press [RETURN] key to display main menu";D$
2330 RETURN
2340 '
2350 '" Binary ---> Hex conversion procedure
2360 '
3000 CLS:PRINT "Binary to Hex":PRINT
3010 LINE INPUT"Name of BINARY File to convert FROM:";BF$
3020 IF BF$="" THEN RETURN
3030 XX$=BF$:GOSUB 3500:IF NOT FILE.EXISTS THEN 3000
3040 LINE INPUT "Name of file to receive HEXADECIMAL text:";HF$
3050 IF HF$="" THEN 3000
3060 OPEN"R",1,BF$,1
3070 PRINT "LENGTH of Binary file is ";BF$;":";LOF(1)
3080 OPEN"O",2,HF$
3090 FIELD 1,1 AS D$
3100 F$=BF$:GOSUB 4000
3110 PRINT "TYPE of binary file is:";LEFT$(TYPEAPPL$,4)
3120 PRINT "CREATOR of binary file is:";RIGHT$(TYPEAPPL$,4)
3130 CALL TEXTFONT(4):CALL TEXTSIZE(9)
3140 PRINT #2,"#";TYPEAPPL$
3150 ON ERROR GOTO 3260:REM EOF(1) DOESN'T SEEM TO WORK WITH LEN=1
3160 COUNT = 0
3170 FOR I=0 TO 30
3180 IF COUNT=LOF(1) THEN 3260
3190 GET 1,COUNT+1
3200 DD$=HEX$(ASC(D$)):IF LEN(DD$)<2 THEN DD$="0"+DD$
3210 PRINT #2,DD$;:PRINT DD$;
3220 COUNT=COUNT+1
3230 NEXT I
3240 PRINT #2,"":PRINT" ";COUNT;"/";LOF(1)
3250 GOTO 3170
3260 PRINT #2,"":PRINT:PRINT
3270 CLOSE:CALL TEXTFONT(0):CALL TEXTSIZE(12)
3280 BEEP:PRINT COUNT;" * 2 Bytes processed"
3290 PRINT "Binary file ";BF$;" converted to hex file ";HF$
3300 LINE INPUT " Press [RETURN] key to display main menu ";D$
3310 RETURN
3500 ON ERROR GOTO 3530
3510 OPEN"I",1,XX$:CLOSE
3520 FILE.EXISTS=TRUE:RETURN
3530 BEEP:PRINT"File ";
3540 CALL TEXTFACE(1):PRINT XX$;:CALL TEXTFACE(0)
3550 PRINT" does not exist!"
3560 LINE INPUT "Press the [RETURN] key to select another";XX$
3570 FILE.EXISTS=FALSE:RESUME 3580
3580 RETURN
3590 REM Subroutine to get type and application of a file
3600 REM
4000 FL=LEN(F$)
4010 F$=CHR$(FL)+F$
4020 FP!=VARPTR(F$)
4030 PARAM!=VARPTR(PARAMLIST%(0))
4040 FOR I=0 TO 79: POKE PARAM!+I,0: NEXT I
4050 POKE PARAM!+19,PEEK(FP!+2)
4060 POKE PARAM!+20,PEEK(FP!+3)
4070 POKE PARAM!+21,PEEK(FP!+4)
4080 GETFILEINFO!=VARPTR(GETFILEINFOCODE%(0))
4090 CALL GETFILEINFO!(PARAM!)
4100 TYPEAPPL$ = ""
4110 FOR I = 1 TO 8
4120 TYPEAPPL$ = TYPEAPPL$ + CHR$(PEEK(PARAM!+31+I))
4130 NEXT I
4140 RETURN
4150 REM
4160 REM
4170 REM Subroutine to set type and application of a file
4180 REM
4500 FL=LEN(F$)
4510 F$=CHR$(FL)+F$
4520 PARAM!=VARPTR(PARAMLIST%(0))
4530 FP!=VARPTR(F$)
4540 FOR I=0 TO 79: POKE PARAM!+I,0: NEXT I
4550 POKE PARAM!+19,PEEK(FP!+2)
4560 POKE PARAM!+20,PEEK(FP!+3)
4570 POKE PARAM!+21,PEEK(FP!+4)
4580 GETFILEINFO!=VARPTR(GETFILEINFOCODE%(0))
4590 CALL GETFILEINFO!(PARAM!)
4600 FOR I=1 TO 8
4610 POKE PARAM!+31+I,ASC(MID$(TYPEAPPL$,I,1))
4620 NEXT I
4630 SETFILEINFO!=VARPTR(SETFILEINFOCODE%(0))
4640 CALL SETFILEINFO!(PARAM!)
4650 RETURN
4660 REM
4670 REM
4680 REM Pre-allocate all variables so the machine code arrays do
4690 REM not move. Even so, always take array addresses just before
4700 REM using them, for insurance against unintended declaration
4710 REM of a new variable.
5000 F$="": FL = 0: REM File name and its length
5010 FP! = 0
5020 DIM PARAMLIST%(39): PARAM! = 0
5030 TYPEAPPL$=""
5040 GETFILEINFO!=0
5050 SETFILEINFO!=0
5060 X$="":D$="":HF$="":DF$="":FT$="":XX$="":DD$=":X=0:D=0
5070 I=0:TRUE=-1:FALSE=0:FILE.EXISTS=0
5080 REM Set up GetFileInfo ROM call
5090 REM
5100 DIM GETFILEINFOCODE%(25)
5110 RESTORE 5180
5120 I=0
5130 READ A: GETFILEINFOCODE%(I)=A
5140 I=I+1
5150 IF A<>-1 THEN GOTO 5130
5160 REM
5170 REM
5180 REM Machine language code to invoke GetFileInfo ROM function
5190 REM
5200 DATA &H4E56, &HFFF8, &H48EE, &H0101, &HFFF8, &H206E, &H0008, &HA00C
5210 DATA &H4CEE, &H0101, &HFFF8, &H4E5E, &H4E75
5220 DATA -1
5230 REM
5240 REM
5250 REM Set up SetFileInfo ROM call
5260 REM
5270 DIM SETFILEINFOCODE%(25)
5280 RESTORE 5350
5290 I=0
5300 READ A: SETFILEINFOCODE%(I)=A
5310 I=I+1
5320 IF A<>-1 THEN GOTO 5300
5330 REM
5340 REM
5350 REM Machine language code to invoke SetFileInfo ROM function
5360 REM
5370 DATA &H4E56, &HFFF8, &H48EE, &H0101, &HFFF8, &H206E, &H0008, &HA00D
5380 DATA &H4CEE, &H0101, &HFFF8, &H4E5E, &H4E75
5390 DATA -1
5400 REM
5410 REM
5420 RETURN
5430 REM
5440 REM
5450 END