
' SeekRecords
' 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. Seeks are performed on the
' index tags in order to quickly find records in the database.

' 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
                            
   
   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"

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


   ' ADD RECORDS TO THE DATABASE
   xdbClearBuffer dbfHandle
   
   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"
   
   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."

   

   ' 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
   
   Print
   sLookfor = Space$( xdbGetFieldLength( dbfHandle, "custid", 0) )
   LSet sLookfor = "1500" 
   
   errcode = xdbSeek( tagHandle1, sLookfor, nRecNum )   ' exact match
   
   ' The xdbSeek will return one of three error codes signifying
   ' the type of match achieved.
   ' ERR_SEEKNOMATCH      
   ' ERR_SEEKEXACTMATCH   
   ' ERR_SEEKPARTIALMATCH 
   Select Case errcode 
      Case ERR_SEEKNOMATCH      
         Print "No match for "; sLookfor; " in Tag:custid"
      Case ERR_SEEKEXACTMATCH   
         Print "Exact match for "; sLookfor; " in Tag:custid at RecNum"; Str$(nRecNum)
      Case ERR_SEEKPARTIALMATCH 
         Print "Partial match for "; sLookfor; " in Tag:custid at RecNum"; Str$(nRecNum)
   End Select   
        
        
   LSet sLookfor = "99999999" 
   errcode = xdbSeek( tagHandle1, sLookfor, nRecNum )   ' no match
   Select Case errcode 
      Case ERR_SEEKNOMATCH      
         Print "No match for "; sLookfor; " in Tag:custid"
      Case ERR_SEEKEXACTMATCH   
         Print "Exact match for "; sLookfor; " in Tag:custid at RecNum"; Str$(nRecNum)
      Case ERR_SEEKPARTIALMATCH 
         Print "Partial match for "; sLookfor; " in Tag:custid at RecNum"; Str$(nRecNum)
   End Select   
        
        
   errcode = xdbSeek( tagHandle1, "150", nRecNum )  ' partial match
   Select Case errcode 
      Case ERR_SEEKNOMATCH      
         Print "No match for 150 in Tag:custid"
      Case ERR_SEEKEXACTMATCH   
         Print "Exact match for 150 in Tag:custid at RecNum"; Str$(nRecNum)
      Case ERR_SEEKPARTIALMATCH 
         Print "Partial match for 150 in Tag:custid at RecNum"; Str$(nRecNum)
   End Select                        
   Print

   
   ' GET THE TAG HANDLES
       
'   errcode = xdbGetTag( "fullname", idxHandle, tagHandle2 ) 
'   If errcode Then GoTo exitout
'   Print "Tag 'fullname'. Handle ="; Str$( tagHandle2 )

   


   ' 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
