Sunday 12 April 2009

A Snippet of Code

Here is a snippet of SBASIC that came from QL Today and is in the words of the author indispensible. There are many such bits of code. What are yours.

ffnm$ is a variable containing the complete file name ie Win1_SBASIC_Myfile_bas
This has been changed from the original listing as there is also a resident extension that also uses filename$ - the original variable used.

27280 DEFine FuNction Directory_Name$ (ffnm$)
27290 LOCal ch,d$(36)
27300 ch=FOP_DIR(ffnm$)
27310 IF ch<0 THEN
27320 d$=""
27330 ELSE
27340 d$=FNAME$(#ch)
27350 IF d$>""
27360 IF d$(LEN(d$))<>"_" THEN d$=d$&"_"
27370 END IF
27380 CLOSE#ch
27390 END IF
27400 RETurn d$
27410 END DEFine
27420 :
27430 DEFine FuNction Drive_Name$ (ffnm$)
27440 LOCal d$(36),ch
27450 d$=""
27460 ch="_" INSTR ffnm$
27470 IF ch>0:d$=ffnm$(1 TO ch)
27480 RETurn d$
27490 END DEFine
27500 :
27510 DEFine FuNction Pure_Filename$ (ffnm$)
27520 LOCal ch,d$(36)
27530 ch=LEN(Drive_Name$(ffnm$))+LEN(Directory_Name$(ffnm$))
27540 d$=""
27550 IF LEN(ffnm$)>ch : d$=ffnm$(ch+1 TO LEN(ffnm$))
27560 RETurn d$
27570 END DEFine
27580 :
27590 DEFine FuNction Extension$ (ffnm$,separator$,mxln)
27600 LOCal ch,c,ext$,f$
27610 REMark mxln is the maximum length of extension permitted
27620 REMark usually '_' or'>' plus 3 characters
27630 REMark separator$ is '_' (QDOS0 or '.' (PC)
27640 f$=Pure_Filename$(ffnm$) : REMark remove drive and directory
27650 ext$="":REMark extension string
27660 ch=LEN(f$)-mxln+1
27670 IF ch<1 THEN ch=1
27680 FOR c=LEN(f$) TO ch STEP -1
27690 IF f$(c) = separator$ THEN
27700 ext$=f$(c TO LEN(f$))
27710 EXIT c
27720 END IF
27730 END FOR c
27740 RETurn ext$
27750 END DEFine
27770 :

No comments:

Post a Comment