Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
|
|
@ -0,0 +1,253 @@
|
|||
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
|
||||
' 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
|
||||
Loading…
Add table
Add a link
Reference in a new issue