QBDbase v2.0 (WIP)

[SMcNeill]

Terry decided to redo his sprite library to enhance it with the latest powers/goodness of QB64, and I thought I'd sit down and redo my QBDbase library and address some of the issues or lack of functionality in it, that I was hoping to add at some time..

Below is a little test snippet of the work-in-progress, in case anyone wants to see how this version would differ  from the last one.

Code: QB64: [Select]

1. CONST True = -1, False = 0
2. CONST DB_Static = 0, DB_Dynamic = 1
3. DIM SHARED DB_MaxDataBases AS _UNSIGNED _BYTE
4.  
5. TYPE HeaderType
6.     Offset AS _UNSIGNED LONG 'size of total header plus field data
7.     NumberOfFields AS _UNSIGNED _BYTE 'number of fields
8.     Style AS _BYTE '0 for STATIC, 1 for DYNAMIC -- totally changes our data structure/interaction
9.     NumberOfRecords AS LONG
10.     LastRecord AS LONG
11.     MaxNumberofRecords AS LONG
12. END TYPE
13.  
14. REDIM SHARED Header(0) AS HeaderType
15.  
16. TYPE FieldType
17.     Name AS STRING * 20
18.     Type AS _UNSIGNED _BYTE '1 = (String)/Number, 2 = (Real)/Integer , 4 = (Signed)/Unsigned
19.     Size AS _UNSIGNED LONG '1 for byte, 2 for integer, 4 for long/single, 8 for int64/float, any value > 0 for strings
20. END TYPE
21.  
22. REDIM SHARED FieldHeader(0, 1 TO 255) AS FieldType '
23. REDIM SHARED DB_RecordStatus(0, 0) AS _BYTE '1 = Normal, -1 = Deleted, -2 = Hidden, -3 = Password Protected
24.  
25. DIM SHARED DatabasesInUse AS _UNSIGNED _BYTE
26. REDIM SHARED DatabaseHandle(0) AS _BIT 'True/False Flag
27.  
28. REDIM SHARED DB_InternalMemory(0, 1 TO 255) AS _MEM
29.  
30. '**************** END OF HEADER
31.  
32. TYPE foo
33.     Name AS STRING * 10
34.     Age AS INTEGER
35.     Sex AS STRING * 1
36. END TYPE
37.  
38. DIM Customer AS foo 'Our reference variable
39.  
40.  
41. result = DB_SetMaxDatabases&(3) 'only 3 databases total
42. CDB = DB_CreateDatabase&(100, DB_Static) 'CDB = Customer DataBase; the name I chose for the reference handle
43. result = DB_AddField&(CDB, "Name", "STRING * 10")
44. IF result <> 0 THEN PRINT "ERROR ADDING NAME = "; result
45. result = DB_AddField&(CDB, "Age", "INTEGER")
46. IF result <> 0 THEN PRINT "ERROR ADDING AGE= "; result
47. result = DB_AddField&(CDB, "Sex", "STRING * 1")
48. IF result <> 0 THEN PRINT "ERROR ADDING SEX = "; result
49. result = DB_LinkToType&(CDB, _OFFSET(Customer)) 'Offset to the reference variable
50. IF result <> 0 THEN PRINT "ERROR LINKING = "; result
51.  
52. PRINT
53. PRINT "We're going to add some new records to our test database.  Just hit <ENTER> at the name to quit!"
54. PRINT
55.  
56. DO
57.     PRINT
58.     INPUT "Enter Name =>"; Customer.Name
59.     IF _TRIM$(Customer.Name) = "" THEN EXIT DO
60.     INPUT "Enter Age =>"; Customer.Age
61.     INPUT "Enter Sex =>"; Customer.Sex
62.     result = DB_AddRecord&(CDB, 0)
63.     IF result < 0 THEN PRINT "ERROR ADDING RECORD = "; result
64. LOOP
65.  
66. Customer.Name = "": Customer.Age = 0: Customer.Sex = ""
67.  
68. CLS
69.  
70. PRINT "Record", "Name", "Age", "Sex"
71. DO
72.     result = DB_GetRecord(CDB, 0)
73.     PRINT result, Customer.Name, Customer.Age, Customer.Sex
74. LOOP UNTIL result = -6 OR _KEYHIT
75.  
76.  
77.  
78. '**************** START OF SUBS/FUNCTIONS
79.  
80. FUNCTION DB_GetRecord& (DB_Handle AS _UNSIGNED _BYTE, DB_Record AS LONG)
81.     'Error Codes
82.     '>0 = Proper return tells us the record number recovered
83.     '-1 = If user passed a 0 value handle
84.     '-2 = If handle not in use
85.     '-3 = If handle is larger than max set number of databases
86.     '-4 = Invalid database type.  Dynamic DBs dont link to user variables
87.     '-5 = Invalid Record
88.     '-6 = Reached End of Data; nothing left to read.
89.     '-7 = Blank Record
90.     '-8 = Deleted Record
91.     '-9 = Hidden Record
92.     '-10 = Password Protected Record
93.     STATIC DB_RecordOn AS LONG
94.     IF DB_Handle = 0 THEN DB_GetRecord& = -1: EXIT FUNCTION '-1 if user passed a 0 value handle
95.     IF DB_Handle > DB_MaxDataBases THEN DB_GetRecord& = -3 '-3 if handle is larger than max set number of databases
96.     IF DatabaseHandle(DB_Handle) = False THEN DB_GetRecord& = -2: EXIT FUNCTION '-2 if handle not in use
97.     IF Header(DB_Handle).Style = DB_Dynamic THEN DB_GetRecord& = -4: EXIT FUNCTION '-4 invalid database type.  Static DBs dont link to user variables
98.  
99.     IF DB_RecordOn < 1 THEN DB_RecordOn = 1
100.  
101.     DIM Temp AS _OFFSET: Temp = DB_InternalMemory(DB_Handle, 2).SIZE
102.  
103.     IF DB_Record > 0 THEN
104.         SELECT CASE DB_RecordStatus(DB_Handle, DB_Record)
105.             CASE 0, -1, -2, -3 'blank/deleted/hidden/password protected
106.                 DB_GetRecord& = -7 - DB_RecordStatus(DB_Handle, DB_Record)
107.                 _MEMFILL DB_InternalMemory(DB_Handle, 2), DB_InternalMemory(DB_Handle, 2).OFFSET, Temp, 0 AS _BYTE 'blank the return field
108.             CASE 1 'It's all good and readable, no flags to worry about
109.                 _MEMCOPY DB_InternalMemory(DB_Handle, 1), DB_InternalMemory(DB_Handle, 1).OFFSET + Temp * (DB_Record - 1), Temp TO DB_InternalMemory(DB_Handle, 2), DB_InternalMemory(DB_Handle, 2).OFFSET
110.                 DB_GetRecord& = DB_Record 'proper return tells us the record number recovered
111.                 IF DB_RecordOn < Header(DB_Handle).LastRecord THEN DB_RecordOn = DB_Record + 1
112.         END SELECT
113.         EXIT FUNCTION
114.     ELSEIF DB_Record = 0 THEN
115.         FOR i = DB_RecordOn TO Header(DB_Handle).LastRecord 'look for the next available record we can read
116.             IF DB_RecordStatus(DB_Handle, i) = 1 THEN
117.                 _MEMCOPY DB_InternalMemory(DB_Handle, 1), DB_InternalMemory(DB_Handle, 1).OFFSET + Temp * (i - 1), Temp TO DB_InternalMemory(DB_Handle, 2), DB_InternalMemory(DB_Handle, 2).OFFSET
118.                 DB_GetRecord& = i 'proper return tells us the record number recovered
119.                 DB_RecordOn = i + 1
120.                 EXIT FUNCTION
121.             END IF
122.         NEXT
123.     ELSE
124.         DB_GetRecord& = -5 'Invalid Record (user passed a negative value handle)
125.     END IF
126.     DB_GetRecord& = -6 'Reached End of Data
127. END FUNCTION
128.  
129.  
130. FUNCTION DB_AddRecord& (DB_Handle AS _UNSIGNED _BYTE, DB_Record AS LONG)
131.     'Error Codes
132.     '>0 = Proper return tells us the record number written
133.     '-1 = If user passed a 0 value handle
134.     '-2 = If handle not in use
135.     '-3 = If handle is larger than max set number of databases
136.     '-4 = Invalid database type.  Dynamic DBs dont link to user variables
137.     '-5 = Invalid Record
138.     '-6 = Failure to Write Data.  (All records probably full.)
139.  
140.     IF DB_Handle = 0 THEN DB_AddRecord& = -1: EXIT FUNCTION '-1 if user passed a 0 value handle
141.     IF DB_Handle > DB_MaxDataBases THEN DB_AddRecord& = -3 '-3 if handle is larger than max set number of databases
142.     IF DatabaseHandle(DB_Handle) = False THEN DB_AddRecord& = -2: EXIT FUNCTION '-2 if handle not in use
143.     IF Header(DatabasesInUse).Style = DB_Dynamic THEN DB_AddRecord& = -4: EXIT FUNCTION '-4 invalid database type.  Static DBs dont link to user variables
144.  
145.     DIM Temp AS _OFFSET: Temp = DB_InternalMemory(DB_Handle, 2).SIZE
146.  
147.     IF DB_Record > 0 THEN
148.         _MEMCOPY DB_InternalMemory(DB_Handle, 2), DB_InternalMemory(DB_Handle, 2).OFFSET, Temp TO DB_InternalMemory(DB_Handle, 1), DB_InternalMemory(DB_Handle, 1).OFFSET + Temp * (DB_Record - 1)
149.         DB_RecordStatus(DB_Handle, DB_Record) = 1 'no unusal statuses; it's a new, good, visible, valid record
150.         DB_AddRecord& = DB_Record
151.     ELSEIF DB_Record = 0 THEN
152.         FOR i = 1 TO Header(DB_Handle).MaxNumberofRecords
153.             SELECT CASE DB_RecordStatus(DB_Handle, i)
154.                 CASE 0, -1 'blank or deleted record
155.                     _MEMCOPY DB_InternalMemory(DB_Handle, 2), DB_InternalMemory(DB_Handle, 2).OFFSET, Temp TO DB_InternalMemory(DB_Handle, 1), DB_InternalMemory(DB_Handle, 1).OFFSET + Temp * (i - 1)
156.                     DB_RecordStatus(DB_Handle, i) = 1 'no unusal statuses; it's a new, good, visible, valid record
157.                     DB_AddRecord& = i
158.                     IF i > Header(DB_Handle).LastRecord THEN Header(DB_Handle).LastRecord = Header(DB_Handle).LastRecord + 1
159.                     EXIT FUNCTION
160.             END SELECT
161.         NEXT
162.     ELSE
163.         DB_AddRecord& = -5 'Invalid Record
164.     END IF
165.     DB_AddRecord& = -6 'Failure to Write Data.  (All records probably full.)
166. END FUNCTION
167.  
168.  
169.  
170. FUNCTION DB_LinkToType& (DB_Handle AS _UNSIGNED _BYTE, DB_Offset AS _OFFSET) 'DB_Offset is the offset to the type variable
171.     IF DB_Handle = 0 THEN DB_LinkToType& = -1: EXIT FUNCTION '-1 if user passed a 0 value handle
172.     IF DB_Handle > DB_MaxDataBases THEN DB_LinkToType& = -3 '-3 if handle is larger than max set number of databases
173.     IF DatabaseHandle(DB_Handle) = False THEN DB_LinkToType& = -2: EXIT FUNCTION '-2 if handle not in use
174.     IF Header(DatabasesInUse).Style = DB_Dynamic THEN DB_LinkToType& = -4: EXIT FUNCTION '-4 invalid database type.  Static DBs dont link to user variables
175.     FOR i = 1 TO 255
176.         TotalSize&& = TotalSize&& + FieldHeader(DB_Handle, i).Size
177.     NEXT
178.     PRINT TotalSize&&; "SIZE"
179.  
180.     DB_InternalMemory(DB_Handle, 1) = _MEMNEW(TotalSize&& * Header(DB_Handle).MaxNumberofRecords) 'first field is the actual data
181.     _MEMFILL DB_InternalMemory(DB_Handle, 1), DB_InternalMemory(DB_Handle, 1).OFFSET, DB_InternalMemory(DB_Handle, 1).SIZE, 0 AS _BYTE
182.     DB_InternalMemory(DB_Handle, 2) = _MEM(DB_Offset, TotalSize&&) 'second field links to the refernce variable
183. END FUNCTION
184.  
185. FUNCTION DB_SetMaxDatabases& (Number AS _UNSIGNED _BYTE)
186.     IF Number = 0 THEN DB_SetMaxDatabases& = -1 'Can't set zero as a limit
187.     IF DB_MaxDataBases <> 0 THEN DB_SetMaxDatabases& = -2 'Max has already been set
188.     DB_MaxDataBases = Number
189.     REDIM DatabaseHandle(1 TO DB_MaxDataBases) AS _BIT 'True/False Flag
190.     REDIM Header(1 TO DB_MaxDataBases) AS HeaderType
191.     REDIM FieldHeader(1 TO DB_MaxDataBases, 0 TO 255) AS FieldType '
192.     REDIM DB_InternalMemory(1 TO DB_MaxDataBases, 1 TO 255) AS _MEM
193.     FOR X = 1 TO DB_MaxDataBases
194.         FOR Y = 1 TO 255
195.             FieldHeader(X, Y).Type = 255 'If all bits are set, the field is empty
196.         NEXT
197.     NEXT
198. END FUNCTION
199.  
200. FUNCTION DB_CreateDatabase& (DB_SetMaxRecords AS LONG, STYLE AS INTEGER) '0 to 255 return value only
201.     'Error Codes
202.     '-1 = User hasn't set DB_SetMaxDatabases yet
203.     '-2 = Invalid number of max records
204.     '-3 = Too many databases open
205.     '-4 = Invalid style set for database
206.  
207.     IF DB_MaxDataBases = 0 THEN DB_CreateDatabase& = -1 'Max amount hasn't been set yet
208.     IF DB_SetMaxRecords <= 0 THEN DB_CreateDatabase& = -2 'Invalid number of max records
209.     IF STYLE < 0 OR STYLE > 1 THEN DB_CreateDatabase& = -4 'Invalid style set for database
210.     FOR i = 1 TO DatabasesInUse
211.         IF DatabaseHandle(i) = False THEN
212.             DB_CreateDatabase& = i
213.             Header(i).NumberOfRecords = 0
214.             Header(i).MaxNumberofRecords = DB_SetMaxRecords
215.             DatabaseHandle(i) = True
216.             EXIT FUNCTION
217.         END IF
218.     NEXT
219.     IF DatabasesInUse = DB_MaxDataBases THEN DB_CreateDatabase& = -3: EXIT FUNCTION 'Return -3 if we have too many databases open
220.     DatabasesInUse = DatabasesInUse + 1
221.     DB_CreateDatabase& = DatabasesInUse
222.     Header(DatabasesInUse).NumberOfRecords = 0
223.     Header(DatabasesInUse).MaxNumberofRecords = DB_SetMaxRecords
224.     DatabaseHandle(DatabasesInUse) = True
225.     REDIM DB_RecordStatus(1 TO DB_MaxDataBases, 1 TO DB_SetMaxRecords) AS _BYTE
226. END FUNCTION
227.  
228. FUNCTION DB_FreeDatabase& (DB_Handle AS _UNSIGNED _BYTE) 'true/false return value
229.     IF DB_Handle = 0 THEN DB_FreeDatabase& = -1: EXIT FUNCTION '-1 if user passed a 0 value handle
230.     IF DB_Handle > DB_MaxDataBases THEN DB_FreeDatabase& = -3 '-3 if handle is larger than max set number of databases
231.     IF DatabaseHandle(DB_Handle) = False THEN DB_FreeDatabase& = -2: EXIT FUNCTION '-2 if handle not in use
232.     DatabaseHandle(DB_Handle) = False
233.     IF DB_Handle = DatabaseHandle THEN DatabaseHandle = DatabaseHandle - 1 'clear up a handle if we're freeing the last one
234.     DB_FreeDatabase& = True
235.     IF Header(DatabasesInUse).Style = DB_Dynamic THEN
236.         FOR i = 1 TO 255
237.             IF FieldHeader(DB_Handle, i).Type <> 255 THEN
238.                 FieldHeader(DB_Handle, i).Type = 255
239.                 _MEMFREE DB_InternalMemory(DB_Handle, i)
240.             END IF
241.         NEXT
242.     ELSE
243.         _MEMFREE DB_InternalMemory(DB_Handle, 1)
244.     END IF
245. END FUNCTION
246.  
247. FUNCTION DB_AddField& (DB_Handle AS _UNSIGNED _BYTE, DB_FieldLabel AS STRING * 20, DB_Type AS STRING * 30)
248.     'Error Return Values:
249.     '-1 = Handle Value of 0
250.     '-2 = Handle > DB_MaxDataBases limit
251.     '-3 = Handle not in use
252.     '-4 = Too many fields in databse already (255 fields found)
253.     '-5 = Name contains invalid characters.  Only A-Z (upper or lowercase), 0-9, space, and period allowed
254.     '-6 = Invalid letters in type
255.     '-7 = Invalid information in type
256.     '-8 = Too large a STRING size (0 or blank for variable length, 1 - 255 for fixed length)
257.     '-9 = Database already has 255 fields; can't add any more.
258.     IF (DB_Handle = 0) THEN DB_AddField = -1: EXIT FUNCTION
259.     IF DB_Handle > DB_MaxDataBases THEN DB_AddField = -2 '-2 if handle is larger than max set number of databases
260.     IF (DatabaseHandle(DB_Handle) = False) THEN DB_AddField = -3: EXIT FUNCTION
261.     FOR i = 1 TO DB_MaxDataBases
262.         IF FieldHeader(DB_Handle, i).Type = 255 THEN found = i: EXIT FOR
263.     NEXT
264.     IF found = 0 THEN DB_AddField = -4: EXIT FUNCTION '-4 for too many fields
265.     temp$ = _TRIM$(DB_FieldLabel)
266.     FOR i = 1 TO LEN(temp$)
267.         SELECT CASE MID$(temp$, i, 1)
268.             CASE "a" TO "z", "A" TO "Z", "0" TO "9", ".", " ", CHR$(0)
269.             CASE ELSE
270.                 DB_AddField = -5 'invalid characters in field name
271.                 EXIT FUNCTION
272.         END SELECT
273.     NEXT
274.     t1$ = _TRIM$(UCASE$(DB_Type))
275.     FOR i = 1 TO LEN(t1$)
276.         SELECT CASE MID$(t1$, i, 1)
277.             CASE "A" TO "Z", "0" TO "9" 'acceptable letters
278.                 t$ = t$ + MID$(t1$, i, 1)
279.             CASE "_", " ", "*"
280.             CASE ELSE
281.                 DB_AddField = -6 'invalid letters in type
282.                 EXIT FUNCTION
283.         END SELECT
284.     NEXT
285.  
286.     FOR i = 1 TO Header(DB_Handle).NumberOfFields
287.         IF FieldHeader(DB_Handle, i).Type = 255 THEN n = Header(DB_Handle).NumberOfFields: EXIT FOR
288.     NEXT
289.     IF n = 0 THEN
290.         IF Header(DB_Handle).NumberOfFields = 255 THEN
291.             DB_AddField = -9 'Database already has 255 fields; can't add any more.
292.         ELSE
293.             n = Header(DB_Handle).NumberOfFields + 1 'prepare to update for a new field, if everything else passes muster
294.         END IF
295.     END IF
296.  
297.  
298.     IF LEFT$(t$, 6) = "STRING" THEN
299.         v% = VAL(MID$(t$, 7))
300.         IF LEN(_TRIM$(STR$(v%))) + 6 <> LEN(t$) THEN DB_AddField = -7: EXIT FUNCTION 'invalid information in type
301.         IF v% > 255 THEN DB_AddField = -8 'too large a string size
302.         Header(DB_Handle).NumberOfFields = n 'add a new field
303.         FieldHeader(DB_Handle, n).Name = DB_FieldLabel
304.         FieldHeader(DB_Handle, n).Type = 1
305.         FieldHeader(DB_Handle, n).Size = v%
306.     ELSE
307.         SELECT CASE t$ '1 = (String)/Number, 2 = (Real)/Integer , 4 = (Signed)/Unsigned
308.             CASE "SINGLE"
309.                 Header(DB_Handle).NumberOfFields = n 'add a new field
310.                 FieldHeader(DB_Handle, n).Name = DB_FieldLabel
311.                 FieldHeader(DB_Handle, n).Type = 2
312.                 FieldHeader(DB_Handle, n).Size = 4
313.             CASE "DOUBLE"
314.                 Header(DB_Handle).NumberOfFields = n 'add a new field
315.                 FieldHeader(DB_Handle, n).Name = DB_FieldLabel
316.                 FieldHeader(DB_Handle, n).Type = 2
317.                 FieldHeader(DB_Handle, n).Size = 8
318.             CASE "FLOAT"
319.                 Header(DB_Handle).NumberOfFields = n 'add a new field
320.                 FieldHeader(DB_Handle, n).Name = DB_FieldLabel
321.                 FieldHeader(DB_Handle, n).Type = 2
322.                 FieldHeader(DB_Handle, n).Size = 32
323.             CASE "UNSIGNEDBYTE"
324.                 Header(DB_Handle).NumberOfFields = n 'add a new field
325.                 FieldHeader(DB_Handle, n).Name = DB_FieldLabel
326.                 FieldHeader(DB_Handle, n).Type = 4
327.                 FieldHeader(DB_Handle, n).Size = 1
328.             CASE "UNSIGNEDINTEGER"
329.                 Header(DB_Handle).NumberOfFields = n 'add a new field
330.                 FieldHeader(DB_Handle, n).Name = DB_FieldLabel
331.                 FieldHeader(DB_Handle, n).Type = 4
332.                 FieldHeader(DB_Handle, n).Size = 2
333.             CASE "UNSIGNEDLONG"
334.                 Header(DB_Handle).NumberOfFields = n 'add a new field
335.                 FieldHeader(DB_Handle, n).Name = DB_FieldLabel
336.                 FieldHeader(DB_Handle, n).Type = 4
337.                 FieldHeader(DB_Handle, n).Size = 4
338.             CASE "UNSIGNEDINTEGER64"
339.                 Header(DB_Handle).NumberOfFields = n 'add a new field
340.                 FieldHeader(DB_Handle, n).Name = DB_FieldLabel
341.                 FieldHeader(DB_Handle, n).Type = 4
342.                 FieldHeader(DB_Handle, n).Size = 8
343.             CASE "BYTE"
344.                 Header(DB_Handle).NumberOfFields = n 'add a new field
345.                 FieldHeader(DB_Handle, n).Name = DB_FieldLabel
346.                 FieldHeader(DB_Handle, n).Type = 0
347.                 FieldHeader(DB_Handle, n).Size = 1
348.             CASE "INTEGER"
349.                 Header(DB_Handle).NumberOfFields = n 'add a new field
350.                 FieldHeader(DB_Handle, n).Name = DB_FieldLabel
351.                 FieldHeader(DB_Handle, n).Type = 0
352.                 FieldHeader(DB_Handle, n).Size = 2
353.             CASE "LONG"
354.                 Header(DB_Handle).NumberOfFields = n 'add a new field
355.                 FieldHeader(DB_Handle, n).Name = DB_FieldLabel
356.                 FieldHeader(DB_Handle, n).Type = 0
357.                 FieldHeader(DB_Handle, n).Size = 4
358.             CASE "INTEGER64"
359.                 Header(DB_Handle).NumberOfFields = n 'add a new field
360.                 FieldHeader(DB_Handle, n).Name = DB_FieldLabel
361.                 FieldHeader(DB_Handle, n).Type = 0
362.                 FieldHeader(DB_Handle, n).Size = 8
363.             CASE ELSE
364.                 DB_AddField = -7: EXIT FUNCTION 'invalid information in type
365.         END SELECT
366.     END IF
367.     IF Header(DatabasesInUse).Style = DB_Dynamic THEN
368.         DB_InternalMemory(DB_Handle, n) = _MEMNEW(FieldHeader(DB_Handle, n).Size * Header(DB_Handle).MaxNumberofRecords)
369.         _MEMFILL DB_InternalMemory(DB_Handle, n), DB_InternalMemory(DB_Handle, n).OFFSET, DB_InternalMemory(DB_Handle, n).SIZE, 0 AS _BYTE
370.     END IF
371. END FUNCTION
372.  
373.  

Now, if I were to remove out the lines which would become the actual library, what the user supplied code would look like is the following (which might help highlight how things are different):

Code: QB64: [Select]

1. TYPE foo
2.     Name AS STRING * 10
3.     Age AS INTEGER
4.     Sex AS STRING * 1
5. END TYPE
6.  
7. DIM Customer AS foo 'Our reference variable
8.  
9.  
10. result = DB_SetMaxDatabases&(3) 'only 3 databases total
11. CDB = DB_CreateDatabase&(100, DB_Static) 'CDB = Customer DataBase; the name I chose for the reference handle
12. result = DB_AddField&(CDB, "Name", "STRING * 10")
13. IF result <> 0 THEN PRINT "ERROR ADDING NAME = "; result
14. result = DB_AddField&(CDB, "Age", "INTEGER")
15. IF result <> 0 THEN PRINT "ERROR ADDING AGE= "; result
16. result = DB_AddField&(CDB, "Sex", "STRING * 1")
17. IF result <> 0 THEN PRINT "ERROR ADDING SEX = "; result
18. result = DB_LinkToType&(CDB, _OFFSET(Customer)) 'Offset to the reference variable
19. IF result <> 0 THEN PRINT "ERROR LINKING = "; result
20.  
21. PRINT
22. PRINT "We're going to add some new records to our test database.  Just hit <ENTER> at the name to quit!"
23. PRINT
24.  
25. DO
26.     PRINT
27.     INPUT "Enter Name =>"; Customer.Name
28.     IF _TRIM$(Customer.Name) = "" THEN EXIT DO
29.     INPUT "Enter Age =>"; Customer.Age
30.     INPUT "Enter Sex =>"; Customer.Sex
31.     result = DB_AddRecord&(CDB, 0)
32.     IF result < 0 THEN PRINT "ERROR ADDING RECORD = "; result
33. LOOP
34.  
35. Customer.Name = "": Customer.Age = 0: Customer.Sex = ""
36.  
37. CLS
38.  
39. PRINT "Record", "Name", "Age", "Sex"
40. DO
41.     result = DB_GetRecord(CDB, 0)
42.     PRINT result, Customer.Name, Customer.Age, Customer.Sex
43. LOOP UNTIL result = -6 OR _KEYHIT
44.  
45.  
46.  

First note of difference -- EVERYTHING is basically a FUNCTION.   The reason for this is rather simple:  this library is going to work with various mem blocks (and most with $CHECKING:OFF once it gets finished), so I wanted it to be able to return as much ERROR information as possible back to the end user. 

For example, when attempting to add a field, we could get back any of the following error codes:
    'Error Return Values:
    '-1 = Handle Value of 0
    '-2 = Handle > DB_MaxDataBases limit
    '-3 = Handle not in use
    '-4 = Too many fields in database already (255 fields found)
    '-5 = Name contains invalid characters.  Only A-Z (upper or lowercase), 0-9, space, and period allowed
    '-6 = Invalid letters in type
    '-7 = Invalid information in type
    '-8 = Too large a STRING size (0 or blank for variable length, 1 - 255 for fixed length)
    '-9 = Database already has 255 fields; can't add any more.

I'm trying to make this fairly decent at error catching and returning helpful, decipherable error messages for us.
 
*********************

Next thing you might notice is that we now can add Fields to our database, and Link to a user-defined type. (Note, linking is for Static databases only, but I'll explain the difference between what this library calls 'Static' and 'Dynamic' later.)

If you  look at our user defined TYPE, what we see is:

Code: QB64: [Select]

1. TYPE foo
2.     name AS STRING * 10
3.     age AS INTEGER
4.     sex AS STRING * 1
5. END TYPE
6.  
7. DIM Customer AS foo 'Our reference variable

And the way we associate these fields with our database is rather simple:

Code: QB64: [Select]

1. result = DB_AddField&(CDB, "Name", "STRING * 10")
2. result = DB_AddField&(CDB, "Age", "INTEGER")
3. result = DB_AddField&(CDB, "Sex", "STRING * 1")
4. result = DB_LinkToType&(CDB, _OFFSET(Customer)) 'Offset to the reference variable

Then, when it's time to add an actual record to the database, we do so just by using the same variables in our code as normal:

Code: QB64: [Select]

1. DO
2.     PRINT
3.     INPUT "Enter Name =>"; Customer.name
4.     IF _TRIM$(Customer.name) = "" THEN EXIT DO
5.     INPUT "Enter Age =>"; Customer.age
6.     INPUT "Enter Sex =>"; Customer.sex
7.     result = DB_AddRecord&(CDB, 0)
8. LOOP

All-in-all, it's more-or-less a complete revisioning of the QBDbase system, and by using what I learned while making the last version, this one should be much simpler for the end-user to implement and make use of.  (And a LOT more flexible, when all is said and done.)

Anywho....  It's just a little taste of what I'm playing around with, but there's no need to get too excited and hold your breath for a finished product; my precious for programming time is limited a lot anymore, and I'm not even going to attempt to put a date on when this little revision might be finished.  It'll get done when it gets done, is the best I'm going to offer.  :P

[TerryRitchie]

Excellent news!

[SMcNeill]

Updated the demo.  You can now Create the database, Add Records, and GetRecords....

Looking at the actual program code (not the part which will become the library files), it seems a lot more complicated now, but it's not!  The majority of the new code is just adding lines so the program will print out a message in case any errors occur while running.  :P

[luke]

Suggestion: use the built in ERROR command to throw fatal errors, especially those that indicate a programming error. It'll keep the caller code cleaner and ensure mistakes don't go unnoticed.

[SMcNeill]

Suggestion: use the built in ERROR command to throw fatal errors, especially those that indicate a programming error. It'll keep the caller code cleaner and ensure mistakes don't go unnoticed.

Before I finish, I plan to set a flag so a person can choose between internal and external error messages.  Internal would basically be what we have now: the function returns a result and the programmer can write their own method for dealing with the issue.  External errors give us a pop up message and a choice "halt execution or resume", like we often see in QB64 errors such as "subscript out of range".

Part of the idea behind this database is to allow the end USER to add/remove fields, not just the programmer, and external errors may not be the desired route to go for simple cases of user typos and such.  (Like a user defining a field "STRIG * 10"... We can catch that and program for them to retype the entry without just popping up an error message.)

[TempodiBasic]

Hi Steve
great project !
Good evolution of your library!

about

First note of difference -- EVERYTHING is basically a FUNCTION

going from Qbasic toward C/C++ and passing throug Pascal/TurboPascal I learnt how a SUBroutine can be useful mimed by a Function that return an OK_feedback value while no SUB can mimy a Function. So the simple block of code separated has its evolution in the simple block separated returning a feedback message. And IMHO this become the basis for event driven coding and the oriented object programming.