$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 MKUFILE(Path$) AS STRING
DECLARE FUNCTION FILESPEC(BYVAL OPT AS STRING, BYVAL FLNAME AS STRING) AS STRING
DECLARE SUB DBUPDATE(FB,NRECS#)
DECLARE SUB DBOPEN(FB,FILENAME$,LRECL,NRECS#,OFFSET)
DECLARE SUB DBSEEK(BYVAL FB,BYVAL RNBR#,BYVAL LRECL,BYVAL OFFSET)
$CODE SEG "MLIB4"
'/*------------------------------------------------------------------*/
' DBUNLOAD OPT$,FILENAME$,TFILE$
'     dBase Unload.
'     Unloads the data base file from FILENAME$ to a flat (sequential)
'     file, TFILE$ using OPT$ to determine what records are extracted.
'     OPT:  A - All - Extracts all records including deleted and blank
'               records.
'           N - Nondeleted records only.  Blank records are NOT extracted.
'           B - Include blank records.
'           D - Deleted records only.
'     EXAMPLE:  DBUNLOAD "NB","C:\CODE\DBASE.DBF","DBASE.TXT"
'/*------------------------------------------------------------------*/
    SUB DBUNLOAD(OPT$,FILENAME$,TFILE$) PUBLIC
      OPT$ = UCASE$(OPT$)
'/*   --- Copy All Records ---*/
      IF INSTR(1,OPT$,"A") > 0 THEN OFLAGA = 1 ELSE OFLAGA = 0
'/*   --- Copy Records That Are NOT Deleted ---
      IF INSTR(1,OPT$,"N") > 0 THEN OFLAGN = 1 ELSE OFLAGN = 0
'/*   --- Copy Those Records That Are Deleted ---
      IF INSTR(1,OPT$,"D") > 0 THEN OFLAGD = 1 ELSE OFLAGD = 0
'/*   --- Copy Those Records That Are Blank  ---
      IF INSTR(1,OPT$,"B") > 0 THEN OFLAGB = 1 ELSE OFLAGB = 0
'/*   --- Open Data Base File ---*/
      FB = FREEFILE
      DBOPEN FB,FILENAME$,LRECL,NRECS#,OFFSET
'/*   --- Get Next File Handle ---*/
      TFB = FREEFILE
'/*   --- Open Temp File ---*/
      OPEN"O",TFB,TFILE$
      FOR CNT# = 1 TO NRECS#
'/*     --- Get DB Record ---*/
        DBSEEK FB,CNT#,LRECL,OFFSET
        GET$ #FB,LRECL,TD$
'/*     --- Get Record Data ---*/
        IF OFLAGA = 1 THEN
          PRINT#TFB,TD$
          ITERATE
        END IF
        IF OFLAGN = 1 AND LEFT$(TD$,1) = " " THEN
          IF OFLAGB = 0 THEN
            T$ = TD$
            REPLACE ANY "0." WITH "  " IN T$
            MID$(T$,1,1) = "*"
            T$ = RTRIM$(T$)
            IF LEN(T$) = 1 THEN ITERATE
          END IF
          PRINT#TFB,TD$
          ITERATE
        END IF
        IF OFLAGD = 1 AND LEFT$(TD$,1) = "*" THEN
          PRINT#TFB,TD$
          ITERATE
        END IF
      NEXT CNT#
      CLOSE#TFB
      CLOSE#FB
    END SUB
'/*------------------------------------------------------------------*/
' DBRELOAD DBFILENAME$,TFILE$
'     dBase Reload.
'     Reloads existing data base file with contents of TFILE$.  Header and
'     file descriptions are preserved though number of records and date last
'     updated are changed to new values.
'     EXAMPLE:  DBRELOAD "C:\CODE\DBASE.DBF","C:\CODE\DBASE.DAT"
'/*------------------------------------------------------------------*/
    SUB DBRELOAD(DBNAME$,TFILE$) PUBLIC
'/*   --- Open Data Base ---*/
      FB = FREEFILE
      DBOPEN FB,DBNAME$,LRECL,NRECS#,OFFSET
'/*   OPEN DBNAME$ FOR BINARY ACCESS READ WRITE SHARED AS #FB
'/*   --- Get DB & FD Header ---*/
      SEEK #FB, 0
      GET$ #FB, OFFSET, DBH$
'/*   --- Delete Existing Data Base ---*/
      CLOSE #FB
      KILL DBNAME$
'/*   --- Re-Create Data Base ---*/
      OPEN DBNAME$ FOR BINARY ACCESS READ WRITE SHARED AS #FB
'/*   --- Get Zero Position ---*/
      SEEK #FB, 0
'/*   --- Put Header/FD Back to Hold Position ---*/
      PUT$ #FB, DBH$
'/*   --- Get Next File Handle ---*/
      TFB = FREEFILE
'/*   --- Open Temp File ---*/
      CNT# = 0
      OPEN"I",TFB,TFILE$
      DO WHILE NOT EOF(TFB)
        CNT# = CNT# + 1
'/*     --- Get Data Record ---*/
        LINE INPUT#TFB,T$
'/*     --- Put Into Data Base ---*/
        PUT$ #FB,T$
      LOOP
      CLOSE#TFB
'/*   --- Update Data Base ---*/
      DBUPDATE FB,CNT#
      CLOSE#FB
    END SUB
'/*------------------------------------------------------------------*/
' DBPACK DBFILENAME$
'     dBase Pack.
'     Unloads the data base file DBFILENAME$ to a temporary flat (sequential)
'     file and reloads only those records that do NOT have a delete flag and
'     are NOT blank.
'     EXAMPLE:  DBPACK "C:\CODE\DBASE.DBF"
'
'     NOTE: Sorting dBase files can be slow and difficult.  I recommend
'           using QUIKSORT by Omniware.  It can sort your dBase file
'           without having to unload it plus tons of other features.
'/*------------------------------------------------------------------*/
    SUB DBPACK(DBFILENAME$) PUBLIC
      T$ = FILESPEC("H",DBFILENAME$)
      FTMP$ = MKUFILE(T$)
      DBUNLOAD "N",DBFILENAME$,FTMP$
      DBRELOAD DBFILENAME$,FTMP$
      KILL FTMP$
    END SUB
'/*------------------------------------------------------------------*/
'/* $INCLUDE "C:\CODE\MLIB\MLIB.INC"
'/* FB = 1
'/* PRINT "EXECUTING DBUNLOAD"
'/* DBUNLOAD "A","C:\CODE\DBASE.DBF","C:\TEMP\TFILE$.TXT"
'/* PRINT "EXECUTING DBRELOAD"
'/* DBRELOAD "C:\TEMP\TBASE.DBF","C:\TEMP\TFILE$.TXT"
'/* DBPACK "C:\TEMP\TBASE.DBF"