10 REM > BLib.File 1.02 J.G.Harston
   20 REM Platform-independant filing functions
   30 :
   40 :
   50 REM PROCf_init - initialise filing-system variables
   60 REM -----------------------------------------------
   70 DEFPROCf_init
   80 d$=".":s$="/":IF(os%AND-24):d$="/":s$=".":IF(os%AND-32):d$="\"
   90 ENDPROC
  100 :
  110 :
  120 REM FNfn_root(path$) - return root of path
  130 REM --------------------------------------
  140 DEFFNfn_root(A$):LOCALA%,B%:IFLEFT$(A$,2)=d$+d$:=LEFT$(A$,INSTR(A$+d$,d$,3)-1)
  150 A%=INSTR(A$,":",2):B%=INSTR(A$,d$,A%)AND(A%<>0):IFB%:A%=B%-1
  160 IFA%:=LEFT$(A$,A%)
  170 IFINSTR(":$%&^@\-",LEFT$(A$,1)):=LEFT$(A$,INSTR(A$+d$,d$)-1)
  180 =""
  190 :
  200 :
  210 REM FNfn_leaf(path$) - returns leafname
  220 REM -----------------------------------
  230 DEFFNfn_leaf(A$):LOCALA%,B%:A%=INSTR(A$,":",2)
  240 REPEATB%=A%:A%=INSTR(A$,d$,A%+1):UNTILA%=0:=MID$(A$,B%+1)
  250 :
  260 :
  270 REM FNfn_path(path$) - returns pathname
  280 REM -----------------------------------
  290 DEFFNfn_path(A$):LOCALA%,B%:A%=INSTR(A$,":",2)
  300 REPEATB%=A%:A%=INSTR(A$,d$,A%+1):UNTILA%=0:=LEFT$(A$,B%)
  310 :
  320 :
  330 REM FNfn_ext(path$) - returns leafname's extension
  340 REM ----------------------------------------------
  350 DEFFNfn_ext(A$):IFINSTR(A$,s$)=0:=""
  360 LOCAL A%:A%=LENA$+1:REPEATA%=A%-1:UNTILINSTR(":"+d$+s$,MID$(A$,A%,1))
  370 IFMID$(A$,A%,1)=s$:=MID$(A$,A%) ELSE =""
  380 :
  390 :
  400 REM FNfn_noext(path$) - returns path with no extension
  410 REM --------------------------------------------------
  420 DEFFNfn_noext(A$):IFINSTR(A$,s$)=0:=A$
  430 LOCAL A%:A%=LENA$+1:REPEATA%=A%-1:UNTILINSTR(":"+s$+d$,MID$(A$,A%,1))
  440 IFMID$(A$,A%,1)=s$:=LEFT$(A$,A%-1) ELSE =A$
  450 :
  460 :
  470 REM FNfn_fullpath(path$, file$) - return full absolute path
  480 REM -------------------------------------------------------
  490 DEFFNfn_fullpath(P$,A$)
  500 IFINSTR("$%&^\-",LEFT$(A$,1)):IF(os%AND-24)=0:=A$
  510 IFINSTR(A$,":")ORLEFT$(A$,1)=d$:=A$
  520 =P$+LEFT$(d$,RIGHT$(P$,1)<>d$)+A$
  530 :
  540 :
  550 REM PROCf_gbpb() - multiple get-bytes or put-bytes call
  560 REM ---------------------------------------------------
  570 DEFPROCf_gbpb(A%,chn%,addr%,num%,ptr%)
  580 ?X%=chn%:X%!1=addr%:X%!5=num%:X%!9=ptr%:IFPAGE<&FFFF:CALL&FFD1:ENDPROC
  590 IFA%=1ORA%=3:PTR#?X%=X%!9
  600 REPEAT:IFA%=1ORA%=2:BPUT#?X%,?X%!1 ELSE IFA%=3ORA%=4:?X%!1=BGET#?X%
  610 X%!1=X%!1+1:X%!5=X%!5-1:UNTIL(EOF#?X% AND A%>2)OR X%!5<1:ENDPROC
  620 :
  630 :
  640 REM FNfs - get current filing system number
  650 REM ---------------------------------------
  660 DEFFNfs:IFPAGE<&FFFF:LOCALA%,Y%,E%:=(USR&FFDA)AND&FF
  670 =29
  680 :
  690 :
  700 REM PROCf_dir(dir$) - select directory
  710 REM PROCf_delete(object$) - delete object
  720 REM -------------------------------------
  730 DEFPROCf_dir(A$):IF(os%AND-24):A$="cd "+A$ ELSE A$="dir "+FNf_name(A$)
  740 DEFPROCf_delete(A$):IF(os%AND-24)=8:A$="rm "+A$ ELSE A$="delete "+FNf_name(A$)
  750 OSCLIA$:ENDPROC
  760 :
  770 :
  780 REM PROCf_cdir(dir$) - create a directory only if it doesn't exist
  790 REM --------------------------------------------------------------
  800 DEFPROCf_cdir(A$):IF(os%AND-24):A$="mkdir "+A$ ELSE A$="cdir "+A$
  810 IF FALSE THEN
  820   OSCLIA$:ENDPROC
  830 ENDIF
  840 LOCAL ERROR:ON ERROR LOCAL:ENDPROC
  850 OSCLIA$:ENDPROC
  860 :
  870 :
  880 REM FNf_name(path$) - ensure no extension if no extension specified
  890 REM ---------------------------------------------------------------
  900 DEFFNf_name(A$)
  910 IF?(TOP-3)=0:LOCALA%,B%:REPEATB%=A%:A%=INSTR(A$,d$,A%+1):UNTILA%=0:IFINSTR(A$,".",B%)=0:A$=A$+"."
  920 =A$
  930 :
  940 :
  950 REM FNf_openin(file$) - open an input file ensuring no extension
  960 REM ------------------------------------------------------------
  970 DEFFNf_openin(A$)=OPENIN(FNf_name(A$))
  980 :
  990 :
 1000 REM FNf_openup(file$) - open an update file ensuring no extension
 1010 REM -------------------------------------------------------------
 1020 DEFFNf_openup(A$)=OPENUP(FNf_name(A$))
 1030 :
 1040 :
 1050 REM FNf_openout(file$) - open an output file ensuring no extension
 1060 REM --------------------------------------------------------------
 1070 DEFFNf_openout(A$)=OPENOUT(FNf_name(A$))
 1080 :
 1090 :
 1100 REM FNf_info(object$) - returns file type, file info in X%!...
 1110 REM ----------------------------------------------------------
 1120 DEFFNf_info(A$):IFPAGE<&FFFF:$name%=A$:?X%=name%:X%?1=name%DIV256:A%=5:=(USR&FFDD)AND&FF
 1130 IFos%<>32:=0
 1140 LOCALdir%,sh%:DIMdir%LOCAL319
 1150 SYS"FindFirstFile",FNf_name(A$),dir%TOsh%
 1160 IFsh%=-1:SYS"GetFileAttributes",FNf_name(A$)TOsh%:=((sh%AND16)DIV16+1)AND(sh%<>-1)
 1170 SYS"FindClose",sh%:X%!10=dir%!32:IFdir%!28:X%!10=-1
 1180 X%?14=(?dir%AND1)*8+(&33 AND ((?dir%AND16)=0))
 1190 SYS"FileTimeToSystemTime",dir%+20,X%+16
 1200 A%=(X%!16AND&FFFF)-1981:X%?15=X%?22+(A%AND&70)*2:X%?16=X%?18+A%*16
 1210 X%?17=X%?24:X%?18=X%?26:X%?19=X%?28:=(?dir%AND16)DIV16+1
 1220 :
 1230 :
 1240 REM PROCf_settype(object%, type%) - set file type
 1250 REM ---------------------------------------------
 1260 DEFPROCf_settype(A$,A%):IFos%=32:ENDPROC
 1270 IFPAGE<&FFFF:IFFNf_info(A$):X%?3=A%:X%?4=(A%DIV256)OR&F0:X%?5=&FF:A%=1:CALL&FFDD
 1280 ENDPROC
 1290 :
 1300 :

Download File.bbc

BBC BASIC detokeniser and syntax highlighter by Ben Ryves.