$CPU 8086          ' make compatible with XT systems
$LIB ALL OFF       ' turn off all PowerBASIC libraries
$ERROR ALL OFF     ' turn off all PowerBASIC error checking
$OPTIMIZE SIZE     ' optimize for smaller code
 $COMPILE UNIT      ' compile to a UNIT (.PBU)
'$COMPILE EXE       ' compile to a UNIT (.PBU)

DEFINT A-Z         ' Required for all numeric functions, forces PB to not
                   ' include floating point in UNIT (makes it smaller)
'/*------------------------------------------------------------------*/
$CODE SEG "MLIB6"
DECLARE FUNCTION EXIST(BYVAL Filename AS STRING) AS INTEGER
DECLARE FUNCTION FILESPEC(BYVAL OPT AS STRING, BYVAL FLNAME AS STRING) AS STRING
DECLARE FUNCTION WORD(BYVAL X AS STRING,XN AS INTEGER) AS STRING
'/*------------------------------------------------------------------*/
' FOPEN FB,FILENAME$,LRECL,NRECS#,P$,SK
'     File OPEN.
'     Works with sequential, fixed length record files.
'     Opens a sequential file using FILENAME.DFD to determine LRECL,
'     NRECS#, P$ (field Parse string) and SK (sort key field).
'
'     Returns FB, LRECL, NRECS#, P$ and SK.
'
'     FORMAT of DFD file is: LINE1 MUST be anytext sorfield#
'                            subseqent lines: FieldName size
'            EXAMPLE: Mailing-List-SORT 2
'                     TITLE 30  edit options can be here
'                     NAME 30
'                     ADDRESS 30
'                     CITY 20
'                     STATE 2
'                     ZIP5 5
'                     ZIP4 4
'                     MISC 4
'                     EOR 3
'
'            EXAMPLE: Mailing-List-SORT 2
'                     TITLE 30       UPPER
'                     NAME 30        UPPER,COMMA
'                     ADDRESS 30     UPPER
'                     CITY 20        UPPER
'                     STATE 2        UPPER
'                     ZIP5 5         ZIP
'                     ZIP4 4         ZIP
'                     MISC 4         ANY
'                     EOR 3
'
'     EXAMPLE:  FOPEN FB,FS$,LRECL,NRECS#,P$,SK
'     NOTE:     If FS$.DFD is not found FB = -2
'               IF FS$ = "" then FS was not found.
'/*------------------------------------------------------------------*/
   SUB FOPEN(FB,FILENAME$,LRECL,NRECS#,P$,SK) PUBLIC
'/*  --- Does File Exist? ---*/
     IF EXIST(FILENAME$) = 0 THEN
       FB = -1
       EXIT SUB
     END IF
'/*  --- Make DFD File Name ---*/
     HPATH$ = FILESPEC("H",FILENAME$)
     BFS$ = FILESPEC("F",FILENAME$)
     DFDFN$ = HPATH$+BFS$+".DFD"
'/*  --- Does DFD File Exist? ---*/
     IF EXIST(DFDFN$) = 0 THEN
       FB = -2
       EXIT SUB
     END IF
'/*  --- Load Data File Definition ---*/
     DFDFB = FREEFILE
     OPEN"I",DFDFB,DFDFN$
     INPUT#DFDFB,TP$
     SK = VAL(WORD(TP$,2))
     LRECL = 0
     CNT = 0
     SC = 1
     DO WHILE NOT EOF(DFDFB)
       CNT = CNT + 1
       LINE INPUT#DFDFB,T$
       L = VAL(WORD(T$,2))
       P$ = P$ + STR$(SC) + STR$(L)
       SC = SC + L
     LOOP
'/*  --- Determine LRECL ---*/
     LRECL = SC -1
     CLOSE#DFDFB
'/*  --- Open Data File ---*/
     FB = FREEFILE
     OPEN FILENAME$ FOR BINARY ACCESS READ WRITE SHARED AS #FB
'/*  --- If Empty File Return Error Code 101 ---
     IF LOF(FB) = 0 THEN
       CLOSE #FB
       FB = -3
       EXIT SUB
     END IF
'/*  --- Calculate # of Records ---*/
     TL# = LOF(FB)
     NRECS# = TL# / LRECL
   END SUB
'/*------------------------------------------------------------------*/
' FSEEK FB,NBR#,LRECL
'     File record Seek.
'     Calculates relative byte address (RBA) of record NBR# and positions
'     GET$ pointer to that RBA.  Works same as SEEK except the RBA
'     is calculated based on LRECL and NBR#.
'     FOPEN.
'     EXAMPLE:  FSEEK FB,10,LRECL
'/*------------------------------------------------------------------*/
   SUB FSEEK(FB,NBR#,LRECL) PUBLIC
     RBA# = (LRECL * NBR#) - LRECL
     SEEK #FB,RBA#
   END SUB
'/*------------------------------------------------------------------*/
'  $INCLUDE "C:\CODE\MLIB\MLIB.INC"
'  REDIM DA$(0:50)
'  FILENAME$ = "C:\DATA\REG97"
'  FOPEN FB,FILENAME$,LRECL,NRECS#,P$
'  PRINT "    Buffer ='"FB"'"
'  PRINT " File Name = '"FILENAME$"'"
'  PRINT "     LRECL ='"LRECL"'"
'  PRINT "     NRECS ='"NRECS#"'"
'  PRINT "POSITIONAL ='"P$"'"
'  Y$ = GETKEY
'  FSEEK FB,10,LRECL
'  GET$ #FB,LRECL,T$
'  PRINT T$
'  PARSE "POSITIONAL",P$,T$,DA$()
'  FCNT = VAL(DA$(0))
'  FOR CNT = 1 TO FCNT
'    PRINT "'"DA$(CNT)"'"
'  NEXT CNT
'  Y$ = GETKEY
'  CLOSE#FB