NewsForumsCodeLogsGallerySpecsSearch

Code archives/Miscellaneous/Streaksy DATABASE Suite 1.4 - Lightening-fast DB building, reading, writing, etc. with definable field types

This code has been declared by its author to be Public Domain code.

Download source code

Streaksy DATABASE Suite 1.4 - Lightening-fast DB building, reading, writing, etc. with definable field types by Streaksy2010
This is very efficient and very fast. The demo shows the built-in database editor, followed by memory-consuption reports and an execution speed test.
Made this because I know how handy it will be for RPGs etc. MySQL goes right over my head.

Check back now and then if you use this because I'm updating quite often.

V1.3 UPDATE: 26 March 2010 - Unlimited records per database, at last. No memory preallocation for certain record info. All you set is MaxDBs and MaxFields to manage memory allocation.

V1.4 UPDATE 27 March 2010 - Recently accessed records are cached and are the first to be checked when searching for records.
General speed is even better now, and in 99% of cases a huge databases won't slow it down (except for queries where all records have to be checked).

Currently, a read/write operation, on my system, can execute 1785714 times a second, according the my execution speed test results in the demo.


To do:

* Make functions to edit a database's fields after it's been built/finalized.
It won't be too hard to do and could be very useful when a database no longer meets your needs but you don't want to re-enter all the info.

* Make periodic file updating so databases are also kept on disk and updating the file only writes changes since the last update. Also not hard to do.


Supported field types:
* Byte (0 - 255)
* SByte (-128 - 127)
* Short (0 - 65535)
* SShort (-32768 - 32767)
* Integer (-2147483648 - 2147483647)
* Float (Anyone know the range of a float in Blitz?)
* String (Any length allocation)
* List (0 - 255) (A list of multiple-choice strings)




Public functions:
* database=DefineDB(name$)
* AddByteField(database,fieldname$)
* AddSByteField(database,fieldname$)
* AddShortField(database,fieldname$)
* AddSShortField(database,fieldname$)
* AddIntField(database,fieldname$)
* AddFloatField(database,fieldname$)
* AddStringField(database,fieldname$,length=25)
* AddListField(database,fieldname$,list$)
* BuildDB(database)

* recordID=AddRecord(database)

* SetData(database,recordID,field$,value)
* SetDataFloat(database,recordID,field$,value#)
* SetDataString(database,recordID,field$,value$)
* value=GetData(database,recordID,field$)
* value#=GetDataFloat#(database,recordID,field$)
* value$=GetDataString$(database,recordID,field$)

* FindRecord(database,field$,value$)
* ListRecords(database,query$)

* FreeDB(database)

* SaveDB(DB,filename$)
* WriteDB(DB,file_handle)

* database=LoadDB(filename$)
* database=ReadDB(file_handle)

* EditDB(database)
* EditDBs









HOW TO QUERY:
Use:
resultcount=ListRecords(database,query$)


RecordIDs that match the query will be saved in the array: DBListedRecord(). DBListedRecords will be the count.

Query$ is a list of simple expressions seperated by a comma.

For example, if you wanted a list of warrior weapons that cost 100 gold or less, you could use:

resultcount=ListRecords(itemdatabase,"type=weapon,class=warrior,cost<=100")


Then, all suitable items will have their recordID stored in DBListedRecords(1-resultcount).






USING THE BUILT-IN EDITOR:

At any point in your code you can execute EditDB(database) to edit a database, or EditDBs() to edit all databases in memory.

The editor is just a useful extra for debugging, really. But you could really populate a whole game with it. At any time in the code you can activate it with EditDB(DB).
When you exit the editor it will cover its tracks and resume from when you triggered it, except putting the font back to what it was because Blitz doesn't supply a command to check the current font.

Click on a value to change it by typing into it's box. Escape cancels typing, enter or clicking away accepts it.

Right-click for menu. If you right-clicked on a record you get options in the menu relating to it. To close the menu, right click again, or click away from it, or press escape.

Drag the scroll bars (if there are any) to navigate, and mousewheel scrolls up and down through the records.

Escape quits the editor.






. 
Const MaxDBs=32				;Maximum number of databases
Const MaxFields=64			;Maximum number of fields in a database

Const DB_Byte=0 ;1 byte 			(0 to 255)
Const DB_SByte=1 ;2 byte 			(-128 to 127)
Const DB_Short=2 ;3 bytes			(0 to 65535
Const DB_SShort=3 ;4 bytes			(-32768 to 32767)
Const DB_Int=4  ;5 bytes			(- to )
Const DB_Float=5;6 bytes			(Anyone know the range of a float?)
Const DB_String=6;string size defined by DBFieldSize+2 bytes
Const DB_List=7;multiple choice	(0 to 255)

Global DBs
Dim DBIDAt(MaxDBs)
Dim DBName$(MaxDBs)
Dim DBActive(MaxDBs)
Dim DBBank(MaxDBs)
Dim DBFields(MaxDBs)
Dim DBRecordSize(MaxDBs)
Dim DBRecords(MaxDBs)
Dim DBDels(MaxDBs)
Dim DBField$(MaxDBs,MaxFields)
Dim DBFieldList$(MaxDBs,MaxFields) ;for multiple choice lists
Dim DBFieldLen(MaxDBs,MaxFields)
Dim DBFieldType(MaxDBs,MaxFields)
Dim DBFieldSize(MaxDBs,MaxFields) ;for strings
Dim DBFieldOffset(MaxDBs,MaxFields)
Global BasicDBMemoryUsage=(MaxDBs*4*7) + (MaxDBs*MaxFields*4*5)
	Global DBMaxQueries=50,DBQueries
	Dim DBQueryOp(DBMaxQueries)
	Dim DBQueryField(DBMaxQueries)
	Dim DBQueryValString$(DBMaxQueries)
	Dim DBQueryValFloat#(DBMaxQueries)
	Dim DBQueryValInt(DBMaxQueries)

Const MaxQueryResults=10000
Global DBListedRecords ;Query results are stored here
Dim DBListedRecord(MaxQueryResults)

Const MaxRecordCache=200
Dim DBRecordsInCache(MaxDBs)
Dim DBRecordCacheID(MaxDBs,MaxRecordCache)
Dim DBRecordCacheIndex(MaxDBs,MaxRecordCache)





; CRUDE DEMO
AppTitle "Database Demo"
Graphics 1024,768,32,2

;First create a database by defining it then building it
	DB=DefineDB("Items")
	AddStringField DB,"Name"
	AddListField DB,"Type","Weapon,Armour,Potion,Loot"
	AddByteField DB,"Level"
	AddIntField DB,"Cost"
	AddFloatField DB,"Weight"
	BuildDB DB

;Add a few records
;For t=1 To 2000:nowt=addrecord(db):Next ;Loads of records at start to see what difference it makes to speed

	r1=AddRecord(DB)
		SetDataString DB,r1,"Name","Longsword"
		SetDataString DB,r1,"Type","Weapon"
		SetData DB,r1,"Level",1
		SetData DB,r1,"Cost",8
		SetDataFloat DB,r1,"Weight",.5
	r2=AddRecord(DB)
		SetDataString DB,r2,"Name","Chainmail"
		SetDataString DB,r2,"Type","Armour"
		SetData DB,r2,"Level",2
		SetData DB,r2,"Cost",11
		SetDataFloat DB,r2,"Weight",.9
	r3=AddRecord(DB)
		SetDataString DB,r3,"Name","Elixir"
		SetDataString DB,r3,"Type","Potion"
		SetData DB,r3,"Level",1
		SetData DB,r3,"Cost",4
		SetDataFloat DB,r3,"Weight",.16
	r4=AddRecord(DB)
		SetDataString DB,r4,"Name","Jewel"
		SetDataString DB,r4,"Type","Loot"
		SetData DB,r4,"Level",2
		SetData DB,r4,"Cost",17
		SetDataFloat DB,r4,"Weight",.01
	r5=AddRecord(DB)
		SetDataString DB,r5,"Name","Platemail"
		SetDataString DB,r5,"Type","Armour"
		SetData DB,r5,"Level",4
		SetData DB,r5,"Cost",25
		SetDataFloat DB,r5,"Weight",1.6
	r6=AddRecord(DB)
		SetDataString DB,r6,"Name","Gold Nugget"
		SetDataString DB,r6,"Type","Loot"
		SetData DB,r6,"Level",3
		SetData DB,r6,"Cost",19
		SetDataFloat DB,r6,"Weight",.21
	r7=AddRecord(DB)
		SetDataString DB,r7,"Name","Staff"
		SetDataString DB,r7,"Type","Weapon"
		SetData DB,r7,"Level",1
		SetData DB,r7,"Cost",2
		SetDataFloat DB,r7,"Weight",.3


.restart
Cls:Locate 0,0
Print "A small demo database has been prepared.  Select an option:":Print ""

Print "ESC: Quit"
Print "1: Edit database"
Print "2: Measure database & do time trial (Requires the longsword to be still in the database)"

Repeat
If KeyHit(2) Then EditDB DB:Goto restart
If KeyHit(1) Then End
Until KeyHit(3)
FlushKeys

Cls:Locate 0,0
Color 255,255,0
Print "ADJUSTABLE ALLOCATION CONSTANTS:"
Color 155,255,0
Print "Current MaxDBs = "+MaxDBs
Print "Current MaxFields = "+MaxFields
Color 255,255,255
Print "The database library itself currently uses up "+((BasicDBMemoryUsage)/1024)+" kilobytes.  (Depends on MaxDBs and MaxFields)"
Print ""
Color 255,255,0
Print "USED BY DEMO DATABASE:"
Color 155,255,0
Print "Fields = "+DBFields(DB)
Print "Records = "+DBRecords(DB)
Print ""
Print ""
Color 255,255,255
Print "The demo database bank is "+BankSize(DBBank(DB))+" bytes. ("+(BankSize(DBBank(DB))/1024)+" kilobytes)"
Print "There are "+DBRecords(DB)+" records in this demo database and each record takes up "+DBRecordSize(DB)+" bytes."
reps#=100000
Color 255,255,0
Locate 0,200
Color 255,255,155:Print "MAIN FUNCTION EXECUTION TIME TRIALS:":Color 255,155,255:Print ""

ms1#=MilliSecs()
For t=1 To reps
GetData(DB,r1,"Cost")
Next
ms2#=MilliSecs()
Print "GetData() - "+Int(((reps/(ms2-ms1))*1000))+" times per second"

ms1#=MilliSecs()
For t=1 To reps
SetData(DB,r1,"Cost",0)
Next
ms2#=MilliSecs()
Print "SetData() - "+Int(((reps/(ms2-ms1))*1000))+" times per second"

Print "":Color 255,255,155:Print "SEEK FUNCTION EXECUTION TIME TRIALS:":Color 255,155,255:Print ""

ms1#=MilliSecs()
For t=1 To reps
FindRecord(DB,"Level","1")
Next
ms2#=MilliSecs()
Print "FindRecord() - "+Int(((reps/(ms2-ms1))*1000))+" times per second (SEARCHING BY A NUMERIC FIELD)"

ms1#=MilliSecs()
For t=1 To reps
FindRecord(DB,"Name","Longsword")
Next
ms2#=MilliSecs()
Print "FindRecord() - "+Int(((reps/(ms2-ms1))*1000))+" times per second (SEARCHING BY A STRING FIELD)"

Print "":Color 255,255,155:Print "QUERY FUNCTION EXECUTION TIME TRIALS:":Color 255,155,255:Print ""

ms1#=MilliSecs()
For t=1 To reps
ListRecords DB,"Level=1"
Next
ms2#=MilliSecs()
Print "ListRecords() (QUERY!!) - "+Int(((reps/(ms2-ms1))*1000))+" times per second (using simple query: "+Chr(34)+"Level=1"+Chr(34)+")"

Print ""
Print ""
Color 255,255,255
Print "Note: Execution speeds of ListRecords() will be slower with bigger databases."
WaitKey:Goto restart
















;*********** PUBLIC FUNCTIONS


Function ListRecords(DB,Query$)
lq=Len(query)	;tokenise queries
DBQueries=0
qu$=""
For qa=1 To lq ;go trough query list
m$=Mid(query,qa,1)
If m="," Or qa=lq Then
If qa=lq Then qu=qu+m
DBqueries=DBqueries+1
	phase=0:q1$="":q2$="":q3$=""
	For zz=1 To Len(qu) ;tokenise query components
	mmm$=Mid(qu,zz,1)
	sym=(mmm="<" Or mmm="=" Or mmm=">")
	If phase=0 And sym=0 Then q1=q1+mmm
	If phase=0 And sym Then phase=1
	If phase=1 And sym Then q2=q2+mmm
	If phase=1 And sym=0 Then phase=2
	If phase=2 And sym=0 Then q3=q3+mmm
	Next
		If q2="=" Then DBQueryOp(DBqueries)=1
		If q2="<" Then DBQueryOp(DBqueries)=2
		If q2=">" Then DBQueryOp(DBqueries)=3
		If q2="<=" Or q2="=<" Then DBQueryOp(DBqueries)=4
		If q2="=>" Or q2=">=" Then DBQueryOp(DBqueries)=5
		If q2="<>" Or q2="><" Then DBQueryOp(DBqueries)=6
	DBQueryField(DBQueries)=FindField(DB,q1):fld=DBQueryField(DBQueries)
	If DBFieldType(DB,Fld)=DB_Byte Then DBQueryValInt(DBQueries)=q3
	If DBFieldType(DB,Fld)=DB_SByte Then DBQueryValInt(DBQueries)=q3
	If DBFieldType(DB,Fld)=DB_Short Then DBQueryValInt(DBQueries)=q3
	If DBFieldType(DB,Fld)=DB_SShort Then DBQueryValInt(DBQueries)=q3
	If DBFieldType(DB,Fld)=DB_Int Then DBQueryValInt(DBQueries)=q3
	If DBFieldType(DB,Fld)=DB_Float Then DBQueryValFloat(DBQueries)=q3
	If DBFieldType(DB,Fld)=DB_String Then DBQueryValString(DBQueries)=q3
	If DBFieldType(DB,Fld)=DB_List Then DBQueryValString(DBQueries)=q3
qu=""
Else
qu=qu+m
EndIf
Next
DBListedRecords=0
For r=1 To DBRecords(DB)
	doit=1
	For q=1 To DBQueries
	; = (Equals)
	If DBFieldType(DB,DBQueryField(q))=DB_Byte Then If DBQueryOp(q)=1 Then If Not (GetDataSimple(DB,DBQueryField(q),r)=DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_SByte Then If DBQueryOp(q)=1 Then If Not (GetDataSimple(DB,DBQueryField(q),r)=DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Short Then If DBQueryOp(q)=1 Then If Not (GetDataSimple(DB,DBQueryField(q),r)=DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_SShort Then If DBQueryOp(q)=1 Then If Not (GetDataSimple(DB,DBQueryField(q),r)=DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Int Then If DBQueryOp(q)=1 Then If Not (GetDataSimple(DB,DBQueryField(q),r)=DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Float Then If DBQueryOp(q)=1 Then If Not (GetDataFloatSimple(DB,DBQueryField(q),r)=DBQueryValFloat(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_String Then If DBQueryOp(q)=1 Then If Not (GetDataStringSimple(DB,DBQueryField(q),r)=DBQueryValString(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_List Then If DBQueryOp(q)=1 Then If Not (GetDataStringSimple(DB,DBQueryField(q),r)=DBQueryValString(q)) Then doit=0:Exit
	; < (Less Than)
	If DBFieldType(DB,DBQueryField(q))=DB_Byte Then If DBQueryOp(q)=2 Then If Not (GetDataSimple(DB,DBQueryField(q),r)<DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_SByte Then If DBQueryOp(q)=2 Then If Not (GetDataSimple(DB,DBQueryField(q),r)<DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Short Then If DBQueryOp(q)=2 Then If Not (GetDataSimple(DB,DBQueryField(q),r)<DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_SShort Then If DBQueryOp(q)=2 Then If Not (GetDataSimple(DB,DBQueryField(q),r)<DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Int Then If DBQueryOp(q)=2 Then If Not (GetDataSimple(DB,DBQueryField(q),r)<DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Float Then If DBQueryOp(q)=2 Then If Not (GetDataFloatSimple(DB,DBQueryField(q),r)<DBQueryValFloat(q)) Then doit=0:Exit
	; > (More Than)
	If DBFieldType(DB,DBQueryField(q))=DB_Byte Then If DBQueryOp(q)=3 Then If Not (GetDataSimple(DB,DBQueryField(q),r)>DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_SByte Then If DBQueryOp(q)=3 Then If Not (GetDataSimple(DB,DBQueryField(q),r)>DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Short Then If DBQueryOp(q)=3 Then If Not (GetDataSimple(DB,DBQueryField(q),r)>DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_SShort Then If DBQueryOp(q)=3 Then If Not (GetDataSimple(DB,DBQueryField(q),r)>DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Int Then If DBQueryOp(q)=3 Then If Not (GetDataSimple(DB,DBQueryField(q),r)>DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Float Then If DBQueryOp(q)=3 Then If Not (GetDataFloatSimple(DB,DBQueryField(q),r)>DBQueryValFloat(q)) Then doit=0:Exit
	; =< (Equals or Less Than)
	If DBFieldType(DB,DBQueryField(q))=DB_Byte Then If DBQueryOp(q)=4 Then If Not (GetDataSimple(DB,DBQueryField(q),r)=<DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_SByte Then If DBQueryOp(q)=4 Then If Not (GetDataSimple(DB,DBQueryField(q),r)=<DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Short Then If DBQueryOp(q)=4 Then If Not (GetDataSimple(DB,DBQueryField(q),r)=<DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_SShort Then If DBQueryOp(q)=4 Then If Not (GetDataSimple(DB,DBQueryField(q),r)=<DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Int Then If DBQueryOp(q)=4 Then If Not (GetDataSimple(DB,DBQueryField(q),r)=<DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Float Then If DBQueryOp(q)=4 Then If Not (GetDataFloatSimple(DB,DBQueryField(q),r)=<DBQueryValFloat(q)) Then doit=0:Exit
	; => (Equals or More Than)
	If DBFieldType(DB,DBQueryField(q))=DB_Byte Then If DBQueryOp(q)=5 Then If Not (GetDataSimple(DB,DBQueryField(q),r)=>DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_SByte Then If DBQueryOp(q)=5 Then If Not (GetDataSimple(DB,DBQueryField(q),r)=>DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Short Then If DBQueryOp(q)=5 Then If Not (GetDataSimple(DB,DBQueryField(q),r)=>DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_SShort Then If DBQueryOp(q)=5 Then If Not (GetDataSimple(DB,DBQueryField(q),r)=>DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Int Then If DBQueryOp(q)=5 Then If Not (GetDataSimple(DB,DBQueryField(q),r)=>DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Float Then If DBQueryOp(q)=5 Then If Not (GetDataFloatSimple(DB,DBQueryField(q),r)=>DBQueryValFloat(q)) Then doit=0:Exit
	; <> (Not)
	If DBFieldType(DB,DBQueryField(q))=DB_Byte Then If DBQueryOp(q)=6 Then If Not (GetDataSimple(DB,DBQueryField(q),r)<>DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_SByte Then If DBQueryOp(q)=6 Then If Not (GetDataSimple(DB,DBQueryField(q),r)<>DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Short Then If DBQueryOp(q)=6 Then If Not (GetDataSimple(DB,DBQueryField(q),r)<>DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_SShort Then If DBQueryOp(q)=6 Then If Not (GetDataSimple(DB,DBQueryField(q),r)<>DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Int Then If DBQueryOp(q)=6 Then If Not (GetDataSimple(DB,DBQueryField(q),r)<>DBQueryValInt(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_Float Then If DBQueryOp(q)=6 Then If Not (GetDataFloatSimple(DB,DBQueryField(q),r)<>DBQueryValFloat(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_String Then If DBQueryOp(q)=6 Then If Not (GetDataStringSimple(DB,DBQueryField(q),r)<>DBQueryValString(q)) Then doit=0:Exit
	If DBFieldType(DB,DBQueryField(q))=DB_List Then If DBQueryOp(q)=6 Then If Not (GetDataStringSimple(DB,DBQueryField(q),r)<>DBQueryValString(q)) Then doit=0:Exit
	Next
If doit Then
DBListedRecords=DBListedRecords+1
DBListedRecord(DBListedRecords)=DBRecordID(DB,r)
;Color 255,255,0
;Print GetDataStringSimple(db,1,r)
EndIf
Next
Return DBListedRecords
End Function



Function DefineDB(nam$="")
For t=1 To DBs
If DBFields(t)=0 And DBActive(t)=0 Then DaDB=t:Goto gotit
Next
If DBs>MaxDBs Then RuntimeError "Out of database space."
DBs=DBs+1:DaDB=DBs
.gotit
DBName(DaDB)=nam
DBActive(DaDB)=1
Return DaDB
End Function

Function BuildDB(DB)
If DBFields(DB)=0 Then RuntimeError "Cannot build a database with no fields."
sum=4
For t=1 To DBFields(DB)
DBFieldOffset(DB,t)=sum
If DBFieldType(DB,t)=DB_Byte Then sum=sum+1
If DBFieldType(DB,t)=DB_SByte Then sum=sum+1
If DBFieldType(DB,t)=DB_Short Then sum=sum+2
If DBFieldType(DB,t)=DB_SShort Then sum=sum+2
If DBFieldType(DB,t)=DB_Int Then sum=sum+4
If DBFieldType(DB,t)=DB_Float Then sum=sum+4
If DBFieldType(DB,t)=DB_String Then sum=sum+DBFieldSize(DB,t)
If DBFieldType(DB,t)=DB_List Then sum=sum+1
Next
DBRecordsInCache(DB)=0
DBRecordSize(DB)=sum
DBBank(DB)=CreateBank()
End Function


Function AddByteField(DB,N$)
Return AddField(DB,N$,DB_Byte)
End Function

Function AddSByteField(DB,N$)
Return AddField(DB,N$,DB_SByte)
End Function

Function AddShortField(DB,N$)
Return AddField(DB,N$,DB_Short)
End Function

Function AddSShortField(DB,N$)
Return AddField(DB,N$,DB_SShort)
End Function

Function AddIntField(DB,N$)
Return AddField(DB,N$,DB_Int)
End Function

Function AddFloatField(DB,N$)
Return AddField(DB,N$,DB_Float)
End Function

Function AddStringField(DB,N$,ln=25)
Return AddField(DB,N$,DB_String,ln)
End Function

Function AddListField(DB,N$,l$)
Return AddField(DB,N$,DB_List,0,l)
End Function


Function AddRecord(DB)
DBRecords(DB)=DBRecords(DB)+1:E=DBRecords(DB)
loc=BankSize(DBBank(DB))
ID=DBIDAt(DB)
If DBIDAt(DB)=2147483647 Then DBIDAt(DB)=-2147483648  Else DBIDAt(DB)=DBIDAt(DB)+1
ResizeBank DBBank(DB),loc+DBRecordSize(DB)
PokeInt DBBank(DB),loc,id
For f=1 To DBFields(DB)
If DBFieldType(DB,f)=DB_Byte Then WriteByteToDB db,f,e,0
If DBFieldType(DB,f)=DB_SByte Then WriteSByteToDB db,f,e,0
If DBFieldType(DB,f)=DB_Short Then WriteShortToDB db,f,e,0
If DBFieldType(DB,f)=DB_SShort Then WriteSShortToDB db,f,e,0
If DBFieldType(DB,f)=DB_Int Then WriteIntToDB db,f,e,0
If DBFieldType(DB,f)=DB_Float Then WriteFloatToDB db,f,e,0
If DBFieldType(DB,f)=DB_String Then WriteStringToDB db,f,e,""
If DBFieldType(DB,f)=DB_List Then WriteByteToDB db,f,e,0
Next
AddRecordToCache DB,DBRecords(DB)
Return DBRecordID(DB,E)
End Function


Function FreeRecord(DB,e)
rec=FindRecordByID(DB,e):If rec=0 Then RuntimeError "Database doesn't contain specified record. (FindRecord)"
sz=DBRecordSize(db)
lc=DBRecordLocation(DB,rec)
	If rec<DBRecords(db)
	For s=lc To (BankSize(DBBank(DB))-sz)
	b=PeekByte(DBBank(db),s+sz)
	PokeByte DBBank(db),s,b
	Next
	EndIf
	ResizeBank DBBank(db),BankSize(DBBank(db))-sz
	DBRecords(DB)=DBRecords(DB)-1
	DBDels(DB)=DBDels(DB)+1
		.redel	
		For c=1 To DBRecordsInCache(db) ;remove any instances of the record from the cache
		If DBRecordCacheIndex(db,c)=rec Then
			For tt=1 To DBRecordsInCache(db)-1
			DBRecordCacheID(db,tt)=DBRecordCacheID(db,tt+1)
			DBRecordCacheIndex(db,tt)=DBRecordCacheIndex(db,tt+1)
			Next
		DBRecordsInCache(db)=DBRecordsInCache(db)-1
		Goto redel
		EndIf
		Next
			For c=1 To DBRecordsInCache(db) ;update record indices in cache
			If DBRecordCacheIndex(db,c)>rec Then DBRecordCacheIndex(db,c)=DBRecordCacheIndex(db,c)-1
			Next
End Function


Function SetData(DB,E,F$,val)
rec=FindRecordByID(DB,e):If rec=0 Then RuntimeError "Database doesn't contain specified record.1"
fld=FindField(DB,F):If fld=0 Then RuntimeError "Database doesn't contain specified field (`"+f+"')."
SetDataSimple db,fld,rec, val
AddRecordToCache DB,rec
End Function

Function SetDataFloat(DB,E,F$,val#)
rec=FindRecordByID(DB,e):If rec=0 Then RuntimeError "Database doesn't contain specified record.2"
fld=FindField(DB,F):If fld=0 Then RuntimeError "Database doesn't contain specified field (`"+f+"')."
SetDataFloatSimple db,fld,rec, val
AddRecordToCache DB,rec
End Function

Function SetDataString(DB,E,F$,val$)
rec=FindRecordByID(DB,e):If rec=0 Then RuntimeError "Database doesn't contain specified record.3"
fld=FindField(DB,F):If fld=0 Then RuntimeError "Database doesn't contain specified field (`"+f+"')."
SetDataStringSimple db,fld,rec, val
AddRecordToCache DB,rec
End Function



Function GetData(DB,E,F$)
rec=FindRecordByID(DB,e):If rec=0 Then RuntimeError "Database doesn't contain specified record.4"
fld=FindField(DB,F):If fld=0 Then RuntimeError "Database doesn't contain specified field (`"+f+"')."
AddRecordToCache DB,rec
Return GetDataSimple (db,fld,rec)
End Function

Function GetDataFloat#(DB,E,F$)
rec=FindRecordByID(DB,e):If rec=0 Then RuntimeError "Database doesn't contain specified record.5"
fld=FindField(DB,F):If fld=0 Then RuntimeError "Database doesn't contain specified field (`"+f+"')."
AddRecordToCache DB,rec
Return GetDataFloatSimple (db,fld,rec)
End Function

Function GetDataString$(DB,E,F$)
rec=FindRecordByID(DB,e):If rec=0 Then RuntimeError "Database doesn't contain specified record.6"
fld=FindField(DB,F):If fld=0 Then RuntimeError "Database doesn't contain specified field (`"+f+"')."
AddRecordToCache DB,rec
Return GetDataStringSimple (db,fld,rec)
End Function






Function FindRecord(DB,f$,val$) ;this should first check the cache records!
fld=FindField(DB,F):If fld=0 Then RuntimeError "Database doesn't contain specified field (`"+f+"')."
ftyp=DBFieldType(DB,Fld)
;CHECK RECENTLY USED RECORDS
		If ftyp=DB_Byte Then
		valint=Int(val)
		For c=1 To DBRecordsInCache(DB)
		e=DBRecordCacheIndex(db,c)
		If ReadByteFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
		Next
		Return -1
		EndIf	
			If ftyp=DB_SByte Then
			valint=Int(val)
			For c=1 To DBRecordsInCache(DB)
			e=DBRecordCacheIndex(db,c)
			If ReadSByteFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
			Next
			Return -1
			EndIf	
				If ftyp=DB_Short Then
				valint=Int(val)
				For c=1 To DBRecordsInCache(DB)
				e=DBRecordCacheIndex(db,c)
				If ReadShortFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
				Next
				Return -1
				EndIf
			If ftyp=DB_SShort Then
			valint=Int(val)
			For c=1 To DBRecordsInCache(DB)
			e=DBRecordCacheIndex(db,c)
			If ReadSShortFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
			Next
			Return -1
			EndIf
		If ftyp=DB_Int Then
		valint=Int(val)
		For c=1 To DBRecordsInCache(DB)
		e=DBRecordCacheIndex(db,c)
		If ReadIntFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
		Next
		Return -1
		EndIf	
	If ftyp=DB_Float Then
	valfloat#=Float(val)
	For c=1 To DBRecordsInCache(DB)
	e=DBRecordCacheIndex(db,c)
	If ReadFloatFromDB(db,fld,e)=valfloat Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
	Next
	Return -1
	EndIf	
		If ftyp=DB_String Then
		ln=Len(val)
		For c=1 To DBRecordsInCache(DB)
		e=DBRecordCacheIndex(db,c)
		ln2=StringLength(db,fld,e):If ln=ln2 Then If ReadStringFromDB(db,fld,e)=val Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
;		If ReadStringFromDB(db,fld,e)=val Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
		Next
		Return -1
		EndIf	
			If ftyp=DB_List Then
			For c=1 To DBRecordsInCache(DB)
			e=DBRecordCacheIndex(db,c)
			If DBGetListString(db,fld,ReadByteFromDB(db,fld,e))=val Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
			Next
			Return -1
			EndIf	

;CHECK ALL RECORDS
		If ftyp=DB_Byte Then
		valint=Int(val)
		For e=1 To DBRecords(DB)
		If ReadByteFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordID(db,e)
		Next
		Return -1
		EndIf	
			If ftyp=DB_SByte Then
			valint=Int(val)
			For e=1 To DBRecords(DB)
			If ReadSByteFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordID(db,e)
			Next
			Return -1
			EndIf	
				If ftyp=DB_Short Then
				valint=Int(val)
				For e=1 To DBRecords(DB)
				If ReadShortFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordID(db,e)
				Next
				Return -1
				EndIf	
			If ftyp=DB_SShort Then
			valint=Int(val)
			For e=1 To DBRecords(DB)
			If ReadSShortFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordID(db,e)
			Next
			Return -1
			EndIf	
		If ftyp=DB_Int Then
		valint=Int(val)
		For e=1 To DBRecords(DB)
		If ReadIntFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordID(db,e)
		Next
		Return -1
		EndIf	
	If ftyp=DB_Float Then
	valfloat#=Int(val)
	For e=1 To DBRecords(DB)
	If ReadFloatFromDB(db,fld,e)=valfloat Then AddRecordToCache DB,e:Return DBRecordID(db,e)
	Next
	Return -1
	EndIf	
		If ftyp=DB_String Then
		ln=Len(val)
		For e=1 To DBRecords(DB)
		ln2=StringLength(db,fld,e):If ln=ln2 Then If ReadStringFromDB(db,fld,e)=val Then AddRecordToCache DB,e:Return DBRecordID(db,e)
		Next
		Return -1
		EndIf	
			If ftyp=DB_List Then
			For e=1 To DBRecords(DB)
			If DBGetListString(db,fld,ReadByteFromDB(db,fld,e))=val Then AddRecordToCache DB,e:Return DBRecordID(db,e)
			Next
			Return -1
			EndIf	
End Function




Function FreeDB(DB)
If db<1 Or db>DBs Then RuntimeError "No such database for FreeDB."
If dbactive(db)=0 Then RuntimeError "No such database for FreeDB."
FreeBank DBBank(DB)
DBFields(DB)=0
DBRecords(DB)=0
DBIDAt(DB)=0
DBName(DB)=""
DBActive(DB)=0
DBRecordsInCache(DB)=0
End Function




Function SaveDB(DB,filename$)
fh=WriteFile(filename):If fh=0 Then Return
WriteDB fh,DB
CloseFile fh
Return 1
End Function


Function WriteDB(fil,DB)
WriteString fil,DBName$(DB)
WriteInt fil,DBIDAt(DB)
WriteInt fil,DBFields(DB)
WriteInt fil,DBRecordSize(DB)
WriteInt fil,DBRecords(DB)
	For f=1 To DBFields(DB)
	WriteByte fil,DBFieldType(DB,f)
	If dbfieldtype(db,f)=DB_String Then WriteInt fil,DBFieldSize(DB,f)
	WriteInt fil,DBFieldOffset(DB,f)
	If dbfieldtype(db,f)=DB_List Then WriteString fil,DBFieldList(DB,f)
	Next
WriteInt fil,BankSize(DBBank(DB))
WriteBytes DBBank(DB),fil,0,BankSize(DBBank(DB))
End Function




Function LoadDB(filename$)
fh=ReadFile(filename):If fh=0 Then Return
DB=ReadDB(fh)
CloseFile fh
Return DB
End Function


Function ReadDB(fil)
DB=DefineDB():DBActive(DB)=1
DBName$(DB)=ReadString(fil)
DBIDAt(DB)=ReadInt(fil)
DBFields(DB)=ReadInt(fil)
DBRecordSize(DB)=ReadInt(fil)
DBRecords(DB)=ReadInt(fil)
	For f=1 To DBFields(DB)
	DBFieldType(DB,f)=ReadByte(fil)
	If dbfieldtype(db,f)=DB_String Then DBFieldSize(DB,f)=ReadInt(fil)
	DBFieldOffset(DB,f)=ReadInt(fil)
	If dbfieldtype(db,f)=DB_List Then DBFieldList(DB,f)=ReadString(fil)
	Next
bs=ReadInt(fil):DBBank(DB)=CreateBank(bs)
ReadBytes DBBank(DB),fil,0,bs
Return DB
End Function







Function EditDBs() ;Edit all databases
If DBs=0 Then Return
buf=GraphicsBuffer():sred=ColorRed():sgreen=ColorGreen():sblue=ColorBlue()
w=GraphicsWidth():h=GraphicsHeight()
	Color 0,0,0
	For y=0 To h Step 2
	Line 0,y,w,y
	Next
;		For x=0 To w Step 3
;		Line x,0,x,h
;		Next
rempic=CreateImage(w,h):GrabImage rempic,0,0
w=GraphicsWidth():h=GraphicsHeight()
SetBuffer BackBuffer()
edbfont=LoadFont("verdana",20)
SetFont edbfont:fh=FontHeight()
dw=200
FlushKeys:FlushMouse
Repeat
DrawBlock rempic,0,0
wh=h-100:yspan=wh/(fh*1.5):xspan=(DBs-1)/yspan
ww=((xspan+1)*(dw+10))
If xspan=0 Then wh=fh*1.5*dbs
wy=(h/2)-(wh/2)
wx=(w/2)-(ww/2)
Color 30,30,50:Rect wx,wy,ww+20,wh+20,1
Color 230,230,250:Rect wx,wy,ww+20,wh+20,0
msx=MouseX():msy=MouseY():mh1=MouseHit(1)
wx=wx+10:wy=wy+10
dx=wx:dy=wy
For d=1 To dbs
Color 20,20,20
Rect dx,dy,dw,fh,1
Color 255,255,255
Text dx+(dw/2),dy,DBName(d)+" ("+DBRecords(d)+")",1
Color 48,48,48:Rect dx,dy,dw,fh,0
If msx=>dx And msy=>dy And msx<dx+dw And msy<dy+fh Then
Color 248,248,48:Rect dx,dy,dw,fh,0
If mh1 Then EditDB d:SetFont edbfont
EndIf
dy=dy+(fh*1.5):If dy>(wy+wh-10) Then dx=dx+(dw+10):dy=wy
Next
Color 255,255,255:Line Msx-1,msy,msx+1,msy:Line msx,msy-1,msx,msy+1
Flip
kh1=KeyHit(1):If kh1 And rightmenu Then rightmenu=0:kh1=0
Until kh1; Or MouseHit(2)
FlushKeys:FlushMouse
FreeFont edbfont
SetBuffer buf:Color sred,sgreen,sblue
DrawBlock rempic,0,0:FreeImage rempic
End Function


Function EditDB(DB) ;this changes the active font!  also causes problems if the current graphics buffer is an image buffer or texture buffer
If DBActive(DB)=0 Then RuntimeError "Database doesnt exist.
buf=GraphicsBuffer():sred=ColorRed():sgreen=ColorGreen():sblue=ColorBlue()
w=GraphicsWidth():h=GraphicsHeight()
rempic=CreateImage(w,h):GrabImage rempic,0,0
SetBuffer BackBuffer()
edbfont=LoadFont("verdana",17)
edbfont2=LoadFont("verdana",27)
SetFont edbfont
fh=FontHeight()
fw=w/8:If wf<100 Then wf=100
sw=20
ww=w-sw
wh=h-(sw+(fh*2))
yspan=wh/fh
xspan=ww/fw
FlushKeys:FlushMouse
Repeat
Color 30,30,50
Rect 0,0,w,h,1
msx=MouseX()
msy=MouseY()
mh1=MouseHit(1):If mh1 And rightmenu Then If msx<rmx Or msx=>rmx+rmw Or msy<rmy Or msy=>rmy+rmh Then rightmenu=0:mh1=0
mh2=MouseHit(2)
md1=MouseDown(1)
fof=DBscrollx+1:x=0
If dbscrollx>dbfields(db)-xspan Then dbscrollx=dbfields(db)-xspan
If dbscrollx<0 Then dbscrollx=0
If dbscrolly>dbrecords(db)-yspan Then dbscrolly=dbrecords(db)-yspan
If dbscrolly<0 Then dbscrolly=0
Repeat
If fof=>0 And fof<=DBFields(DB) And fof>0 Then
Color 255,255,255
Text x,0,DBField(DB,fof)
	rof=DBScrolly+1:y=fh
	Repeat
	If rof>0 And rof=<DBRecords(DB) And rof>0 Then
		dat$=GetDataStringSimple(DB,fof,rof)
		Color 0,0,0
		Rect x,y,fw,fh-2,1
		Color 30,30,50
		Rect x+fw-3,y,3,fh-2,1
			If msx<(w-fh) Then
			If (msy=>y And msy<y+fh And dragbar=0 And rightmenu=0) Or (rightmenu And recordsel=rof) Then
			recordsel=rof
			Color 55,55,125
			Rect x,y,fw-3,fh-2,1
			Color 255,155,255
			Text x,y,dat$
				If msx=>x And msx<x+fw And rightmenu=0 Then
				fieldsel=fof
				editx=x:edity=y
				Color 255,255,255
				Rect x,y,fw-3,fh-2,0
				EndIf
			Else
				Color 255,255,155
				Text x,y,dat$
			EndIf
			Else
				Color 255,255,155
				Text x,y,dat$
			EndIf
	EndIf
	rof=rof+1:y=y+fh
	Until y+fh>(wh+fh) Or rof>DBRecords(DB)
EndIf
fof=fof+1:x=x+fw
Until x>w Or fof>DBFields(DB)
If DBFields(db)>xspan Then ;H Scrollbar
Color 95,90,90
scx=0
scy=h-(fh*2)
scw=w-fh
sch=fh
Rect scx,scy,scw,sch,1
Color 255,190,100
CarretW=(xspan*scw)/DBFields(db)
CarretX=(DBscrollx*scw)/DBFields(db)
If dragbar=1 Then Color 255,255,255
Rect carretx,scy,carretw,sch,1
		If msx=>carretx And msy=>scy And msx<carretx+carretw And msy<scy+sch Then
		Color 255,255,255:Rect carretx,scy,carretw,sch,0
		If mh1 Then dragoffset=msx-(carretx+(carretw/2)):dragbar=1
		EndIf
	If dragbar=1 Then
	If msx-dragoffset<scx+(carretw/2) Then msx=scx+(carretw/2)+dragoffset
	If msx-dragoffset>scx+scw-(carretw/2) Then msx=scx+w-(carretw/2)+dragoffset
	;MoveMouse msx,scy+(fh/2)
	mmmp=(((msx-scx)-dragoffset)-(carretw/2))
	dbscrollx=(mmmp*(dbfields(DB)))/scw
	EndIf
	If md1=0 Then dragbar=0
EndIf
					mwspd=MouseZSpeed() ;mouse wheel
					If mwspd<>0 Then
					dbscrolly=dbscrolly-(mwspd*(yspan*.4))
					If dbscrolly>dbrecords(db)-yspan Then dbscrolly=dbrecords(db)-yspan
					If dbscrolly<0 Then dbscrolly=0
					EndIf
If DBRecords(db)>yspan Then ;V Scrollbar
Color 95,90,90
scx=w-fh
scy=fh
scw=fh
sch=h-(fh*3)
Rect scx,scy,scw,sch,1
Color 255,190,100
CarretH=(yspan*sch)/(DBRecords(db))
CarretY=scy+((DBscrolly*sch)/(DBRecords(db)))
If dragbar=2 Then Color 255,255,255
Rect scx,carrety,fh,carreth,1
		If msx=>scx And msy=>carrety And msx<scx+scw And msy<carrety+carreth Then
		Color 255,255,255:Rect scx,carrety,scw,carreth,0
		If mh1 Then dragoffset=msy-(carrety+(carreth/2)):dragbar=2
		EndIf
	If dragbar=2 Then
	If msy-dragoffset<scy+(carreth/2) Then msy=scy+(carreth/2)+dragoffset
	If msy-dragoffset>scy+sch+1-(carreth/2) Then msy=scy+sch+1-(carreth/2)+dragoffset
	;MoveMouse scx+(fh/2),msy
	mmmp=(((msy-scy)-dragoffset)-(carreth/2))
	dbscrolly=(mmmp*(dbrecords(DB)))/sch
	EndIf
	If md1=0 Then dragbar=0
EndIf
Color 60,60,160 ;status bar
Rect 0,h-fh,w,fh,1
Color 255,255,255
If DBName(DB)<>"" Then n$=DBName(DB) Else n$="Unnamed"
Text 1,(h-fh)+1,"Database: `"+n$+"'"
Text w*.25,(h-fh)+1,"Fields: "+DBFields(DB)
Text w*.5,(h-fh)+1,"Records: "+DBRecords(DB)
If recordsel>0 Then Text w*.78,(h-fh)+1,fieldsel+" x "+recordsel
		If mh1 And recordsel>0 And fieldsel>0 And rightmenu=0 Then ;edit record field
			dbbgpic2=CreateImage(w,h):GrabImage dbbgpic2,0,0
		
			If DBFieldType(db,fieldsel)<>DB_List Then ;typing into the box
			daval$=GetDataStringSimple(db,fieldsel,recordsel)
			Odaval$=daval
			Repeat
			DrawBlock dbbgpic2,0,0
			Color 0,0,0:Rect editx,edity,fw-3,fh,1
			Color 255,255,255:Rect editx-1,edity-1,fw+2-3,fh+1,0
			Color 60,255,60
			ms=MilliSecs()
			If ms-curstime > 100 Then curstik=curstik+1:curstime=ms:If curstik=2 Then curstik=0
			If curstik=1 Then cursor$="_" Else cursor$=""
			Text editx,edity,daval+cursor
			k=GetKey()
			If k>0 And k<>27 And k<>8 And k<>13 Then daval=daval+Chr(k)
			If k=8 Then If Len(daval)>0 Then daval=Left(daval,Len(daval)-1)
			msx2=MouseX():msy2=MouseY():Color 255,255,255:Line Msx2-1,msy2,msx2+1,msy2:Line msx2,msy2-1,msx2,msy2+1
			Flip
			Until k=27 Or k=13 Or MouseHit(1) Or MouseHit(2)
			FlushKeys:FlushMouse
			If k<>27 Then SetDataStringSimple(db,fieldsel,recordsel, daval)
			EndIf
			
				If DBFieldType(db,fieldsel)=DB_List Then ;list box (multiple choice)
				omsx=MouseX():omsy=MouseY()
							opts=0:minl=100
							Repeat
							kkk$=DBGetListString(db,fieldsel,opts)
							If minl<StringWidth(kkk)+20 Then minl=StringWidth(kkk)+20
							opts=opts+1
							Until kkk=""
							opts=opts-1
				Repeat
				mh1=MouseHit(1)
				DrawBlock dbbgpic2,0,0
				rmw=minl:rmh=20+(opts*(fh+5))-5
				rmx=msx-(rmw/2):rmy=msy-(rmh/2)
				If rmx<0 Then rmx=0
				If rmy<0 Then rmy=0
				If rmx>(w-rmw) Then rmx=(w-rmw)
				If rmy>(h-rmh) Then rmy=(h-rmh)
				Color 90,90,120:Rect rmx,rmy,rmw,rmh,1
				Color 255,255,255:Rect rmx,rmy,rmw,rmh,0
					optsel=-1
					For o=1 To opts
					Color 20,20,20
					optx=rmx+10:opty=rmy+10+((o-1)*(fh+5))
					optw=rmw-20
					Rect optx,opty,optw,fh,1
					If ReadByteFromDB(db,fieldsel,recordsel)=o-1 Then Color 0,255,0:Rect optx,opty,optw,fh,0
					Color 255,255,255
					opop$=DBGetListString(db,fieldsel,o-1)
					If MouseX()=>optx And MouseY()=>opty And MouseX()<optx+optw And MouseY()<opty+fh Then
					Color 255,255,55
					Rect optx,opty,optw,fh,0:Color 255,255,255
					If mh1 Then optsel=o-1
					EndIf
					Text optx+(optw/2),opty,opop,1
					Next
				msx2=MouseX():msy2=MouseY():Color 255,255,255:Line Msx2-1,msy2,msx2+1,msy2:Line msx2,msy2-1,msx2,msy2+1
				Flip
				Until KeyHit(1) Or mh1 Or MouseHit(2)
				If mh1 And optsel>-1 Then SetDataStringSimple db,fieldsel,recordsel,dbgetliststring(db,fieldsel,optsel):MoveMouse omsx,omsy
				FlushMouse:FlushKeys
				EndIf
		
		DrawBlock dbbgpic2,0,0:FreeImage dbbgpic2
		EndIf
rmw=150:rmh=116
If mh2 Then rightmenu=rightmenu+1:rmx=msx-(rmw/2):rmy=msy-(rmh/2):If rightmenu=2 Then rightmenu=0
If rightmenu Then
If rmx<0 Then rmx=0
If rmy<0 Then rmy=0
If rmx>(w-rmw) Then rmx=(w-rmw)
If rmy>(h-rmh) Then rmy=(h-rmh)
Color 150,150,150:Rect rmx,rmy,rmw,rmh,1
Color 255,255,255:Rect rmx,rmy,rmw,rmh,0
	optx=rmx+10:opty=rmy+10:optw=rmw-20:opth=fh
;	Color 0,0,0:Text optx,opty,dbrecordid(db,recordsel):opty=opty+(fh*1.5)
	opt$="New Record"
	Color 80,80,80:Rect optx,opty,optw,opth,1:Color 255,255,255:Text optx+(optw/2),opty,opt,1
	If msx=>optx And msy=>opty And msx<optx+optw And msy<opty+opth Then Color 255,255,0:Rect optx,opty,optw,opth,0:If mh1 Then AddRecord DB:DBScrollY=dbrecords(db)-yspan:recordsel=dbrecords(db)
		If recordsel>0 Then
		opty=opty+(fh*1.5):opt$="Clone Record"
		Color 80,80,80:Rect optx,opty,optw,opth,1:Color 255,255,255:Text optx+(optw/2),opty,opt,1
		If msx=>optx And msy=>opty And msx<optx+optw And msy<opty+opth Then Color 255,255,0:Rect optx,opty,optw,opth,0:If mh1 Then
			AddRecord DB
			CopyRecordSimple DB,RecordSel,DBRecords(DB)
			DBScrollY=dbrecords(db)-yspan
			recordsel=dbrecords(db)
		EndIf
		EndIf
		If recordsel>0 Then
		opty=opty+(fh*1.5):opt$="Delete Record"
		Color 80,80,80:Rect optx,opty,optw,opth,1:Color 255,255,255:Text optx+(optw/2),opty,opt,1
		If msx=>optx And msy=>opty And msx<optx+optw And msy<opty+opth Then Color 255,255,0:Rect optx,opty,optw,opth,0:If mh1 Then FreeRecord DB,DBRecordID(DB,recordsel);:rightmenu=0:mh1=0
		EndIf
	opty=opty+(fh*1.5):opt$="Save Database"
	Color 80,80,80:Rect optx,opty,optw,opth,1:Color 255,255,255:Text optx+(optw/2),opty,opt,1
	If msx=>optx And msy=>opty And msx<optx+optw And msy<opty+opth Then Color 255,255,0:Rect optx,opty,optw,opth,0:If mh1 Then
	result=SaveDB(DB,"Database.db")
	If result Then repo$="Successfully exported database to Database.db" Else repo$="Failed to write file!"
	Color 50,50,120
	Rect 0,0,w,h,1
	Color 255,255,255
	SetFont edbfont2
	Text w/2,h/2,repo,1,1
	SetFont edbfont
	Flip
	Repeat
	Until KeyHit(1) Or KeyHit(57) Or KeyHit(26) Or MouseHit(1) Or MouseHit(2)
	FlushKeys
	FlushMouse
	EndIf
EndIf
If recordsel<1 Then recordsel=1
If recordsel>DBRecords(DB) Then recordsel=DBRecords(DB)
If dbrecords(db)=0 Then recordsel=0:fieldsel=0
If rightmenu=0 Then recordsel=0:fieldsel=0

msx2=MouseX():msy2=MouseY():Color 255,255,255:Line Msx2-1,msy2,msx2+1,msy2:Line msx2,msy2-1,msx2,msy2+1
Flip
kh1=KeyHit(1):If kh1 And rightmenu Then rightmenu=0:kh1=0
Until kh1
FlushKeys
FreeFont edbfont
SetBuffer buf:Color sred,sgreen,sblue
DrawBlock rempic,0,0:FreeImage rempic
End Function








;*********** PRIVATE FUNCTIONS


Function FindField(DB,f$)
l=Len(f)
For t=1 To DBFields(DB)
If DBFieldLen(DB,t)=l Then If f=DBField(DB,t) Then Return t
Next
End Function

Function FindRecordByID(DB,lab)
		For c=DBRecordsInCache(DB) To 1 Step -1 ;first check the recently used records for a match (the whole point of the cache)
		If DBRecordCacheID(DB,c)=lab Then Return DBRecordCacheIndex(DB,c)
		Next
	lab2=lab-(DBDels(DB)+1):If lab2<1 Then lab2=1 ;failing that, take a educated guess at where to search from
	If lab2<=DBRecords(DB) Then
	For t=lab2 To DBRecords(DB)
	If DBRecordID(DB,t)=lab Then Return t
	Next
	EndIf
For t=1 To lab2; failing that, check every record that hasn't been checked yet
If DBRecordID(DB,t)=lab Then Return t
Next
End Function

Function GetDataSimple(DB,F,E)
If DBFieldType(DB,F)=DB_Byte Then Return ReadByteFromDB(db,f,e)
If DBFieldType(DB,F)=DB_SByte Then Return ReadSByteFromDB(db,f,e)
If DBFieldType(DB,F)=DB_Short Then Return ReadShortFromDB(db,f,e)
If DBFieldType(DB,F)=DB_SShort Then Return ReadSShortFromDB(db,f,e)
If DBFieldType(DB,F)=DB_Int Then Return ReadIntFromDB(db,f,e)
If DBFieldType(DB,F)=DB_Float Then Return ReadFloatFromDB(db,f,e)
If DBFieldType(DB,F)=DB_List Then Return ReadByteFromDB(db,f,e)
End Function

Function GetDataFloatSimple#(DB,F,E)
If DBFieldType(DB,F)=DB_Byte Then Return ReadByteFromDB(db,f,e)
If DBFieldType(DB,F)=DB_SByte Then Return ReadSByteFromDB(db,f,e)
If DBFieldType(DB,F)=DB_Short Then Return ReadShortFromDB(db,f,e)
If DBFieldType(DB,F)=DB_SShort Then Return ReadSShortFromDB(db,f,e)
If DBFieldType(DB,F)=DB_Int Then Return ReadIntFromDB(db,f,e)
If DBFieldType(DB,F)=DB_Float Then Return ReadFloatFromDB(db,f,e)
If DBFieldType(DB,F)=DB_List Then Return ReadByteFromDB(db,f,e)
End Function

Function GetDataStringSimple$(DB,F,E)
If DBFieldType(DB,F)=DB_Byte Then Return ReadByteFromDB(db,f,e)
If DBFieldType(DB,F)=DB_SByte Then Return ReadSByteFromDB(db,f,e)
If DBFieldType(DB,F)=DB_Short Then Return ReadShortFromDB(db,f,e)
If DBFieldType(DB,F)=DB_SShort Then Return ReadSShortFromDB(db,f,e)
If DBFieldType(DB,F)=DB_Int Then Return ReadIntFromDB(db,f,e)
If DBFieldType(DB,F)=DB_Float Then Return ReadFloatFromDB(db,f,e)
If DBFieldType(DB,F)=DB_String Then Return ReadStringFromDB(db,f,e)
If DBFieldType(DB,F)=DB_List Then Return DBGetListSTring(db,f,ReadByteFromDB(db,f,e))
End Function


Function SetDataSimple(DB,F,E, Val)
If DBFieldType(DB,F)=DB_Byte Then WriteByteToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_SByte Then WriteSByteToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_Short Then WriteShortToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_SShort Then WriteSShortToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_Int Then WriteIntToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_Float Then WriteStringToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_List Then WriteByteToDB(db,f,e, val):Return
End Function

Function SetDataFloatSimple(DB,F,E, Val#)
If DBFieldType(DB,F)=DB_Byte Then WriteByteToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_SByte Then WriteSByteToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_Short Then WriteShortToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_SShort Then WriteSShortToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_Int Then WriteIntToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_Float Then WriteFloatToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_List Then WriteByteToDB(db,f,e, val):Return
End Function

Function SetDataStringSimple(DB,F,E, Val$)
If DBFieldType(DB,F)=DB_Byte Then WriteByteToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_SByte Then WriteSByteToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_Short Then WriteShortToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_SShort Then WriteSShortToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_Int Then WriteIntToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_Float Then WriteFloatToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_String Then WriteStringToDB(db,f,e, val):Return
If DBFieldType(DB,F)=DB_List Then WriteByteToDB(db,f,e, DBGetListValue(db,f,val)):Return
End Function





Function ReadByteFromDB(db,f,e)
Return PeekByte(DBBank(DB),DBDataLocation(db,f,e))
End Function

Function ReadSByteFromDB(db,f,e)
Return PeekByte(DBBank(DB),DBDataLocation(db,f,e))-128
End Function

Function ReadShortFromDB(db,f,e)
v1=PeekByte(DBBank(db),DBDataLocation(db,f,e))
v2=PeekByte(DBBank(db),DBDataLocation(db,f,e)+1)
Return ((v1*256)+v2)
End Function

Function ReadSShortFromDB(db,f,e)
v1=PeekByte(DBBank(db),DBDataLocation(db,f,e))
v2=PeekByte(DBBank(db),DBDataLocation(db,f,e)+1)
Return ((v1*256)+v2)-32768
End Function

Function ReadIntFromDB(db,f,e)
Return PeekInt(DBBank(db),DBDataLocation(db,f,e))
End Function

Function ReadFloatFromDB#(db,f,e)
Return PeekFloat(DBBank(db),DBDataLocation(db,f,e))
End Function

Function ReadStringFromDB$(db,f,e)
ln1=PeekByte(DBBank(DB),DBDataLocation(db,f,e) )
ln2=PeekByte(DBBank(DB),DBDataLocation(db,f,e)+1 )
ln=(ln1*256)+ln2
If ln>DBFieldSize(DB,f) Then ln=DBFieldSize(DB,f)
If ln=0 Then Return ""
For s=1 To ln
result$=result$+Chr( PeekByte(DBBank(db),DBDataLocation(db,f,e)+s+1) )
Next
Return result
End Function


Function WriteByteToDB(db,f,e, val)
If val<0 Then val=0
If val>255 Then val=255
PokeByte DBBank(DB),DBDataLocation(db,f,e),val
End Function

Function WriteSByteToDB(db,f,e, val)
If val<-128 Then val=-128
If val>127 Then val=127
val=val+128
PokeByte DBBank(DB),DBDataLocation(db,f,e),val
End Function

Function WriteShortToDB(db,f,e, val)
If val>65535 Then val=65535
If val<0 Then val=0
val1=val/256
val2=val Mod 256
PokeByte DBBank(DB),DBDataLocation(db,f,e),val1
PokeByte DBBank(DB),DBDataLocation(db,f,e)+1,val2
End Function

Function WriteSShortToDB(db,f,e, val)
If val>32767 Then val=32767
If val<-32768 Then val=-32768
val=val+32768
If val<0 Then val=0
val1=val/256
val2=val Mod 256
PokeByte DBBank(DB),DBDataLocation(db,f,e),val1
PokeByte DBBank(DB),DBDataLocation(db,f,e)+1,val2
End Function

Function WriteIntToDB(db,f,e, val)
PokeInt DBBank(DB),DBDataLocation(db,f,e),val
End Function

Function WriteFloatToDB(db,f,e, val#)
PokeFloat DBBank(DB),DBDataLocation(db,f,e),val
End Function

Function WriteStringToDB(db,f,e, val$)
ln=Len(val):If ln>DBFieldSize(db,f) Then ln=DBFieldSize(db,f)
ln1=ln/256
ln2=ln Mod 256
PokeByte DBBank(DB),DBDataLocation(db,f,e),ln1
PokeByte DBBank(DB),DBDataLocation(db,f,e)+1,ln2
For s=1 To ln
PokeByte DBBank(DB),DBDataLocation(db,f,e)+s+1, Asc(Mid(val,s,1))
Next
End Function

Function StringLength(db,f,e)
If DBFieldType(db,f)<>DB_String Then Return
b1=PeekByte(DBBank(db),DBDataLocation(db,f,e))
b2=PeekByte(DBBank(db),DBDataLocation(db,f,e)+1)
Return (b1*256)+b2
End Function

Function CopyRecordSimple(DB,r1,r2)
For f=1 To DBFields(DB)
val$=GetDataStringSimple(DB,f,r1)
SetDataStringSimple DB,f,r2,val$
Next
End Function

Function AddField(DB,N$,Typ=DB_Int,StrLen=25,lst$="")
If DBBank(DB) Then RuntimeError "Cannot add fields to a finalized database."
If DBFields(DB)=MaxFields Then RuntimeError "Database has reached field limit. (While adding `"+n+"')"
DBFields(DB)=DBFields(DB)+1:F=DBFields(DB)
DBField(DB,F)=n
DBFieldType(DB,F)=Typ
DBFieldLen(DB,F)=Len(n)
If Typ=DB_List Then DBFieldList(DB,F)=lst$ Else DBFieldList(DB,F)=""
If Typ=DB_String Then DBFieldSize(DB,F)=StrLen+2 Else DBFieldSize(DB,F)=0 ;first 2 bytes of a string is length
End Function



Function DBGetListString$(db,f,val)
ss$=DBFieldList(db,f)
For l=1 To Len(ss)
cc$=Mid(ss,l,1)
If cc="," Then
valat=valat+1:If valat=val+1 Then Return oot$ Else oot$=""
Else
oot=oot$+cc
EndIf
Next
If valat=val Then Return oot
End Function

Function DBGetListValue(db,f,s$)
ss$=DBFieldList(db,f)
For l=1 To Len(ss)
cc$=Mid(ss,l,1)
If cc="," Then
valat=valat+1:If s=oot$ Then Return valat-1 Else oot$=""
Else
oot=oot$+cc
EndIf
Next
If s=oot Then Return valat
End Function







Function DBRecordID(DB,r)
Return PeekInt(DBBank(db),DBRecordLocation(db,r))
End Function


Function DBRecordLocation(DB,r)
Return (DBRecordSize(DB)*(r-1))
End Function

Function DBDataLocation(db,f,e)
Return (DBFieldOffset(DB,F)+DBRecordLocation(DB,e))-0
End Function





Function AddRecordToCache(DB,r)
If DBRecordsInCache(DB)>0 Then
If DBRecordCacheIndex(DB,DBRecordsInCache(DB))=r Then Return ;if its already at the top of the cache, no need to proceed
		For c=1 To DBRecordsInCache(DB) ;see if its already in the cache, and if so, move it to the top of the pile
		If DBRecordCacheIndex(DB,c)=r Then
		daid=DBRecordCacheID(DB,c)
			For t=c To DBRecordsInCache(DB)-1
			DBRecordCacheID(db,t)=DBRecordCacheID(db,t+1)
			DBRecordCacheIndex(db,t)=DBRecordCacheIndex(db,t+1)
			Next
		DBRecordCacheID(db,DBRecordsInCache(DB))=daid
		DBRecordCacheIndex(db,DBRecordsInCache(DB))=r
		Return
		EndIf
		Next
EndIf
	If DBRecordsInCache(DB)=MaxRecordCache Then
		For t=1 To MaxRecordCache-1;stack is full so shift them down
		DBRecordCacheID(db,t)=DBRecordCacheID(db,t+1)
		DBRecordCacheIndex(db,t)=DBRecordCacheIndex(db,t+1)
		Next
		Else
		DBRecordsInCache(DB)=DBRecordsInCache(DB)+1;stack isn't full so just add to it
	EndIf
c=DBRecordsInCache(DB)
DBRecordCacheID(db,c)=DBRecordID(db,r)
DBRecordCacheIndex(db,c)=r
End Function

Comments

Shifty Geezer2011
Excellent little database tool, especially with the inbuilt editor, but saving/loading is bugged and unusable :(.

First I was told none of my fields exist. AFAICS you don't save any of the field names, which is demonstrated when I load a DB and run editdb() - the fields are unnamed.

I edited your load/save functions to include exporting the Field$() names, which works, but the search for fields fails - I'm told a field doesn't exist when I try to set its value, even though it's listed in editdb(). I noticed in your optimisation of the field search, you compare the field length in character/bytes DBFieldLen, with the search string length len(). So I fixed that to

If Len(DBField(DB,t))=l Then If f=DBField(DB,t) Then Return t

Loading restores the data, but now when I try to change values I get overflow errors. I'll have a look further, and many thanks for contributing this which AFAICS is the only simple database option for Blitz given every other link is dead, but it does need a little more work. ;)

Edit: Okay, the final error was my fault, with a rogue debug value I had! So with the above described fix for saving and loading data, it seems to be working okay. My code changes are:

Function WriteDB(fil,DB)
WriteString fil,DBName$(DB)
WriteInt fil,DBIDAt(DB)
WriteInt fil,DBFields(DB)
WriteInt fil,DBRecordSize(DB)
WriteInt fil,DBRecords(DB)
	For f=1 To DBFields(DB)
	WriteString fil,DBField$(DB,f)									; for each field, save name
	WriteByte fil,DBFieldType(DB,f)
	If dbfieldtype(db,f)=DB_String Then WriteInt fil,DBFieldSize(DB,f)
	WriteInt fil,DBFieldOffset(DB,f)
	If dbfieldtype(db,f)=DB_List Then WriteString fil,DBFieldList(DB,f)
	Next
WriteInt fil,BankSize(DBBank(DB))
WriteBytes DBBank(DB),fil,0,BankSize(DBBank(DB))
End Function

Function ReadDB(fil)
DB=DefineDB():DBActive(DB)=1
DBName$(DB)=ReadString(fil)
DBIDAt(DB)=ReadInt(fil)
DBFields(DB)=ReadInt(fil)
DBRecordSize(DB)=ReadInt(fil)
DBRecords(DB)=ReadInt(fil)
	For f=1 To DBFields(DB)
	DBField$(DB,f)=ReadString(fil)								; for each field, read name
	DBFieldType(DB,f)=ReadByte(fil)
	If DBFieldType(db,f)=DB_String Then DBFieldSize(DB,f)=ReadInt(fil)
	DBFieldOffset(DB,f)=ReadInt(fil)
	If dbfieldtype(db,f)=DB_List Then DBFieldList(DB,f)=ReadString(fil)
	Next
bs=ReadInt(fil):DBBank(DB)=CreateBank(bs)
ReadBytes DBBank(DB),fil,0,bs
Return DB
End Function

Function FindField(DB,f$)
l=Len(f)
For t=1 To DBFields(DB)
q$ = DBField(DB,t)
If Len(DBField(DB,t))=l Then If f=DBField(DB,t) Then Return t			; check length of field contents
Next
End Function



slenkar2011
you could use this with the server code to create a website he he he
it would run a lot faster than PHP scripts too


Code Archives Forum