home *** CD-ROM | disk | FTP | other *** search
/ ftp.uni-stuttgart.de/pub/systems/acorn/ / Acorn.tar / Acorn / 6502 / archivers / bfm.basic < prev    next >
Text File  |  1992-09-17  |  9KB  |  167 lines
  1.    10REM BBC BFM 0.0f (B,B+,M,C)
  2.    20REM Format devised by Pat Cain, Wed 10 May 1989
  3.    30REM Enhanced by Friso Dijstelbergen
  4.    40REM Modified by David Sainty, Thu 29 Nov 1990 - append option
  5.    50REM and once more by Pat, May 1991 - y/N Y/n option
  6.    60REM Call Sideways BBS for latest BBC/Amstrad CPC/IBM PC versions
  7.    70REM   PHONE +64 4 569-5695  USENET sideways.welly.gen.nz
  8.    80REM
  9.    90MODE7:ONERRORCLOSE#0:REPORT:PRINT;" at line ";ERL:END
  10.   100PROCinit:REPEATVDU12:PRINTFNdbl("BBC File Merger and Extracter")'CHR$129"Version 0.0f _ public domain!"
  11.   110PRINT'''CHR$134"1) Split up a BFM file"'CHR$134"2) Create a BFM file"
  12.   120PRINTCHR$134"3) Append to a BFM file"'CHR$134"4) Info"
  13.   130PRINTCHR$134"5) Exit to Basic"''CHR$134"*  OS Command"
  14.   140REPEAT
  15.   150opt=GET-48:UNTILopt>0 ANDopt<6 ORopt=-6
  16.   160IFopt=-6 VDU31,0,11,129:PRINT'"(press RETURN to exit)":REPEATINPUTLINE" *"OS$:PROCoscli(OS$):UNTILOS$=""
  17.   170VDU31,0,opt+5,135,31,0,13
  18.   180IFopt=1 PROCsplit:PROCpak
  19.   190IFopt=2 PROCcreate:PROCpak
  20.   200IFopt=3 PROCappend:PROCpak
  21.   210IFopt=4 PROCinfo
  22.   220UNTILopt=5:END
  23.   230DEFPROCsplit:REPEATPRINTFNdbl("Source BFM filename")':BFMname$=FNget("name of BFM file to"+CHR$134+"split"):IFBFMname$="" UNTILTRUE:ENDPROC
  24.   240IFFNck(BFMname$)=0:PRINT"Can't find that file!"'':UNTILFALSE
  25.   250UNTILTRUE
  26.   260in%=OPENUP(BFMname$):IFFNcheck(in%):ENDPROC
  27.   270PRINT"Reading data from"CHR$134BFMname$
  28.   280PRINT"Date created:"CHR$134;:PROCgetinfo(in%):PRINT$bfm
  29.   290PRINT"Time created:"CHR$134;:PROCgetinfo(in%):PRINT$bfm
  30.   300PRINT"Comment found in BFM:":PROCgetinfo(in%):PRINT$bfm
  31.   310IFFNend(in%) CLOSE#in%:PRINTFNdbl("No files found in BFM"):ENDPROC
  32.   320PROCpaktc:tot%=1:REPEATPROCgetinfo(in%):fname$=$bfm
  33.   330FORl%=0TO11:l%?bfm=BGET#in%:NEXT:len%=!bfm
  34.   340PRINTfname$CHR$131"(file ";tot%")":old$=fname$
  35.   350IFdfs%fname$=FNdfs(fname$)
  36.   360IFfname$<>old$:PRINT"Renaming to: ";fname$
  37.   370IFFNck(fname$) IFNOTFNyes("Already exists. Overwrite?",0) THENPTR#in%=PTR#in%+len%:tot%=tot%+1:GOTO430
  38.   380PRINTCHR$129"Len"CHR$135;len%CHR$129"Load"CHR$135"&";~bfm!4CHR$129"Exec"CHR$135"&";~bfm!8
  39.   390PRINTCHR$131"o";:PROCoscli("SAVE "+fname$+" "+STR$~bfm!4+"+"+STR$~len%+" "+STR$~bfm!8):out%=OPENOUTfname$:count=0
  40.   400REPEATcount=count+1
  41.   410IFcount*ble%>=len% PROCrw(in%,out%,bfm,len%-(count-1)*ble%) ELSEPROCrw(in%,out%,bfm,ble%)
  42.   420UNTILcount*ble%>=len%:PRINTCHR$131"c":CLOSE#out%:tot%=tot%+1
  43.   430UNTILFNend(in%):CLOSE#in%:ENDPROC
  44.   440DEFPROCatl(text$):$ptr=text$:ptr=ptr+1+LENtext$:ENDPROC
  45.   450DEFFNend(handle%):PROCgetinfo(handle%):IF$bfm="END:" =TRUE ELSEIF$bfm="BEGIN:" =FALSE ELSEPRINT"Unknown token:"$bfm':=TRUE
  46.   460DEFPROCgetinfo(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
  47.   470DEFPROCpak:PRINT'CHR$130"Press any key to return to menu"CHR$8;:REPEATUNTILGET:ENDPROC
  48.   480DEFPROCpaktc:PRINT'FNdbl("Press a key"):*FX15
  49.   490IFGETENDPROC
  50.   500DEFPROCcreate
  51.   510PRINTFNdbl("Destination BFM filename")'
  52.   520BFMname$=FNget("name of BFM file to"+CHR$134+"create")
  53.   530IFBFMname$="" ENDPROC
  54.   540PRINT"Creating BFM:"CHR$134BFMname$
  55.   550IFFNck(BFMname$)<>0 IFNOTFNyes(CHR$13+CHR$10+"Already exists, Overwrite?",0) ENDPROC
  56.   560out%=OPENOUTBFMname$
  57.   570PRINTFNdbl("Comments for BFM")
  58.   580PRINT"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."
  59.   590INPUTLINE"]"comment$
  60.   600IFINKEY-256=253 date$=LEFT$(TIME$,15):time$=RIGHT$(TIME$,8) ELSEdate$=FNgetdate:time$=FNgettime
  61.   610PRINT"Please wait, adding file header info to BFM:"CHR$134BFMname$
  62.   620ptr=bfm:PROCatl(header$):PROCatl(date$):PROCatl(time$):PROCatl(comment$)
  63.   630PROCadd
  64.   640PROCdo_add
  65.   650ENDPROC
  66.   660DEFFNck(F$)
  67.   670fnamead=(bl%+18)
  68.   680?bl%=fnamead MOD256:bl%?1=fnamead DIV256:$fnamead=F$
  69.   690A%=5:X%=bl% MOD256:Y%=bl% DIV256
  70.   700=USR&FFDD AND&FF
  71.   710DEFPROCfile_addr:load=bl%!2:exec=bl%!6:leng=bl%!10:attr=bl%!14:ENDPROC
  72.   720DEFFNdbl(text$)=CHR$141+text$+CHR$13+CHR$10+CHR$141+text$
  73.   730DEFFNget(text$):REPEATPRINT"Enter "text$'"or enter a *command"
  74.   740INPUTLINE"]"name$
  75.   750IFLEFT$(name$,1)="*" PROCoscli(name$)
  76.   760UNTILLEFT$(name$,1)<>"*":=name$
  77.   770DEFFNgetdate:PRINT'FNdbl("Creation date of BFM")
  78.   780REPEATPRINT'"Please enter today's"CHR$134"date."'"eg. Wed,10th May 1989 or press RETURN   only to leave blank."
  79.   790INPUTLINE"]"date$
  80.   800IFdate$="" date$="-No date entered-"
  81.   810IFLENdate$<17 date$=date$+STRING$(17-LENdate$," ")
  82.   820UNTILFNyes("Creation date:"+CHR$135+LEFT$(date$,17),1):=LEFT$(date$,17)
  83.   830DEFFNgettime:PRINT'FNdbl("Creation time of BFM")
  84.   840REPEATPRINT'"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."
  85.   850INPUTLINE"]"time$:IFtime$="" time$="00:00"
  86.   860IFLENtime$<5 time$=time$+STRING$(5-LENtime$," ")
  87.   870UNTILFNyes("Creation time:"+CHR$135+LEFT$(time$,5),1):=LEFT$(time$,5)
  88.   880DEFPROCadd:FORloop=0TO(ptr-bfm-1):BPUT#out%,bfm?loop:NEXT:ENDPROC
  89.   890DEFFNyes(text$,zz%):PRINTCHR$130text$'CHR$132CHR$157CHR$135"Is this okay? (";:IFzz%PRINT"Y/n"; ELSEPRINT"y/N";
  90.   900PRINT"):"CHR$134;:REPEATkey%=GETAND&DF:UNTILkey%=89ORkey%=78ORkey%=13:IFkey%=13ANDzz% key%=89 ELSEIFkey%=13ANDNOTzz% key%=78
  91.   910IFkey%=78 PRINT"No":=FALSE ELSEPRINT"Yes":=TRUE
  92.   920DEFPROCinit:REM ** Don't change any of the below **
  93.   930ble%=&4000:DIM bl% &FF,bfm ble%
  94.   940A%=0:Y%=0:dfs%=((USR&FFDA AND&FF)=4)
  95.   950header$="**I am a BBC BFM file**"
  96.   960begin$="BEGIN:":end$="END:"
  97.   970ENDPROC
  98.   980DEFPROCinfo:CLS:PRINTFNdbl("Program info")
  99.   990PRINT'"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."
  100.  1000PROCpak
  101.  1010ENDPROC
  102.  1020DEFPROCrw(in%,out%,memloc,len):PROCsetb:PRINTCHR$132"r";:?bl%=in%:A%=4:CALL&FFD1
  103.  1030PROCsetb:PRINTCHR$134"w";:?bl%=out%:A%=2:CALL&FFD1:ENDPROC
  104.  1040DEFPROCsetb:bl%!1=memloc:bl%!5=len:bl%!9=-1:X%=bl% MOD256:Y%=bl% DIV256:ENDPROC
  105.  1050DEFPROCoscli($&700):X%=0:Y%=7:CALL&FFF7:ENDPROC
  106.  1060DEFPROCappend
  107.  1070REPEAT
  108.  1080PRINTFNdbl("Source BFM filename")'
  109.  1090BFMname$=FNget("name of BFM file to"+CHR$134+"append to")
  110.  1100IFBFMname$="" UNTILTRUE:ENDPROC
  111.  1110IFFNck(BFMname$)=0:PRINT"Can't find that file!"'':UNTILFALSE
  112.  1120UNTILTRUE
  113.  1130out%=OPENUP(BFMname$)
  114.  1140IFFNcheck(out%):ENDPROC
  115.  1150PRINT"Reading data from"CHR$134BFMname$
  116.  1160PRINT"Date created:"CHR$134;
  117.  1170PROCgetinfo(out%)
  118.  1180PRINT$bfm
  119.  1190PRINT"Time created:"CHR$134;
  120.  1200PROCgetinfo(out%)
  121.  1210PRINT$bfm
  122.  1220PRINT"Comment found in BFM:"
  123.  1230PROCgetinfo(out%)
  124.  1240PRINT$bfm
  125.  1250IFFNend(out%):PRINT'"File empty"':GOTO1330
  126.  1260PRINT'"Files found:"'
  127.  1270REPEAT
  128.  1280PROCgetinfo(out%):fname$=$bfm
  129.  1290FORl%=0TO11:l%?bfm=BGET#out%:NEXT
  130.  1300PRINT"å";fname$;" - ";!bfm;" bytes"
  131.  1310PTR#out%=PTR#out%+!bfm
  132.  1320UNTILFNend(out%):PRINT'"No more files"'
  133.  1330PTR#out%=PTR#out%-5
  134.  1340PRINT"Ready to add new files:"'
  135.  1350PROCdo_add
  136.  1360ENDPROC
  137.  1370DEFPROCdo_add
  138.  1380REPEAT:REPEAT
  139.  1390source$=FNget("source file (or press RETURN to"+CHR$13+CHR$10+"finish entering list)")
  140.  1400res%=1:IFsource$="" res%=FNyes("End of BFM files list",1):IFres% UNTILTRUE:UNTILTRUE:GOTO1530 ELSEIFres%=0:UNTILFALSE
  141.  1410IFFNck(source$)<>1 PRINT"ERROR:"CHR$134"Can't find file"':UNTILFALSE
  142.  1420PROCfile_addr
  143.  1430PRINT"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$""""
  144.  1440INPUTLINE"]"dest$:IFdest$="" dest$=source$
  145.  1450PRINT"Source filename is"CHR$134source$'"Filename inside BFM is"CHR$134dest$
  146.  1460UNTILFNyes("Confirm names are correct",1)
  147.  1470PRINTsource$'CHR$129"Length"CHR$135;leng;CHR$129"Load"CHR$135"&";~load;CHR$129"Exec"CHR$135"&";~exec
  148.  1480PRINTCHR$131"o";:in%=OPENIN(source$):ptr=bfm:PROCatl(begin$):PROCatl(dest$):!ptr=leng:ptr!4=load:ptr!8=exec:ptr=ptr+12:PROCadd
  149.  1490count=0:REPEATcount=count+1
  150.  1500IFcount*ble%>=leng PROCrw(in%,out%,bfm,leng-(count-1)*ble%) ELSEPROCrw(in%,out%,bfm,ble%)
  151.  1510UNTILcount*ble%>=leng
  152.  1520PRINTCHR$131"c":CLOSE#in%:UNTILFALSE
  153.  1530ptr=bfm:PROCatl(end$):PROCadd
  154.  1540PRINT"Closing BFM file ...":CLOSE#out%
  155.  1550ENDPROC
  156.  1560DEFFNdfs(fname$)
  157.  1570IFINSTR(fname$,".")>2 fname$=RIGHT$(fname$,LEN(fname$)-INSTR(fname$,".")):GOTO1570
  158.  1580IFMID$(fname$,2,1)="." ANDLENfname$<10:=fname$
  159.  1590IFLENfname$<8:=fname$
  160.  1600B%=48
  161.  1610REPEATfname$=LEFT$(fname$,5)+"#"+CHR$B%
  162.  1620B%=B%+1:IFB%=58:B%=65
  163.  1630UNTILFNck(fname$)=0:=fname$
  164.  1640DEFFNcheck(handle%):PRINT"Checking..."':l%=-1:REPEAT:l%=l%+1:l%?bfm=BGET#handle%:UNTILEOF#handle%ORl%?bfm=13 ORPTR#handle%>LENheader$+1
  165.  1650IF$bfm<>header$ PRINTFNdbl("That file is not a BFM file"):CLOSE#handle%:=TRUE
  166.  1660=FALSE
  167.