From PATTERMANN@SUMEX-AIM.ARPA Tue Jun 26 11:36:41 1984 Received: from SUMEX-AIM.ARPA by Pescadero with TCP; Tue, 26 Jun 84 11:36:16 pdt Return-Path: Received: from BNL by SUMEX-AIM.ARPA with TCP; Sat 23 Jun 84 09:35:09-PDT Date: 23 Jun 84 12:34:23 EDT From: jmh@BNL Subject: binhex.bas To: INFO-MAC@SUMEX-AIM Resent-Date: Tue 26 Jun 84 11:19:58-PDT Resent-From: Ed Pattermann Resent-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