Imports System.Collections.Generic

Friend Enum ExistingAction
	ReturnNegative 'Use when you want to know that something is wrong
	ReturnExistingIndex	'Use when extending any existing table
	DeleteExisting 'Use then creating the table from scratch
End Enum

Module DatabaseTypeConversion
	Friend Function DBTC_FromBoolean(B As Boolean) As String
		If B Then
			DBTC_FromBoolean = "Y"
		Else
			DBTC_FromBoolean = "N"
		End If
	End Function
	
	Friend Function DBTC_ToBoolean(S As String) As Boolean
		Select Case DetToUpper(Left(S, 1))
		Case "0", "N", "F", "P"	'No/Nej/Nein/Njet, Pas, False/Fuo
			DBTC_ToBoolean = False
		Case "1", "Y", "J", "D", "S", "H", "O", "T"	'Yes, Ja, Da, Si/Shi, Hai, Oui, True
			DBTC_ToBoolean = True
		Case Else
			MsgBox("The string """ & S & """ could not be interpreted as a boolean truth value.", MsgBoxStyle.OkOnly, "Error!")
			DBTC_ToBoolean = False
		End Select
	End Function
	
	Friend Function DBTC_FromInteger(I As Integer) As String
		DBTC_FromInteger = IntegerToString(I)
	End Function
	
	Friend Function DBTC_ToInteger(S As String) As Integer
		DBTC_ToInteger = StringToInteger(S)
	End Function
	
	Friend Function DBTC_FromSingle(I As Single, ByVal Decimals As Integer) As String
		DBTC_FromSingle = DoubleToString(I, Decimals)
	End Function
	
	Friend Function DBTC_ToSingle(S As String) As Single
		DBTC_ToSingle = StringToDouble(S) '¤¤¤¤ Make explicit conversion method that only use decimal form
	End Function
End Module

Friend Class Database
	Const Terminator As Integer = 0 'String in the database can not contain this character
	
	Private Class Column
		Friend Name As String
		Friend Cells As New List(Of String)
		Friend Sub New(NewName As String)
			Name = NewName
		End Sub
	End Class
	
	Private Class Table
		Friend Name As String
		Friend Rows As Integer
		Friend Columns As New List(Of Column)
		Friend Sub New(NewName As String)
			Name = NewName
		End Sub
	End Class
	
	Private Class NamedValue
		Friend Name As String
		Friend Value As String
		Friend Sub New(NewName As String, NewValue As String)
			Name = NewName
			Value = NewValue
		End Sub
	End Class
	
	Private Tables As New List(Of Table)
	Private Properties As New List(Of NamedValue)
	
	'Post condition:
	'	If a table with the same name already exist and GetExistingTable = true, the existing index is returned
	'	If a table with the same name already exist and GetExistingTable = false, -1 is returned
	'	Otherwise, the index to the new table is returned
	Friend Function AddTable(ByRef NewName As String, ByVal HandleExisting As ExistingAction) As Integer
		Dim TableIndex As Integer
		TableIndex = GetTableIndex(NewName)
		If TableIndex > -1 Then
			'A table with the name already exist
			Select Case HandleExisting
			Case ExistingAction.ReturnExistingIndex
				'Return the existing index
				AddTable = TableIndex
			Case ExistingAction.DeleteExisting
				'Remove the old table
				Tables.RemoveAt(TableIndex)
				'Make a new table
				Tables.Add(New Table(NewName))
				'Return the index to the new table
				AddTable = Tables.Count - 1
			Case Else
				'Return error code
				AddTable = -1
			End Select
		Else
			'Make a new table
			Tables.Add(New Table(NewName))
			'Return the index to the new table
			AddTable = Tables.Count - 1
		End If
	End Function
	
	'Post condition: Returns the index to the new column in Tables(TableIndex)
	Friend Function AddColumn(ByVal TableIndex As Integer, ByRef NewName As String, ByRef InitialValue As String, ByVal HandleExisting As ExistingAction) As Integer
		On Error GoTo BadIndex 'Use the framework's own array bound checks to save performance
		Dim I As Integer
		Dim ColumnIndex As Integer
		ColumnIndex = GetColumnIndex(TableIndex, NewName)
		If ColumnIndex > -1 Then
			'A column with the name already exist
			Select Case HandleExisting
			Case ExistingAction.ReturnExistingIndex
				'Return the existing index
				AddColumn = ColumnIndex
			Case ExistingAction.DeleteExisting
				'Remove the old column
				Tables(TableIndex).Columns.RemoveAt(TableIndex)
				'Make a new column
				Tables(TableIndex).Columns.Add(New Column(NewName))
				'Return the index to the new column
				AddColumn = Tables(TableIndex).Columns.Count - 1
				'Fill new cells with the initial value
				For I = 0 To Tables(TableIndex).Rows - 1
					Tables(TableIndex).Columns(AddColumn).Cells.Add(InitialValue)
				Next I
			Case Else
				'Return error code
				AddColumn = -1
			End Select
		Else
			'Make a new column
			Tables(TableIndex).Columns.Add(New Column(NewName))
			'Return the index to the new column
			AddColumn = Tables(TableIndex).Columns.Count - 1
			'Fill new cells with the initial value
			For I = 0 To Tables(TableIndex).Rows - 1
				Tables(TableIndex).Columns(AddColumn).Cells.Add(InitialValue)
			Next I
		End If
		Exit Function
		BadIndex:
		AddColumn = -1 'Return error code
	End Function
	
	'Post condition: Returns the index to the first table that match Name with a case insensitive match
	Friend Function GetTableIndex(ByRef Name As String) As Integer
		Dim UpperName As String
		Dim I As Integer
		UpperName = DetToUpper(Name)
		For I = 0 To Tables.Count - 1
			If DetToUpper(Tables(I).Name) = UpperName Then
				Return I
			End If
		Next I
		Return -1
	End Function
	
	'Post condition: Returns the index to the first column that match Name with a case insensitive match in Tables(TableIndex)
	Friend Function GetColumnIndex(ByVal TableIndex As Integer, ByRef Name As String) As Integer
		Dim UpperName As String
		Dim I As Integer
		UpperName = DetToUpper(Name)
		For I = 0 To Tables(TableIndex).Columns.Count - 1
			If DetToUpper(Tables(TableIndex).Columns(I).Name) = UpperName Then
				Return I
			End If
		Next I
		Return -1
	End Function
	
	'Post condition: Returns the index to the first table that match Name with a case insensitive match
	Private Function GetPropertyIndex(ByRef Name As String) As Integer
		Dim UpperName As String
		Dim I As Integer
		UpperName = DetToUpper(Name)
		For I = 0 To Properties.Count - 1
			If DetToUpper(Properties(I).Name) = UpperName Then
				Return I
			End If
		Next I
		Return -1
	End Function
	
	'Post condition: Get the value from the first property with a matching name or NotExistValue if it does not exist
	Friend Function GetProperty(ByRef Name As String, ByRef NotExistValue As String) As String
		Dim PropertyIndex As Integer
		PropertyIndex = GetPropertyIndex(Name)
		If PropertyIndex > -1 Then
			GetProperty = Properties(PropertyIndex).Value
		Else
			GetProperty = NotExistValue
		End If
	End Function
	
	'Side effect: Set the value of a named property and create a new property if the name don't exist yet
	Friend Sub SetProperty(ByRef Name As String, ByRef Value As String)
		Dim PropertyIndex As Integer
		PropertyIndex = GetPropertyIndex(Name)
		If PropertyIndex > -1 Then
			Properties(PropertyIndex).Value = Value
		Else
			Properties.Add(New NamedValue(Name, Value))
		End If
	End Sub
	
	Friend Sub SetCell(ByVal TableIndex As integer, ByVal ColumnIndex As integer, ByVal RowIndex As integer, ByRef Value As String)
		On Error resume next 'Use the framework's own array bound checks to save performance
		Tables(TableIndex).Columns(ColumnIndex).Cells(RowIndex) = Value
	End Sub
	
	'Post condition: Returns the name of the table at TableIndex
	Friend Function GetTableName(ByVal TableIndex As Integer) As String
		On Error GoTo BadIndex 'Use the framework's own array bound checks to save performance
		GetTableName = Tables(TableIndex).Name
		Exit Function
		BadIndex:
		GetTableName = ""
	End Function
	
	'Post condition: Returns the number of columns in the table at TableIndex
	Friend Function GetTableColumns(ByVal TableIndex As Integer) As Integer
		On Error GoTo BadIndex 'Use the framework's own array bound checks to save performance
		GetTableColumns = Tables(TableIndex).Columns.Count
		Exit Function
		BadIndex:
		GetTableColumns = -1
	End Function
	
	'Post condition: Returns the number of rows in the table at TableIndex
	Friend Function GetTableRows(ByVal TableIndex As Integer) As Integer
		On Error GoTo BadIndex 'Use the framework's own array bound checks to save performance
		GetTableRows = Tables(TableIndex).Rows
		Exit Function
		BadIndex:
		GetTableRows = -1
	End Function
	
	'Post condition: Returns the name of the column at ColumnIndex in the table at TableIndex
	Friend Function GetColumnName(ByVal TableIndex As Integer, ByVal ColumnIndex As Integer) As String
		On Error GoTo BadIndex 'Use the framework's own array bound checks to save performance
		GetColumnName = Tables(TableIndex).Columns(ColumnIndex).Name
		Exit Function
		BadIndex:
		GetColumnName = ""
	End Function
	
	'Post condition: Returns the value in the cell at RowIndex from the column at ColumnIndex in the table at TableIndex
	Friend Function GetCell(ByVal TableIndex As Integer, ByVal ColumnIndex As Integer, ByVal RowIndex As Integer) As String
		On Error GoTo BadIndex 'Use the framework's own array bound checks to save performance
		GetCell = Tables(TableIndex).Columns(ColumnIndex).Cells(RowIndex)
		Exit Function
		BadIndex:
		GetCell = ""
	End Function
	
	Friend Function GetColumnAsList(ByVal TableIndex As Integer, ByVal ColumnIndex As Integer) As List(Of String)
		On Error GoTo BadIndex 'Use the framework's own array bound checks to save performance
		GetColumnAsList = Tables(TableIndex).Columns(ColumnIndex).Cells
		Exit Function
		BadIndex:
		GetColumnAsList = Nothing
	End Function
	
	'Side effect: Adds a row to the table at TableIndex
	'Post condition: Returns the index to the new row at the end
	Friend Function AddRow(ByVal TableIndex As Integer, ByRef InitialValue As String) As Integer
		On Error GoTo BadIndex 'Use the framework's own array bound checks to save performance
		Dim I As Integer
		Dim C As Integer
		For C = 0 To Tables(TableIndex).Columns.Count - 1
			Tables(TableIndex).Columns(C).Cells.Add(InitialValue)
		Next C
		Tables(TableIndex).Rows = Tables(TableIndex).Rows + 1 'Count the size of the table
		AddRow = Tables(TableIndex).Rows - 1 'Return the index to the last row
		Exit Function
		BadIndex:
		AddRow = -1
	End Function
	
	'Side effect: Delete the row at RowIndex in TableIndex so that every row after it have it's index decreased by one
	Friend Sub DeleteRow(ByVal TableIndex As Integer, ByVal RowIndex As Integer)
		On Error GoTo BadIndex 'Use the framework's own array bound checks to save performance
		Dim C As Integer
		For C = 0 To Tables(TableIndex).Columns.Count - 1
			Tables(TableIndex).Columns(C).Cells.RemoveAt(RowIndex)
		Next C
		Tables(TableIndex).Rows = Tables(TableIndex).Rows - 1
		Exit Sub
		BadIndex:
	End Sub
	
	'Returns the row index to the first cell in the column ColumnIndex in the table TableIndex that exactly match ValueToFind
	Friend Function FindValue(ByVal TableIndex As Integer, ByVal ColumnIndex As Integer, ByRef ValueToFind As String) As Integer
		On Error GoTo BadIndex 'Use the framework's own array bound checks to save performance
		FindValue = -1
		Dim R As Integer
		For R = 0 To Tables(TableIndex).Columns(ColumnIndex).Cells.Count - 1
			If Tables(TableIndex).Columns(ColumnIndex).Cells(R) = ValueToFind Then
				FindValue = R
				Exit function
			End If
		Next R
		Exit Function
		BadIndex:
	End Function
	
	Friend Function AllowOverwrite(ByRef FileName As String, ByVal AskToOverwrite As Boolean) As Boolean
		If Dir(FileName) <> "" And AskToOverwrite Then
			AllowOverwrite = (MsgBox("Do you want to overwrite the existing file?", MsgBoxStyle.YesNo, "Overwrite?") = MsgBoxResult.Yes)
		Else
			AllowOverwrite = True
		End If
	End Function
	
	Friend Function SaveToFile_Safe(ByRef FileName As String, ByVal AskToOverwrite As Boolean) As Boolean
		If AllowOverwrite(FileName, AskToOverwrite) Then
			SaveToFile_Safe = SaveToFile(FileName, AskToOverwrite)
		Else
			SaveToFile_Safe = False
		End If
	End Function
	
	'Tells if the data is okay and can be saved
	Friend Function ValidateContent() As Boolean
		Dim I As Integer
		Dim C As Integer
		For I = 0 To Tables.Count - 1
			For C = 0 To Tables(I).Columns.Count - 1
				If Tables(I).Columns(C).Cells.Count <> Tables(I).Rows Then
					Return False
				End If
			Next C
		Next I
		Return True
	End Function
	
	Friend Function PrintContent() As String
		Dim I As Integer
		Dim C As Integer
		Dim R As Integer
		Dim Rows As Integer
		Dim Columns As Integer
		If Not (ValidateContent()) Then
			Return "Database validation failed"
		End If
		PrintContent = "Content of the database" & vbNewLine
		
		'Tables
		For I = 0 To Tables.Count - 1
			'Name
			PrintContent = PrintContent & "	Table: " & Tables(I).Name & vbNewLine
			
			Rows = Tables(I).Rows
			Columns = Tables(I).Columns.Count
			For C = 0 To Columns - 1
				'Name
				PrintContent = PrintContent & "		Column: " & Tables(I).Columns(C).Name & vbNewLine
				For R = 0 To Tables(I).Columns(C).Cells.Count - 1
					'Each cell
					PrintContent = PrintContent & "			""" & Tables(I).Columns(C).Cells(R) & """" & vbNewLine
				Next R
			Next C
		Next I
		
		'Properties
		For I = 0 To Properties.Count - 1
			PrintContent = PrintContent & "	Property: " & Properties(I).Name & " = """ & Properties(I).Value & """" & vbNewLine
		Next I
	End Function
	
	Friend Function SaveToFile(ByRef FileName As String, ByVal AskToOverwrite As Boolean) As Boolean
		Dim I As Integer
		Dim C As Integer
		Dim R As Integer
		Dim Length As Integer
		Dim Rows As Integer
		Dim Columns As Integer
		SaveToFile = False
		If Not (ValidateContent()) Then
			MsgBox("Database validation failed so that the file could not be saved.", MsgBoxStyle.Critical, "Error!")
			Exit Function
		End If
		If Dir(FileName) <> "" Then
			Kill(FileName)
		End If
		FileOpen(1, FileName, OpenMode.Binary)
		PutString("David Piuva's database format 2.0")
		
		'Tables
		Length = Tables.Count
		PutInteger(Length)
		For I = 0 To Length - 1
			'Name
			PutString(Tables(I).Name)
			'Rows
			Rows = Tables(I).Rows
			PutInteger(Rows)
			'Columns
			Columns = Tables(I).Columns.Count
			PutInteger(Columns)
			For C = 0 To Columns - 1
				'Name
				PutString(Tables(I).Columns(C).Name)
				For R = 0 To Tables(I).Columns(C).Cells.Count - 1
					'Each cell
					PutString(Tables(I).Columns(C).Cells(R))
				Next R
			Next C
		Next I
		
		'Properties
		Length = Properties.Count
		PutInteger(Length)
		For I = 0 To Length - 1
			PutString(Properties(I).Name)
			PutString(Properties(I).Value)
		Next I
		
		FileClose(1)
		SaveToFile = True
		Exit Function
		FileError:
		FileClose(1)
		MsgBox("Saving failed.", MsgBoxStyle.Exclamation, "Error!")
	End Function
	
	Friend Function LoadFromFile(ByRef FileName As String) As Boolean
		Dim I As Integer
		Dim C As Integer
		Dim R As Integer
		Dim Length As Integer
		Dim Rows As Integer
		Dim Columns As Integer
		Dim Name As String
		Dim Value As String
		LoadFromFile = False
		FileOpen(1, FileName, OpenMode.Binary)
		If GetString() <> "David Piuva's database format 2.0" Then GoTo FileError
		
		'Tables
		Length = GetInteger()
		Tables.Clear()
		For I = 0 To Length - 1
			'Name
			Name = GetString()
			Tables.Add(New Table(Name))	'Create a table
			'Rows
			Rows = GetInteger()
			Tables(Tables.Count - 1).Rows = Rows
			'Columns
			Columns = GetInteger()
			For C = 0 To Columns - 1
				'Name
				Name = GetString()
				Tables(Tables.Count - 1).Columns.Add(New Column(Name))
				For R = 0 To Rows - 1
					'Each cell
					Value = GetString()
					Tables(Tables.Count - 1).Columns(C).Cells.Add(Value)
				Next R
			Next C
		Next I
		
		'Properties
		Length = GetInteger()
		Properties.Clear()
		For I = 0 To Length - 1
			Name = GetString()
			Value = GetString()
			Properties.Add(New NamedValue(Name, Value))
		Next I
		
		FileClose(1)
		LoadFromFile = True
		Exit Function
		FileError:
		FileClose(1)
		MsgBox("Loading failed.", MsgBoxStyle.Exclamation, "Error!")
	End Function
	
	Private Sub PutInteger(ByVal TheInteger As Integer)
		PutString((TheInteger))
	End Sub
	
	Private Function GetInteger() As Integer
		GetInteger = (Val(GetString()))
	End Function
	
	Private Function ContainTerminator(ByRef TheText As String) As boolean
		Dim CharCode As Integer
		Dim B As Integer
		For B = 1 To Len(TheText)
			CharCode = Asc(Mid(TheText, B, 1))
			If CharCode = Terminator Then
				Return True
			End If
		Next B
		Return False
	End Function
	
	Private Function IsAnsi(ByRef TheText As String) As boolean
		Dim CharCode As Integer
		Dim B As Integer
		For B = 1 To Len(TheText)
			CharCode = AscW(Mid(TheText, B, 1))
			If CharCode < 0 Or CharCode > 255 Then
				Return False
			End If
		Next B
		Return True
	End Function
	
	Private Sub PutString(ByRef TheText As String)
		Dim CharCode As Integer
		Dim BBuffer As Byte
		Dim B As Integer
		If ContainTerminator(TheText) Then
			MsgBox("PutString: The string to save contains the terminating character that is used to end strings")
			'Input nothing
			BBuffer = Asc("/")
			FilePut(1, BBuffer)
			BBuffer = Terminator
			FilePut(1, BBuffer)
		Else
			If IsAnsi(TheText) Then
				BBuffer = Asc("/") '1 byte characters
				FilePut(1, BBuffer)
				For B = 1 To Len(TheText)
					BBuffer = Asc(Mid(TheText, B, 1))
					If BBuffer = Terminator Then
						BBuffer = Asc("?")
					End If
					FilePut(1, BBuffer)
				Next B
				BBuffer = Terminator
				FilePut(1, BBuffer)
			Else
				BBuffer = Asc("\") '4 byte characters
				FilePut(1, BBuffer)
				For B = 1 To Len(TheText)
					CharCode = Asc(Mid(TheText, B, 1))
					If CharCode = Terminator Then
						CharCode = Asc("?")
					End If
					FilePut(1, CharCode)
				Next B
				FilePut(1, Terminator)
			End If
		End If
	End Sub
	
	Private Function GetString() As String
		On Error GoTo BadString
		Dim CharCode As Integer
		Dim BBuffer As Byte
		GetString = ""
		FileGet(1, BBuffer)
		Select Case BBuffer
		Case Asc("/") 'Slash begins a string with 1 byte characters
			Do while true
				FileGet(1, BBuffer)
				If BBuffer = Terminator Then
					Exit Function
				Else
					GetString = GetString & Chr(BBuffer)
				End If
			loop
		Case Asc("\") 'Backslash begins a string with 4 byte characters
			Do while true
				FileGet(1, CharCode)
				If CharCode = Terminator Then
					Exit Function
				Else
					GetString = GetString & Chr(CharCode)
				End If
			loop
		Case Else
			MsgBox("An unknown character encoding was detected while loading a database file.")
			GetString = ""
		End Select
		Exit Function
		BadString:
		GetString = ""
	End Function
End Class
