VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "mData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Public xTemporaryPath As String
Attribute xTemporaryPath.VB_VarDescription = "Path used for placing in temporary files."
Public DataFilesPath As String
Attribute DataFilesPath.VB_VarDescription = "The common path of the data files if any."
Public xPleaseLogs As Boolean
Attribute xPleaseLogs.VB_VarDescription = "Will write an I/O log if set to True."

Type xPropertyAndValue
 xProperty As String
 xValue As String
End Type

Public Function iAbout(Box As Boolean) As String
Attribute iAbout.VB_Description = "Returns internal information about the DLL, can display a MSGBOX."
Attribute iAbout.VB_UserMemId = 0
iAbout = "ICI style I/O databank file access module" + vbCrLf + _
"Made by Jure Sah of MesonAI" + vbCrLf + _
"Last modified on 12:32 3.5.2002" + vbCrLf + _
"DO NOT MODIFY WITHOUT MY PREMITION!!!" + vbCrLf + _
"jure.sah@guest.arnes.si" + vbCrLf + _
vbCrLf + _
"FREEWARE!" + vbCrLf + _
vbCrLf + _
"ICI xc project, originals for ICI Console interface"
If Box Then MsgBox iAbout, vbInformation, "DS DLL"
End Function

Public Function iVB_Code(Box As Boolean) As String
Attribute iVB_Code.VB_Description = "Returns the internal VB code to get the Temp path. Can display a MSGBOX."
iVB_Code = "Data.xTemporaryPath = Environ$(" + Chr$(34) + "ICI" + Chr$(34) + ")" + vbCrLf + _
"If Data.xTemporaryPath = " + Chr$(34) + Chr$(34) + " Then Data.xTemporaryPath = Environ$(" + Chr$(34) + "TEMP" + Chr$(34) + ") " + vbCrLf + _
"If Data.xTemporaryPath = " + Chr$(34) + Chr$(34) + " Then Data.xTemporaryPath = Environ$(" + Chr$(34) + "TMP" + Chr$(34) + ") " + vbCrLf + _
"If Data.xTemporaryPath = " + Chr$(34) + Chr$(34) + " Then Data.xTemporaryPath = App.Path"
If Box Then MsgBox iVB_Code, vbInformation, "DS DLL"
End Function

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)
Attribute xCreate.VB_Description = "Creates a new databank (not required to set)"
''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)
Attribute xRemove.VB_Description = "Removes a databank"
''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)
Attribute xSet.VB_Description = "Sets a value to a property (will create databank and property if required)."
''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
Attribute xQuery.VB_Description = "Returns the value of a property"
''Get the value of a property
'    On Error Resume Next
xQuery = ""
xFile$ = xFixName(xName)

''Don't read if the file is empty
If FileLen(xFile$) = 0 Then xQuery = "": Exit Function

''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
Attribute xNextSerial.VB_Description = "Finds next available serial"
''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)
Attribute xRemoveEntry.VB_Description = "Removes an entry."
''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)
Attribute xRemoveSerial.VB_Description = "Removes a serial entry, without the need for a serial number."
''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
Attribute xFindEntry.VB_Description = "Finds an entry by value"
''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
Attribute xFindSerial.VB_Description = "Finds a serial entry by property name and value, without the serial number."
''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
Attribute xQueryByLineNumber.VB_Description = "Returns the property and value of an entry in the databank given the line number."
''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
Attribute xFindSerialNumber.VB_Description = "Finds a serial number, given a property and value name"
'    On Error Resume Next
S$ = xFindSerial(xName, xProperty, xValue)
xFindSerialNumber = Val(Mid$(S$, Len(xProperty) + 1))
End Function

Public Function xNextSerialFile(xPath As String) As String
Attribute xNextSerialFile.VB_Description = "Finds next available serial file (for ICSA comm)"
'    On Error Resume Next
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)
Attribute xAppendSerial.VB_Description = "Appends a serial entry"
'    On Error Resume Next
N = Data.xNextSerial(xName, xProperty)
Data.xSet xName, xProperty + Trim$(Str$(N)), xValue
End Sub

Public Sub xRemoveAllSerials(xName As String, xProperty As String)
Attribute xRemoveAllSerials.VB_Description = "Removes all serial entries of a specific property."
''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)
Attribute xSimpleAddSerial.VB_Description = "Light procedure to add serial entries."
''Simpler method
    On Error Resume Next
''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 Resume Next
'On Error GoTo 0
inst = 0
3 inst = inst + 1
xSwpFile = Data.xTemporaryPath + "\DSP." + Dir$(xName) + "." + Hex$(inst) + ".TMP"
'Debug.Print "["; xName; "]", "["; xSwpFile; "]"
If Not (Dir$(xSwpFile) = "") Then GoTo 3
If xPleaseLogs Then dLog " --> Database " + xName + " allocated swap " + xSwpFile
End Function

Private Sub dLog(xEntryText As String)
'    On Error Resume Next
'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