Category : Files from Magazines
Archive   : VOL11N18.ZIP
Filename : RANDFI.BAS

DEFINT A-Z

DECLARE SUB OpenFile (FileName$, FieldData$(), FieldType(), FileNumber)
DECLARE SUB GetData (FldData$(), FldText$(), FldType(), FileNum, RecNumber)
DECLARE SUB PutData (FldData$(), FldText$(), FldType(), FileNum, RecNumber)

'--- These constants are not used, and are here only to show the type codes.
CONST IntType% = -2 'integer
CONST LongType% = -3 'long integer
CONST SingleType% = -4 'single precision
CONST CurrencyType% = -7 'BASIC PDS Currency
CONST DoubleType% = -8 'double precision
'all positive numbers are string lengths

REDIM FieldArray$(1 TO 10) 'this holds the actual record data
REDIM FieldName$(1 TO 10) 'this is for prompting the user only
REDIM DataType(1 TO 10) 'this holds each field's data type

FOR X = 1 TO 10
READ FieldName$(X) 'read the field names for prompting
READ DataType(X) 'and the type of data each field is to hold
NEXT

DATA CustNumber, -2 : 'this is an integer field
DATA FirstName, 15 : 'these are all string fields
DATA LastName, 15 : '(colons are needed to comment DATA lines)
DATA Company, 32
DATA Address, 32
DATA City, 15
DATA State, 2
DATA Zip, 9
DATA LastAmount, -8 : 'this is a double precision field
DATA LastTax, -4 : 'this is a single precision field

CLS
FOR X = 1 TO 10 'enter the data for a record
PRINT FieldName$(X); ": "; 'print a prompt
LINE INPUT Text$(X) 'then accept the field data as plain text
NEXT

FileName$ = "TESTFILE.DAT" 'the name of our test file
FileNum = FREEFILE 'get next available number and open the file
CALL OpenFile(FileName$, FieldArray$(), DataType(), FileNum)

RecordNum = 1 'write the data in Text$() to record 1
CALL PutData(FieldArray$(), Text$(), DataType(), FileNum, RecordNum)
CLOSE #FileNum 'close the file to prove this is working

FileNum = FREEFILE 'open the file again and read the data
CALL OpenFile(FileName$, FieldArray$(), DataType(), FileNum)
CALL GetData(FieldArray$(), Text$(), DataType(), FileNum, RecordNum)

PRINT : PRINT 'kick out a couple of blank lines
FOR X = 1 TO 10 'print the data for a record
PRINT FieldName$(X); ": "; 'print the field name
PRINT Text$(X) 'then print the field data as text
NEXT

SUB GetData (FldData$(), FldText$(), FldType(), FileNumber, RecNumber) STATIC

GET #FileNumber, RecNumber 'first read the record from disk

FOR X = 1 TO UBOUND(FldData$) 'process all of the fields
SELECT CASE FldType(X) 'based on their data type
CASE -2 'integer
FldText$(X) = STR$(CVI(FldData$(X)))
CASE -3 'long integer
FldText$(X) = STR$(CVL(FldData$(X)))
CASE -4 'single precision
FldText$(X) = STR$(CVS(FldData$(X)))
CASE -7 'BASIC PDS Currency
'FldText$(X) = STR$(CVC(FldData$(X)))
CASE -8 'double precision
FldText$(X) = STR$(CVD(FldData$(X)))
CASE ELSE 'string
FldText$(X) = RTRIM$(FldData$(X)) 'trim trailing blanks
END SELECT
NEXT

END SUB

SUB OpenFile (FileName$, FldData$(), FldType(), FileNumber) STATIC

RecLength = 0 'build the record length
TotalFields = UBOUND(FldData$) 'and number of fields

FOR X = 1 TO TotalFields 'go through once to get the length
RecLength = RecLength + ABS(FldType(X))
NEXT

OPEN FileName$ FOR RANDOM AS #FileNumber LEN = RecLength

RecLength = 0 'build the record structure
FOR X = 1 TO TotalFields
ThisLength = ABS(FldType(X)) 'get the field length
IF FldType(X) = -3 THEN ThisLength = 4 'special test for long integers
IF FldType(X) = -7 THEN ThisLength = 8 'special test for Currency data
FIELD #FileNumber, RecLength AS Dummy$, ThisLength AS FldData$(X)
RecLength = RecLength + ThisLength
NEXT

END SUB

SUB PutData (FldData$(), FldText$(), FldType(), FileNumber, RecNumber) STATIC

FOR X = 1 TO UBOUND(FldData$) 'process all of the fields
SELECT CASE FldType(X) 'based on their data type
CASE -2 'integer
LSET FldData$(X) = MKI$(VAL(FldText$(X)))
CASE -3 'long integer
LSET FldData$(X) = MKL$(VAL(FldText$(X)))
CASE -4 'single precision
LSET FldData$(X) = MKS$(VAL(FldText$(X)))
CASE -7 'BASIC PDS Currency
'LSET FldData$(X) = MKC$(VAL(FldText$(X)))
CASE -8 'double precision
LSET FldData$(X) = MKD$(VAL(FldText$(X)))
CASE ELSE 'string
LSET FldData$(X) = FldText$(X)
END SELECT
NEXT

PUT #FileNumber, RecNumber 'finally, write the record to disk

END SUB