ON ERROR GOTO TRAP
'
' Prog Name  = CREATE.BAS
' Run String = CREATE <filename>
' Author     = Douglas Welch
  Version$    = "1.1"
' Date = December 16, 1987
'
' Run Name    Date  Who Ver#  Description/Mod's
' ---------- ------ --- ----  ----------------------------------
' CREATE     871221 DEW  1.0  Create DBF Files directly
' CREATE     871221 DEW  1.1  Add support for MEMO Fields and Files
'
' Create DBASE III+ / Foxbase+ (tm) DBF files directly
'
' -- Variables --
'
' INFILE$       -  Name of Input File
' COMMAND$      -  Command Line Arguments
' DBFNAME$      -  Name of DBF to be created
' MEMO$         -  Are there any memo fields (Y/N)
' SIZE$         -  Total of Field Characters
' NUMFLD$       -  Number of Fields
' DATE$         -  Current Date
' FDNAME$()     -  FIELDNAME
' TYPE$()       -  FIELD TYPE
' WID()         -  FIELD WIDTH
' DEC()         -  DECIMAL NUMBER
'
' --- Data File Structure ---
'
' Name of Database to be created
' MEMO Fields (Y/N)
' Total Character Count of DBF File
' Number of Fields in DBF File
' Field Name, Field Type, Field Width, Decimal Number
' etc...
'========================================================
'
' Dimesion the arrays to hold field data
DIM FDNAME$(30), TYPE$(30)
DIM WID%(30), DEC%(30)

' Clear the screen
CLS
' Header
PRINT "dBase DBF File Creation Utility Version "+ VERSION$
PRINT "(C) Douglas E. Welch 1987"
PRINT "-----------------------------------"
PRINT

' If ARG is given then do not prompt
IF COMMAND$ = "" THEN
   LINE INPUT "Input file  : ", INFILE$
   IF INFILE$  = "" THEN GOTO QUIT
ELSE
   INFILE$ = COMMAND$
END IF

' Open Files
OPEN INFILE$ FOR INPUT AS #1

' Read in the file until file is empty
DO WHILE NOT EOF(1)
   ' Get Header Information
   LINE INPUT #1, DBFNAME$
   LINE INPUT #1, MEMO$
   LINE INPUT #1, SIZE$
   LINE INPUT #1, NUMFLD$
   ' Read in Field info
   FOR COUNT% = 1 TO VAL(NUMFLD$)
      INPUT#1,FDNAME$(COUNT%),TYPE$(COUNT%),WID%(COUNT%),DEC%(COUNT%)
' Pad Out Field Name with nulls
      SHORT = 11 - LEN(FDNAME$(COUNT%))
      FDNAME$(COUNT%) = FDNAME$(COUNT%) + STRING$(SHORT,CHR$(0))
' Debug
' PRINT FDNAME$(COUNT%),TYPE$(COUNT%),WID%(COUNT%),DEC%(COUNT%)
   NEXT COUNT%

' Do some data type conversion
SIZE = VAL(SIZE$)
YY = VAL(MID$(DATE$,9,2))
DD = VAL(MID$(DATE$,4,2))
MM = VAL(MID$(DATE$,1,2))

PRINT
PRINT "Creating "; DBFNAME$ ; " as dBase III+ file...";

' If there is a memo field then create the memo file
IF MEMO$ = "Y" THEN
   TEMP$ = LEFT$(DBFNAME$,LEN(DBFNAME$)-3)
   OPEN TEMP$+"DBT" FOR BINARY AS #3
   CLOSE #3
END IF

' Open output file
OPEN DBFNAME$ FOR BINARY AS #2

' Insert header in the file
IF MEMO$ = "Y" THEN
   PUT$ #2, CHR$(131)
ELSE
   PUT$ #2, CHR$(3)

END IF

PUT$ #2, CHR$(YY)+CHR$(MM)+CHR$(DD)+CHR$(0)+CHR$(0)+CHR$(0)+CHR$(0)
PUT$ #2, CHR$(193)+CHR$(0)+CHR$(SIZE)+CHR$(0)+CHR$(0)+CHR$(0)+CHR$(0)+CHR$(0)

' Insert 16 bytes of nulls
FOR I = 1 TO 16:PUT$ #2, CHR$(0):NEXT I

' Insert Fields into output field
FOR I = 1 TO VAL(NUMFLD$)
PUT$ #2,FDNAME$(I)+TYPE$(I)+CHR$(0)+CHR$(0)+CHR$(0)+CHR$(0)
PUT$ #2,CHR$(WID%(I))+CHR$(DEC%(I))
   FOR J = 1 TO 14
      PUT$ #2, CHR$(0)
   NEXT J
NEXT I

' Insert End of Dbase info marker
PUT$ #2, CHR$(13)
PRINT "Done"
' Close the output files
CLOSE #2
WEND

QUIT:
CLOSE #1
CLOSE #2
PRINT
PRINT "Done..."
END

TRAP:
IF ERR = 53 THEN PRINT:PRINT "File not Found: "+INFILE$ : BEEP
GOTO QUIT
END