Author Topic: DBF conversion/use programs  (Read 6943 times)

0 Members and 1 Guest are viewing this topic.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
DBF conversion/use programs
« on: July 28, 2017, 12:18:03 pm »
Two programs here which might be useful for someone who needs to access data from a DBF file for use inside a QB64 program.

First, we have a simple program to change DBF files to CSV (Comma Separated Value) Text files:

Code: QB64: [Select]
  1. 'DBF to CSV text converter
  2.  
  3. 'Program written by Steve McNeill @ 9/19/2012
  4.  
  5. 'Code is free to use, abuse, modify, destroy, steal, copy, share, and alter in any way anyone wishes.
  6. 'Just be aware, I'm not responsible if it melts your computer, fries your brain, or makes you sing like a drunken sailor.
  7. 'Use is purely at your own risk, but it seems safe enough to me!
  8.  
  9. 'All this does is convert old dbf files into a simple CSV text file, which can then be read into any program which you wish to use the data with.
  10. 'Your old files stay as they are, and it does nothing to them except read them and then give you a new, converted file to work with.
  11.  
  12. 'change file$ and file1$ to the name of your DBF and new converted filename, respectively.
  13.  
  14. 'No credit, cash, check, or money order needed for this.  Enjoy!!
  15.  
  16.  
  17. TYPE DBF_Header
  18.     FileType AS _UNSIGNED _BYTE
  19.     Year AS _UNSIGNED _BYTE
  20.     Month AS _UNSIGNED _BYTE
  21.     Day AS _UNSIGNED _BYTE
  22.     RecordNumber AS _UNSIGNED LONG
  23.     FirstRecord AS _UNSIGNED INTEGER
  24.     RecordLength AS _UNSIGNED INTEGER
  25.     ReservedJunk AS STRING * 16
  26.     TableFlag AS _UNSIGNED _BYTE
  27.     CodePageMark AS _UNSIGNED _BYTE
  28.     ReservedJunk1 AS STRING * 2
  29.  
  30. TYPE Field_Subrecord
  31.     FieldName AS STRING * 11
  32.     FieldType AS STRING * 1
  33.     Displacement AS _UNSIGNED LONG
  34.     FieldLength AS _UNSIGNED _BYTE
  35.     FieldDecimal AS _UNSIGNED _BYTE
  36.     FieldFlags AS _UNSIGNED _BYTE
  37.     AutoNext AS _UNSIGNED LONG
  38.     AutoStep AS _UNSIGNED _BYTE
  39.     ReservedJunk AS STRING * 8
  40.  
  41. TYPE DBF_HeaderTerminator
  42.     EndCode AS _UNSIGNED _BYTE 'Our End of Field Code is a CHR$(13), or 13 if we read it as a byte
  43.  
  44. TYPE DBF_VFPInfo
  45.     Info AS STRING * 263
  46.  
  47. DIM DataH AS DBF_Header
  48. DIM DataFS(1) AS Field_Subrecord
  49. DIM DataHT AS DBF_HeaderTerminator
  50. DIM DataVFP AS DBF_VFPInfo
  51.  
  52. file$ = ".\tempdata.dbf"
  53. file2$ = ".\converted.txt"
  54.  
  55. Get_Header file$, DataH
  56. 'Display_Header DataH
  57. Get_Fields file$, DataFS()
  58. 'Display_Fields DataFS()
  59. Print_Data file$, DataH, DataFS(), file2$
  60. PRINT "Your file has been converted."
  61. PRINT "The original file was: "; file$
  62. PRINT "The converted file is: "; file2$
  63.  
  64.  
  65.  
  66. SUB Display_Header (DataH AS DBF_Header)
  67. PRINT "Data File Type: ";
  68. SELECT CASE DataH.FileType
  69.     CASE 2: PRINT "FoxBASE"
  70.     CASE 3: PRINT "FoxBASE+/Dbase III plus, no memo"
  71.     CASE 48: PRINT "Visual FoxPro"
  72.     CASE 49: PRINT "Visual FoxPro, autoincrement enabled"
  73.     CASE 50: PRINT "Visual FoxPro with field type Varchar or Varbinary"
  74.     CASE 67: PRINT "dBASE IV SQL table files, no memo"
  75.     CASE 99: PRINT "dBASE IV SQL system files, no memo"
  76.     CASE 131: PRINT "FoxBASE+/dBASE III PLUS, with memo"
  77.     CASE 139: PRINT "dBASE IV with memo"
  78.     CASE 203: PRINT "dBASE IV SQL table files, with memo"
  79.     CASE 229: PRINT "HiPer-Six format with SMT memo file"
  80.     CASE 245: PRINT "FoxPro 2.x (or earlier) with memo"
  81.     CASE 251: PRINT "FoxBASE"
  82.     CASE ELSE: PRINT "Unknown File Type"
  83. PRINT "Date: "; DataH.Month; "/"; DataH.Day; "/"; DataH.Year
  84. PRINT "Number of Records: "; DataH.RecordNumber
  85. PRINT "First Record: "; DataH.FirstRecord
  86. PRINT "Record Length: "; DataH.RecordLength
  87. PRINT "Reserved Junk: "; DataH.ReservedJunk
  88. PRINT "Table Flags: ";
  89. none = 0
  90. IF DataH.TableFlag AND 1 THEN PRINT "file has a structural .cdx ";: none = -1
  91. IF DataH.TableFlag AND 2 THEN PRINT "file has a Memo field ";: none = -1
  92. IF DataH.TableFlag AND 4 THEN PRINT "file is a database (.dbc) ";: none = -1
  93. IF none THEN PRINT ELSE PRINT "None"
  94. PRINT "Code Page Mark: "; DataH.CodePageMark
  95. PRINT "Reserved Junk: "; DataH.ReservedJunk1
  96.  
  97. SUB Display_Fields (DataH() AS Field_Subrecord)
  98. FOR r = 1 TO UBOUND(DataH)
  99.     PRINT "Field Name :"; DataH(r).FieldName
  100.     PRINT "Field Type :"; DataH(r).FieldType
  101.     PRINT "Field Displacement :"; DataH(r).Displacement
  102.     PRINT "Field Length :"; DataH(r).FieldLength
  103.     PRINT "Field Decimal :"; DataH(r).FieldDecimal
  104.     PRINT "Field Flags :"; DataH(r).FieldFlags
  105.     PRINT "Field AutoNext :"; DataH(r).AutoNext
  106.     PRINT "Field SutoStep :"; DataH(r).AutoStep
  107.     PRINT "Field Reserved Junk :"; DataH(r).ReservedJunk
  108.     SLEEP
  109.     PRINT "**************************"
  110.  
  111. SUB Get_Header (file$, DataH AS DBF_Header)
  112. OPEN file$ FOR BINARY AS #1 LEN = LEN(DataH)
  113. GET #1, 1, DataH
  114.  
  115. SUB Get_Fields (file$, DataH() AS Field_Subrecord)
  116. DIM temp AS Field_Subrecord
  117. OPEN file$ FOR BINARY AS #1 LEN = 1
  118. counter = -1: s = 33
  119.     counter = counter + 1
  120.     GET #1, s, databyte
  121.     s = s + 32
  122. LOOP UNTIL databyte = 13
  123. REDIM DataH(counter) AS Field_Subrecord
  124. IF counter < 1 THEN BEEP: BEEP: PRINT "Database has no file records.": END
  125. OPEN file$ FOR BINARY AS #1 LEN = 32
  126. FOR r = 1 TO counter
  127.     GET #1, 32 * r + 1, DataH(r) 'record 1 is our header info, so we need to start our field info at record 2
  128.  
  129.  
  130. SUB Print_Data (file$, DataH AS DBF_Header, DataFS() AS Field_Subrecord, file2$)
  131. OPEN file$ FOR BINARY AS #1
  132. OPEN file2$ FOR OUTPUT AS #2
  133. SEEK #1, DataH.FirstRecord + 1
  134.     GET #1, , databyte 'This is the first byte which tells us if the record is good, or has been deleted.
  135.     IF databyte = 32 THEN WRITE #2, "Good Record", ELSE WRITE #2, "Deleted Record",
  136.     FOR i = 1 TO UBOUND(DataFS)
  137.         SELECT CASE DataFS(i).FieldType
  138.             CASE "C", "0"
  139.                 'C is for Characters, or basically STRING characters.
  140.                 '0 is for Null Flags, which I have no clue what they're for.  I'm basically reading them here as worthless characters until I learn otherwise.
  141.                 temp$ = ""
  142.                 FOR j = 1 TO DataFS(i).FieldLength
  143.                     GET #1, , databyte
  144.                     temp$ = temp$ + CHR$(databyte)
  145.                 NEXT
  146.             CASE "Y"
  147.                 'Y is for currency, which is an _INTEGER 64, with an implied 4 spaces for decimal built in.
  148.                 REDIM temp AS _INTEGER64
  149.                 GET #1, , temp
  150.                 temp$ = STR$(temp)
  151.                 l = LEN(temp$)
  152.                 temp$ = LEFT$(temp$, l - 4) + "." + RIGHT$(temp$, 4)
  153.             CASE "N", "F", "M", "G"
  154.                 'N is for numberic, F is for Floating numbers, and both seem to work in the same manner.
  155.                 'M is for Memo's, which are stored in a different  DBT file.  What we have here is the block number of the memo location in that file, stored as a simple set of characters.
  156.                 'G is for OLE files.  We store the info for it just the same as we do for a Memo.
  157.                 'we read the whole thing as a string, which is an odd way for dBase to write it, but I don't make the rules.  I just convert them!
  158.                 temp$ = ""
  159.                 FOR j = 1 TO DataFS(i).FieldLength
  160.                     GET #1, , databyte
  161.                     temp$ = temp$ + CHR$(databyte)
  162.                 NEXT
  163.             CASE "D"
  164.                 'D is for Date fields.
  165.                 'Dates are stored as a string, in the format YYYYMMDD
  166.                 temp$ = ""
  167.                 FOR j = 1 TO DataFS(i).FieldLength
  168.                     GET #1, , databyte
  169.                     temp$ = temp$ + CHR$(databyte)
  170.                 NEXT
  171.                 year$ = LEFT$(temp$, 4)
  172.                 month$ = MID$(temp$, 5, 2)
  173.                 day$ = RIGHT$(temp$, 2)
  174.                 temp$ = day$ + "/" + month$ + "/" + year$
  175.             CASE "L"
  176.                 'L is our logical operator.  Basically, it's simply True or False Boolean logic
  177.                 GET #1, , databyte
  178.                 IF databyte = 32 THEN temp$ = "True" ELSE temp$ = "false"
  179.             CASE "@", "O"
  180.                 '@ are Timestamps, which I'm too lazy to fully support at the moment.
  181.                 'They are 8 bytes - two longs, first for date, second for time.
  182.                 'The date is the number of days since  01/01/4713 BC.
  183.                 'Time is hours * 3600000L + minutes * 60000L + Seconds * 1000L
  184.                 'All I'm going to do is read both longs as a single _Integer64 and then write that data to the disk.
  185.                 'Be certain to convert it as needed to make use of the Timestamp.
  186.                 'I'm just lazy and don't wanna convert anything right now!  :P
  187.  
  188.                 'O are double long integers -- basically Integer 64s.  Since I'm reading a timestamp as an Int64, this routine works for them as well.
  189.                 REDIM temp1 AS _INTEGER64
  190.                 GET #1, , temp1
  191.                 temp$ = STR$(temp1)
  192.             CASE "I", "+"
  193.                 'Long Integers.  Basically 4 byte numbers
  194.                 '+ are auto-increments.  Stored the same way as a Long.
  195.                 REDIM temp2 AS LONG
  196.                 GET #1, , temp2
  197.                 temp$ = STR$(temp2)
  198.         END SELECT
  199.         IF i = UBOUND(datafs) THEN WRITE #2, temp$ ELSE WRITE #2, temp$,
  200.     NEXT

Useage here is simple:
1) Download the file below and put it in your QB64 folder
2) copy and paste the code above into your QB64 IDE.
3) compile and run
4) Enjoy looking at the "converted.txt" file which we created in that same folder, which now has all the DATA in that DBF file converted over to CSV TXT for ease of use in QB64 (or any other program which you might need it for).
* tempdata.dbf (Filesize: 0.52 KB, Downloads: 506)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: DBF conversion/use programs
« Reply #1 on: July 28, 2017, 12:26:04 pm »
And here, we have a second program which does something which I always love doing:

It writes QB64 code for us automagically!!   

A program which writes programs (or at least a custom part of a program)!!  You have to love that.

Code: QB64: [Select]
  1.  
  2. TYPE DBF_Header
  3.     FileType AS _UNSIGNED _BYTE
  4.     Year AS _UNSIGNED _BYTE
  5.     Month AS _UNSIGNED _BYTE
  6.     Day AS _UNSIGNED _BYTE
  7.     RecordNumber AS _UNSIGNED LONG
  8.     FirstRecord AS _UNSIGNED INTEGER
  9.     RecordLength AS _UNSIGNED INTEGER
  10.     ReservedJunk AS STRING * 16
  11.     TableFlag AS _UNSIGNED _BYTE
  12.     CodePageMark AS _UNSIGNED _BYTE
  13.     ReservedJunk1 AS STRING * 2
  14.  
  15. TYPE Field_Subrecord
  16.     FieldName AS STRING * 11
  17.     FieldType AS STRING * 1
  18.     Displacement AS _UNSIGNED LONG
  19.     FieldLength AS _UNSIGNED _BYTE
  20.     FieldDecimal AS _UNSIGNED _BYTE
  21.     FieldFlags AS _UNSIGNED _BYTE
  22.     AutoNext AS _UNSIGNED LONG
  23.     AutoStep AS _UNSIGNED _BYTE
  24.     ReservedJunk AS STRING * 8
  25.  
  26. 'The next two types really seem unimportant to us.
  27. 'I mainly put them in here so that no one would forget that our database has them.
  28. 'After the Field_Subrecords, there is a ENTER byte (CHR$(13)), for an End-of-Subrecord code.
  29. 'After that, there MAY be 263 bytes of information which FoxPro tosses into the dbd file.
  30. 'Honestly, it seems useless to me, but should be remembered just for documention sake if nothing else.
  31.  
  32.  
  33. TYPE DBF_HeaderTerminator
  34.     EndCode AS _UNSIGNED _BYTE 'Our End of Field Code is a CHR$(13), or 13 if we read it as a byte
  35.  
  36. TYPE DBF_VFPInfo
  37.     Info AS STRING * 263
  38.  
  39. DIM DataH AS DBF_Header
  40. DIM DataFS(1) AS Field_Subrecord
  41. 'Notice I didn't even bother to define a variable for our other two types?  That's how important they seem to me.  ;)
  42.  
  43.  
  44. file$ = ".\tempdata.dbf"
  45. file2$ = ".\converted.txt"
  46.  
  47. Get_Header file$, DataH
  48. 'Display_Header DataH 'You can unremark this line, if you want to see what the Header looks like itself.
  49. Get_Fields file$, DataFS()
  50. 'Display_Fields DataFS() ' Unremark this line to see how many fields we have, what types, and their properties, if you want.
  51. Print_Data file$, DataH, DataFS(), file2$
  52. PRINT "Your file has been converted."
  53. PRINT "The original file was: "; file$
  54. PRINT "The converted file is: "; file2$
  55.  
  56.  
  57.  
  58. SUB Display_Header (DataH AS DBF_Header)
  59. PRINT "Data File Type: ";
  60. SELECT CASE DataH.FileType
  61.     CASE 2: PRINT "FoxBASE"
  62.     CASE 3: PRINT "FoxBASE+/Dbase III plus, no memo"
  63.     CASE 48: PRINT "Visual FoxPro"
  64.     CASE 49: PRINT "Visual FoxPro, autoincrement enabled"
  65.     CASE 50: PRINT "Visual FoxPro with field type Varchar or Varbinary"
  66.     CASE 67: PRINT "dBASE IV SQL table files, no memo"
  67.     CASE 99: PRINT "dBASE IV SQL system files, no memo"
  68.     CASE 131: PRINT "FoxBASE+/dBASE III PLUS, with memo"
  69.     CASE 139: PRINT "dBASE IV with memo"
  70.     CASE 203: PRINT "dBASE IV SQL table files, with memo"
  71.     CASE 229: PRINT "HiPer-Six format with SMT memo file"
  72.     CASE 245: PRINT "FoxPro 2.x (or earlier) with memo"
  73.     CASE 251: PRINT "FoxBASE"
  74.     CASE ELSE: PRINT "Unknown File Type"
  75. PRINT "Date: "; DataH.Month; "/"; DataH.Day; "/"; DataH.Year
  76. PRINT "Number of Records: "; DataH.RecordNumber
  77. PRINT "First Record: "; DataH.FirstRecord
  78. PRINT "Record Length: "; DataH.RecordLength
  79. PRINT "Reserved Junk: "; DataH.ReservedJunk
  80. PRINT "Table Flags: ";
  81. none = 0
  82. IF DataH.TableFlag AND 1 THEN PRINT "file has a structural .cdx ";: none = -1
  83. IF DataH.TableFlag AND 2 THEN PRINT "file has a Memo field ";: none = -1
  84. IF DataH.TableFlag AND 4 THEN PRINT "file is a database (.dbc) ";: none = -1
  85. IF none THEN PRINT ELSE PRINT "None"
  86. PRINT "Code Page Mark: "; DataH.CodePageMark
  87. PRINT "Reserved Junk: "; DataH.ReservedJunk1
  88.  
  89. SUB Display_Fields (DataH() AS Field_Subrecord)
  90. FOR r = 1 TO UBOUND(DataH)
  91.     PRINT "Field Name :"; DataH(r).FieldName
  92.     PRINT "Field Type :"; DataH(r).FieldType
  93.     PRINT "Field Displacement :"; DataH(r).Displacement
  94.     PRINT "Field Length :"; DataH(r).FieldLength
  95.     PRINT "Field Decimal :"; DataH(r).FieldDecimal
  96.     PRINT "Field Flags :"; DataH(r).FieldFlags
  97.     PRINT "Field AutoNext :"; DataH(r).AutoNext
  98.     PRINT "Field SutoStep :"; DataH(r).AutoStep
  99.     PRINT "Field Reserved Junk :"; DataH(r).ReservedJunk
  100.     SLEEP
  101.     PRINT "**************************"
  102.  
  103. SUB Get_Header (file$, DataH AS DBF_Header)
  104. OPEN file$ FOR BINARY AS #1 LEN = LEN(DataH)
  105. GET #1, 1, DataH
  106.  
  107. SUB Get_Fields (file$, DataFS() AS Field_Subrecord)
  108. DIM temp AS Field_Subrecord
  109. OPEN file$ FOR BINARY AS #1 LEN = 1
  110. counter = -1: s = 33
  111.     counter = counter + 1
  112.     GET #1, s, databyte
  113.     s = s + 32
  114. LOOP UNTIL databyte = 13
  115. REDIM DataFS(counter) AS Field_Subrecord
  116. IF counter < 1 THEN BEEP: BEEP: PRINT "Database has no file records.": END
  117. OPEN file$ FOR BINARY AS #1 LEN = 32
  118. FOR r = 1 TO counter
  119.     GET #1, 32 * r + 1, DataFS(r) 'record 1 is our header info, so we need to start our field info at record 2
  120.  
  121.  
  122. SUB Print_Data (file$, DataH AS DBF_Header, DataFS() AS Field_Subrecord, file2$)
  123. OPEN file$ FOR BINARY AS #1
  124. OPEN file2$ FOR OUTPUT AS #2
  125. SEEK #1, DataH.FirstRecord + 1
  126.  
  127.  
  128. PRINT #2, "TYPE DB_Header"
  129. PRINT #2, "    FileType AS _UNSIGNED _BYTE"
  130. PRINT #2, "    Year AS _UNSIGNED _BYTE"
  131. PRINT #2, "    Month AS _UNSIGNED _BYTE"
  132. PRINT #2, "    Day AS _UNSIGNED _BYTE"
  133. PRINT #2, "    RecordNumber AS _UNSIGNED LONG"
  134. PRINT #2, "    FirstRecord AS _UNSIGNED INTEGER"
  135. PRINT #2, "    RecordLength AS _UNSIGNED INTEGER"
  136. PRINT #2, "    ReservedJunk AS STRING * 16"
  137. PRINT #2, "    TableFlag AS _UNSIGNED _BYTE"
  138. PRINT #2, "    CodePageMark AS _UNSIGNED _BYTE"
  139. PRINT #2, "    ReservedJunk1 AS STRING * 2"
  140. PRINT #2, "END TYPE"
  141. PRINT #2, ""
  142. PRINT #2, ""
  143.  
  144. PRINT #2, "TYPE DATE_FORMAT"
  145. PRINT #2, "    Year AS STRING * 4"
  146. PRINT #2, "    Month AS STRING * 2"
  147. PRINT #2, "    Day AS STRING * 2"
  148. PRINT #2, "END TYPE"
  149. PRINT #2, ""
  150. PRINT #2, ""
  151.  
  152. PRINT #2, "TYPE DataType"
  153. PRINT #2, "    VALID AS _BYTE"
  154. FOR i = 1 TO UBOUND(DataFS)
  155.     temp$ = DataFS(i).FieldName + " AS "
  156.     SELECT CASE DataFS(i).FieldType
  157.         CASE "C"
  158.             'C is for Characters, or basically STRING characters.
  159.             temp$ = temp$ + "STRING * " + STR$(DataFS(i).FieldLength) + " ' A basic Character field"
  160.         CASE "G"
  161.             temp$ = temp$ + "STRING * " + STR$(DataFS(i).FieldLength) + " ' OLE Info Field."
  162.         CASE "N"
  163.             temp$ = temp$ + "STRING * " + STR$(DataFS(i).FieldLength) + " ' A Numberic Field, with " + STR$(DataFS(i).FieldDecimal) + " Decimal Places"
  164.         CASE "F"
  165.             temp$ = temp$ + "STRING * " + STR$(DataFS(i).FieldLength) + " ' A Floating Field, with " + STR$(DataFS(i).FieldDecimal) + " Decimal Places"
  166.         CASE "0"
  167.             '0 is for Null Flags, which I have no clue what they're for.  I'm basically reading them here as worthless characters until I learn otherwise.
  168.             temp$ = temp$ + "STRING * " + STR$(DataFS(i).FieldLength) + " ' A Null Flag.  No idea what these are actually for, but they're part of the data structure."
  169.         CASE "M"
  170.             temp$ = temp$ + "STRING * " + STR$(DataFS(i).FieldLength) + " ' Memo Field, which is stored in a different DBT file.  What we have here is the block number of the memo location in that file, stored as a simple set of characters."
  171.         CASE "D"
  172.             'D is for Date fields.
  173.             'Dates are stored as a string, in the format YYYYMMDD
  174.             temp$ = temp$ + "DATE_FORMAT"
  175.         CASE "Y"
  176.             'Y is for currency, which is an _INTEGER 64, with an implied 4 spaces for decimal built in.
  177.             temp$ = temp$ + "_INTEGER64 ' This is actually a currency field.  Divide this by 1000 to get your actual data, as dBase doesn't store the decimal."
  178.         CASE "L"
  179.             'L is our logical operator.  Basically, it's simply True or False Boolean logic
  180.             temp$ = temp$ + "_BYTE"
  181.         CASE "@"
  182.             '@ are Timestamps, which I'm too lazy to fully support at the moment.
  183.             'They are 8 bytes - two longs, first for date, second for time.
  184.             'The date is the number of days since  01/01/4713 BC.
  185.             'Time is hours * 3600000L + minutes * 60000L + Seconds * 1000L
  186.             'All I'm going to do is read both longs as a single _Integer64 and then write that data to the disk.
  187.             'Be certain to convert it as needed to make use of the Timestamp.
  188.             'I'm just lazy and don't wanna convert anything right now!  :P
  189.             temp$ = temp$ + "LONG" + CHR$(13) + DataFS(i).FieldName + "1 AS LONG ' Timestamps here and above.  First is the number of days since  01/01/4713 BC, Second is hours * 3600000L + minutes * 60000L + Seconds * 1000L "
  190.         CASE "O"
  191.             'O are double long integers -- basically Integer 64s.
  192.             temp$ = temp$ + "_INTEGER 64"
  193.         CASE "I", "+"
  194.             'Long Integers.  Basically 4 byte numbers
  195.             '+ are auto-increments.  Stored the same way as a Long.
  196.             temp$ = temp$ + "LONG"
  197.     END SELECT
  198.     IF LEFT$(temp$, 1) = "_" THEN temp$ = RIGHT$(temp$, LEN(temp$) - 1)
  199.     temp$ = "    " + temp$
  200.     PRINT #2, UCASE$(temp$)
  201. PRINT #2, "END TYPE"
  202. PRINT #2, ""
  203. PRINT #2, "DIM DBH AS DB_Header"
  204. PRINT #2, "DIM DB AS DataType"
  205. PRINT #2, ""
  206. temp$ = "OPEN " + CHR$(34) + file$ + CHR$(34) + " FOR BINARY AS #1 LEN = " + STR$(DataH.RecordLength)
  207. PRINT #2, temp$
  208. temp$ = "GET #1, 1, DBH"
  209. PRINT #2, temp$
  210.  
  211. temp$ = "FirstRecord = DBH.FirstRecord +1 ' Add one for QB64 file counting offset"
  212. PRINT #2, temp$
  213. temp$ = "RecordLength = DBH.RecordLength"
  214. PRINT #2, temp$
  215. temp$ = "TotalRecordNumber = DBH.RecordNumber"
  216. PRINT #2, temp$
  217. PRINT #2, ""
  218. PRINT #2, "'    SEEK #1, FirstRecord 'Use this and the next remark if you prefer sequental reads."
  219. PRINT #2, "FOR i = 1 to TotalRecordNumber"
  220. PRINT #2, "    'GET #1, , DB 'Use this and the previous remark if you prefer sequental reads."
  221. PRINT #2, "    GET #1,FirstRecord + (i-1) * RecordLength, DB 'Remark this line out, if you use the other two for sequental input."
  222. PRINT #2, ""
  223. PRINT #2, "    'insert code to do stuff here with your data."
  224. PRINT #2, ""
  225. PRINT #2, "    'Remember to update DBH.RecordNumber if you add any extra records, so that they'll be available in use in your other dBase programs."
  226. PRINT #2, "    'Do this with DBH.RecordNumber = ###, where the ### is the total number of records."
  227. PRINT #2, "    'And then PUT #1, 1, DBH"
  228. PRINT #2, ""
  229. PRINT #2, "NEXT"
  230.  

Use this with the same file from above, and then look at the "converted.txt" file which we generate.  It should look like the following:

Code: QB64: [Select]
  1. TYPE DB_Header
  2.     FileType AS _UNSIGNED _BYTE
  3.     Year AS _UNSIGNED _BYTE
  4.     Month AS _UNSIGNED _BYTE
  5.     Day AS _UNSIGNED _BYTE
  6.     RecordNumber AS _UNSIGNED LONG
  7.     FirstRecord AS _UNSIGNED INTEGER
  8.     RecordLength AS _UNSIGNED INTEGER
  9.     ReservedJunk AS STRING * 16
  10.     TableFlag AS _UNSIGNED _BYTE
  11.     CodePageMark AS _UNSIGNED _BYTE
  12.     ReservedJunk1 AS STRING * 2
  13.  
  14.  
  15. TYPE DATE_FORMAT
  16.     Year AS STRING * 4
  17.     Month AS STRING * 2
  18.     Day AS STRING * 2
  19.  
  20.  
  21. TYPE DataType
  22.     VALID AS _BYTE
  23.     NAME        AS STRING *  10 ' A BASIC CHARACTER FIELD
  24.     PHONE       AS STRING *  10 ' A BASIC CHARACTER FIELD
  25.     MONEY       AS _INTEGER64 ' THIS IS ACTUALLY A CURRENCY FIELD.  DIVIDE THIS BY 1000 TO GET YOUR ACTUAL DATA, AS DBASE DOESN'T STORE THE DECIMAL.
  26.     NUMBER      AS STRING *  10 ' A NUMBERIC FIELD, WITH  2 DECIMAL PLACES
  27.     NULLFLAGS  AS STRING *  1 ' A NULL FLAG.  NO IDEA WHAT THESE ARE ACTUALLY FOR, BUT THEY'RE PART OF THE DATA STRUCTURE.
  28.  
  29. DIM DBH AS DB_Header
  30. DIM DB AS DataType
  31.  
  32. OPEN ".\tempdata.dbf" FOR BINARY AS #1 LEN =  40
  33. GET #1, 1, DBH
  34. FirstRecord = DBH.FirstRecord +1 ' Add one for QB64 file counting offset
  35. RecordLength = DBH.RecordLength
  36. TotalRecordNumber = DBH.RecordNumber
  37.  
  38. '    SEEK #1, FirstRecord 'Use this and the next remark if you prefer sequental reads.
  39. FOR i = 1 to TotalRecordNumber
  40.     'GET #1, , DB 'Use this and the previous remark if you prefer sequental reads.
  41.     GET #1,FirstRecord + (i-1) * RecordLength, DB 'Remark this line out, if you use the other two for sequental input.
  42.  
  43.     'insert code to do stuff here with your data.
  44.  
  45.     'Remember to update DBH.RecordNumber if you add any extra records, so that they'll be available in use in your other dBase programs.
  46.     'Do this with DBH.RecordNumber = ###, where the ### is the total number of records.
  47.     'And then PUT #1, 1, DBH
  48.  
  49.  

If you look at it, you'll see what it did for us -- it decoded the DBF file, converted it to QB64 data types, and set the stage so we can read and write to that file with QB64!

This makes DBF files readable, writeable, and editable with QB64, while maintaining their basic data structure.  What more could a person want?  :D
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!