Attribute VB_Name = "Data"
''+-------------------------------------------+
''| ICI style I/O database file access module |
''+-------------------------------------------+
''|       Made by Jure Sah of MesonAI         |
''|      TimeDateStamp: 15:21 27.1.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

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 already 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
''Set filenames
xFile$ = xFixName(xName)
SwapFile$ = xTemporaryPath + "\ICIC.SWP"

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 xTemporaryPath + "\ICIC.SWP"
End Sub

Public Function xQuery(xName As String, xProperty As String) As String
''Get the value of a property
On Error Resume Next
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
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
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
''Set filenames
xFile$ = xFixName(xName)
SwapFile$ = xTemporaryPath + "\ICIC.SWP"

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 "=" is 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 xTemporaryPath + "\ICIC.SWP"
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
''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
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
''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(1, Trim$(Mid$(a$, 1, InStr(a$, "=") - 1)), xProperty, vbTextCompare) Then
   xFindSerial = Trim$(Mid$(a$, 1, InStr(a$, "=") - 1))
  End If
 Loop Until EOF(MainFN)
Close #MainFN
End If
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
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 Exit Do
Loop Until EOF(InputFN)
Close #InputFN
End If
End Function