
' SeekRecords2
' Code to create a dBase database, Cheetah index with one TAG,
' and add records to the database which automatically adds the
' correct keys to the index tags. Seeks are performed on the
' index tags in order to quickly find records in the database.
' This demo shows how to seek to the first match and iterate
' through subsequent records until the search key is no longer
' matched. That is, look up all records that even have duplicate
' keys.

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


#include once "..\..\include\Cheetah4_FreeBasic.bi"
   
   Dim dbfHandle  As Long        
   Dim idxHandle  As Long
   Dim tagHandle1 As Long
   Dim tagHandle2 As Long
   Dim errcode    As Long
   Dim nRecNum    As Long
   Dim sData      As String
   Dim sLookfor   As String
   dim sKeyValue  as string                         
   
   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 

   errcode = xdbCreateDatabase( sData ) 
   If errcode Then GoTo ExitOut
   Print "Database created."

   sData = "disk = dbasetest.btx;"  
   errcode = xdbCreateIndex( sData ) 
   If errcode Then GoTo ExitOut
   Print "Index created"
   
   sData = "disk=dbasetest.dbf"
   errcode = xdbOpenDatabase( sData, dbfHandle ) 
   If errcode Then GoTo ExitOut
   Print "Database opened. Handle ="; Str$( dbfHandle )                  
                  
   sData = "disk=dbasetest.btx"
   errcode = xdbOpenIndex( sData, dbfHandle, idxHandle ) 
   If errcode Then GoTo exitout
   Print "Index opened. Handle ="; Str$( idxHandle )                  

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


   ' ADD RECORDS TO THE DATABASE
   xdbClearBuffer dbfHandle
   
   xdbSetField dbfHandle, "custid",    0, "1000"
   xdbSetField dbfHandle, "firstname", 0, "Paul"
   xdbSetField dbfHandle, "lastname",  0, "Squires"
  
   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"
   
   errcode = xdbPutRecord( dbfHandle, 0 )
   If errcode Then GoTo exitout
   Print "Record added, index/tag updated."


   ' ADD A THIRD RECORD (DUPLICATE)
   xdbClearBuffer dbfHandle
   
   xdbSetField dbfHandle, "custid",    0, "2000"
   xdbSetField dbfHandle, "firstname", 0, "Mary"
   xdbSetField dbfHandle, "lastname",  0, "Beckworth"
   
   errcode = xdbPutRecord( dbfHandle, 0 )
   If errcode Then GoTo exitout
   Print "Record added, index/tag updated."

   
   ' ADD A FOURTH RECORD 
   xdbClearBuffer dbfHandle
   
   xdbSetField dbfHandle, "custid",    0, "3000"
   xdbSetField dbfHandle, "firstname", 0, "Jim"
   xdbSetField dbfHandle, "lastname",  0, "Williams"
   
   errcode = xdbPutRecord( dbfHandle, 0 )
   If errcode Then GoTo exitout
   Print "Record added, index/tag updated."



   ' PERFORM SEEKS ON THE TAGS
   ' In order to get an exact match for the seek you must pass a search
   ' key in the same size as the field(s) in the database. For example,
   ' The CustId field is 8 characters wide. For an exact match, you
   ' must pass a character string 8 characters wide containing the value
   ' that you want to match.
   errcode = xdbGetTag( "custid", idxHandle, tagHandle1 ) 
   If errcode Then GoTo exitout
   
   sLookfor = Space$( xdbGetFieldLength( dbfHandle, "custid", 0) )
   LSet sLookfor = "2000" 
   
   errcode = xdbSeek( tagHandle1, sLookfor, nRecNum )   ' exact match

   do until errcode = ERR_MOVEERROR
      xdbGetKey tagHandle1, sKeyValue, nRecNum 
      If sKeyValue <> sLookFor Then Exit Do
      
      if xdbIsDeleted( dbfHandle ) = false then
         Print "Exact match for "; sLookfor; " in Tag:custid at RecNum"; Str$(nRecNum)
      End If

      errcode = xdbMove( dbfHandle, tagHandle1, XDB_MOVENEXT_ATOMIC, nRecNum )
      
   Loop
        
        
   ' 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
        

