10
20
30
40
50
60
70
80
90
100 MODE7:ONERRORCLOSE#0:REPORT:PRINT;" at line ";ERL:END
110 PROCinit:REPEATVDU12:PRINTFNdbl("BBC File Merger and Extracter")'CHR$129"Version 0.0f _ public domain!"
120 PRINT'''CHR$134"1) Split up a BFM file"'CHR$134"2) Create a BFM file"
130 PRINTCHR$134"3) Append to a BFM file"'CHR$134"4) Info"
140 PRINTCHR$134"5) Exit to Basic"''CHR$134"* OS Command"
150 REPEAT
160 opt=GET-48:UNTILopt>0 ANDopt<6 ORopt=-6
170 IFopt=-6 VDU31,0,11,129:PRINT'"(press RETURN to exit)":REPEATINPUTLINE" *"OS$:PROCoscli(OS$):UNTILOS$=""
180 VDU31,0,opt+5,135,31,0,13
190 IFopt=1 PROCsplit:PROCpak
200 IFopt=2 PROCcreate:PROCpak
210 IFopt=3 PROCappend:PROCpak
220 IFopt=4 PROCinfo
230 UNTILopt=5:END
240 DEFPROCsplit:REPEATPRINTFNdbl("Source BFM filename")':BFMname$=FNget("name of BFM file to"+CHR$134+"split"):IFBFMname$="" UNTILTRUE:ENDPROC
250 IFFNck(BFMname$,5)=0:PRINT"Can't find that file!"'':UNTILFALSE
260 UNTILTRUE
270 in%=OPENIN(BFMname$):IFFNcheck(in%):ENDPROC
280 PRINT"Reading data from"CHR$134BFMname$
290 PRINT"Date created:"CHR$134;:PROCgetinfo(in%):PRINT$bfm
300 PRINT"Time created:"CHR$134;:PROCgetinfo(in%):PRINT$bfm
310 PRINT"Comment found in BFM:":PROCgetinfo(in%):PRINT$bfm
320 IFFNend(in%) CLOSE#in%:PRINTFNdbl("No files found in BFM"):ENDPROC
330 PROCpaktc:tot%=1:REPEATPROCgetinfo(in%):fname$=$bfm
340 FORl%=0TO11:l%?bfm=BGET#in%:NEXT:len%=!bfm:load=bfm!4:exec=bfm!8
350 PRINTfname$CHR$131"(file ";tot%")":old$=fname$
360 IFdfs%fname$=FNdfs(fname$)
370 IFfname$<>old$:PRINT"Renaming to: ";fname$
380 IFFNck(fname$,5) IFNOTFNyes("Already exists. Overwrite?",0) THENPTR#in%=PTR#in%+len%:tot%=tot%+1:GOTO450
390 PRINTCHR$129"Len"CHR$135;len%CHR$129"Load"CHR$135"&";~bfm!4CHR$129"Exec"CHR$135"&";~bfm!8
400 PRINTCHR$131"o";:PROCoscli("SAVE "+fname$+" 0+"+STR$~len%):out%=OPENOUTfname$:count=0
410 REPEATcount=count+1
420 IFcount*ble%>=len% PROCrw(in%,out%,bfm,len%-(count-1)*ble%) ELSEPROCrw(in%,out%,bfm,ble%)
430 UNTILcount*ble%>=len%:PRINTCHR$131"c":CLOSE#out%:tot%=tot%+1
440 bl%!2=load:A%=FNck(fname$,2):bl%!6=exec:A%=FNck(fname$,3)
450 UNTILFNend(in%):CLOSE#in%:ENDPROC
460 DEFPROCatl(text$):$ptr=text$:ptr=ptr+1+LENtext$:ENDPROC
470 DEFFNend(handle%):PROCgetinfo(handle%):IF$bfm="END:" =TRUE ELSEIF$bfm="BEGIN:" =FALSE ELSEPRINT"Unknown token:"$bfm':=TRUE
480 DEFPROCgetinfo(in%):l%=0:IFNOTEOF#in% REPEATl%?bfm=BGET#in%:l%=l%+1:UNTIL?(l%-1+bfm)=13:ENDPROC ELSEPRINTCHR$129"Fatal error:"'" end of file - corrupt BFM file":CLOSE#0:PROCpak:RUN
490 DEFPROCpak:PRINT'CHR$130"Press any key to return to menu"CHR$8;:REPEATUNTILGET:ENDPROC
500 DEFPROCpaktc:PRINT'FNdbl("Press a key"):*FX15
510 IFGETENDPROC
520 DEFPROCcreate
530 PRINTFNdbl("Destination BFM filename")'
540 BFMname$=FNget("name of BFM file to"+CHR$134+"create")
550 IFBFMname$="" ENDPROC
560 PRINT"Creating BFM:"CHR$134BFMname$
570 IFFNck(BFMname$,5)<>0 IFNOTFNyes(CHR$13+CHR$10+"Already exists, Overwrite?",0) ENDPROC
580 out%=OPENOUTBFMname$
590 PRINTFNdbl("Comments for BFM")
600 PRINT"Enter any special"+CHR$134+"comment/s"+CHR$135+"that will"'"appear when this BFM file is extracted, or press RETURN only for no comment."
610 INPUTLINE"]"comment$
620 IFINKEY-256=253 date$=LEFT$(TIME$,15):time$=RIGHT$(TIME$,8) ELSEdate$=FNgetdate:time$=FNgettime
630 PRINT"Please wait, adding file header info to BFM:"CHR$134BFMname$
640 ptr=bfm:PROCatl(header$):PROCatl(date$):PROCatl(time$):PROCatl(comment$)
650 PROCadd
660 PROCdo_add
670 ENDPROC
680 DEFFNck(F$,A%)
690 fnamead=(bl%+18)
700 ?bl%=fnamead MOD256:bl%?1=fnamead DIV256:$fnamead=F$
710 X%=bl% MOD256:Y%=bl% DIV256
720 =USR&FFDD AND&FF
730 DEFPROCfile_addr:load=bl%!2:exec=bl%!6:leng=bl%!10:attr=bl%!14:ENDPROC
740 DEFFNdbl(text$)=CHR$141+text$+CHR$13+CHR$10+CHR$141+text$
750 DEFFNget(text$):REPEATPRINT"Enter "text$'"or enter a *command"
760 INPUTLINE"]"name$
770 IFLEFT$(name$,1)="*" PROCoscli(name$)
780 UNTILLEFT$(name$,1)<>"*":=name$
790 DEFFNgetdate:PRINT'FNdbl("Creation date of BFM")
800 REPEATPRINT'"Please enter today's"CHR$134"date."'"eg. Wed,10th May 1989 or press RETURN only to leave blank."
810 INPUTLINE"]"date$
820 IFdate$="" date$="-No date entered-"
830 IFLENdate$<17 date$=date$+STRING$(17-LENdate$," ")
840 UNTILFNyes("Creation date:"+CHR$135+LEFT$(date$,17),1):=LEFT$(date$,17)
850 DEFFNgettime:PRINT'FNdbl("Creation time of BFM")
860 REPEATPRINT'"Please enter the"CHR$134"time"CHR$135"in 24 hour format"'"eg. 08:45 is 8.45 am, 20:02 is 8.02 pm"'"or press RETURN only for none."
870 INPUTLINE"]"time$:IFtime$="" time$="00:00"
880 IFLENtime$<5 time$=time$+STRING$(5-LENtime$," ")
890 UNTILFNyes("Creation time:"+CHR$135+LEFT$(time$,5),1):=LEFT$(time$,5)
900 DEFPROCadd:FORloop=0TO(ptr-bfm-1):BPUT#out%,bfm?loop:NEXT:ENDPROC
910 DEFFNyes(text$,zz%):PRINTCHR$130text$'CHR$132CHR$157CHR$135"Is this okay? (";:IFzz%PRINT"Y/n"; ELSEPRINT"y/N";
920 PRINT"):"CHR$134;:REPEATkey%=GETAND&DF:UNTILkey%=89ORkey%=78ORkey%=13:IFkey%=13ANDzz% key%=89 ELSEIFkey%=13ANDNOTzz% key%=78
930 IFkey%=78 PRINT"No":=FALSE ELSEPRINT"Yes":=TRUE
940 DEFPROCinit:
950 ble%=&4000:DIM cli% 79,bl% &FF,bfm ble%
960 A%=0:Y%=0:dfs%=((USR&FFDA AND&FF)=4)
970 header$="**I am a BBC BFM file**"
980 begin$="BEGIN:":end$="END:"
990 ENDPROC
1000 DEFPROCinfo:CLS:PRINTFNdbl("Program info")
1010 PRINT'"This is BFM version 0.0f."'"BFM lets you place many files into one"'"for transfers to/from bulletin boards."'"Compression is currently not done."
1020 PROCpak
1030 ENDPROC
1040 DEFPROCrw(in%,out%,memloc,len):PROCsetb:PRINTCHR$132"r";:?bl%=in%:A%=4:CALL&FFD1
1050 PROCsetb:PRINTCHR$134"w";:?bl%=out%:A%=2:CALL&FFD1:ENDPROC
1060 DEFPROCsetb:bl%!1=memloc:bl%!5=len:bl%!9=-1:X%=bl% MOD256:Y%=bl% DIV256:ENDPROC
1070 DEFPROCoscli($cli%):X%=cli%:Y%=X%DIV256:CALL&FFF7:ENDPROC
1080 DEFPROCappend
1090 REPEAT
1100 PRINTFNdbl("Source BFM filename")'
1110 BFMname$=FNget("name of BFM file to"+CHR$134+"append to")
1120 IFBFMname$="" UNTILTRUE:ENDPROC
1130 IFFNck(BFMname$,5)=0:PRINT"Can't find that file!"'':UNTILFALSE
1140 UNTILTRUE
1150 out%=OPENUP(BFMname$)
1160 IFFNcheck(out%):ENDPROC
1170 PRINT"Reading data from"CHR$134BFMname$
1180 PRINT"Date created:"CHR$134;
1190 PROCgetinfo(out%)
1200 PRINT$bfm
1210 PRINT"Time created:"CHR$134;
1220 PROCgetinfo(out%)
1230 PRINT$bfm
1240 PRINT"Comment found in BFM:"
1250 PROCgetinfo(out%)
1260 PRINT$bfm
1270 IFFNend(out%):PRINT'"File empty"':GOTO1350
1280 PRINT'"Files found:"'
1290 REPEAT
1300 PROCgetinfo(out%):fname$=$bfm
1310 FORl%=0TO11:l%?bfm=BGET#out%:NEXT
1320 PRINT"†";fname$;" - ";!bfm;" bytes"
1330 PTR#out%=PTR#out%+!bfm
1340 UNTILFNend(out%):PRINT'"No more files"'
1350 PTR#out%=PTR#out%-5
1360 PRINT"Ready to add new files:"'
1370 PROCdo_add
1380 ENDPROC
1390 DEFPROCdo_add
1400 REPEAT:REPEAT
1410 source$=FNget("source file (or press RETURN to"+CHR$13+CHR$10+"finish entering list)")
1420 res%=1:IFsource$="" res%=FNyes("End of BFM files list",1):IFres% UNTILTRUE:UNTILTRUE:GOTO1550 ELSEIFres%=0:UNTILFALSE
1430 IFFNck(source$,5)<>1 PRINT"ERROR:"CHR$134"Can't find file"':UNTILFALSE
1440 PROCfile_addr
1450 PRINT"Enter name of file that will be created when"CHR$134""""source$""""'"is extracted from the BFM, or press"'"RETURN only to use"CHR$134""""source$""""
1460 INPUTLINE"]"dest$:IFdest$="" dest$=source$
1470 PRINT"Source filename is"CHR$134source$'"Filename inside BFM is"CHR$134dest$
1480 UNTILFNyes("Confirm names are correct",1)
1490 PRINTsource$'CHR$129"Length"CHR$135;leng;CHR$129"Load"CHR$135"&";~load;CHR$129"Exec"CHR$135"&";~exec
1500 PRINTCHR$131"o";:in%=OPENIN(source$):ptr=bfm:PROCatl(begin$):PROCatl(dest$):!ptr=leng:ptr!4=load:ptr!8=exec:ptr=ptr+12:PROCadd
1510 count=0:REPEATcount=count+1
1520 IFcount*ble%>=leng PROCrw(in%,out%,bfm,leng-(count-1)*ble%) ELSEPROCrw(in%,out%,bfm,ble%)
1530 UNTILcount*ble%>=leng
1540 PRINTCHR$131"c":CLOSE#in%:UNTILFALSE
1550 ptr=bfm:PROCatl(end$):PROCadd
1560 PRINT"Closing BFM file ...":CLOSE#out%
1570 ENDPROC
1580 DEFFNdfs(fname$)
1590 IFINSTR(fname$,".")>2 fname$=RIGHT$(fname$,LEN(fname$)-INSTR(fname$,".")):GOTO1590
1600 IFMID$(fname$,2,1)="." ANDLENfname$<10:=fname$
1610 IFLENfname$<8:=fname$
1620 B%=48
1630 REPEATfname$=LEFT$(fname$,5)+"#"+CHR$B%
1640 B%=B%+1:IFB%=58:B%=65
1650 UNTILFNck(fname$,5)=0:=fname$
1660 DEFFNcheck(handle%):PRINT"Checking..."':l%=-1:REPEAT:l%=l%+1:l%?bfm=BGET#handle%:UNTILEOF#handle%ORl%?bfm=13 ORPTR#handle%>LENheader$+1
1670 IF$bfm<>header$ PRINTFNdbl("That file is not a BFM file"):CLOSE#handle%:=TRUE
1680 =FALSE