'--------------------------------------------------------------------
'                Create a dBASE III File from QB45              Dapro
'
'                Dennis Gellert      23 April 1991
'
'  This QB45/QBX demo program creates a dBASE III compatible file
'  called TESTMAKE.DBF. The file includes 1 Record. (Note, for a
'  dBASE file, the header, etc must be structured correctly, or
'  dBASE will refuse to open as a valid dBASE File).
'
'  To change this program to create a dBASE III file with the field
'  data structure you require:
'  (1) Change the Data statements at the end to reflect new structure
'  (2) Change the TYPE block "FldDataSpec" to follow above.
'  (3) Change the code within the area labelled: "Records Go Here".
'
'  To edit an existing dBASE file, read the existing Header instead
'  of writing. You may then calc the offset of the Records/Fields you
'  wish to Edit/Append.
'---------------------------------------------------------------------
CLS
PRINT "Create dBASE III Data File"
PRINT "--------------------------"
'
'--- dBaseIII file header, 32 bytes ---
'Do not change!
'
TYPE dBHeader
   Version AS STRING * 1
   Lastupdate AS STRING * 3
   NumRecs AS LONG
   NumbytesHeader AS INTEGER
   NumBytesRec AS INTEGER
   Trash AS STRING * 20
END TYPE

'--- Field Descriptions ---
'Do not change!
'
TYPE FieldDescriptor          '32 bytes * Number of Fields (up to 128)
   FName AS STRING * 11
   FType AS STRING * 1
   DataAddress AS STRING * 4
   Length AS STRING * 1
   DecimalCount AS STRING * 1
   Trash AS STRING * 14
END TYPE

'--- Actual data written for this file ---
'This structure should follow the data structure specified
'for the dBASE file. Edit to Suit.
'
TYPE FldDataSpec
  DELETED AS STRING * 1
  CHRISTIAN AS STRING * 15
  SURNAME AS STRING * 15
  AGE AS STRING * 3
  DOLLARS AS STRING * 6
END TYPE

'--- Creating variables for user-defined types ---
DIM header AS dBHeader
DIM FieldDes AS FieldDescriptor
DIM FldData AS FldDataSpec
'
'--- This will be dBASE III File ---
OPEN "TESTMAKE.DBF" FOR BINARY AS #1
'
'--------------- Create & Write dBASE III Header -----------------
READ tfields%                  'Total Fields to process
header.Version = CHR$(&H3)     'dBASE III, no memo file
'
MID$(header.Lastupdate, 1, 1) = CHR$(VAL(RIGHT$(DATE$, 2)))
MID$(header.Lastupdate, 2, 1) = CHR$(VAL(LEFT$(DATE$, 2)))
MID$(header.Lastupdate, 3, 1) = CHR$(VAL(MID$(DATE$, 4, 2)))
'
header.NumRecs = 0
'
NumFields% = tfields%
'
'Number of bytes in Header = 32 start +32 for each field +1 for terminator
header.NumbytesHeader = 32 + (NumFields% * 32) + 1
'
'--- Read through data to calc length of Record (+1 for delete flag) ---
RecLength% = 1
FOR fldnum% = 1 TO tfields%
  READ AFName$, AFType$, AL%, ADC%
  RecLength% = RecLength% + AL%
NEXT fldnum%
'
header.NumBytesRec = RecLength%
header.Trash = STRING$(20, 0)    'Unused here
'
PUT #1, , header    'Save the Header start
'
'-------------- Field Descriptions ----------------
nf$ = STRING$(11, 0)
'
FieldDes.DataAddress = STRING$(4, 0)    'Unused in File, set in memory
FieldDes.Trash = STRING$(14, 0)         'Unused here
'
RESTORE flddes
FOR fldnum% = 1 TO tfields%
  'Field Names are padded with nulls, and must be in Upper case
  READ AFName$: FieldDes.FName = UCASE$(LEFT$(AFName$ + nf$, 11))
  READ AFType$: FieldDes.FType = UCASE$(AFType$)
  READ AL%: FieldDes.Length = CHR$(AL%)
  READ ADC%: FieldDes.DecimalCount = CHR$(ADC%)
  PUT #1, ((fldnum% * 32) + 1), FieldDes
NEXT fldnum%
'
FldTerm$ = CHR$(&HD)
PUT #1, , FldTerm$
'------------------------------------------------
'
'--- Records Go Here. Edit to Suit. ---
'DO
   'Include the loop if appending a number of records
   FldData.DELETED = CHR$(32)      'SPACE for NOT deleted flag (* =deleted)
   FldData.CHRISTIAN = "Robert"
   FldData.SURNAME = "Hawke"
   RSET FldData.AGE = "55"         'dBASE III Right justifies numbers
   RSET FldData.DOLLARS = "23.45"
   PUT #1, , FldData
   header.NumRecs = header.NumRecs + 1    'Increment for each Record
'LOOP until all records are processed
'
'------------------------------------------------
'--- End of File marker appended to the end ---
EOFMarker$ = CHR$(&H1A)
PUT #1, , EOFMarker$
'
'--- Go back to header and write number of Records written to file ---
'    and finish up the program.

PUT #1, 5, header.NumRecs
CLOSE #1
PRINT
PRINT "Complete."
END
'
'--- Data Statements specify dBASE III file data structure ---
'    Edit to Suit.
'
DATA 4   : 'tfields   Total number of Fields in a Record
'
flddes:    'Field Name, Data Type, Length, Decimal
DATA CHRISTIAN,C,15,0    : 'Field 1
DATA SURNAME,C,15,0      : 'Field 2
DATA AGE,N,3,0           : 'Field 3
DATA DOLLARS,N,6,2       : 'Field 4