254 lines
7.6 KiB
Plaintext
254 lines
7.6 KiB
Plaintext
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
|
|
' Read a Configuration File V1.0 '
|
|
' '
|
|
' Developed by A. David Garza Marín in VB-DOS for '
|
|
' RosettaCode. December 2, 2016. '
|
|
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
|
|
|
|
OPTION EXPLICIT ' For VB-DOS, PDS 7.1
|
|
' OPTION _EXPLICIT ' For QB64
|
|
|
|
' SUBs and FUNCTIONs
|
|
DECLARE FUNCTION ErrorMessage$ (WhichError AS INTEGER)
|
|
DECLARE FUNCTION YorN$ ()
|
|
DECLARE FUNCTION FileExists% (WhichFile AS STRING)
|
|
DECLARE FUNCTION ReadConfFile% (NameOfConfFile AS STRING)
|
|
DECLARE FUNCTION getVariable$ (WhichVariable AS STRING)
|
|
DECLARE FUNCTION getArrayVariable$ (WhichVariable AS STRING, WhichIndex AS INTEGER)
|
|
|
|
' Register for values located
|
|
TYPE regVarValue
|
|
VarName AS STRING * 20
|
|
VarType AS INTEGER ' 1=String, 2=Integer, 3=Real
|
|
VarValue AS STRING * 30
|
|
END TYPE
|
|
|
|
' Var
|
|
DIM rVarValue() AS regVarValue, iErr AS INTEGER, i AS INTEGER, iHMV AS INTEGER
|
|
DIM otherfamily(1 TO 2) AS STRING
|
|
DIM fullname AS STRING, favouritefruit AS STRING, needspeeling AS INTEGER, seedsremoved AS INTEGER
|
|
CONST ConfFileName = "config.fil"
|
|
|
|
' ------------------- Main Program ------------------------
|
|
CLS
|
|
PRINT "This program reads a configuration file and shows the result."
|
|
PRINT
|
|
PRINT "Default file name: "; ConfFileName
|
|
PRINT
|
|
iErr = ReadConfFile(ConfFileName)
|
|
IF iErr = 0 THEN
|
|
iHMV = UBOUND(rVarValue)
|
|
PRINT "Variables found in file:"
|
|
FOR i = 1 TO iHMV
|
|
PRINT RTRIM$(rVarValue(i).VarName); " = "; RTRIM$(rVarValue(i).VarValue); " (";
|
|
SELECT CASE rVarValue(i).VarType
|
|
CASE 0: PRINT "Undefined";
|
|
CASE 1: PRINT "String";
|
|
CASE 2: PRINT "Integer";
|
|
CASE 3: PRINT "Real";
|
|
END SELECT
|
|
PRINT ")"
|
|
NEXT i
|
|
PRINT
|
|
|
|
' Sets required variables
|
|
fullname = getVariable$("FullName")
|
|
favouritefruit = getVariable$("FavouriteFruit")
|
|
needspeeling = VAL(getVariable$("NeedSpeeling"))
|
|
seedsremoved = VAL(getVariable$("SeedsRemoved"))
|
|
FOR i = 1 TO 2
|
|
otherfamily(i) = getArrayVariable$("OtherFamily", i)
|
|
NEXT i
|
|
PRINT "Variables requested to set values:"
|
|
PRINT "fullname = "; fullname
|
|
PRINT "favouritefruit = "; favouritefruit
|
|
PRINT "needspeeling = ";
|
|
IF needspeeling = 0 THEN PRINT "false" ELSE PRINT "true"
|
|
PRINT "seedsremoved = ";
|
|
IF seedsremoved = 0 THEN PRINT "false" ELSE PRINT "true"
|
|
FOR i = 1 TO 2
|
|
PRINT "otherfamily("; i; ") = "; otherfamily(i)
|
|
NEXT i
|
|
ELSE
|
|
PRINT ErrorMessage$(iErr)
|
|
END IF
|
|
' --------- End of Main Program -----------------------
|
|
|
|
END
|
|
|
|
FileError:
|
|
iErr = ERR
|
|
RESUME NEXT
|
|
|
|
FUNCTION ErrorMessage$ (WhichError AS INTEGER)
|
|
' Var
|
|
DIM sError AS STRING
|
|
|
|
SELECT CASE WhichError
|
|
CASE 0: sError = "Everything went ok."
|
|
CASE 1: sError = "Configuration file doesn't exist."
|
|
CASE 2: sError = "There are no variables in the given file."
|
|
END SELECT
|
|
|
|
ErrorMessage$ = sError
|
|
END FUNCTION
|
|
|
|
FUNCTION FileExists% (WhichFile AS STRING)
|
|
' Var
|
|
DIM iFile AS INTEGER
|
|
DIM iItExists AS INTEGER
|
|
SHARED iErr AS INTEGER
|
|
|
|
ON ERROR GOTO FileError
|
|
iFile = FREEFILE
|
|
iErr = 0
|
|
OPEN WhichFile FOR BINARY AS #iFile
|
|
IF iErr = 0 THEN
|
|
iItExists = LOF(iFile) > 0
|
|
CLOSE #iFile
|
|
|
|
IF NOT iItExists THEN
|
|
KILL WhichFile
|
|
END IF
|
|
END IF
|
|
ON ERROR GOTO 0
|
|
FileExists% = iItExists
|
|
|
|
END FUNCTION
|
|
|
|
FUNCTION getArrayVariable$ (WhichVariable AS STRING, WhichIndex AS INTEGER)
|
|
' Var
|
|
DIM i AS INTEGER, iHMV AS INTEGER, iCount AS INTEGER
|
|
DIM sVar AS STRING, sVal AS STRING, sWV AS STRING
|
|
SHARED rVarValue() AS regVarValue
|
|
|
|
' Looks for a variable name and returns its value
|
|
iHMV = UBOUND(rVarValue)
|
|
sWV = UCASE$(LTRIM$(RTRIM$(WhichVariable)))
|
|
sVal = ""
|
|
DO
|
|
i = i + 1
|
|
sVar = UCASE$(RTRIM$(rVarValue(i).VarName))
|
|
IF sVar = sWV THEN
|
|
iCount = iCount + 1
|
|
IF iCount = WhichIndex THEN
|
|
sVal = LTRIM$(RTRIM$(rVarValue(i).VarValue))
|
|
END IF
|
|
END IF
|
|
LOOP UNTIL i >= iHMV OR sVal <> ""
|
|
|
|
' Found it or not, it will return the result.
|
|
' If the result is "" then it didn't found the requested variable.
|
|
getArrayVariable$ = sVal
|
|
|
|
END FUNCTION
|
|
|
|
FUNCTION getVariable$ (WhichVariable AS STRING)
|
|
' Var
|
|
DIM i AS INTEGER, iHMV AS INTEGER
|
|
DIM sVal AS STRING
|
|
|
|
' For a single variable, looks in the first (and only)
|
|
' element of the array that contains the name requested.
|
|
sVal = getArrayVariable$(WhichVariable, 1)
|
|
|
|
getVariable$ = sVal
|
|
END FUNCTION
|
|
|
|
FUNCTION ReadConfFile% (NameOfConfFile AS STRING)
|
|
' Var
|
|
DIM iFile AS INTEGER, iType AS INTEGER, iVar AS INTEGER, iHMV AS INTEGER
|
|
DIM iVal AS INTEGER, iCurVar AS INTEGER, i AS INTEGER, iErr AS INTEGER
|
|
DIM dValue AS DOUBLE
|
|
DIM sLine AS STRING, sVar AS STRING, sValue AS STRING
|
|
SHARED rVarValue() AS regVarValue
|
|
|
|
' This procedure reads a configuration file with variables
|
|
' and values separated by the equal sign (=) or a space.
|
|
' It needs the FileExists% function.
|
|
' Lines begining with # or blank will be ignored.
|
|
IF FileExists%(NameOfConfFile) THEN
|
|
iFile = FREEFILE
|
|
REDIM rVarValue(1 TO 10) AS regVarValue
|
|
OPEN NameOfConfFile FOR INPUT AS #iFile
|
|
WHILE NOT EOF(iFile)
|
|
LINE INPUT #iFile, sLine
|
|
sLine = RTRIM$(LTRIM$(sLine))
|
|
IF LEN(sLine) > 0 THEN ' Does it have any content?
|
|
IF LEFT$(sLine, 1) <> "#" THEN ' Is not a comment?
|
|
IF LEFT$(sLine,1) = ";" THEN ' It is a commented variable
|
|
sLine = LTRIM$(MID$(sLine, 2))
|
|
END IF
|
|
iVar = INSTR(sLine, "=") ' Is there an equal sign?
|
|
IF iVar = 0 THEN iVar = INSTR(sLine, " ") ' if not then is there a space?
|
|
|
|
GOSUB AddASpaceForAVariable
|
|
iCurVar = iHMV
|
|
IF iVar > 0 THEN ' Is a variable and a value
|
|
rVarValue(iHMV).VarName = LEFT$(sLine, iVar - 1)
|
|
ELSE ' Is just a variable name
|
|
rVarValue(iHMV).VarName = sLine
|
|
rVarValue(iHMV).VarValue = ""
|
|
END IF
|
|
|
|
IF iVar > 0 THEN ' Get the value(s)
|
|
sLine = LTRIM$(MID$(sLine, iVar + 1))
|
|
DO ' Look for commas
|
|
iVal = INSTR(sLine, ",")
|
|
IF iVal > 0 THEN ' There is a comma
|
|
rVarValue(iHMV).VarValue = RTRIM$(LEFT$(sLine, iVal - 1))
|
|
GOSUB AddASpaceForAVariable
|
|
rVarValue(iHMV).VarName = rVarValue(iHMV - 1).VarName ' Repeats the variable name
|
|
sLine = LTRIM$(MID$(sLine, iVal + 1))
|
|
END IF
|
|
LOOP UNTIL iVal = 0
|
|
rVarValue(iHMV).VarValue = sLine
|
|
|
|
' Determine the variable type of each variable found in this step
|
|
FOR i = iCurVar TO iHMV
|
|
GOSUB DetermineVariableType
|
|
NEXT i
|
|
END IF
|
|
END IF
|
|
END IF
|
|
WEND
|
|
CLOSE iFile
|
|
IF iHMV > 0 THEN
|
|
REDIM PRESERVE rVarValue(1 TO iHMV) AS regVarValue
|
|
iErr = 0 ' Everything ran ok.
|
|
ELSE
|
|
REDIM rVarValue(1 TO 1) AS regVarValue
|
|
iErr = 2 ' No variables found in configuration file
|
|
END IF
|
|
ELSE
|
|
iErr = 1 ' File doesn't exist
|
|
END IF
|
|
|
|
ReadConfFile = iErr
|
|
|
|
EXIT FUNCTION
|
|
|
|
AddASpaceForAVariable:
|
|
iHMV = iHMV + 1
|
|
|
|
IF UBOUND(rVarValue) < iHMV THEN ' Are there space for a new one?
|
|
REDIM PRESERVE rVarValue(1 TO iHMV + 9) AS regVarValue
|
|
END IF
|
|
RETURN
|
|
|
|
DetermineVariableType:
|
|
sValue = RTRIM$(rVarValue(i).VarValue)
|
|
IF ASC(LEFT$(sValue, 1)) < 48 OR ASC(LEFT$(sValue, 1)) > 57 THEN
|
|
rVarValue(i).VarType = 1 ' String
|
|
ELSE
|
|
dValue = VAL(sValue)
|
|
IF CLNG(dValue) = dValue THEN
|
|
rVarValue(i).VarType = 2 ' Integer
|
|
ELSE
|
|
rVarValue(i).VarType = 3 ' Real
|
|
END IF
|
|
END IF
|
|
RETURN
|
|
|
|
END FUNCTION
|