While I'm experimenting about how the Module work I have updated the Droopy's Little DataBase Lib. Originally coded for PureBasic V3.93
I hope this example can help others about using module.
Edit #1: After a deeper inspection of the code I make few more changes.
Edit #2 : I'm sorry for those who have save this code on their computer. You will have to do it again or just replace the LDB_CloseDataBase() precedure by this one :
Code: Select all
Procedure LDB_CloseDataBase()
ClearList(LdbBdd())
ClearList(LdbField())
LdbDatabaseFile.s = ""
LdbFieldCount = 0
LdbSearchStop = 0
LdbSearchReturn = 0
LdbSearchField = 0
LdbSearchPointer = 0
LdbSearchOption = 0
LdbSearchString.s = ""
LdbFlag.b = 0
If IsRegularExpression(Reg_Ex_IsNumeric)
FreeRegularExpression(Reg_Ex_IsNumeric)
Reg_Ex_IsNumeric = #Null
EndIf
EndProcedureStarBootics
Code: Select all
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : Little DataBase - Module Version
; File Name : LittleDataBase - Module.pb
; File version: 1.0.0
; Programming : OK
; Programmed by : StarBootics
; Date : 12-02-2015
; Last Update : 12-02-2015
; PureBasic code : V5.31
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Programming notes :
;
; This my first try using module in PureBasic. This code came from the Droopy Lib, so I
; deserve credit only for conversion to Module, the LDB_FormatFields() command addition,
; the verification if the field is really numeric in the LDB_SortNum() command and a more
; complete clean up for the LDB_CloseDatabase() command.
;
; Only tested with PureBasic 5.31 x64 under Ubuntu Gnome 14.10 x64. Should work fine on
; other OS as is.
;
; I DESERVE NO CREDIT FOR 98% OF THIS CODE. The original author deserve the honor !
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Original Comment from the Droopy Lib :
;
; Ldb (Start)
; PureBasic 3.93
; Library for managing little local Database ( Little DataBase = LDB )
; Droopy 08/03/05-19/03/05 and 13/06/05-
; Version 1.1 ( Integration in Droopy Lib)
; Remove LdbInit
; Translation French to English
;
; RES RES RES RES RES RES RES RES RES RES RES RES RES RES RES RES
;/ #CaseInsensitive=1 ; Need to be in .res
;/ #EveryWhere=2 ; Need to be in .res
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
DeclareModule LittleDataBase
#LDB_CASE_INSENSITIVE = 1
#LDB_EVERYWHERE = 2
Declare LDB_GetPointer()
Declare LDB_SetPointer(RecordID)
Declare LDB_CountField()
Declare LDB_OpenDataBase(Database.s)
Declare LDB_CreateDataBase(Database.s, Fields.s)
Declare LDB_CountRecord()
Declare.s LDB_Read(FieldID)
Declare LDB_Write(FieldID, Text.s)
Declare LDB_AddRecord()
Declare LDB_DeleteRecord()
Declare.b LDB_SaveDataBase()
Declare LDB_CloseDataBase()
Declare LDB_SetFieldName(Nb, FieldName.s)
Declare.s LDB_GetFieldName(Nb)
Declare LDB_PreviousRecord()
Declare LDB_NextRecord()
Declare LDB_InsertRecord(Nb.l)
Declare LDB_SearchInit(FieldID, SearchText.s, Option)
Declare LDB_Search()
Declare LDB_SortNum(FieldID)
Declare LDB_SortAlpha(FieldID, Option)
Declare.s LDB_FormatFields(Separator.s)
EndDeclareModule
Module LittleDataBase
;/ Constants
#Separator = Chr(1)
#FieldSeparator = ","
#CRLFSubstitution = Chr(2)
Global LdbDatabaseFile.s, LdbFieldCount.l, LdbSearchStop.l, LdbSearchReturn.l
Global LdbSearchField.l, LdbSearchPointer.l, LdbSearchOption.l, LdbSearchString.s
Global LdbFlag.b, Reg_Ex_IsNumeric.i
Global NewList LdbBdd.s()
Global NewList LdbField.s()
; Initialise the Global Variable / LinkedList ( Internal Function )
Procedure LDB_Init()
If LdbFlag=0
LdbFlag=1
EndIf
EndProcedure
; Get the index of the current record
Procedure LDB_GetPointer()
If ListSize(LdbBdd())
ProcedureReturn ListIndex(LdbBdd())
EndIf
EndProcedure
; Set the index of the current record
Procedure LDB_SetPointer(RecordID)
If ListSize(LdbBdd())
SelectElement(LdbBdd(),RecordID)
EndIf
EndProcedure
; Count the number of Fields
Procedure LDB_CountField()
If ListSize(LdbBdd())
tmp = LDB_GetPointer()
FirstElement(LdbBdd())
LdbFieldCount = CountString(LdbBdd(),#Separator) + 1
LDB_SetPointer(tmp)
ProcedureReturn LdbFieldCount
EndIf
EndProcedure
; Open an existing Database ( Return 1 if success / 0 if fail ) Thanks to Baldrick
Procedure LDB_OpenDataBase(Database.s)
LDB_Init()
FileID = ReadFile(#PB_Any, Database)
If IsFile(FileID)
Retour = 1
LdbDatabaseFile = Database
ClearList(LdbBdd())
ClearList(LdbField())
While Eof(FileID) = 0
AddElement(LdbBdd())
LdbBdd() = ReadString(FileID)
Wend
CloseFile(FileID)
LDB_CountField()
EndIf
ProcedureReturn Retour
EndProcedure
; Create a new empty database
Procedure LDB_CreateDataBase(Database.s, Fields.s)
LDB_Init()
LdbDatabaseFile = Database
ClearList(LdbBdd())
ClearList(LdbField())
ttmp.s = ""
maxfields = CountString(Fields, #FieldSeparator) + 1
For n=1 To maxfields
ttmp + StringField(Fields, n, #FieldSeparator)
If n <> maxfields
ttmp + #Separator
EndIf
Next
AddElement(LdbBdd())
LdbBdd() = ttmp
LDB_CountField()
EndProcedure
; Return the number of records
Procedure LDB_CountRecord()
If ListSize(LdbBdd())
ProcedureReturn ListSize(LdbBdd()) - 1
EndIf
EndProcedure
; (Internal procedure) Read the specified field in the current record ( include 0 )
Procedure.s LDB_Rid(FieldID)
Temp.s = StringField(LdbBdd(),FieldID, #Separator)
; Replace CRLF by #CRLFSubstitution
Temp = ReplaceString(Temp, #CRLFSubstitution, #CRLF$)
ProcedureReturn Temp
EndProcedure
; Read the specified field in the current record ( 0 return "" )
Procedure.s LDB_Read(FieldID)
xx.s = ""
If LDB_GetPointer() <> 0
xx.s = LDB_Rid(FieldID)
EndIf
ProcedureReturn xx.s
EndProcedure
; Write text in the field 'Field'
Procedure LDB_Write(FieldID, Text.s)
; Verify if trying to overwrite the first record
If LDB_GetPointer() <> 0
; Replace CRLF by #CRLFSubstitution
Text = ReplaceString(Text,#CRLF$,#CRLFSubstitution)
ClearList(LdbField())
For n=1 To LdbFieldCount
AddElement(LdbField())
LdbField() = StringField(LdbBdd(),n,#Separator)
Next
SelectElement(LdbField(),FieldID - 1)
LdbField() = Text
LdbBdd() = ""
ForEach LdbField()
LdbBdd()+LdbField()+#Separator
Next
EndIf
EndProcedure
; ( Internal ) Add a record at the end of the database / set the pointer to this record
Procedure LDB_AddRecord()
LastElement(LdbBdd())
AddElement(LdbBdd())
For n=1 To LdbFieldCount
LdbBdd()+#Separator
Next
EndProcedure
; Delete the current record
Procedure LDB_DeleteRecord()
DeleteElement(LdbBdd(),1)
EndProcedure
; Write LinkedList to Disk
Procedure.b LDB_SaveDataBase()
PointerTemp = LDB_GetPointer()
FileID = CreateFile(#PB_Any, LdbDatabaseFile)
If IsFile(FileID)
ForEach LdbBdd()
WriteStringN(FileID, LdbBdd())
Next
CloseFile(FileID)
LDB_SetPointer(PointerTemp)
ProcedureReturn 1
EndIf
EndProcedure
; Close the open Database
Procedure LDB_CloseDataBase()
ClearList(LdbBdd())
ClearList(LdbField())
LdbDatabaseFile.s = ""
LdbFieldCount = 0
LdbSearchStop = 0
LdbSearchReturn = 0
LdbSearchField = 0
LdbSearchPointer = 0
LdbSearchOption = 0
LdbSearchString.s = ""
LdbFlag.b = 0
If IsRegularExpression(Reg_Ex_IsNumeric)
FreeRegularExpression(Reg_Ex_IsNumeric)
Reg_Ex_IsNumeric = #Null
EndIf
EndProcedure
; Set a field name
Procedure LDB_SetFieldName(Nb,FieldName.s)
tmp = LDB_GetPointer()
LDB_SetPointer(0)
LDB_Write(Nb, FieldName)
LDB_SetPointer(tmp)
EndProcedure
; Get a field name
Procedure.s LDB_GetFieldName(Nb)
tmp = LDB_GetPointer()
LDB_SetPointer(0)
ttt.s = LDB_Rid(Nb)
LDB_SetPointer(tmp)
ProcedureReturn ttt
EndProcedure
; Set the pointer to the previous record
Procedure LDB_PreviousRecord()
PreviousElement(LdbBdd())
If LDB_GetPointer() = 0
LDB_SetPointer(1)
EndIf
EndProcedure
; Set the pointer to the next record
Procedure LDB_NextRecord()
NextElement(LdbBdd())
EndProcedure
; Insert a record at position 'nb' / -1 add a record as the last record
Procedure LDB_InsertRecord(Nb.l)
If Nb=-1
LDB_AddRecord()
Else
LDB_SetPointer(Nb)
InsertElement(LdbBdd())
For n=1 To LdbFieldCount
LdbBdd()+#Separator
Next
EndIf
EndProcedure
; Add a Field as the last field
Procedure LDB_AddField(FieldName.s)
tmp = LDB_GetPointer()
LdbFieldCount + 1
ForEach LdbBdd()
LdbBdd()+#Separator
Next
LDB_SetFieldName(LdbFieldCount,FieldName)
LDB_SetPointer(tmp)
EndProcedure
; Delete a field in the database
Procedure LDB_DeleteField(Nb.l)
tmp = LDB_GetPointer()
ForEach LdbBdd()
ClearList(LdbField())
ttmp.s=""
For n=1 To LdbFieldCount
If Nb=n
Continue
EndIf
ttmp + StringField(LdbBdd(),n,#Separator)+#Separator
Next
LdbBdd() = ttmp
Next
LDB_CountField()
LDB_SetPointer(tmp)
EndProcedure
; Search with options ( #CaseInsensitive #EveryWhere )
; Initialise a search in Ldb
Procedure LDB_SearchInit(FieldID, SearchText.s,Option)
LdbSearchPointer = 1
LdbSearchString.s = SearchText.s
LdbSearchOption = Option
LdbSearchField = FieldID
LdbSearchStop = 0
LdbSearchReturn = 0
EndProcedure
; Search and return record that match ( 0 = There is no more record that match )
; You must stop call this function
Procedure LDB_Search()
; If there is no records : Quit
If LdbSearchPointer = 1 And LDB_CountRecord() = 0
LdbSearchStop = 1
LdbSearchReturn = 0
EndIf
LdbSearchReturn = 0
If LdbSearchPointer > LDB_CountRecord()
LdbSearchStop = 1
EndIf
If LdbSearchStop = 0
For n = LdbSearchPointer To LDB_CountRecord()
LDB_SetPointer(n)
xxc.s = LDB_Read(LdbSearchField)
xxs.s = LdbSearchString
; Search case Insensitive : Put all stirng to Upper Case
If LdbSearchOption & #LDB_CASE_INSENSITIVE
xxc = UCase(xxc)
xxs = UCase(xxs)
EndIf
; Flag Stop : Quit at the next loop
If n = LDB_CountRecord()
LdbSearchStop = 1
EndIf
If LdbSearchOption & #LDB_EVERYWHERE
If FindString(xxc, xxs, 1) > 0
LdbSearchPointer = n + 1
LdbSearchReturn = LdbSearchPointer - 1
Break
EndIf
Else
If xxc = xxs
LdbSearchPointer = n + 1
LdbSearchReturn = LdbSearchPointer - 1
Break
EndIf
EndIf
Next
EndIf
ProcedureReturn LdbSearchReturn
EndProcedure
; Sort the database assuming field as Numerical
Procedure LDB_SortNum(FieldID)
If Reg_Ex_IsNumeric = #Null
Reg_Ex_IsNumeric = CreateRegularExpression(#PB_Any,"^[[:digit:].]+$") ;
EndIf
If IsRegularExpression(Reg_Ex_IsNumeric)
Nb = LDB_CountRecord()
If Nb > 1 ; Si au moins 2 enregistrements
PointerTemp = LDB_GetPointer()
If MatchRegularExpression(Reg_Ex_IsNumeric, LDB_Read(FieldID))
For n = 1 To Nb-1
For i=n+1 To Nb
LDB_SetPointer(n)
FirstRecord.f = ValF(LDB_Read(FieldID))
LDB_SetPointer(i)
SecondRecord.f = ValF(LDB_Read(FieldID))
If FirstRecord.f > SecondRecord.f
SelectElement(LdbBdd(), n)
*Temp00 = @LdbBdd()
SelectElement(LdbBdd(), i)
*Temp01 = @LdbBdd()
SwapElements(LdbBdd(), *Temp00, *Temp01)
EndIf
Next i
Next n
EndIf
EndIf
LDB_SetPointer(PointerTemp)
EndIf
EndProcedure
; Sort the database assuming field as String
; Défault = CaseSensitive / Just 1 Option = #CaseInsensitive
Procedure LDB_SortAlpha(FieldID, Option)
Nb = LDB_CountRecord()
If Nb > 1 ; There is at list 2 records
PointerTemp = LDB_GetPointer()
For n = 1 To Nb-1
For i = n + 1 To Nb
LDB_SetPointer(n)
FirstRecord.s = LDB_Read(FieldID)
LDB_SetPointer(i)
SecondRecord.s = LDB_Read(FieldID)
; Pur all in UpperCase if #CaseInsensitive
If Option = #LDB_CASE_INSENSITIVE
FirstRecord = UCase(FirstRecord)
SecondRecord = UCase(SecondRecord)
EndIf
If FirstRecord > SecondRecord
SelectElement(LdbBdd(), n)
*Temp00 = @LdbBdd()
SelectElement(LdbBdd(), i)
*Temp01 = @LdbBdd()
SwapElements(LdbBdd(), *Temp00, *Temp01)
EndIf
Next i
Next n
LDB_SetPointer(PointerTemp)
EndIf
EndProcedure
Procedure.s LDB_FormatFields(Separator.s)
For FieldID = 1 To LdbFieldCount
Output.s + LDB_Read(FieldID)
If FieldID < LdbFieldCount
Output + Separator
EndIf
Next
ProcedureReturn Output
EndProcedure
EndModule
CompilerIf #PB_Compiler_IsMainFile
; F1 Test for the LDB library ( Little Database )
; launch it in debug mode
If FileSize("Drivers.ldb") > 0
DeleteFile("Drivers.ldb")
EndIf
; Create a new Database with 3 fields
LittleDataBase::LDB_CreateDataBase("Drivers.ldb","Birth Date,Name,Surname")
; Add one Record
LittleDataBase::LDB_InsertRecord(-1)
; Write data to this record
LittleDataBase::LDB_Write(1,"1969") ; 1st field
LittleDataBase::LDB_Write(2,"schumacher") ; 2nd field
LittleDataBase::LDB_Write(3,"Mikael") ; 3rd field
; Add another Record
LittleDataBase::LDB_InsertRecord(-1)
; Write data to this record
LittleDataBase::LDB_Write(1,"1980") ; 1st field
LittleDataBase::LDB_Write(2,"Button") ; 2nd field
LittleDataBase::LDB_Write(3,"Jenson") ; 3rd field
; Add another Record
LittleDataBase::LDB_InsertRecord(-1)
; Write data to this record
LittleDataBase::LDB_Write(1,"1981") ; 1st field
LittleDataBase::LDB_Write(2,"Alonso") ; 2nd field
LittleDataBase::LDB_Write(3,"Fernando") ; 3rd field
; Add another Record
LittleDataBase::LDB_InsertRecord(-1)
; Write data to this record
LittleDataBase::LDB_Write(1,"1971") ; 1st field
LittleDataBase::LDB_Write(2,"Villeneuve") ; 2nd field
LittleDataBase::LDB_Write(3,"Jacques") ; 3rd field
; Insert a record at 3rd position
LittleDataBase::LDB_InsertRecord(3)
; Write data to this record
LittleDataBase::LDB_Write(1,"1975") ; 1st field
LittleDataBase::LDB_Write(2,"Schumacher") ; 2nd field
LittleDataBase::LDB_Write(3,"Ralph") ; 3rd field
; Sort the database by field 1 ( Birth Date )
LittleDataBase::LDB_SortNum(1)
; Show all drivers sorted by birth Date
Debug "Drivers sorted by birth date"
For n=1 To LittleDataBase::LDB_CountRecord()
LittleDataBase::LDB_SetPointer(n)
Debug LittleDataBase::LDB_FormatFields(" ")
Next
Debug ""
; Sort the database by Drivers names
LittleDataBase::LDB_SortAlpha(2,LittleDataBase::#LDB_CASE_INSENSITIVE)
; Show all drivers sorted by name
Debug "Drivers sorted by name"
For n=1 To LittleDataBase::LDB_CountRecord()
LittleDataBase::LDB_SetPointer(n)
Debug LittleDataBase::LDB_FormatFields(" ")
Next
Debug ""
; Search all name = Schumacher
LittleDataBase::LDB_SearchInit(2,"Schumacher", LittleDataBase::#LDB_CASE_INSENSITIVE)
; Show all drivers = Schumacher
Debug "Drivers with name = Schumacher"
Repeat
Champ = LittleDataBase::LDB_Search()
If Champ = 0
Break
EndIf ; if 0 --> search finished
LittleDataBase::LDB_SetPointer(Champ)
Debug LittleDataBase::LDB_Read(1) + " " + LittleDataBase::LDB_Read(2) + " " + LittleDataBase::LDB_Read(3)
ForEver
Debug ""
; Database Infos
Debug "Database Infos"
Debug "Number of fields " + Str(LittleDataBase::LDB_CountField())
Debug "Name of field"
For n = 1 To LittleDataBase::LDB_CountField()
Debug "Field n°" + Str(n) + " = " + LittleDataBase::LDB_GetFieldName(n)
Next
Debug "Number of records " + Str(LittleDataBase::LDB_CountRecord())
; Save Database to disk
LittleDataBase::LDB_SaveDatabase()
LittleDataBase::LDB_CloseDatabase()
Debug ""
Debug "--------------------------------------------------------"
Debug "Loading from file test"
Debug ""
LittleDataBase::LDB_OpenDataBase("Drivers.ldb")
LittleDataBase::LDB_SortNum(1)
Debug "Drivers sorted by birth date"
For n=1 To LittleDataBase::LDB_CountRecord()
LittleDataBase::LDB_SetPointer(n)
Debug LittleDataBase::LDB_FormatFields(" ")
Next
Debug ""
Debug "Database Infos"
Debug "Number of fields " + Str(LittleDataBase::LDB_CountField())
Debug "Name of field"
For n = 1 To LittleDataBase::LDB_CountField()
Debug "Field n°" + Str(n) + " = " + LittleDataBase::LDB_GetFieldName(n)
Next
Debug "Number of records " + Str(LittleDataBase::LDB_CountRecord())
; Close the Database
LittleDataBase::LDB_CloseDatabase()
CompilerEndIf
; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
