Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : CREATE1.ZIP
Filename : CREATE11.BAS

 
Output of file : CREATE11.BAS contained in archive : CREATE1.ZIP

ON ERROR GOTO TRAP
'
' Prog Name = CREATE.BAS
' Run String = CREATE
' 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