
' AddRecords
' Code to create a dBase database, Cheetah index with two TAGs,
' and add records to the database which automatically adds the
' correct keys to the index tags.

' This demo uses the FreeBASIC (0.24) Console compiler.


#Include Once "..\..\include\Cheetah4_FreeBasic.bi"

Declare Sub DisplayRecords( ByVal dbfHandle As uInteger, ByVal idxHandle As uInteger, ByVal tagHandle1 As uInteger ) 


   dim dbfHandle  as long        
   dim idxHandle  as long
   dim tagHandle1 as long
   dim tagHandle2 as long
   dim errcode    as long
   dim sData      as string
   dim nRecNum    as long
                            
   cls
   
   ' // CREATE A DBASE COMPATIBLE DATABASE 
   sData = "disk  = dbasetest.dbf;"    & _  
           "type  = dbase;"            & _
           "memosize = 512;"           & _     ' always 512 for dBase style databases
           "field = custid,c,8,0;"     & _     ' character
           "field = firstname,c,20,0;" & _     ' character
           "field = lastname,c,20,0;"  & _     ' character
           "field = amountdue,n,12,2;" & _     ' numeric, 2 decimal places
           "field = lastpymt,d,8,0;"   & _     ' date
           "field = isactive,l,1,0;"   & _     ' logical y/n, t/f
           "field = notes,m,10,0;"             ' dbase memos are always size 10 

   ' Create the actual database. A second file with a .dbt extension is
   ' created to hold the memo field text. If no fields were specified 
   ' with the Memo type then the .dbt would not be created.
   errcode = xdbCreateDatabase( sData ) 
   If errcode Then Goto ExitOut
   Print "Database created."
   

   ' // CREATE THE INDEX FILE
   ' In Cheetah, the index file is simply a disk file. It holds one or
   ' more index "TAGS". The Tags are basically the information describing
   ' how the index should be sorted. It is the Tags that you use when
   ' specifying what order to iterate/move through a database.
   sData = "disk = dbasetest.btx;"  
   errcode = xdbCreateIndex( sData ) 
   If errcode Then GoTo ExitOut
   Print "Index created"
   
   
   ' // OPEN THE DATABASE //   
   ' You must open the database and index prior to creating any TAGS. It
   ' is important that you track the 'handles' that are returned from
   ' these processes because it is those handles that you use from now
   ' on to refer to the database, index or Tag.
   sData = "disk=dbasetest.dbf"
   errcode = xdbOpenDatabase( sData, dbfHandle ) 
   If errcode Then GoTo ExitOut
   Print "Database opened. Handle ="; Str$( dbfHandle )                  
                  

   ' // OPEN THE INDEX
   sData = "disk=dbasetest.btx"
   errcode = xdbOpenIndex( sData, dbfHandle, idxHandle ) 
   If errcode Then GoTo exitout
   Print "Index opened. Handle ="; Str$( idxHandle )                  

                                                           
                                                           
   ' // CREATE TWO INDEX TAGS
   ' We will now create two Tags, each specifying how we want our
   ' main database to be indexed (we can create up to 100 Tags per
   ' index file).                          
   
   ' The first tag, CustId, is created based on the database field
   ' called CustId. We could name it something different if we
   ' wanted to (Tag names can be up to 10 characters long).
   
   ' The Expression is the actual field in the database that we
   ' want to index on. The expression can contain up to 6 different
   ' database fields (e.g. LNAME+FNAME )
   
   ' If UpperCase is set to TRUE then all keys added to the Tag 
   ' will be converted to uppercase. This is useful if you need to
   ' perform case insensitive seeks later.
   
   sData = "TagName=custid; Expression=custid; UpperCase=TRUE"
   errcode = xdbCreateTag( sData, idxHandle ) 
   If errcode Then Goto exitout
   Print "Tag 'custid' created"

   sData = "TagName=fullname; Expression=lastname+firstname; UpperCase=TRUE"
   errcode = xdbCreateTag( sData, idxHandle ) 
   If errcode Then GoTo exitout
   Print "Tag 'fullname' created"

   ' We need to retrieve the Tag handle and feed that value to
   ' the move functions.
   errcode = xdbGetTag( "custid", idxHandle, tagHandle1 ) 
   If errcode Then Goto ExitOut


   ' // ADD RECORDS TO THE DATABASE
   ' We must clear the existing record buffer prior to adding a new record.
   xdbClearBuffer dbfHandle
   
   ' Set the values for some of the database fields. 
   xdbSetField dbfHandle, "custid",    0, "1000"
   xdbSetField dbfHandle, "firstname", 0, "Paul"
   xdbSetField dbfHandle, "lastname",  0, "Squires"
   xdbSetField dbfHandle, "amountdue", 0, "199.95"
   xdbSetField dbfHandle, "lastpymt",  0, "20061231"
   xdbSetField dbfHandle, "isactive",  0, "T"          ' True
   xdbSetField dbfHandle, "notes",     0, "This is my note for record 1"
   
   ' Add the record to the database. The index Tags are automatically
   ' updated based on the database field values. When adding the record,
   ' we use a value of 0 for the record number. This tells Cheetah to
   ' append the record at the end of the database.
   errcode = xdbPutRecord( dbfHandle, 0 )
   If errcode Then GoTo exitout
   Print "Record added, index/tag updated."
      
      
   ' // ADD A SECOND RECORD
   xdbClearBuffer dbfHandle
   
   xdbSetField dbfHandle, "custid",    0, "2000"
   xdbSetField dbfHandle, "firstname", 0, "Bill"
   xdbSetField dbfHandle, "lastname",  0, "Smith"
   xdbSetField dbfHandle, "amountdue", 0, "500.00"
   xdbSetField dbfHandle, "lastpymt",  0, "20050930"
   xdbSetField dbfHandle, "isactive",  0, "T"          ' True
   xdbSetField dbfHandle, "notes",     0, "This is my note for record 2"
   
   errcode = xdbPutRecord( dbfHandle, 0 )
   If errcode Then GoTo exitout
   Print "Record added, index/tag updated."


   ' // ADD A THIRD RECORD
   xdbClearBuffer dbfHandle
   
   xdbSetField dbfHandle, "custid",    0, "1500"
   xdbSetField dbfHandle, "firstname", 0, "Mary"
   xdbSetField dbfHandle, "lastname",  0, "Beckworth"
   xdbSetField dbfHandle, "amountdue", 0, "0.00"
   xdbSetField dbfHandle, "lastpymt",  0, "20060115"
   xdbSetField dbfHandle, "isactive",  0, "T"          ' True
   xdbSetField dbfHandle, "notes",     0, "This is my note for record 3"
   
   errcode = xdbPutRecord( dbfHandle, 0 )
   If errcode Then GoTo exitout
   Print "Record added, index/tag updated."
                               
   DisplayRecords dbfHandle, idxHandle, tagHandle1
                             
                               
   ' // UPDATE THE FIRST RECORD 
   ' Update by changing the custid field value. This will automatically
   ' update the related CustId index tag.
   errcode = xdbGetRecord( dbfHandle, 1 )
   If errcode Then GoTo exitout

   xdbSetField dbfHandle, "custid",   0, "1700"
   
   errcode = xdbPutRecord( dbfHandle, 1 )
   If errcode Then GoTo exitout
   Print "First Record updated, index/tag updated."
                             
                             
   DisplayRecords dbfHandle, idxHandle, tagHandle1
                             
                             
   ' // CLOSE THE DATABASE AND INDEX(ES)
   ' Closing the database will automatically close all indexes associated
   ' with it. The xdbShutDown command will also close the databases and
   ' indexes if you fail to remember to close them prior to the program ending.
   errcode = xdbCloseDatabase( dbfHandle ) 
   If errcode Then GoTo exitout
   Print "Database and index closed."
   

ExitOut:

   ' // SHUTDOWN THE SYSTEM (This will close files and free internal allocated memory)
   xdbShutdown

   Print "Demo Completed"
   
   Sleep

   
   
Sub DisplayRecords( ByVal dbfHandle As uInteger, _  
                    ByVal idxHandle As uInteger, _
                    ByVal tagHandle1 As uInteger ) 

   dim st1     as string
   Dim st2     As String
   Dim st3     As String
   Dim nRecNum As Integer 
   Dim errcode As Integer
   
   Print
   Print "Move through database based on CustId Tag"
   errcode = xdbMove( dbfHandle, tagHandle1, XDB_MOVEFIRST, nRecNum )
      
   Do Until errcode <> 0   ' loop until end of file reached or error
       
      errcode = xdbGetRecord( dbfHandle, nRecNum )
      If errcode Then Exit Sub
       
      ' Bypass any deleted records
      If Not xdbIsDeleted( dbfHandle ) Then 
         xdbGetField dbfHandle, "custid",    0, TRUE, st1
         xdbGetField dbfHandle, "lastname",  0, TRUE, st2
         xdbGetField dbfHandle, "firstname", 0, TRUE, st3
         
         Print st1; Spc(5); st2; ", "; st3
      End If
       
      
      ' You can use the %XDB_MOVENEXT_ATOMIC move ONLY if you know
      ' that the most previous inkey key position has not changed. A %XDB_MOVENEXT
      ' performs a seek prior to doing the move to the next key. The %XDB_MOVENEXT_ATOMIC
      ' does not do the seek and assumes that the key position is valid. 
      errcode = xdbMove( dbfHandle, tagHandle1, XDB_MOVENEXT_ATOMIC, nRecNum )
      
      'errcode = xdbMove( dbfHandle, tagHandle1, XDB_MOVENEXT, nRecNum )
   Loop
   Print

   
End Sub

