Ooops
January 15, 2021, 06:04:35 PM
« previous next »
Pages: [1]   Go Down

Author Topic: [bb] Streaksy DATABASE Suite 1.4 - Lightening-fast DB building, reading, writing, etc. with definable field types by Streaksy [ 1+ years ago ]  (Read 620 times)

Offline BlitzBot

  • Jr. Member
  • **
  • Posts: 1
[bb] Streaksy DATABASE Suite 1.4 - Lightening-fast DB building, reading, writing, etc. with definable field types by Streaksy [ 1+ years ago ]
« on: June 29, 2017, 12:28:42 AM »
Title : Streaksy DATABASE Suite 1.4 - Lightening-fast DB building, reading, writing, etc. with definable field types
Author : Streaksy
Posted : 1+ years ago

Description : 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:
Code: [Select]
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:

Code: [Select]
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.


. [/i]

Code :
Code: BlitzBasic
  1. Const MaxDBs=32                         ;Maximum number of databases
  2. Const MaxFields=64                      ;Maximum number of fields in a database
  3.  
  4. Const DB_Byte=0 ;1 byte                         (0 to 255)
  5. Const DB_SByte=1 ;2 byte                        (-128 to 127)
  6. Const DB_Short=2 ;3 bytes                       (0 to 65535
  7. Const DB_SShort=3 ;4 bytes                      (-32768 to 32767)
  8. Const DB_Int=4  ;5 bytes                        (- to )
  9. Const DB_Float=5;6 bytes                        (Anyone know the range of a float?)
  10. Const DB_String=6;string size defined by DBFieldSize+2 bytes
  11. Const DB_List=7;multiple choice (0 to 255)
  12.  
  13. Global DBs
  14. Dim DBIDAt(MaxDBs)
  15. Dim DBName$(MaxDBs)
  16. Dim DBActive(MaxDBs)
  17. Dim DBBank(MaxDBs)
  18. Dim DBFields(MaxDBs)
  19. Dim DBRecordSize(MaxDBs)
  20. Dim DBRecords(MaxDBs)
  21. Dim DBDels(MaxDBs)
  22. Dim DBField$(MaxDBs,MaxFields)
  23. Dim DBFieldList$(MaxDBs,MaxFields) ;for multiple choice lists
  24. Dim DBFieldLen(MaxDBs,MaxFields)
  25. Dim DBFieldType(MaxDBs,MaxFields)
  26. Dim DBFieldSize(MaxDBs,MaxFields) ;for strings
  27. Dim DBFieldOffset(MaxDBs,MaxFields)
  28. Global BasicDBMemoryUsage=(MaxDBs*4*7) + (MaxDBs*MaxFields*4*5)
  29.         Global DBMaxQueries=50,DBQueries
  30.         Dim DBQueryOp(DBMaxQueries)
  31.         Dim DBQueryField(DBMaxQueries)
  32.         Dim DBQueryValString$(DBMaxQueries)
  33.         Dim DBQueryValFloat#(DBMaxQueries)
  34.         Dim DBQueryValInt(DBMaxQueries)
  35.  
  36. Const MaxQueryResults=10000
  37. Global DBListedRecords ;Query results are stored here
  38. Dim DBListedRecord(MaxQueryResults)
  39.  
  40. Const MaxRecordCache=200
  41. Dim DBRecordsInCache(MaxDBs)
  42. Dim DBRecordCacheID(MaxDBs,MaxRecordCache)
  43. Dim DBRecordCacheIndex(MaxDBs,MaxRecordCache)
  44.  
  45.  
  46.  
  47.  
  48.  
  49. ; CRUDE DEMO
  50. AppTitle "Database Demo"
  51. Graphics 1024,768,32,2
  52.  
  53. ;First create a database by defining it then building it
  54.         DB=DefineDB("Items")
  55.         AddStringField DB,"Name"
  56.         AddListField DB,"Type","Weapon,Armour,Potion,Loot"
  57.         AddByteField DB,"Level"
  58.         AddIntField DB,"Cost"
  59.         AddFloatField DB,"Weight"
  60.         BuildDB DB
  61.  
  62. ;Add a few records
  63. ;For t=1 To 2000:nowt=addrecord(db):Next ;Loads of records at start to see what difference it makes to speed
  64.  
  65.         r1=AddRecord(DB)
  66.                 SetDataString DB,r1,"Name","Longsword"
  67.                 SetDataString DB,r1,"Type","Weapon"
  68.                 SetData DB,r1,"Level",1
  69.                 SetData DB,r1,"Cost",8
  70.                 SetDataFloat DB,r1,"Weight",.5
  71.         r2=AddRecord(DB)
  72.                 SetDataString DB,r2,"Name","Chainmail"
  73.                 SetDataString DB,r2,"Type","Armour"
  74.                 SetData DB,r2,"Level",2
  75.                 SetData DB,r2,"Cost",11
  76.                 SetDataFloat DB,r2,"Weight",.9
  77.         r3=AddRecord(DB)
  78.                 SetDataString DB,r3,"Name","Elixir"
  79.                 SetDataString DB,r3,"Type","Potion"
  80.                 SetData DB,r3,"Level",1
  81.                 SetData DB,r3,"Cost",4
  82.                 SetDataFloat DB,r3,"Weight",.16
  83.         r4=AddRecord(DB)
  84.                 SetDataString DB,r4,"Name","Jewel"
  85.                 SetDataString DB,r4,"Type","Loot"
  86.                 SetData DB,r4,"Level",2
  87.                 SetData DB,r4,"Cost",17
  88.                 SetDataFloat DB,r4,"Weight",.01
  89.         r5=AddRecord(DB)
  90.                 SetDataString DB,r5,"Name","Platemail"
  91.                 SetDataString DB,r5,"Type","Armour"
  92.                 SetData DB,r5,"Level",4
  93.                 SetData DB,r5,"Cost",25
  94.                 SetDataFloat DB,r5,"Weight",1.6
  95.         r6=AddRecord(DB)
  96.                 SetDataString DB,r6,"Name","Gold Nugget"
  97.                 SetDataString DB,r6,"Type","Loot"
  98.                 SetData DB,r6,"Level",3
  99.                 SetData DB,r6,"Cost",19
  100.                 SetDataFloat DB,r6,"Weight",.21
  101.         r7=AddRecord(DB)
  102.                 SetDataString DB,r7,"Name","Staff"
  103.                 SetDataString DB,r7,"Type","Weapon"
  104.                 SetData DB,r7,"Level",1
  105.                 SetData DB,r7,"Cost",2
  106.                 SetDataFloat DB,r7,"Weight",.3
  107.  
  108.  
  109. .restart
  110. Cls:Locate 0,0
  111. Print "A small demo database has been prepared.  Select an option:":Print ""
  112.  
  113. Print "ESC: Quit"
  114. Print "1: Edit database"
  115. Print "2: Measure database & do time trial (Requires the longsword to be still in the database)"
  116.  
  117. Repeat
  118. If KeyHit(2) Then EditDB DB:Goto restart
  119. If KeyHit(1) Then End
  120. Until KeyHit(3)
  121. FlushKeys
  122.  
  123. Cls:Locate 0,0
  124. Color 255,255,0
  125. Print "ADJUSTABLE ALLOCATION CONSTANTS:"
  126. Color 155,255,0
  127. Print "Current MaxDBs = "+MaxDBs
  128. Print "Current MaxFields = "+MaxFields
  129. Color 255,255,255
  130. Print "The database library itself currently uses up "+((BasicDBMemoryUsage)/1024)+" kilobytes.  (Depends on MaxDBs and MaxFields)"
  131. Print ""
  132. Color 255,255,0
  133. Print "USED BY DEMO DATABASE:"
  134. Color 155,255,0
  135. Print "Fields = "+DBFields(DB)
  136. Print "Records = "+DBRecords(DB)
  137. Print ""
  138. Print ""
  139. Color 255,255,255
  140. Print "The demo database bank is "+BankSize(DBBank(DB))+" bytes. ("+(BankSize(DBBank(DB))/1024)+" kilobytes)"
  141. Print "There are "+DBRecords(DB)+" records in this demo database and each record takes up "+DBRecordSize(DB)+" bytes."
  142. reps#=100000
  143. Color 255,255,0
  144. Locate 0,200
  145. Color 255,255,155:Print "MAIN FUNCTION EXECUTION TIME TRIALS:":Color 255,155,255:Print ""
  146.  
  147. ms1#=MilliSecs()
  148. For t=1 To reps
  149. GetData(DB,r1,"Cost")
  150. Next
  151. ms2#=MilliSecs()
  152. Print "GetData() - "+Int(((reps/(ms2-ms1))*1000))+" times per second"
  153.  
  154. ms1#=MilliSecs()
  155. For t=1 To reps
  156. SetData(DB,r1,"Cost",0)
  157. Next
  158. ms2#=MilliSecs()
  159. Print "SetData() - "+Int(((reps/(ms2-ms1))*1000))+" times per second"
  160.  
  161. Print "":Color 255,255,155:Print "SEEK FUNCTION EXECUTION TIME TRIALS:":Color 255,155,255:Print ""
  162.  
  163. ms1#=MilliSecs()
  164. For t=1 To reps
  165. FindRecord(DB,"Level","1")
  166. Next
  167. ms2#=MilliSecs()
  168. Print "FindRecord() - "+Int(((reps/(ms2-ms1))*1000))+" times per second (SEARCHING BY A NUMERIC FIELD)"
  169.  
  170. ms1#=MilliSecs()
  171. For t=1 To reps
  172. FindRecord(DB,"Name","Longsword")
  173. Next
  174. ms2#=MilliSecs()
  175. Print "FindRecord() - "+Int(((reps/(ms2-ms1))*1000))+" times per second (SEARCHING BY A STRING FIELD)"
  176.  
  177. Print "":Color 255,255,155:Print "QUERY FUNCTION EXECUTION TIME TRIALS:":Color 255,155,255:Print ""
  178.  
  179. ms1#=MilliSecs()
  180. For t=1 To reps
  181. ListRecords DB,"Level=1"
  182. Next
  183. ms2#=MilliSecs()
  184. Print "ListRecords() (QUERY!!) - "+Int(((reps/(ms2-ms1))*1000))+" times per second (using simple query: "+Chr(34)+"Level=1"+Chr(34)+")"
  185.  
  186. Print ""
  187. Print ""
  188. Color 255,255,255
  189. Print "Note: Execution speeds of ListRecords() will be slower with bigger databases."
  190. WaitKey:Goto restart
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207. ;*********** PUBLIC FUNCTIONS
  208.  
  209.  
  210. Function ListRecords(DB,Query$)
  211. lq=Len(query)   ;tokenise queries
  212. DBQueries=0
  213. qu$=""
  214. For qa=1 To lq ;go trough query list
  215. m$=Mid(query,qa,1)
  216. If m="," Or qa=lq Then
  217. If qa=lq Then qu=qu+m
  218. DBqueries=DBqueries+1
  219.         phase=0:q1$="":q2$="":q3$=""
  220.         For zz=1 To Len(qu) ;tokenise query components
  221.         mmm$=Mid(qu,zz,1)
  222.         sym=(mmm="<" Or mmm="=" Or mmm=">")
  223.         If phase=0 And sym=0 Then q1=q1+mmm
  224.         If phase=0 And sym Then phase=1
  225.         If phase=1 And sym Then q2=q2+mmm
  226.         If phase=1 And sym=0 Then phase=2
  227.         If phase=2 And sym=0 Then q3=q3+mmm
  228.         Next
  229.                 If q2="=" Then DBQueryOp(DBqueries)=1
  230.                 If q2="<" Then DBQueryOp(DBqueries)=2
  231.                 If q2=">" Then DBQueryOp(DBqueries)=3
  232.                 If q2="<=" Or q2="=<" Then DBQueryOp(DBqueries)=4
  233.                 If q2="=>" Or q2=">=" Then DBQueryOp(DBqueries)=5
  234.                 If q2="<>" Or q2="><" Then DBQueryOp(DBqueries)=6
  235.         DBQueryField(DBQueries)=FindField(DB,q1):fld=DBQueryField(DBQueries)
  236.         If DBFieldType(DB,Fld)=DB_Byte Then DBQueryValInt(DBQueries)=q3
  237.         If DBFieldType(DB,Fld)=DB_SByte Then DBQueryValInt(DBQueries)=q3
  238.         If DBFieldType(DB,Fld)=DB_Short Then DBQueryValInt(DBQueries)=q3
  239.         If DBFieldType(DB,Fld)=DB_SShort Then DBQueryValInt(DBQueries)=q3
  240.         If DBFieldType(DB,Fld)=DB_Int Then DBQueryValInt(DBQueries)=q3
  241.         If DBFieldType(DB,Fld)=DB_Float Then DBQueryValFloat(DBQueries)=q3
  242.         If DBFieldType(DB,Fld)=DB_String Then DBQueryValString(DBQueries)=q3
  243.         If DBFieldType(DB,Fld)=DB_List Then DBQueryValString(DBQueries)=q3
  244. qu=""
  245. Else
  246. qu=qu+m
  247. EndIf
  248. Next
  249. DBListedRecords=0
  250. For r=1 To DBRecords(DB)
  251.         doit=1
  252.         For q=1 To DBQueries
  253.         ; = (Equals)
  254.         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
  255.         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
  256.         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
  257.         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
  258.         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
  259.         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
  260.         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
  261.         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
  262.         ; < (Less Than)
  263.         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
  264.         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
  265.         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
  266.         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
  267.         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
  268.         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
  269.         ; > (More Than)
  270.         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
  271.         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
  272.         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
  273.         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
  274.         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
  275.         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
  276.         ; =< (Equals or Less Than)
  277.         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
  278.         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
  279.         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
  280.         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
  281.         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
  282.         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
  283.         ; => (Equals or More Than)
  284.         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
  285.         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
  286.         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
  287.         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
  288.         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
  289.         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
  290.         ; <> (Not)
  291.         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
  292.         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
  293.         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
  294.         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
  295.         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
  296.         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
  297.         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
  298.         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
  299.         Next
  300. If doit Then
  301. DBListedRecords=DBListedRecords+1
  302. DBListedRecord(DBListedRecords)=DBRecordID(DB,r)
  303. ;Color 255,255,0
  304. ;Print GetDataStringSimple(db,1,r)
  305. EndIf
  306. Next
  307. Return DBListedRecords
  308. End Function
  309.  
  310.  
  311.  
  312. Function DefineDB(nam$="")
  313. For t=1 To DBs
  314. If DBFields(t)=0 And DBActive(t)=0 Then DaDB=t:Goto gotit
  315. Next
  316. If DBs>MaxDBs Then RuntimeError "Out of database space."
  317. DBs=DBs+1:DaDB=DBs
  318. .gotit
  319. DBName(DaDB)=nam
  320. DBActive(DaDB)=1
  321. Return DaDB
  322. End Function
  323.  
  324. Function BuildDB(DB)
  325. If DBFields(DB)=0 Then RuntimeError "Cannot build a database with no fields."
  326. sum=4
  327. For t=1 To DBFields(DB)
  328. DBFieldOffset(DB,t)=sum
  329. If DBFieldType(DB,t)=DB_Byte Then sum=sum+1
  330. If DBFieldType(DB,t)=DB_SByte Then sum=sum+1
  331. If DBFieldType(DB,t)=DB_Short Then sum=sum+2
  332. If DBFieldType(DB,t)=DB_SShort Then sum=sum+2
  333. If DBFieldType(DB,t)=DB_Int Then sum=sum+4
  334. If DBFieldType(DB,t)=DB_Float Then sum=sum+4
  335. If DBFieldType(DB,t)=DB_String Then sum=sum+DBFieldSize(DB,t)
  336. If DBFieldType(DB,t)=DB_List Then sum=sum+1
  337. Next
  338. DBRecordsInCache(DB)=0
  339. DBRecordSize(DB)=sum
  340. DBBank(DB)=CreateBank()
  341. End Function
  342.  
  343.  
  344. Function AddByteField(DB,N$)
  345. Return AddField(DB,N$,DB_Byte)
  346. End Function
  347.  
  348. Function AddSByteField(DB,N$)
  349. Return AddField(DB,N$,DB_SByte)
  350. End Function
  351.  
  352. Function AddShortField(DB,N$)
  353. Return AddField(DB,N$,DB_Short)
  354. End Function
  355.  
  356. Function AddSShortField(DB,N$)
  357. Return AddField(DB,N$,DB_SShort)
  358. End Function
  359.  
  360. Function AddIntField(DB,N$)
  361. Return AddField(DB,N$,DB_Int)
  362. End Function
  363.  
  364. Function AddFloatField(DB,N$)
  365. Return AddField(DB,N$,DB_Float)
  366. End Function
  367.  
  368. Function AddStringField(DB,N$,ln=25)
  369. Return AddField(DB,N$,DB_String,ln)
  370. End Function
  371.  
  372. Function AddListField(DB,N$,l$)
  373. Return AddField(DB,N$,DB_List,0,l)
  374. End Function
  375.  
  376.  
  377. Function AddRecord(DB)
  378. DBRecords(DB)=DBRecords(DB)+1:E=DBRecords(DB)
  379. loc=BankSize(DBBank(DB))
  380. ID=DBIDAt(DB)
  381. If DBIDAt(DB)=2147483647 Then DBIDAt(DB)=-2147483648  Else DBIDAt(DB)=DBIDAt(DB)+1
  382. ResizeBank DBBank(DB),loc+DBRecordSize(DB)
  383. PokeInt DBBank(DB),loc,id
  384. For f=1 To DBFields(DB)
  385. If DBFieldType(DB,f)=DB_Byte Then WriteByteToDB db,f,e,0
  386. If DBFieldType(DB,f)=DB_SByte Then WriteSByteToDB db,f,e,0
  387. If DBFieldType(DB,f)=DB_Short Then WriteShortToDB db,f,e,0
  388. If DBFieldType(DB,f)=DB_SShort Then WriteSShortToDB db,f,e,0
  389. If DBFieldType(DB,f)=DB_Int Then WriteIntToDB db,f,e,0
  390. If DBFieldType(DB,f)=DB_Float Then WriteFloatToDB db,f,e,0
  391. If DBFieldType(DB,f)=DB_String Then WriteStringToDB db,f,e,""
  392. If DBFieldType(DB,f)=DB_List Then WriteByteToDB db,f,e,0
  393. Next
  394. AddRecordToCache DB,DBRecords(DB)
  395. Return DBRecordID(DB,E)
  396. End Function
  397.  
  398.  
  399. Function FreeRecord(DB,e)
  400. rec=FindRecordByID(DB,e):If rec=0 Then RuntimeError "Database doesn't contain specified record. (FindRecord)"
  401. sz=DBRecordSize(db)
  402. lc=DBRecordLocation(DB,rec)
  403.         If rec<DBRecords(db)
  404.         For s=lc To (BankSize(DBBank(DB))-sz)
  405.         b=PeekByte(DBBank(db),s+sz)
  406.         PokeByte DBBank(db),s,b
  407.         Next
  408.         EndIf
  409.         ResizeBank DBBank(db),BankSize(DBBank(db))-sz
  410.         DBRecords(DB)=DBRecords(DB)-1
  411.         DBDels(DB)=DBDels(DB)+1
  412.                 .redel 
  413.                 For c=1 To DBRecordsInCache(db) ;remove any instances of the record from the cache
  414.                 If DBRecordCacheIndex(db,c)=rec Then
  415.                         For tt=1 To DBRecordsInCache(db)-1
  416.                         DBRecordCacheID(db,tt)=DBRecordCacheID(db,tt+1)
  417.                         DBRecordCacheIndex(db,tt)=DBRecordCacheIndex(db,tt+1)
  418.                         Next
  419.                 DBRecordsInCache(db)=DBRecordsInCache(db)-1
  420.                 Goto redel
  421.                 EndIf
  422.                 Next
  423.                         For c=1 To DBRecordsInCache(db) ;update record indices in cache
  424.                         If DBRecordCacheIndex(db,c)>rec Then DBRecordCacheIndex(db,c)=DBRecordCacheIndex(db,c)-1
  425.                         Next
  426. End Function
  427.  
  428.  
  429. Function SetData(DB,E,F$,val)
  430. rec=FindRecordByID(DB,e):If rec=0 Then RuntimeError "Database doesn't contain specified record.1"
  431. fld=FindField(DB,F):If fld=0 Then RuntimeError "Database doesn't contain specified field (`"+f+"')."
  432. SetDataSimple db,fld,rec, val
  433. AddRecordToCache DB,rec
  434. End Function
  435.  
  436. Function SetDataFloat(DB,E,F$,val#)
  437. rec=FindRecordByID(DB,e):If rec=0 Then RuntimeError "Database doesn't contain specified record.2"
  438. fld=FindField(DB,F):If fld=0 Then RuntimeError "Database doesn't contain specified field (`"+f+"')."
  439. SetDataFloatSimple db,fld,rec, val
  440. AddRecordToCache DB,rec
  441. End Function
  442.  
  443. Function SetDataString(DB,E,F$,val$)
  444. rec=FindRecordByID(DB,e):If rec=0 Then RuntimeError "Database doesn't contain specified record.3"
  445. fld=FindField(DB,F):If fld=0 Then RuntimeError "Database doesn't contain specified field (`"+f+"')."
  446. SetDataStringSimple db,fld,rec, val
  447. AddRecordToCache DB,rec
  448. End Function
  449.  
  450.  
  451.  
  452. Function GetData(DB,E,F$)
  453. rec=FindRecordByID(DB,e):If rec=0 Then RuntimeError "Database doesn't contain specified record.4"
  454. fld=FindField(DB,F):If fld=0 Then RuntimeError "Database doesn't contain specified field (`"+f+"')."
  455. AddRecordToCache DB,rec
  456. Return GetDataSimple (db,fld,rec)
  457. End Function
  458.  
  459. Function GetDataFloat#(DB,E,F$)
  460. rec=FindRecordByID(DB,e):If rec=0 Then RuntimeError "Database doesn't contain specified record.5"
  461. fld=FindField(DB,F):If fld=0 Then RuntimeError "Database doesn't contain specified field (`"+f+"')."
  462. AddRecordToCache DB,rec
  463. Return GetDataFloatSimple (db,fld,rec)
  464. End Function
  465.  
  466. Function GetDataString$(DB,E,F$)
  467. rec=FindRecordByID(DB,e):If rec=0 Then RuntimeError "Database doesn't contain specified record.6"
  468. fld=FindField(DB,F):If fld=0 Then RuntimeError "Database doesn't contain specified field (`"+f+"')."
  469. AddRecordToCache DB,rec
  470. Return GetDataStringSimple (db,fld,rec)
  471. End Function
  472.  
  473.  
  474.  
  475.  
  476.  
  477.  
  478. Function FindRecord(DB,f$,val$) ;this should first check the cache records!
  479. fld=FindField(DB,F):If fld=0 Then RuntimeError "Database doesn't contain specified field (`"+f+"')."
  480. ftyp=DBFieldType(DB,Fld)
  481. ;CHECK RECENTLY USED RECORDS
  482.                 If ftyp=DB_Byte Then
  483.                 valint=Int(val)
  484.                 For c=1 To DBRecordsInCache(DB)
  485.                 e=DBRecordCacheIndex(db,c)
  486.                 If ReadByteFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
  487.                 Next
  488.                 Return -1
  489.                 EndIf  
  490.                         If ftyp=DB_SByte Then
  491.                         valint=Int(val)
  492.                         For c=1 To DBRecordsInCache(DB)
  493.                         e=DBRecordCacheIndex(db,c)
  494.                         If ReadSByteFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
  495.                         Next
  496.                         Return -1
  497.                         EndIf  
  498.                                 If ftyp=DB_Short Then
  499.                                 valint=Int(val)
  500.                                 For c=1 To DBRecordsInCache(DB)
  501.                                 e=DBRecordCacheIndex(db,c)
  502.                                 If ReadShortFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
  503.                                 Next
  504.                                 Return -1
  505.                                 EndIf
  506.                         If ftyp=DB_SShort Then
  507.                         valint=Int(val)
  508.                         For c=1 To DBRecordsInCache(DB)
  509.                         e=DBRecordCacheIndex(db,c)
  510.                         If ReadSShortFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
  511.                         Next
  512.                         Return -1
  513.                         EndIf
  514.                 If ftyp=DB_Int Then
  515.                 valint=Int(val)
  516.                 For c=1 To DBRecordsInCache(DB)
  517.                 e=DBRecordCacheIndex(db,c)
  518.                 If ReadIntFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
  519.                 Next
  520.                 Return -1
  521.                 EndIf  
  522.         If ftyp=DB_Float Then
  523.         valfloat#=Float(val)
  524.         For c=1 To DBRecordsInCache(DB)
  525.         e=DBRecordCacheIndex(db,c)
  526.         If ReadFloatFromDB(db,fld,e)=valfloat Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
  527.         Next
  528.         Return -1
  529.         EndIf  
  530.                 If ftyp=DB_String Then
  531.                 ln=Len(val)
  532.                 For c=1 To DBRecordsInCache(DB)
  533.                 e=DBRecordCacheIndex(db,c)
  534.                 ln2=StringLength(db,fld,e):If ln=ln2 Then If ReadStringFromDB(db,fld,e)=val Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
  535. ;               If ReadStringFromDB(db,fld,e)=val Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
  536.                 Next
  537.                 Return -1
  538.                 EndIf  
  539.                         If ftyp=DB_List Then
  540.                         For c=1 To DBRecordsInCache(DB)
  541.                         e=DBRecordCacheIndex(db,c)
  542.                         If DBGetListString(db,fld,ReadByteFromDB(db,fld,e))=val Then AddRecordToCache DB,e:Return DBRecordCacheID(db,c)
  543.                         Next
  544.                         Return -1
  545.                         EndIf  
  546.  
  547. ;CHECK ALL RECORDS
  548.                 If ftyp=DB_Byte Then
  549.                 valint=Int(val)
  550.                 For e=1 To DBRecords(DB)
  551.                 If ReadByteFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordID(db,e)
  552.                 Next
  553.                 Return -1
  554.                 EndIf  
  555.                         If ftyp=DB_SByte Then
  556.                         valint=Int(val)
  557.                         For e=1 To DBRecords(DB)
  558.                         If ReadSByteFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordID(db,e)
  559.                         Next
  560.                         Return -1
  561.                         EndIf  
  562.                                 If ftyp=DB_Short Then
  563.                                 valint=Int(val)
  564.                                 For e=1 To DBRecords(DB)
  565.                                 If ReadShortFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordID(db,e)
  566.                                 Next
  567.                                 Return -1
  568.                                 EndIf  
  569.                         If ftyp=DB_SShort Then
  570.                         valint=Int(val)
  571.                         For e=1 To DBRecords(DB)
  572.                         If ReadSShortFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordID(db,e)
  573.                         Next
  574.                         Return -1
  575.                         EndIf  
  576.                 If ftyp=DB_Int Then
  577.                 valint=Int(val)
  578.                 For e=1 To DBRecords(DB)
  579.                 If ReadIntFromDB(db,fld,e)=valint Then AddRecordToCache DB,e:Return DBRecordID(db,e)
  580.                 Next
  581.                 Return -1
  582.                 EndIf  
  583.         If ftyp=DB_Float Then
  584.         valfloat#=Int(val)
  585.         For e=1 To DBRecords(DB)
  586.         If ReadFloatFromDB(db,fld,e)=valfloat Then AddRecordToCache DB,e:Return DBRecordID(db,e)
  587.         Next
  588.         Return -1
  589.         EndIf  
  590.                 If ftyp=DB_String Then
  591.                 ln=Len(val)
  592.                 For e=1 To DBRecords(DB)
  593.                 ln2=StringLength(db,fld,e):If ln=ln2 Then If ReadStringFromDB(db,fld,e)=val Then AddRecordToCache DB,e:Return DBRecordID(db,e)
  594.                 Next
  595.                 Return -1
  596.                 EndIf  
  597.                         If ftyp=DB_List Then
  598.                         For e=1 To DBRecords(DB)
  599.                         If DBGetListString(db,fld,ReadByteFromDB(db,fld,e))=val Then AddRecordToCache DB,e:Return DBRecordID(db,e)
  600.                         Next
  601.                         Return -1
  602.                         EndIf  
  603. End Function
  604.  
  605.  
  606.  
  607.  
  608. Function FreeDB(DB)
  609. If db<1 Or db>DBs Then RuntimeError "No such database for FreeDB."
  610. If dbactive(db)=0 Then RuntimeError "No such database for FreeDB."
  611. FreeBank DBBank(DB)
  612. DBFields(DB)=0
  613. DBRecords(DB)=0
  614. DBIDAt(DB)=0
  615. DBName(DB)=""
  616. DBActive(DB)=0
  617. DBRecordsInCache(DB)=0
  618. End Function
  619.  
  620.  
  621.  
  622.  
  623. Function SaveDB(DB,filename$)
  624. fh=WriteFile(filename):If fh=0 Then Return
  625. WriteDB fh,DB
  626. CloseFile fh
  627. Return 1
  628. End Function
  629.  
  630.  
  631. Function WriteDB(fil,DB)
  632. WriteString fil,DBName$(DB)
  633. WriteInt fil,DBIDAt(DB)
  634. WriteInt fil,DBFields(DB)
  635. WriteInt fil,DBRecordSize(DB)
  636. WriteInt fil,DBRecords(DB)
  637.         For f=1 To DBFields(DB)
  638.         WriteByte fil,DBFieldType(DB,f)
  639.         If dbfieldtype(db,f)=DB_String Then WriteInt fil,DBFieldSize(DB,f)
  640.         WriteInt fil,DBFieldOffset(DB,f)
  641.         If dbfieldtype(db,f)=DB_List Then WriteString fil,DBFieldList(DB,f)
  642.         Next
  643. WriteInt fil,BankSize(DBBank(DB))
  644. WriteBytes DBBank(DB),fil,0,BankSize(DBBank(DB))
  645. End Function
  646.  
  647.  
  648.  
  649.  
  650. Function LoadDB(filename$)
  651. fh=ReadFile(filename):If fh=0 Then Return
  652. DB=ReadDB(fh)
  653. CloseFile fh
  654. Return DB
  655. End Function
  656.  
  657.  
  658. Function ReadDB(fil)
  659. DB=DefineDB():DBActive(DB)=1
  660. DBName$(DB)=ReadString(fil)
  661. DBIDAt(DB)=ReadInt(fil)
  662. DBFields(DB)=ReadInt(fil)
  663. DBRecordSize(DB)=ReadInt(fil)
  664. DBRecords(DB)=ReadInt(fil)
  665.         For f=1 To DBFields(DB)
  666.         DBFieldType(DB,f)=ReadByte(fil)
  667.         If dbfieldtype(db,f)=DB_String Then DBFieldSize(DB,f)=ReadInt(fil)
  668.         DBFieldOffset(DB,f)=ReadInt(fil)
  669.         If dbfieldtype(db,f)=DB_List Then DBFieldList(DB,f)=ReadString(fil)
  670.         Next
  671. bs=ReadInt(fil):DBBank(DB)=CreateBank(bs)
  672. ReadBytes DBBank(DB),fil,0,bs
  673. Return DB
  674. End Function
  675.  
  676.  
  677.  
  678.  
  679.  
  680.  
  681.  
  682. Function EditDBs() ;Edit all databases
  683. If DBs=0 Then Return
  684. buf=GraphicsBuffer():sred=ColorRed():sgreen=ColorGreen():sblue=ColorBlue()
  685. w=GraphicsWidth():h=GraphicsHeight()
  686.         Color 0,0,0
  687.         For y=0 To h Step 2
  688.         Line 0,y,w,y
  689.         Next
  690. ;               For x=0 To w Step 3
  691. ;               Line x,0,x,h
  692. ;               Next
  693. rempic=CreateImage(w,h):GrabImage rempic,0,0
  694. w=GraphicsWidth():h=GraphicsHeight()
  695. SetBuffer BackBuffer()
  696. edbfont=LoadFont("verdana",20)
  697. SetFont edbfont:fh=FontHeight()
  698. dw=200
  699. FlushKeys:FlushMouse
  700. Repeat
  701. DrawBlock rempic,0,0
  702. wh=h-100:yspan=wh/(fh*1.5):xspan=(DBs-1)/yspan
  703. ww=((xspan+1)*(dw+10))
  704. If xspan=0 Then wh=fh*1.5*dbs
  705. wy=(h/2)-(wh/2)
  706. wx=(w/2)-(ww/2)
  707. Color 30,30,50:Rect wx,wy,ww+20,wh+20,1
  708. Color 230,230,250:Rect wx,wy,ww+20,wh+20,0
  709. msx=MouseX():msy=MouseY():mh1=MouseHit(1)
  710. wx=wx+10:wy=wy+10
  711. dx=wx:dy=wy
  712. For d=1 To dbs
  713. Color 20,20,20
  714. Rect dx,dy,dw,fh,1
  715. Color 255,255,255
  716. Text dx+(dw/2),dy,DBName(d)+" ("+DBRecords(d)+")",1
  717. Color 48,48,48:Rect dx,dy,dw,fh,0
  718. If msx=>dx And msy=>dy And msx<dx+dw And msy<dy+fh Then
  719. Color 248,248,48:Rect dx,dy,dw,fh,0
  720. If mh1 Then EditDB d:SetFont edbfont
  721. EndIf
  722. dy=dy+(fh*1.5):If dy>(wy+wh-10) Then dx=dx+(dw+10):dy=wy
  723. Next
  724. Color 255,255,255:Line Msx-1,msy,msx+1,msy:Line msx,msy-1,msx,msy+1
  725. Flip
  726. kh1=KeyHit(1):If kh1 And rightmenu Then rightmenu=0:kh1=0
  727. Until kh1; Or MouseHit(2)
  728. FlushKeys:FlushMouse
  729. FreeFont edbfont
  730. SetBuffer buf:Color sred,sgreen,sblue
  731. DrawBlock rempic,0,0:FreeImage rempic
  732. End Function
  733.  
  734.  
  735. Function EditDB(DB) ;this changes the active font!  also causes problems if the current graphics buffer is an image buffer or texture buffer
  736. If DBActive(DB)=0 Then RuntimeError "Database doesnt exist.
  737. buf=GraphicsBuffer():sred=ColorRed():sgreen=ColorGreen():sblue=ColorBlue()
  738. w=GraphicsWidth():h=GraphicsHeight()
  739. rempic=CreateImage(w,h):GrabImage rempic,0,0
  740. SetBuffer BackBuffer()
  741. edbfont=LoadFont("verdana",17)
  742. edbfont2=LoadFont("verdana",27)
  743. SetFont edbfont
  744. fh=FontHeight()
  745. fw=w/8:If wf<100 Then wf=100
  746. sw=20
  747. ww=w-sw
  748. wh=h-(sw+(fh*2))
  749. yspan=wh/fh
  750. xspan=ww/fw
  751. FlushKeys:FlushMouse
  752. Repeat
  753. Color 30,30,50
  754. Rect 0,0,w,h,1
  755. msx=MouseX()
  756. msy=MouseY()
  757. 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
  758. mh2=MouseHit(2)
  759. md1=MouseDown(1)
  760. fof=DBscrollx+1:x=0
  761. If dbscrollx>dbfields(db)-xspan Then dbscrollx=dbfields(db)-xspan
  762. If dbscrollx<0 Then dbscrollx=0
  763. If dbscrolly>dbrecords(db)-yspan Then dbscrolly=dbrecords(db)-yspan
  764. If dbscrolly<0 Then dbscrolly=0
  765. Repeat
  766. If fof=>0 And fof<=DBFields(DB) And fof>0 Then
  767. Color 255,255,255
  768. Text x,0,DBField(DB,fof)
  769.         rof=DBScrolly+1:y=fh
  770.         Repeat
  771.         If rof>0 And rof=<DBRecords(DB) And rof>0 Then
  772.                 dat$=GetDataStringSimple(DB,fof,rof)
  773.                 Color 0,0,0
  774.                 Rect x,y,fw,fh-2,1
  775.                 Color 30,30,50
  776.                 Rect x+fw-3,y,3,fh-2,1
  777.                         If msx<(w-fh) Then
  778.                         If (msy=>y And msy<y+fh And dragbar=0 And rightmenu=0) Or (rightmenu And recordsel=rof) Then
  779.                         recordsel=rof
  780.                         Color 55,55,125
  781.                         Rect x,y,fw-3,fh-2,1
  782.                         Color 255,155,255
  783.                         Text x,y,dat$
  784.                                 If msx=>x And msx<x+fw And rightmenu=0 Then
  785.                                 fieldsel=fof
  786.                                 editx=x:edity=y
  787.                                 Color 255,255,255
  788.                                 Rect x,y,fw-3,fh-2,0
  789.                                 EndIf
  790.                         Else
  791.                                 Color 255,255,155
  792.                                 Text x,y,dat$
  793.                         EndIf
  794.                         Else
  795.                                 Color 255,255,155
  796.                                 Text x,y,dat$
  797.                         EndIf
  798.         EndIf
  799.         rof=rof+1:y=y+fh
  800.         Until y+fh>(wh+fh) Or rof>DBRecords(DB)
  801. EndIf
  802. fof=fof+1:x=x+fw
  803. Until x>w Or fof>DBFields(DB)
  804. If DBFields(db)>xspan Then ;H Scrollbar
  805. Color 95,90,90
  806. scx=0
  807. scy=h-(fh*2)
  808. scw=w-fh
  809. sch=fh
  810. Rect scx,scy,scw,sch,1
  811. Color 255,190,100
  812. CarretW=(xspan*scw)/DBFields(db)
  813. CarretX=(DBscrollx*scw)/DBFields(db)
  814. If dragbar=1 Then Color 255,255,255
  815. Rect carretx,scy,carretw,sch,1
  816.                 If msx=>carretx And msy=>scy And msx<carretx+carretw And msy<scy+sch Then
  817.                 Color 255,255,255:Rect carretx,scy,carretw,sch,0
  818.                 If mh1 Then dragoffset=msx-(carretx+(carretw/2)):dragbar=1
  819.                 EndIf
  820.         If dragbar=1 Then
  821.         If msx-dragoffset<scx+(carretw/2) Then msx=scx+(carretw/2)+dragoffset
  822.         If msx-dragoffset>scx+scw-(carretw/2) Then msx=scx+w-(carretw/2)+dragoffset
  823.         ;MoveMouse msx,scy+(fh/2)
  824.         mmmp=(((msx-scx)-dragoffset)-(carretw/2))
  825.         dbscrollx=(mmmp*(dbfields(DB)))/scw
  826.         EndIf
  827.         If md1=0 Then dragbar=0
  828. EndIf
  829.                                         mwspd=MouseZSpeed() ;mouse wheel
  830.                                         If mwspd<>0 Then
  831.                                         dbscrolly=dbscrolly-(mwspd*(yspan*.4))
  832.                                         If dbscrolly>dbrecords(db)-yspan Then dbscrolly=dbrecords(db)-yspan
  833.                                         If dbscrolly<0 Then dbscrolly=0
  834.                                         EndIf
  835. If DBRecords(db)>yspan Then ;V Scrollbar
  836. Color 95,90,90
  837. scx=w-fh
  838. scy=fh
  839. scw=fh
  840. sch=h-(fh*3)
  841. Rect scx,scy,scw,sch,1
  842. Color 255,190,100
  843. CarretH=(yspan*sch)/(DBRecords(db))
  844. CarretY=scy+((DBscrolly*sch)/(DBRecords(db)))
  845. If dragbar=2 Then Color 255,255,255
  846. Rect scx,carrety,fh,carreth,1
  847.                 If msx=>scx And msy=>carrety And msx<scx+scw And msy<carrety+carreth Then
  848.                 Color 255,255,255:Rect scx,carrety,scw,carreth,0
  849.                 If mh1 Then dragoffset=msy-(carrety+(carreth/2)):dragbar=2
  850.                 EndIf
  851.         If dragbar=2 Then
  852.         If msy-dragoffset<scy+(carreth/2) Then msy=scy+(carreth/2)+dragoffset
  853.         If msy-dragoffset>scy+sch+1-(carreth/2) Then msy=scy+sch+1-(carreth/2)+dragoffset
  854.         ;MoveMouse scx+(fh/2),msy
  855.         mmmp=(((msy-scy)-dragoffset)-(carreth/2))
  856.         dbscrolly=(mmmp*(dbrecords(DB)))/sch
  857.         EndIf
  858.         If md1=0 Then dragbar=0
  859. EndIf
  860. Color 60,60,160 ;status bar
  861. Rect 0,h-fh,w,fh,1
  862. Color 255,255,255
  863. If DBName(DB)<>"" Then n$=DBName(DB) Else n$="Unnamed"
  864. Text 1,(h-fh)+1,"Database: `"+n$+"'"
  865. Text w*.25,(h-fh)+1,"Fields: "+DBFields(DB)
  866. Text w*.5,(h-fh)+1,"Records: "+DBRecords(DB)
  867. If recordsel>0 Then Text w*.78,(h-fh)+1,fieldsel+" x "+recordsel
  868.                 If mh1 And recordsel>0 And fieldsel>0 And rightmenu=0 Then ;edit record field
  869.                         dbbgpic2=CreateImage(w,h):GrabImage dbbgpic2,0,0
  870.                
  871.                         If DBFieldType(db,fieldsel)<>DB_List Then ;typing into the box
  872.                         daval$=GetDataStringSimple(db,fieldsel,recordsel)
  873.                         Odaval$=daval
  874.                         Repeat
  875.                         DrawBlock dbbgpic2,0,0
  876.                         Color 0,0,0:Rect editx,edity,fw-3,fh,1
  877.                         Color 255,255,255:Rect editx-1,edity-1,fw+2-3,fh+1,0
  878.                         Color 60,255,60
  879.                         ms=MilliSecs()
  880.                         If ms-curstime > 100 Then curstik=curstik+1:curstime=ms:If curstik=2 Then curstik=0
  881.                         If curstik=1 Then cursor$="_" Else cursor$=""
  882.                         Text editx,edity,daval+cursor
  883.                         k=GetKey()
  884.                         If k>0 And k<>27 And k<>8 And k<>13 Then daval=daval+Chr(k)
  885.                         If k=8 Then If Len(daval)>0 Then daval=Left(daval,Len(daval)-1)
  886.                         msx2=MouseX():msy2=MouseY():Color 255,255,255:Line Msx2-1,msy2,msx2+1,msy2:Line msx2,msy2-1,msx2,msy2+1
  887.                         Flip
  888.                         Until k=27 Or k=13 Or MouseHit(1) Or MouseHit(2)
  889.                         FlushKeys:FlushMouse
  890.                         If k<>27 Then SetDataStringSimple(db,fieldsel,recordsel, daval)
  891.                         EndIf
  892.                        
  893.                                 If DBFieldType(db,fieldsel)=DB_List Then ;list box (multiple choice)
  894.                                 omsx=MouseX():omsy=MouseY()
  895.                                                         opts=0:minl=100
  896.                                                         Repeat
  897.                                                         kkk$=DBGetListString(db,fieldsel,opts)
  898.                                                         If minl<StringWidth(kkk)+20 Then minl=StringWidth(kkk)+20
  899.                                                         opts=opts+1
  900.                                                         Until kkk=""
  901.                                                         opts=opts-1
  902.                                 Repeat
  903.                                 mh1=MouseHit(1)
  904.                                 DrawBlock dbbgpic2,0,0
  905.                                 rmw=minl:rmh=20+(opts*(fh+5))-5
  906.                                 rmx=msx-(rmw/2):rmy=msy-(rmh/2)
  907.                                 If rmx<0 Then rmx=0
  908.                                 If rmy<0 Then rmy=0
  909.                                 If rmx>(w-rmw) Then rmx=(w-rmw)
  910.                                 If rmy>(h-rmh) Then rmy=(h-rmh)
  911.                                 Color 90,90,120:Rect rmx,rmy,rmw,rmh,1
  912.                                 Color 255,255,255:Rect rmx,rmy,rmw,rmh,0
  913.                                         optsel=-1
  914.                                         For o=1 To opts
  915.                                         Color 20,20,20
  916.                                         optx=rmx+10:opty=rmy+10+((o-1)*(fh+5))
  917.                                         optw=rmw-20
  918.                                         Rect optx,opty,optw,fh,1
  919.                                         If ReadByteFromDB(db,fieldsel,recordsel)=o-1 Then Color 0,255,0:Rect optx,opty,optw,fh,0
  920.                                         Color 255,255,255
  921.                                         opop$=DBGetListString(db,fieldsel,o-1)
  922.                                         If MouseX()=>optx And MouseY()=>opty And MouseX()<optx+optw And MouseY()<opty+fh Then
  923.                                         Color 255,255,55
  924.                                         Rect optx,opty,optw,fh,0:Color 255,255,255
  925.                                         If mh1 Then optsel=o-1
  926.                                         EndIf
  927.                                         Text optx+(optw/2),opty,opop,1
  928.                                         Next
  929.                                 msx2=MouseX():msy2=MouseY():Color 255,255,255:Line Msx2-1,msy2,msx2+1,msy2:Line msx2,msy2-1,msx2,msy2+1
  930.                                 Flip
  931.                                 Until KeyHit(1) Or mh1 Or MouseHit(2)
  932.                                 If mh1 And optsel>-1 Then SetDataStringSimple db,fieldsel,recordsel,dbgetliststring(db,fieldsel,optsel):MoveMouse omsx,omsy
  933.                                 FlushMouse:FlushKeys
  934.                                 EndIf
  935.                
  936.                 DrawBlock dbbgpic2,0,0:FreeImage dbbgpic2
  937.                 EndIf
  938. rmw=150:rmh=116
  939. If mh2 Then rightmenu=rightmenu+1:rmx=msx-(rmw/2):rmy=msy-(rmh/2):If rightmenu=2 Then rightmenu=0
  940. If rightmenu Then
  941. If rmx<0 Then rmx=0
  942. If rmy<0 Then rmy=0
  943. If rmx>(w-rmw) Then rmx=(w-rmw)
  944. If rmy>(h-rmh) Then rmy=(h-rmh)
  945. Color 150,150,150:Rect rmx,rmy,rmw,rmh,1
  946. Color 255,255,255:Rect rmx,rmy,rmw,rmh,0
  947.         optx=rmx+10:opty=rmy+10:optw=rmw-20:opth=fh
  948. ;       Color 0,0,0:Text optx,opty,dbrecordid(db,recordsel):opty=opty+(fh*1.5)
  949.         opt$="New Record"
  950.         Color 80,80,80:Rect optx,opty,optw,opth,1:Color 255,255,255:Text optx+(optw/2),opty,opt,1
  951.         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)
  952.                 If recordsel>0 Then
  953.                 opty=opty+(fh*1.5):opt$="Clone Record"
  954.                 Color 80,80,80:Rect optx,opty,optw,opth,1:Color 255,255,255:Text optx+(optw/2),opty,opt,1
  955.                 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
  956.                         AddRecord DB
  957.                         CopyRecordSimple DB,RecordSel,DBRecords(DB)
  958.                         DBScrollY=dbrecords(db)-yspan
  959.                         recordsel=dbrecords(db)
  960.                 EndIf
  961.                 EndIf
  962.                 If recordsel>0 Then
  963.                 opty=opty+(fh*1.5):opt$="Delete Record"
  964.                 Color 80,80,80:Rect optx,opty,optw,opth,1:Color 255,255,255:Text optx+(optw/2),opty,opt,1
  965.                 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
  966.                 EndIf
  967.         opty=opty+(fh*1.5):opt$="Save Database"
  968.         Color 80,80,80:Rect optx,opty,optw,opth,1:Color 255,255,255:Text optx+(optw/2),opty,opt,1
  969.         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
  970.         result=SaveDB(DB,"Database.db")
  971.         If result Then repo$="Successfully exported database to Database.db" Else repo$="Failed to write file!"
  972.         Color 50,50,120
  973.         Rect 0,0,w,h,1
  974.         Color 255,255,255
  975.         SetFont edbfont2
  976.         Text w/2,h/2,repo,1,1
  977.         SetFont edbfont
  978.         Flip
  979.         Repeat
  980.         Until KeyHit(1) Or KeyHit(57) Or KeyHit(26) Or MouseHit(1) Or MouseHit(2)
  981.         FlushKeys
  982.         FlushMouse
  983.         EndIf
  984. EndIf
  985. If recordsel<1 Then recordsel=1
  986. If recordsel>DBRecords(DB) Then recordsel=DBRecords(DB)
  987. If dbrecords(db)=0 Then recordsel=0:fieldsel=0
  988. If rightmenu=0 Then recordsel=0:fieldsel=0
  989.  
  990. msx2=MouseX():msy2=MouseY():Color 255,255,255:Line Msx2-1,msy2,msx2+1,msy2:Line msx2,msy2-1,msx2,msy2+1
  991. Flip
  992. kh1=KeyHit(1):If kh1 And rightmenu Then rightmenu=0:kh1=0
  993. Until kh1
  994. FlushKeys
  995. FreeFont edbfont
  996. SetBuffer buf:Color sred,sgreen,sblue
  997. DrawBlock rempic,0,0:FreeImage rempic
  998. End Function
  999.  
  1000.  
  1001.  
  1002.  
  1003.  
  1004.  
  1005.  
  1006.  
  1007. ;*********** PRIVATE FUNCTIONS
  1008.  
  1009.  
  1010. Function FindField(DB,f$)
  1011. l=Len(f)
  1012. For t=1 To DBFields(DB)
  1013. If DBFieldLen(DB,t)=l Then If f=DBField(DB,t) Then Return t
  1014. Next
  1015. End Function
  1016.  
  1017. Function FindRecordByID(DB,lab)
  1018.                 For c=DBRecordsInCache(DB) To 1 Step -1 ;first check the recently used records for a match (the whole point of the cache)
  1019.                 If DBRecordCacheID(DB,c)=lab Then Return DBRecordCacheIndex(DB,c)
  1020.                 Next
  1021.         lab2=lab-(DBDels(DB)+1):If lab2<1 Then lab2=1 ;failing that, take a educated guess at where to search from
  1022.         If lab2<=DBRecords(DB) Then
  1023.         For t=lab2 To DBRecords(DB)
  1024.         If DBRecordID(DB,t)=lab Then Return t
  1025.         Next
  1026.         EndIf
  1027. For t=1 To lab2; failing that, check every record that hasn't been checked yet
  1028. If DBRecordID(DB,t)=lab Then Return t
  1029. Next
  1030. End Function
  1031.  
  1032. Function GetDataSimple(DB,F,E)
  1033. If DBFieldType(DB,F)=DB_Byte Then Return ReadByteFromDB(db,f,e)
  1034. If DBFieldType(DB,F)=DB_SByte Then Return ReadSByteFromDB(db,f,e)
  1035. If DBFieldType(DB,F)=DB_Short Then Return ReadShortFromDB(db,f,e)
  1036. If DBFieldType(DB,F)=DB_SShort Then Return ReadSShortFromDB(db,f,e)
  1037. If DBFieldType(DB,F)=DB_Int Then Return ReadIntFromDB(db,f,e)
  1038. If DBFieldType(DB,F)=DB_Float Then Return ReadFloatFromDB(db,f,e)
  1039. If DBFieldType(DB,F)=DB_List Then Return ReadByteFromDB(db,f,e)
  1040. End Function
  1041.  
  1042. Function GetDataFloatSimple#(DB,F,E)
  1043. If DBFieldType(DB,F)=DB_Byte Then Return ReadByteFromDB(db,f,e)
  1044. If DBFieldType(DB,F)=DB_SByte Then Return ReadSByteFromDB(db,f,e)
  1045. If DBFieldType(DB,F)=DB_Short Then Return ReadShortFromDB(db,f,e)
  1046. If DBFieldType(DB,F)=DB_SShort Then Return ReadSShortFromDB(db,f,e)
  1047. If DBFieldType(DB,F)=DB_Int Then Return ReadIntFromDB(db,f,e)
  1048. If DBFieldType(DB,F)=DB_Float Then Return ReadFloatFromDB(db,f,e)
  1049. If DBFieldType(DB,F)=DB_List Then Return ReadByteFromDB(db,f,e)
  1050. End Function
  1051.  
  1052. Function GetDataStringSimple$(DB,F,E)
  1053. If DBFieldType(DB,F)=DB_Byte Then Return ReadByteFromDB(db,f,e)
  1054. If DBFieldType(DB,F)=DB_SByte Then Return ReadSByteFromDB(db,f,e)
  1055. If DBFieldType(DB,F)=DB_Short Then Return ReadShortFromDB(db,f,e)
  1056. If DBFieldType(DB,F)=DB_SShort Then Return ReadSShortFromDB(db,f,e)
  1057. If DBFieldType(DB,F)=DB_Int Then Return ReadIntFromDB(db,f,e)
  1058. If DBFieldType(DB,F)=DB_Float Then Return ReadFloatFromDB(db,f,e)
  1059. If DBFieldType(DB,F)=DB_String Then Return ReadStringFromDB(db,f,e)
  1060. If DBFieldType(DB,F)=DB_List Then Return DBGetListSTring(db,f,ReadByteFromDB(db,f,e))
  1061. End Function
  1062.  
  1063.  
  1064. Function SetDataSimple(DB,F,E, Val)
  1065. If DBFieldType(DB,F)=DB_Byte Then WriteByteToDB(db,f,e, val):Return
  1066. If DBFieldType(DB,F)=DB_SByte Then WriteSByteToDB(db,f,e, val):Return
  1067. If DBFieldType(DB,F)=DB_Short Then WriteShortToDB(db,f,e, val):Return
  1068. If DBFieldType(DB,F)=DB_SShort Then WriteSShortToDB(db,f,e, val):Return
  1069. If DBFieldType(DB,F)=DB_Int Then WriteIntToDB(db,f,e, val):Return
  1070. If DBFieldType(DB,F)=DB_Float Then WriteStringToDB(db,f,e, val):Return
  1071. If DBFieldType(DB,F)=DB_List Then WriteByteToDB(db,f,e, val):Return
  1072. End Function
  1073.  
  1074. Function SetDataFloatSimple(DB,F,E, Val#)
  1075. If DBFieldType(DB,F)=DB_Byte Then WriteByteToDB(db,f,e, val):Return
  1076. If DBFieldType(DB,F)=DB_SByte Then WriteSByteToDB(db,f,e, val):Return
  1077. If DBFieldType(DB,F)=DB_Short Then WriteShortToDB(db,f,e, val):Return
  1078. If DBFieldType(DB,F)=DB_SShort Then WriteSShortToDB(db,f,e, val):Return
  1079. If DBFieldType(DB,F)=DB_Int Then WriteIntToDB(db,f,e, val):Return
  1080. If DBFieldType(DB,F)=DB_Float Then WriteFloatToDB(db,f,e, val):Return
  1081. If DBFieldType(DB,F)=DB_List Then WriteByteToDB(db,f,e, val):Return
  1082. End Function
  1083.  
  1084. Function SetDataStringSimple(DB,F,E, Val$)
  1085. If DBFieldType(DB,F)=DB_Byte Then WriteByteToDB(db,f,e, val):Return
  1086. If DBFieldType(DB,F)=DB_SByte Then WriteSByteToDB(db,f,e, val):Return
  1087. If DBFieldType(DB,F)=DB_Short Then WriteShortToDB(db,f,e, val):Return
  1088. If DBFieldType(DB,F)=DB_SShort Then WriteSShortToDB(db,f,e, val):Return
  1089. If DBFieldType(DB,F)=DB_Int Then WriteIntToDB(db,f,e, val):Return
  1090. If DBFieldType(DB,F)=DB_Float Then WriteFloatToDB(db,f,e, val):Return
  1091. If DBFieldType(DB,F)=DB_String Then WriteStringToDB(db,f,e, val):Return
  1092. If DBFieldType(DB,F)=DB_List Then WriteByteToDB(db,f,e, DBGetListValue(db,f,val)):Return
  1093. End Function
  1094.  
  1095.  
  1096.  
  1097.  
  1098.  
  1099. Function ReadByteFromDB(db,f,e)
  1100. Return PeekByte(DBBank(DB),DBDataLocation(db,f,e))
  1101. End Function
  1102.  
  1103. Function ReadSByteFromDB(db,f,e)
  1104. Return PeekByte(DBBank(DB),DBDataLocation(db,f,e))-128
  1105. End Function
  1106.  
  1107. Function ReadShortFromDB(db,f,e)
  1108. v1=PeekByte(DBBank(db),DBDataLocation(db,f,e))
  1109. v2=PeekByte(DBBank(db),DBDataLocation(db,f,e)+1)
  1110. Return ((v1*256)+v2)
  1111. End Function
  1112.  
  1113. Function ReadSShortFromDB(db,f,e)
  1114. v1=PeekByte(DBBank(db),DBDataLocation(db,f,e))
  1115. v2=PeekByte(DBBank(db),DBDataLocation(db,f,e)+1)
  1116. Return ((v1*256)+v2)-32768
  1117. End Function
  1118.  
  1119. Function ReadIntFromDB(db,f,e)
  1120. Return PeekInt(DBBank(db),DBDataLocation(db,f,e))
  1121. End Function
  1122.  
  1123. Function ReadFloatFromDB#(db,f,e)
  1124. Return PeekFloat(DBBank(db),DBDataLocation(db,f,e))
  1125. End Function
  1126.  
  1127. Function ReadStringFromDB$(db,f,e)
  1128. ln1=PeekByte(DBBank(DB),DBDataLocation(db,f,e) )
  1129. ln2=PeekByte(DBBank(DB),DBDataLocation(db,f,e)+1 )
  1130. ln=(ln1*256)+ln2
  1131. If ln>DBFieldSize(DB,f) Then ln=DBFieldSize(DB,f)
  1132. If ln=0 Then Return ""
  1133. For s=1 To ln
  1134. result$=result$+Chr( PeekByte(DBBank(db),DBDataLocation(db,f,e)+s+1) )
  1135. Next
  1136. Return result
  1137. End Function
  1138.  
  1139.  
  1140. Function WriteByteToDB(db,f,e, val)
  1141. If val<0 Then val=0
  1142. If val>255 Then val=255
  1143. PokeByte DBBank(DB),DBDataLocation(db,f,e),val
  1144. End Function
  1145.  
  1146. Function WriteSByteToDB(db,f,e, val)
  1147. If val<-128 Then val=-128
  1148. If val>127 Then val=127
  1149. val=val+128
  1150. PokeByte DBBank(DB),DBDataLocation(db,f,e),val
  1151. End Function
  1152.  
  1153. Function WriteShortToDB(db,f,e, val)
  1154. If val>65535 Then val=65535
  1155. If val<0 Then val=0
  1156. val1=val/256
  1157. val2=val Mod 256
  1158. PokeByte DBBank(DB),DBDataLocation(db,f,e),val1
  1159. PokeByte DBBank(DB),DBDataLocation(db,f,e)+1,val2
  1160. End Function
  1161.  
  1162. Function WriteSShortToDB(db,f,e, val)
  1163. If val>32767 Then val=32767
  1164. If val<-32768 Then val=-32768
  1165. val=val+32768
  1166. If val<0 Then val=0
  1167. val1=val/256
  1168. val2=val Mod 256
  1169. PokeByte DBBank(DB),DBDataLocation(db,f,e),val1
  1170. PokeByte DBBank(DB),DBDataLocation(db,f,e)+1,val2
  1171. End Function
  1172.  
  1173. Function WriteIntToDB(db,f,e, val)
  1174. PokeInt DBBank(DB),DBDataLocation(db,f,e),val
  1175. End Function
  1176.  
  1177. Function WriteFloatToDB(db,f,e, val#)
  1178. PokeFloat DBBank(DB),DBDataLocation(db,f,e),val
  1179. End Function
  1180.  
  1181. Function WriteStringToDB(db,f,e, val$)
  1182. ln=Len(val):If ln>DBFieldSize(db,f) Then ln=DBFieldSize(db,f)
  1183. ln1=ln/256
  1184. ln2=ln Mod 256
  1185. PokeByte DBBank(DB),DBDataLocation(db,f,e),ln1
  1186. PokeByte DBBank(DB),DBDataLocation(db,f,e)+1,ln2
  1187. For s=1 To ln
  1188. PokeByte DBBank(DB),DBDataLocation(db,f,e)+s+1, Asc(Mid(val,s,1))
  1189. Next
  1190. End Function
  1191.  
  1192. Function StringLength(db,f,e)
  1193. If DBFieldType(db,f)<>DB_String Then Return
  1194. b1=PeekByte(DBBank(db),DBDataLocation(db,f,e))
  1195. b2=PeekByte(DBBank(db),DBDataLocation(db,f,e)+1)
  1196. Return (b1*256)+b2
  1197. End Function
  1198.  
  1199. Function CopyRecordSimple(DB,r1,r2)
  1200. For f=1 To DBFields(DB)
  1201. val$=GetDataStringSimple(DB,f,r1)
  1202. SetDataStringSimple DB,f,r2,val$
  1203. Next
  1204. End Function
  1205.  
  1206. Function AddField(DB,N$,Typ=DB_Int,StrLen=25,lst$="")
  1207. If DBBank(DB) Then RuntimeError "Cannot add fields to a finalized database."
  1208. If DBFields(DB)=MaxFields Then RuntimeError "Database has reached field limit. (While adding `"+n+"')"
  1209. DBFields(DB)=DBFields(DB)+1:F=DBFields(DB)
  1210. DBField(DB,F)=n
  1211. DBFieldType(DB,F)=Typ
  1212. DBFieldLen(DB,F)=Len(n)
  1213. If Typ=DB_List Then DBFieldList(DB,F)=lst$ Else DBFieldList(DB,F)=""
  1214. If Typ=DB_String Then DBFieldSize(DB,F)=StrLen+2 Else DBFieldSize(DB,F)=0 ;first 2 bytes of a string is length
  1215. End Function
  1216.  
  1217.  
  1218.  
  1219. Function DBGetListString$(db,f,val)
  1220. ss$=DBFieldList(db,f)
  1221. For l=1 To Len(ss)
  1222. cc$=Mid(ss,l,1)
  1223. If cc="," Then
  1224. valat=valat+1:If valat=val+1 Then Return oot$ Else oot$=""
  1225. Else
  1226. oot=oot$+cc
  1227. EndIf
  1228. Next
  1229. If valat=val Then Return oot
  1230. End Function
  1231.  
  1232. Function DBGetListValue(db,f,s$)
  1233. ss$=DBFieldList(db,f)
  1234. For l=1 To Len(ss)
  1235. cc$=Mid(ss,l,1)
  1236. If cc="," Then
  1237. valat=valat+1:If s=oot$ Then Return valat-1 Else oot$=""
  1238. Else
  1239. oot=oot$+cc
  1240. EndIf
  1241. Next
  1242. If s=oot Then Return valat
  1243. End Function
  1244.  
  1245.  
  1246.  
  1247.  
  1248.  
  1249.  
  1250.  
  1251. Function DBRecordID(DB,r)
  1252. Return PeekInt(DBBank(db),DBRecordLocation(db,r))
  1253. End Function
  1254.  
  1255.  
  1256. Function DBRecordLocation(DB,r)
  1257. Return (DBRecordSize(DB)*(r-1))
  1258. End Function
  1259.  
  1260. Function DBDataLocation(db,f,e)
  1261. Return (DBFieldOffset(DB,F)+DBRecordLocation(DB,e))-0
  1262. End Function
  1263.  
  1264.  
  1265.  
  1266.  
  1267.  
  1268. Function AddRecordToCache(DB,r)
  1269. If DBRecordsInCache(DB)>0 Then
  1270. If DBRecordCacheIndex(DB,DBRecordsInCache(DB))=r Then Return ;if its already at the top of the cache, no need to proceed
  1271.                 For c=1 To DBRecordsInCache(DB) ;see if its already in the cache, and if so, move it to the top of the pile
  1272.                 If DBRecordCacheIndex(DB,c)=r Then
  1273.                 daid=DBRecordCacheID(DB,c)
  1274.                         For t=c To DBRecordsInCache(DB)-1
  1275.                         DBRecordCacheID(db,t)=DBRecordCacheID(db,t+1)
  1276.                         DBRecordCacheIndex(db,t)=DBRecordCacheIndex(db,t+1)
  1277.                         Next
  1278.                 DBRecordCacheID(db,DBRecordsInCache(DB))=daid
  1279.                 DBRecordCacheIndex(db,DBRecordsInCache(DB))=r
  1280.                 Return
  1281.                 EndIf
  1282.                 Next
  1283. EndIf
  1284.         If DBRecordsInCache(DB)=MaxRecordCache Then
  1285.                 For t=1 To MaxRecordCache-1;stack is full so shift them down
  1286.                 DBRecordCacheID(db,t)=DBRecordCacheID(db,t+1)
  1287.                 DBRecordCacheIndex(db,t)=DBRecordCacheIndex(db,t+1)
  1288.                 Next
  1289.                 Else
  1290.                 DBRecordsInCache(DB)=DBRecordsInCache(DB)+1;stack isn't full so just add to it
  1291.         EndIf
  1292. c=DBRecordsInCache(DB)
  1293. DBRecordCacheID(db,c)=DBRecordID(db,r)
  1294. DBRecordCacheIndex(db,c)=r
  1295. End Function


Comments :


Shifty Geezer(Posted 1+ years ago)

 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 tLoading 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:
Code: [Select]
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


slenkar(Posted 1+ years ago)

 you could use this with the server code to create a website he  he heit would run a lot faster than PHP scripts too [/i]
Logged
Pages: [1]   Go Up
« previous next »
 
SimplePortal 2.3.6 © 2008-2014, SimplePortal