Attribute VB_Name = "Data"
''+-------------------------------------------+
''| ICI style I/O database file access module |
''+-------------------------------------------+
''|       Made by Jure Sah of MesonAI         |
''|      TimeDateStamp: 22:39 17.4.2002       |
''+-------------------------------------------+
''
''DO NOT MODIFY WITHOUT MY PREMITION!!!
''(or use in altered form)
''
''Mailto:jure.sah@guest.arnes.si
''
''Feel free to use this module in your
''programs and share it with your friends.
''
''
''You will probably need it if you are
''building apps for the ICI Console.
''
''There is a external public string that
''can be defined: <DataFilesPath>
''It can be used to simplify calling routines

Public xTemporaryPath As String
Public DataFilesPath As String
'Public xPleaseLogs As Boolean
Const xPleaseLogs = False

Type xPropertyAndValue
 xProperty As String
 xValue As String
End Type

Private Function xFixName(xName As String) As String
''Filename problem handler
On Error Resume Next
xFile$ = ""
If Not DataFilesPath = "" And Not InStr(xName, ":") > 0 Then xFile$ = DataFilesPath + "\"
xFile$ = xFile$ + xName
xFixName = xFile$
End Function

Public Sub xCreate(xName As String)
''Create a new database or insure it exists
On Error Resume Next
xFile$ = xFixName(xName)

''Does it already exist?
If Dir(xFile$) = "" Then
 ''Place emptyness in new file
 OutputFN = FreeFile
 Open xFile$ For Output As #OutputFN
  Print #OutputFN, "INTERNAL FLAG = EXISTS!"
 Close #OutputFN
End If
End Sub

Public Sub xRemove(xName As String)
''Delete a database
On Error Resume Next
xFile$ = xFixName(xName)

''Does it really exist?
If Dir(xFile$) <> "" Then
 Kill xFile$
End If
End Sub

Public Sub xSet(xName As String, xProperty As String, xValue As String)
''Set a value to a property
On Error Resume Next
'On Error GoTo 0

'Debug.Print xProperty; "="; xValue

''Set filenames
xFile$ = xFixName(xName)
SwapFile$ = xSwpFile(xName)

If Dir(xFile$) <> "" Then
''Find Property in file and save the remaining data in the swap file
SwapFN = FreeFile
Open SwapFile$ For Output As #SwapFN
MainFN = FreeFile
Open xFile$ For Input As #MainFN
Found = False
Do: Line Input #MainFN, a$
 ''If the thing behind the "=" is our property...
 If UCase$(Trim$(Mid$(a$, 1, InStr(a$, "=") - 1))) = UCase$(Trim$(xProperty)) Then
  Found = True
 Else
  ''Otherwise copy to the swapfile
  Print #SwapFN, a$
 End If
Loop Until EOF(MainFN)
Close #MainFN, #SwapFN
Else
Found = False
End If

If Not Found Then
 ''If property not already inside, append it
 AppendFN = FreeFile
 Open xFile$ For Append As #AppendFN
 Print #AppendFN, xProperty; "="; xValue
 Close #AppendFN
Else
 ''If property inside, put it in the swap file and switch them
 AppendFN2 = FreeFile
 Open SwapFile$ For Append As #AppendFN2
 Print #AppendFN2, xProperty; "="; xValue
 Close #AppendFN2
 Kill xFile$
 Name SwapFile$ As xFile$
End If
Kill SwapFile$

If xPleaseLogs Then
 dLog "Database " + xName + " serial " + Str$(MainFN) + " Set"
 dLog "Swap serial " + Str$(SwapFN) + " Set"
 dLog "Append1 serial " + Str$(AppendFN) + " Set (OR Append2 if 0)"
 dLog "Append2 serial " + Str$(AppendFN2) + " Set (OR Append1 if 0)"
End If
End Sub

Public Function xQuery(xName As String, xProperty As String) As String
''Get the value of a property
On Error Resume Next
xQuery = ""
xFile$ = xFixName(xName)

''Find the right Property and then extract the Value
If Dir(xFile$) <> "" Then
InputFN = FreeFile
Open xFile$ For Input As #InputFN
Found = False
Do: Line Input #InputFN, a$
'Debug.Print "("; UCase$(Trim$(Mid$(a$, 1, InStr(a$, "=") - 1))); ")"
If UCase$(Trim$(Mid$(a$, 1, InStr(a$, "=") - 1))) = UCase$(Trim$(xProperty)) Then
 xQuery = Trim$(Mid$(a$, InStr(a$, "=") + 1))
 Exit Do
End If
Loop Until EOF(InputFN)
Close #InputFN
End If
If xPleaseLogs Then dLog "Database " + xName + " serial " + Str$(InputFN) + " Query"
End Function

Public Function xNextSerial(xName As String, xProperty As String) As Long
''Find the next available serial number for a property name
On Error Resume Next
xNextSerial = 0
Do: N = N + 1
tmp$ = xQuery(xName, xProperty + Trim$(Str$(N)))
Loop Until Trim$(tmp$) = ""
xNextSerial = N
End Function

Public Sub xRemoveEntry(xName As String, xProperty As String)
''Remove an entry, given a property name
On Error Resume Next
'On Error GoTo 0

''Set filenames
xFile$ = xFixName(xName)
SwapFile$ = xSwpFile(xName)

If Dir(xFile$) <> "" Then
''Find Property in file and save the remaining data in the swap file
SwapFN = FreeFile
Open SwapFile$ For Output As #SwapFN
MainFN = FreeFile
Open xFile$ For Input As #MainFN
Found = False
Do: Line Input #MainFN, a$
 ''If the thing before the "=" isn't our property, copy to swapfile
 If Not UCase$(Trim$(Mid$(a$, 1, InStr(a$, "=") - 1))) = UCase$(Trim$(xProperty)) Then Print #SwapFN, a$
Loop Until EOF(MainFN)
Close #MainFN, #SwapFN
End If

''Swap the files and ignore the fact that we've just left out something
Kill xFile$
Name SwapFile$ As xFile$
Kill SwapFile$

If xPleaseLogs Then
 dLog "Database " + xName + " serial " + Str$(MainFN) + " RemoveEntry"
 dLog "Swap serial " + Str$(SwapFN) + " SimpleAddSerial"
End If
End Sub

Public Sub xRemoveSerial(xName As String, xProperty As String, xValue As String)
''Remove a serial entry, given the base property name and it's value

''The last serial should be sought, written over
''the to-be-removed and then removed (as an entry)

On Error Resume Next

''Get the last serial entry number
N = Data.xNextSerial(xName, xProperty) - 1
''If no entries, nothing to do
If N = 0 Then
 Exit Sub
''If one entriy, simply delete it
ElseIf N = 1 Then
 Data.xRemoveEntry xName, xProperty + "1"
''Otherwise...
Else
 ''Find the entry we need to remove
 TProp$ = Data.xFindSerial(xName, xProperty, xValue)
 ''Overwrite
 Data.xSet xName, IProp$, Data.xQuery(xName, xProperty + Trim$(Str$(N)))
 ''Delete the last serial
 Data.xRemoveEntry xName, xProperty + Trim$(Str$(N))
End If
End Sub

Public Function xFindEntry(xName As String, xValue As String) As String
''Find the property name by it's value
On Error Resume Next
xFindEntry = ""
xFile$ = xFixName(xName)
''If the database exists
If Dir(xFile$) <> "" Then
 ''Find Property in file
 MainFN = FreeFile
 Open xFile$ For Input As #MainFN
 Do: Line Input #MainFN, a$
  ''If the thing after the "=" is our value...
  If UCase$(Trim$(Mid$(a$, InStr(a$, "=") + 1))) = UCase$(Trim$(xValue)) Then
   xFindEntry = Trim$(Mid$(a$, 1, InStr(a$, "=") - 1))
  End If
 Loop Until EOF(MainFN)
Close #MainFN
End If
If xPleaseLogs Then dLog "Database " + xName + " serial " + Str$(MainFN) + " FindEntry"
End Function

Public Function xFindSerial(xName As String, xProperty As String, xValue As String) As String
''Find the property + serial number by the base property name and it's value
On Error Resume Next
xFindSerial = ""
xFile$ = xFixName(xName)
''If the database exists
If Dir(xFile$) <> "" Then
 ''Find Property in file
 MainFN = FreeFile
 Open xFile$ For Input As #MainFN
 Do: Line Input #MainFN, a$
  ''If the thing after the "=" is our value and the thing before the "=" contains our property...
  If UCase$(Trim$(Mid$(a$, InStr(a$, "=") + 1))) = UCase$(Trim$(xValue)) _
  And InStr(UCase$(Trim$(Mid$(a$, 1, InStr(a$, "=") - 1))), UCase$(Trim$(xProperty))) Then
   xFindSerial = Trim$(Mid$(a$, 1, InStr(a$, "=") - 1))
  End If
 Loop Until EOF(MainFN)
Close #MainFN
End If
If xPleaseLogs Then dLog "Database " + xName + " serial " + Str$(MainFN) + " FindSerial"
End Function

Public Function xQueryByLineNumber(xName As String, xLineNumber As Long) As xPropertyAndValue
''Get the value and property on a specific LineNumber
On Error Resume Next
xQueryByLineNumber.xProperty = ""
xQueryByLineNumber.xValue = ""
Dim N As Long
xFile$ = xFixName(xName)

''Scroll to the correct LineNumber
If Dir(xFile$) <> "" Then
 InputFN = FreeFile
 Open xFile$ For Input As #InputFN
 N = 0
 Do: N = N + 1
  ''Read
  Line Input #InputFN, a$
  ''Split the read
  xQueryByLineNumber.xProperty = Trim$(Mid$(a$, 1, InStr(a$, "=") - 1))
  xQueryByLineNumber.xValue = Trim$(Mid$(a$, InStr(a$, "=") + 1))
  ''Confirm when at correct LineNumber
  If N = xLineNumber Then GoTo 9
 Loop Until EOF(InputFN)
 Close #InputFN
 ''If it ever gets to this point, return blank
 xQueryByLineNumber.xProperty = ""
 xQueryByLineNumber.xValue = ""
End If
If xPleaseLogs Then dLog "Database " + xName + " serial " + Str$(InputFN) + " QueryByLineNumber"

9 End Function

Public Function xFindSerialNumber(xName As String, xProperty As String, xValue As String) As Long
S$ = xFindSerial(xName, xProperty, xValue)
xFindSerialNumber = Val(Mid$(S$, Len(xProperty) + 1))
End Function

Public Function xNextSerialFile(xPath As String) As String
Dim N As Long
''Fix the path
If Right$(xPath, 1) <> "\" Then xPath = xPath + "\"
''Increase until found an available slot
Do: N = N + 1
 xName = xPath + Trim$(Str$(N))
Loop While Dir(xName) <> ""
''Produce the result
xNextSerialFile = xPath + Trim$(Str$(N))
End Function

Public Sub xAppendSerial(xName As String, xProperty As String, xValue As String)
N = Data.xNextSerial(xName, xProperty)
Data.xSet xName, xProperty + Trim$(Str$(N)), xValue
End Sub

Public Sub xRemoveAllSerials(xName As String, xProperty As String)
''Remove an entire series, given a base property name
On Error Resume Next
'On Error GoTo 0
''Set filenames
xFile$ = xFixName(xName)
SwapFile$ = xSwpFile(xName)

If Dir(xFile$) <> "" Then
''Find Property in file and save the remaining data in the swap file
SwapFN = FreeFile
Open SwapFile$ For Output As #SwapFN
MainFN = FreeFile
Open xFile$ For Input As #MainFN
Found = False
Do: Line Input #MainFN, a$
 ''If the thing before the "=" dosen't contain our base property, copy to swapfile
 If InStr(1, Trim$(Mid$(a$, 1, InStr(a$, "=") - 1)), Trim$(xProperty), vbTextCompare) = 0 Then Print #SwapFN, a$
Loop Until EOF(MainFN)
Close #MainFN, #SwapFN
End If

'Debug.Print "("; FileLen(xFile$); ")", "("; FileLen(swapfile$); ")"
''Swap the files and ignore the fact that we've just left out something
Kill xFile$
Name SwapFile$ As xFile$
Kill SwapFile$

If xPleaseLogs Then
 dLog "Database " + xName + " serial " + Str$(MainFN) + " RemoveAllSerials"
 dLog "Swap serial " + Str$(SwapFN) + " RemoveAllSerials"
End If
End Sub

Public Sub xSimpleAddSerial(xName As String, xProperty As String, xValue As String, xSerial As Long)
''Simpler method
''Fix filename
xFile$ = xFixName(xName)
''Append
p$ = Trim$(xProperty) + Trim$(Str$(xSerial))
FN = FreeFile
''If it already exists, delete it
'If Not xQuery(xName, p$) = "" Then
xRemoveEntry xName, p$
Open xFile$ For Append As #FN
Print #FN, p$ + "=" + xValue
Close #FN
If xPleaseLogs Then dLog "Database " + xName + " serial " + Str$(FN) + " SimpleAddSerial"
End Sub

Private Function xSwpFile(xName As String) As String
'On Error GoTo 0
inst = 0
3 inst = inst + 1
xSwpFile = xTemporaryPath + "\DSP." + Dir$(xName) + "." + Hex$(inst) + ".TMP"
'Debug.Print "["; xName; "]", "["; xSwpFile; "]"
If Not (Dir$(xSwpFile) = "") Then GoTo 3
dLog " --> Database " + xName + " allocated swap " + xSwpFile
End Function

Private Sub dLog(xEntryText As String)
'On Error GoTo 0
yFN = FreeFile
Open App.Path + "\Database_IO.log" For Append As #yFN
Print #yFN, Date$; " "; Time$; "| "; xEntryText
'Debug.Print Date$; " "; Time$; "| "; xEntryText
Close #yFN
End Sub