Here is the BASIC version of BinHex, a program for the Mac that converts resource/data files into mailable .Hex files and back. Use it to convert BinHex.Hex (which follows in my next message) ------------------------- C U T H E R E ------------------------- 10 'BinHex version 3.0.0 - By William B. Davis, Jr {CIS 71505,410} 20 'with modifications by Bob VanBurkleo {CIS 74435,1373} 30 'using subroutines by: 40 ' Dennis Brothers of Brothers Associates {CIS 70065,172} 50 ' Ronald H. Nicholson, Jr {CIS 71505,410} 60 'Permission is hereby granted for personal, non-commercial reproduction 70 'and use of this program, provided that this notice is included. 100 CLEAR,24000 110 CLEAR:DEFINT P:DIM PARAMLIST%(39),RECT%(5),BACKPATTERN%(4),GETFILEINFOCODE%(25) 120 DIM SETFILEINFOCODE%(25),P(89),DBUF%(256),VBUF%(266) 130 X255%=255:LFR=0:LFD=0:RFN=0 140 A=0:BOX=0:BX=0:BY=0:TRUE=-1:FALSE=0:CHOICE=0:CKSUM%=0:COUNT=0:E=0 150 FILE=0:FILEINFO!=0:FL=0:LF=0:FP!=0:I=0:LP=0:P=0:PARAM!=0:TR=0:PX=0:PY=0 160 R=0:RC=0:RF=0:RN=0:RW=0:RX=0:S=0:SETFILEINFO!=0:GETFILEINFO!=0:X=0:X9=0:Y=0:XX%=0 170 A$="":BF$="":D$="":E$="":DD$="":F$="":FT$="":HF$="":HX$="":RET$="":S$="":TEXT$="":FILE.EXISTS=0 180 TYPEAPPL$="":X$="":XX$="" 1000 WIDTH "SCRN:",255 1010 WHILE TRUE 1020 GOSUB 8000:CALL SHOWCURSOR 1030 RECT%(0)=2:RECT%(1)=10:RECT%(2)=275:RECT%(3)=475:GOSUB 7100 1040 RECT%(0)=5:RECT%(1)=13:RECT%(2)=272:RECT%(3)=472:GOSUB 7200 1050 CALL TEXTFONT(0):CALL TEXTSIZE(12) 1060 CALL TEXTMODE(1):CALL TEXTFACE(8) 1070 CALL MOVETO (45,20) 1080 PRINT"BinHex -- Hex to binary/Binary to hex file conversion" 1090 CALL MOVETO(140,40):CALL TEXTFACE(0) 1100 CALL TEXTFONT(1):CALL TEXTSIZE(9) 1110 PRINT" Version 3.0.0 - Data & Resource Files"; 1120 CALL MOVETO(35,260) 1130 PRINT"Copyright ";CHR$(169);"1984 by Calypso! Software "; 1140 PRINT"- May be reproduced for non-commercial use only."; 1150 CALL TEXTFONT(0):CALL TEXTSIZE(12) 1160 CALL MOVETO (120,68):PRINT"Click on the desired conversion method:"; 1170 RESTORE 1200:GOSUB 6000 1180 ON CHOICE GOSUB 3000,2000,1500,1600 1185 GOTO 110 1190 WEND:STOP 1200 DATA 75,90,"Application document --> Upload format document" 1210 DATA 75,130,"Upload format document --> Application document" 1220 DATA 75,170,"Quit BinHex and return to the Macintosh Desktop" 1230 DATA 75,210,"Quit BinHex and return to Microsoft BASIC" 1240 DATA -1,-1,"Dummy end of list" 1500 GOSUB 8000 1510 RECT%(0)=100:RECT%(1)=100:RECT%(2)=150:RECT%(3)=400:GOSUB 7100 1520 RECT%(0)=103:RECT%(1)=103:RECT%(2)=147:RECT%(3)=397:GOSUB 7200 1530 CALL MOVETO(120,130):PRINT"Returning to Macintosh DeskTop...."; 1540 SYSTEM 1600 CLS:CALL TEXTFONT(1):CALL TEXTSIZE(12) 1610 CALL TEXTMODE(0):CALL TEXTFACE(0) 1620 PRINT"Entering MS-BASIC Command mode....":END 1630 '-------------------------------------------------------- 1640 '" Hex ---> Binary conversion procedure 1650 '-------------------------------------------------------- 2000 CHOICE=1 2010 WHILE CHOICE=1:GOSUB 8000:ON ERROR GOTO 0 2020 CALL TEXTMODE(1):CALL TEXTFACE(8) 2030 RECT%(0)=32:RECT%(1)=2:RECT%(2)=200:RECT%(3)=480:GOSUB 7100 2040 RECT%(0)=35:RECT%(1)=5:RECT%(2)=197:RECT%(3)=477:GOSUB 7200 2050 CALL MOVETO(15,52) 2060 PRINT "Convert Upload document (hex) to an Application document"; 2070 CALL TEXTFACE(32):CALL MOVETO (15,73) 2080 PRINT "Enter name of Upload Document to convert FROM (Press RETURN to cancel):"; 2090 CALL MOVETO(15,153) 2100 PRINT "Enter name of Application Document to CREATE (RETURN key skips back):"; 2110 RECT%(0)=80:RECT%(1)=15:RECT%(2)=105:RECT%(3)=450:GOSUB 7000 2120 RECT%(0)=160:RECT%(1)=15:RECT%(2)=185:RECT%(3)=450:GOSUB 7000 2130 BX=20:BY=95:GOSUB 7500:HF$=RET$:IF HF$="" THEN RETURN 2140 FILE.EXISTS=TRUE 2150 ON ERROR GOTO 3600:OPEN"I",1,HF$ 2160 CLOSE:IF NOT FILE.EXISTS THEN 2000 2170 BX=20:BY=175:GOSUB 7500:BF$=RET$:IF BF$="" THEN 2000 2180 OPEN"I",1,HF$,1:OPEN"O",2,BF$ 2185 F$=HF$:GOSUB 4580:GOSUB 4000:LF=LFD 2190 ' Read in lines from file & ignore anything until the 2200 ' Type/Creator header information is encountered. 2210 CKSUM%=0 2220 LINE INPUT #1,D$:'" Prime the pump.... 2230 WHILE LEFT$(D$,1)<>"#" AND NOT EOF(1) 2240 LINE INPUT #1,D$ 2250 WEND 2260 ' if we reach this point (1) we have found the header, of the form 2270 ' #TYPECRTR where TYPE is 4 byte type code & CRTR is 4 byte 2280 ' creator code; or (2) we have reached EOF of hex file. 2290 WHILE NOT EOF(1) 2300 TYPEAPPL$=MID$(D$,2,8) 2310 GOSUB 8000 2320 RECT%(0)=50:RECT%(1)=100:RECT%(2)=200:RECT%(3)=400 2330 CALL PENNORMAL:GOSUB 7000 2340 RECT%(0)=53:RECT%(1)=103:RECT%(2)=197:RECT%(3)=397 2350 CALL PENSIZE(2,2):GOSUB 7000:CALL PENNORMAL 2360 CALL MOVETO(110,80):CALL TEXTFACE(0):CALL TEXTMODE(1) 2370 PRINT "TYPE of new file is................:";MID$(TYPEAPPL$,1,4) 2380 CALL MOVETO(110,95) 2390 PRINT "CREATOR of new file is..........:";MID$(TYPEAPPL$,5,4) 2400 CALL MOVETO(110,110) 2410 PRINT USING "Length of new file will be approx : ###.##K";(LOF(1)/2)/1024; 2420 CALL MOVETO(110,175) 2430 PRINT "Conversion in process - Please stand by...." 2440 CALL TEXTMODE(0) 2450 F$=BF$:GOSUB 4660:GOSUB 4200:'" Set type and creator of file 2460 LINE INPUT #1,D$ 2470 IF LEFT$(D$,12)="***DATA FORK" THEN LINE INPUT #1,D$:CALL MOVETO (110,140):PRINT BF$;": a Data File" 2475 IF LEFT$(D$,11)="***RESOURCE" THEN CALL MOVETO(110,140):PRINT BF$;": a Resource File":GOSUB 21000:GOTO 2540 2480 WHILE NOT EOF(1) AND LEFT$(D$,14)<>"***END OF DATA" 2490 GOSUB 2800:' Convert string to binary 2500 LINE INPUT #1,D$ 2510 WEND 2520 IF NOT EOF(1) THEN LINE INPUT #1,D$:'get checksum if available 2525 GOTO 2540 2530 WEND 2540 CLOSE:GOSUB 8000 2550 RECT%(0)=30:RECT%(1)=80:RECT%(2)=220:RECT%(3)=410:GOSUB 7100 2560 RECT%(0)=33:RECT%(1)=83:RECT%(2)=217:RECT%(3)=407:GOSUB 7200 2570 CALL MOVETO (100,55):CALL TEXTMODE(1) 2580 PRINT "Conversion of upload format document to"; 2590 CALL MOVETO(100,70) 2600 PRINT "application document has been completed!"; 2610 CALL MOVETO(140,100) 2620 IF LEFT$(D$,12)="***CHECKSUM:" THEN PRINT "Checksum in file: ";MID$(D$,13,2); 2630 IF LEFT$(D$,12)<>"***CHECKSUM:" THEN PRINT "No checksum present in file..."; 2640 XX$=HEX$(CKSUM%):IF LEN(XX$)<2 THEN XX$="0"+XX$ 2650 CALL MOVETO (140,115):PRINT "Calculated Checksum: ";XX$; 2660 BEEP:RESTORE 2690:GOSUB 6000:CALL TEXTMODE(0) 2670 WEND:' of the WHILE CHOICE=1 2680 RETURN:' if CHOICE=2 2690 DATA 130,155,"Convert another upload document" 2700 DATA 130,180,"Return to Main Conversion menu" 2710 DATA -1,-1,"dummy end of list" 2720 '----- Loop to break down input line into byte-pairs & convert ----- 2800 FOR I=1 TO LEN(D$) STEP 2 2810 XX%=VAL("&H"+MID$(D$,I,2)):CKSUM%=(CKSUM%+XX%) AND 255 2820 PRINT #2,CHR$(XX%); 2830 NEXT I:RETURN 2840 '------------------------------------------------------- 2850 ' Binary ---> Hex conversion procedure 2860 '------------------------------------------------------- 3000 CHOICE=1 3010 WHILE CHOICE=1:GOSUB 8000 3020 ON ERROR GOTO 0:CALL TEXTMODE(1):CALL TEXTFACE(8) 3030 RECT%(0)=32:RECT%(1)=2:RECT%(2)=200:RECT%(3)=480:GOSUB 7100 3040 RECT%(0)=35:RECT%(1)=5:RECT%(2)=197:RECT%(3)=477:GOSUB 7200 3050 CALL MOVETO(15,52) 3060 PRINT "Convert Application document to an Upload document (hex)"; 3070 CALL TEXTFACE(32):CALL MOVETO (15,73) 3080 PRINT "Enter name of Application Document to convert FROM (Press RETURN to cancel):"; 3090 CALL MOVETO(15,153) 3100 PRINT "Enter name of Upload Document to CREATE (RETURN key skips back):"; 3110 RECT%(0)=80:RECT%(1)=15:RECT%(2)=105:RECT%(3)=450:GOSUB 7000 3120 RECT%(0)=160:RECT%(1)=15:RECT%(2)=185:RECT%(3)=450:GOSUB 7000 3130 BX=20:BY=95:GOSUB 7500:BF$=RET$:IF BF$="" THEN RETURN 3140 FILE.EXISTS=TRUE 3150 ON ERROR GOTO 3600:OPEN"I",1,BF$ 3160 ON ERROR GOTO 0: CLOSE:IF NOT FILE.EXISTS THEN 3000 3170 BX=20:BY=175:GOSUB 7500:HF$=RET$ 3180 OPEN"O",2,HF$ 3190 F$=BF$:GOSUB 4580:GOSUB 4000:LF=LFD+LFR 3200 CLS:CALL TEXTFACE(0) 3210 PRINT "LENGTH of Application document is:";LF;" bytes (characters)" 3220 PRINT "TYPE of Application document is: ";LEFT$(TYPEAPPL$,4) 3230 PRINT "CREATOR of Application document is: ";RIGHT$(TYPEAPPL$,4) 3235 PRINT "DOCUMENT is a ";:IF LFD=0 THEN PRINT "Resource File":ELSE PRINT "Data File" 3240 PRINT:CALL TEXTFONT(4):CALL TEXTSIZE(9) 3250 PRINT "<---Hex data being output--------------------------------------> "; 3260 PRINT"Processed/Total" 3270 CKSUM%=0:COUNT=0 3275 IF LFD=0 THEN GOSUB 22000:GOTO 3380 3280 PRINT #2,"#";TYPEAPPL$:PRINT #2,"***DATA FORK" 3285 OPEN "R",1,BF$,1:FIELD 1,1 AS D$ 3290 FOR I = 1 TO LFD 3300 GET 1,I 3310 DD$=HEX$(ASC(D$)):IF LEN(DD$)<2 THEN DD$="0"+DD$ 3320 CKSUM%=(CKSUM%+ASC(D$)) AND 255 3330 PRINT #2,DD$;:PRINT DD$; 3340 COUNT=COUNT+1 3350 IF COUNT=32 THEN COUNT=0:PRINT #2,"":PRINT USING " ######_/";I;:PRINT LFD 3360 NEXT I 3370 IF COUNT<32 THEN PRINT #2,"" 3380 PRINT #2,"***END OF DATA" 3390 XX$=HEX$(CKSUM%):IF LEN(XX$)<2 THEN XX$="0"+XX$ 3400 PRINT #2,"***CHECKSUM:";XX$ 3410 CLOSE:CALL TEXTFONT(0):CALL TEXTSIZE(12) 3420 RECT%(0)=30:RECT%(1)=80:RECT%(2)=220:RECT%(3)=410:GOSUB 7100 3430 RECT%(0)=33:RECT%(1)=83:RECT%(2)=217:RECT%(3)=407:GOSUB 7200 3440 CALL MOVETO(90,70):CALL TEXTMODE(1) 3450 PRINT "Conversion of Application document to an"; 3460 CALL MOVETO (90,85) 3470 PRINT "Upload format document has been completed!"; 3480 BEEP:RESTORE 3510:GOSUB 6000 3490 WEND: ' of the WHILE CHOICE=1 3500 RETURN: ' if CHOICE=2 3510 DATA 110,120,"Convert another Application document" 3520 DATA 110,160,"Return to Main Conversion Menu" 3530 DATA -1,-1,"dummy end of list" 3540 '------ Subroutine to handle file-not-found condition ------ 3600 RECT%(0)=75:RECT%(1)=100:RECT%(2)=165:RECT%(3)=400:GOSUB 7100 3610 RECT%(0)=79:RECT%(1)=103:RECT%(2)=162:RECT%(3)=397:GOSUB 7200 3620 CALL MOVETO(160,110):PRINT"That document does not exist!"; 3630 BEEP:BEEP:RESTORE 3640:GOSUB 6000 3640 DATA 150,130,"<--Click here to select another file" 3650 DATA -1,-1,"Dummy end of File not found list" 3660 FILE.EXISTS=FALSE:RESUME NEXT 3670 '------------------------------------------------------------ 3680 ' _GetFileInfo -- Subroutine to get type and application of a file 3690 '------------------------------------------------------------ 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 4135 LFD=PEEK(PARAM!+56)*256+PEEK(PARAM!+57) 4136 LFR=PEEK(PARAM!+66)*256+PEEK(PARAM!+67) 4140 RETURN 4150 '------------------------------------------------------------- 4160 ' _SetFileInfo -- Subroutine to set type and application of a file 4170 '------------------------------------------------------------- 4200 FL=LEN(F$) 4210 F$=CHR$(FL)+F$ 4220 PARAM!=VARPTR(PARAMLIST%(0)) 4230 FP!=VARPTR(F$) 4240 FOR I=0 TO 79: POKE PARAM!+I,0: NEXT I 4250 POKE PARAM!+19,PEEK(FP!+2) 4260 POKE PARAM!+20,PEEK(FP!+3) 4270 POKE PARAM!+21,PEEK(FP!+4) 4280 GETFILEINFO!=VARPTR(GETFILEINFOCODE%(0)) 4290 CALL GETFILEINFO!(PARAM!) 4300 FOR I=1 TO LEN(TYPEAPPL$) 4310 POKE PARAM!+31+I,ASC(MID$(TYPEAPPL$,I,1)) 4320 NEXT I 4330 SETFILEINFO!=VARPTR(SETFILEINFOCODE%(0)) 4340 CALL SETFILEINFO!(PARAM!) 4350 RETURN 4360 '----------------------------------------------------------- 4370 ' Setup Machine Language Toolkit calls 4380 '----------------------------------------------------------- 4560 ' Set up _GetFileInfo ToolKit call 4580 RESTORE 4610:I=0 4590 READ A:GETFILEINFOCODE%(I)=A 4600 I=I+1:IF A<>-1 THEN GOTO 4590 4605 RETURN 4610 DATA &H4E56, &HFFF8, &H48EE, &H0101, &HFFF8, &H206E, &H0008, &HA00C 4620 DATA &H4CEE, &H0101, &HFFF8, &H4E5E, &H4E75 4630 DATA -1 4640 ' Set up _SetFileInfo Toolkit call 4660 RESTORE 4700:I=0 4670 READ A:SETFILEINFOCODE%(I)=A 4680 I=I+1:IF A<>-1 THEN GOTO 4670 4690 RETURN 4700 DATA &H4E56, &HFFF8, &H48EE, &H0101, &HFFF8, &H206E, &H0008, &HA00D 4710 DATA &H4CEE, &H0101, &HFFF8, &H4E5E, &H4E75 4720 DATA -1 4730 '---------------------------------------------------------- 4740 ' Pseudo-Dialog-Box subroutine 4750 '---------------------------------------------------------- 6000 BOX=0:READ X,Y,TEXT$ 6010 WHILE X<>-1 6020 BOX=BOX+1:CHECKBOX(BOX,1)=X:CHECKBOX(BOX,2)=Y 6030 CHECKTEXT$(BOX)=TEXT$:READ X,Y,TEXT$ 6040 WEND 6050 FOR I=1 TO BOX 6060 CIRCLE(CHECKBOX(I,1),CHECKBOX(I,2)),7 6070 CIRCLE(CHECKBOX(I,1),CHECKBOX(I,2)),5 6080 CALL MOVETO(CHECKBOX(I,1)+15,CHECKBOX(I,2)+5) 6090 PRINT CHECKTEXT$(I); 6100 NEXT I 6110 CHOICE=0 6120 WHILE CHOICE=0 6130 WHILE MOUSE(0)<>-1:WEND 6140 PX=MOUSE(1):PY=MOUSE(2) 6150 FOR I=1 TO BOX 6160 P=SQR((PX-CHECKBOX(I,1))^2+(PY-CHECKBOX(I,2))^2) 6170 IF P<5 THEN CHOICE=I:I=BOX :' once choice found, stop loop. 6180 NEXT I 6190 WEND 6200 FOR I=0 TO 4 6210 CIRCLE(CHECKBOX(CHOICE,1),CHECKBOX(CHOICE,2)),I 6220 NEXT I 6230 WHILE MOUSE(0)<>1:WEND:RETURN 6240 '--------------------------------------------------- 6250 ' Routines used to draw Dialog boxes 6260 '--------------------------------------------------- 7000 CALL ERASERECT(VARPTR(RECT%(0))) 7010 CALL FRAMERECT(VARPTR(RECT%(0))) 7020 RETURN 7100 CALL PENNORMAL:GOSUB 7000:RETURN 7200 CALL PENSIZE(2,2):GOSUB 7000:CALL PENNORMAL:RETURN 7210 '--------------------------------------------------------- 7220 ' Controlled Keyboard input routine, with cursor 7230 '--------------------------------------------------------- 7500 A$="":RET$="" 7510 CALL MOVETO(BX,BY):CALL TEXTMODE(0) 7520 CALL PENSIZE(1,1):CALL SHOWPEN 7530 CALL OBSCURECURSOR:CALL LINE(0,-10) 7540 WHILE A$<>CHR$(13) AND A$<> CHR$(9) AND A$<>CHR$(3) 7550 A$=INKEY$ 7560 IF A$<>"" AND A$>CHR$(31) THEN GOSUB 7630 7570 IF A$=CHR$(8) AND LEN(RET$)>0 THEN GOSUB 7660 7580 IF A$=CHR$(8) AND LEN(RET$)=0 THEN GOSUB 7690 7590 IF LEN(RET$)>65 THEN BEEP:A$=CHR$(13) 7600 WEND 7610 CALL MOVETO(BX,BY):PRINT RET$;" ";:RETURN 7620 '-------- Handle normal input of letter ASCII 32-255 ------------ 7630 RET$=RET$+A$:CALL LINE(0,10) 7640 PRINT A$;:CALL LINE(0,-10):RETURN 7650 '------- Hande Backspacing with input length >0 ---------------- 7660 CALL MOVETO(BX,BY):RET$=LEFT$(RET$,LEN(RET$)-1) 7670 PRINT RET$;:CALL LINE(0,-10):RETURN 7680 '------- Handle Backspacing when input length goes to 0 ------ 7690 CALL MOVETO(BX,BY):PRINT" ";:CALL LINE(0,-10): 7700 CALL MOVETO (BX,BY):CALL LINE(0,-10):RETURN 7710 '------- Change Window Background pattern to grey ------- 8000 FOR I=0 TO 4:BACKPATTERN%(I)=&HAA55:NEXT I 8010 CALL BACKPAT(VARPTR(BACKPATTERN%(0))):CLS 8020 FOR I=0 TO 4:BACKPATTERN%(I)=0:NEXT I 8030 CALL BACKPAT(VARPTR(BACKPATTERN%(0))):RETURN 10000 ' Open Resource Fork For E$ 10010 IF P(0)<>&H41FA THEN GOSUB 15000 10020 P(8)=&HA20A:' Open RF 10030 Y=VARPTR(P(42)):'length of file name 10040 POKE Y,LEN(E$) 10050 FOR I=1 TO LEN(E$):POKE (Y+I),ASC(MID$(E$,I,1)):NEXT I 10060 P(25)=INT(Y/65536!):GOSUB 20000 10070 P(26)=X:'lsw of name 10080 P(27)=0:'volume 10090 P(29)=RW:'version and R/W Permission 10100 P(30)=0'Nil-> default volume buffer msw 10110 P(31)=0:'Nil-> default volume buffer lsw 10115 IF RW=1 THEN GOTO 10160 10120 Y=VARPTR(VBUF%(0)) 10130 P(30)=INT(Y/65536!):GOSUB 20000:' volume buffer msw 10140 P(31)=X:'volume buffer lsw 10160 X=VARPTR(P(0)):CALL X:'open the Fork 10170 RC=P(16):'return code 10180 RFN=P(28):'reference number 10190 RETURN 10500 ' Close RF at RefNum 10510 IF P(0)<>&H41FA THEN GOSUB 15000 10520 P(8)=&HA201:'Close RF byte 10530 P(28)=RFN:'Refnum 10540 GOTO 10030 :'insert into main loop 11000 'Set up for Write RF 11010 IF P(0)<>&H41FA THEN GOSUB 15000 11020 P(8)=&HA203:'Write byte 11030 P(39)=0:' offset msw 11033 Y=VARPTR(VBUF%(0)):P(30)=INT(Y/65536!):GOSUB 20000 11036 P(31)=X 11040 P(40)=0:'offset lsw 11050 TR=VARPTR(DBUF%(0)) 11060 P(32)=INT(TR/65535!):Y=TR:GOSUB 20000 11080 P(33)=X:'buffer 11090 P(34)=0:'count high 11100 P(35)=1:'count low 11110 P(38)=1:'mode as absolute offset 11120 RETURN 12000 'Write RF (hex->bin) 12010 IF EOF (1) THEN GOTO 12990:' return 12020 E=0: IF EOF(1) THEN CLS:PRINT "Hex File Error":GOTO 12990 12030 INPUT #1,D$ 12040 IF MID$(D$,1,6)="***END" THEN 12100 12050 FOR I=1 TO LEN (D$) STEP 2 12060 X=VAL("&H"+MID$(D$,I,2)):CKSUM%=(CKSUM%+X) AND X255% 12070 GOSUB 13000:E=E+1:'write byte at offset E 12080 NEXT I 12085 CALL MOVETO(190,158):PRINT USING "####.##_K";(E/1024) 12090 GOTO 12030 12100 INPUT #1,D$:'get the checksum 12990 CLOSE:RETURN 13000 'Write Byte X at offset E 13010 POKE VARPTR(DBUF%(0)),X 13015 P(39)=INT(E/65536!):Y=E:GOSUB 20000:' offset msw 13020 P(40)=X:'offset lsw 13030 X=VARPTR (P(0)):CALL X:' write it! 13040 RC=P(16):'return code 13050 IF RC<>0 THEN CLS: PRINT "Write RF Error":GOSUB 14000:CLOSE:END 13060 RETURN 14000 'Close RF 14010 GOSUB 10500:'Closing Header to RF routine 14020 IF RC=0 THEN RETURN 14030 PRINT "File Error on Closing RF" 14040 GOTO 14100 14050 'Open RF for E$ 14060 RW=1:'set to read 14070 GOSUB 10000:'Open RF 14080 IF RC=0 THEN RETURN 14090 CLS:PRINT "FILE ERROR ON OPENING RF" 14100 PRINT "Return Code = ";RC 14110 CLOSE :END 15000 'Load Code Array 15010 I=0 15020 RESTORE 15500 15030 READ X:IF X<>-5 THEN P(I)=X:I=I+1:GOTO 15030 15040 RETURN 15500 DATA &H41FA,&H001E,&H2278,&H011C 15510 DATA &H2269,&H0010,&H2251,&H4280,&HA40A 15520 DATA &H41FA,&H000A,&H3080,&H4E75,&H7268,&H6E00,0 15530 DATA &H0000,&H0000,&H0005,&H0000 15540 DATA &H0000,&H0000,&H0000,&H0000 15550 DATA &H0001,&H0000,&H0000,&H0000 15560 DATA &HFFFE,&H0000,&H0000,&H0000 15570 DATA &H0001,&H3000,&H0000,&H0200 15580 DATA &H0000,&H0000,&H0001,&H0000,&H0000 15590 DATA-5 16000 'REad RF at E 16010 IF P(0)<>&H41FA THEN GOSUB 15000 16020 P(8)=&HA202:'Read byte 16030 P(39)=INT(E/65536!):Y=E:GOSUB 20000:'offset msw 16040 P(40)=X: 'offset lsw 16050 TR=VARPTR(DBUF%(0)) 16060 P(32)=INT(TR/65536!):Y=TR:GOSUB 20000:'buffer msw 16070 P(33)=X:'buffer lsw 16080 P(34)=0:'count high 16090 P(35)=RN:'count low 16100 P(38)=1:'mode is absolute offset 16110 X=VARPTR(P(0)):CALL X:'read it! 16120 RC= P(16):'return code 16130 RX=P(37):'returned count 16140 IF RC<>0 THEN CLS:PRINT "Read RF Error":GOSUB 14000:CLOSE:END 16150 RETURN 18000 'Dump the RF 18010 E=0:CKSUM%=0:S=0 18020 IF E>=LFR-1 THEN RN=0: GOTO 18140: ELSE RN=256:IF LFR-E<=256 THEN RN=LFR-E 18030 GOSUB 16000:'get the buffer filled with RF 18040 FOR I=0 TO RX-1 18050 X9=(PEEK(VARPTR(DBUF%(0))+I)) 18060 HX$=HEX$(X9):IF LEN(HX$)<2 THEN HX$="0"+HX$ 18070 CKSUM%=(CKSUM%+X9) AND X255% 18080 PRINT HX$;: PRINT #2,HX$; 18090 S=S+1:IF S>31 THEN S=0:PRINT USING " ######_/";(E+I+1);:PRINT LFR:PRINT #2,"" 18120 NEXT I 18140 IF S>0 THEN PRINT #2,"" 18150 IF RN<256 THEN RETURN 18160 E=E+256:GOTO 18020 18170 END 20000 X=Y-65536!*INT(Y/65536!):IF X>=32768! THEN X=X-65536! 20010 RETURN 21000 'Resource hex->bin Subroutine 21010 CLOSE #2:E$=BF$:RW=2:GOSUB 14070:'Open RF to write 21020 GOSUB 11000:'Setup To Write to RF 21030 GOSUB 12000:'Dump the Hex->RF 21040 GOSUB 14000:'Close rf 21050 RETURN 22000 'Resource Bin-> hex subroutine 22010 PRINT #2,"#";TYPEAPPL$:PRINT #2,"***RESOURCE FORK" 22020 E$=BF$:RW=1 22030 GOSUB 14070:'Open RF 22040 GOSUB 18000:'Dump Fork 22050 GOSUB 14000:'Close Fork 22060 RETURN