$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)
'/*------------------------------------------------------------------*/
DECLARE FUNCTION FORMAT(BYVAL NUM AS EXT, BYVAL BEF AS INTEGER, BYVAL AFT AS INTEGER) AS STRING
$CODE SEG "MLIB4"
'/*------------------------------------------------------------------*/
' DB2ARRAY DBREC$,DFD$(),RTRNA$()
'     dBase reocord to Array.
'     Puts dBASE record in DBREC$ into array RTRNA$() using DFD$().
'     Number of RTRNA$() elements is put in RTRNA$(0).
'     One data field per array element.
'     EXAMPLE:  DB2ARRAY D$,DFD$(),A$()
'/*------------------------------------------------------------------*/
    SUB DB2ARRAY(D$,FD$(),DA$()) PUBLIC
     FCNT = VAL(FD$(0))
     SP = 2
     FOR CNT = 1 TO FCNT
       FLDNAM$ = LEFT$(FD$(CNT),11)
       FTYPE$ = MID$(FD$(CNT),12,1)
       FLEN = VAL(MID$(FD$(CNT),13,3))
       FDEC = VAL(MID$(FD$(CNT),16,3))
       DA$(CNT) = MID$(D$,SP,FLEN)
       SP = SP + FLEN
     NEXT CNT
     DA$(0) = STR$(FCNT)
    END SUB
'/*------------------------------------------------------------------*/
' DB2ASCII DBREC$,DFD$(),RTRN$
'     dBase record to string.
'     Puts dBASE record passed in DBREC$ into return string RTRN$ placing
'     a comma between each field (comma delimited).
'     EXAMPLE:  DB2ASCII D$,DFD$(), RA$
'/*------------------------------------------------------------------*/
    SUB DB2ASCII(D$,FD$(),A$) PUBLIC
      T = VAL(FD$(0))
      REDIM DA$(0:T)
      DB2ARRAY D$,FD$(),DA$()
      FCNT = VAL(DA$(0))
      FOR CNT = 1 TO FCNT
        A$ = A$ + DA$(CNT) + ","
      NEXT CNT
      A$ = LEFT$(A$,LEN(A$)-1)
    END SUB
'/*------------------------------------------------------------------*/
'/* $INCLUDE "C:\CODE\MLIB\MLIB.INC"
'/* DIM DFD$(20)
'/* DIM DA$(20)
'/* FB = 1
'/* DBOPEN FB,"C:\CODE\DBTEST.DBF",LRECL,NRECS#,OFFSET
'/* DBGETFD FB,LRECL,NRECS#,OFFSET,DFD$()
'/* FCNT = VAL(DFD$(0))
'/* FOR CNT = 1 TO FCNT
'/*   PRINT DFD$(CNT)
'/* NEXT CNT
'/* RNBR# = 2
'/* DBSEEK 1,RNBR#,LRECL,OFFSET
'/* GET$ #FB, LRECL,T$
'/* PRINT T$
'/* DB2ARRAY T$,DFD$(),DA$()
'/* FCNT = VAL(DA$(0))
'/* PRINT FCNT
'/* FOR CNT = 1 TO FCNT
'/*   PRINT DA$(CNT)
'/* NEXT CNT
'/* DB2ASCII T$,DFD$(),A$
'/* PRINT A$
'/* CLOSE#FB
'/* Y$ = GETKEY