
' 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. The database is then iterated
' based on both index tag keys.

' This demo uses the PowerBASIC Console compiler.

#Compile Exe

#Include "..\..\include\Cheetah4_PowerBasic.inc"

'JPRO_COMPILER=PB/CC


Function PBMain() As Long
   
   Local dbfHandle  As Long        
   Local idxHandle  As Long
   Local tagHandle1 As Long
   Local tagHandle2 As Long
   Local errcode    As Long
   Local nRecNum    As Long
   Local sData      As String
   Local st1        As String
   Local st2        As String
   Local st3        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."

   
   '// MOVE THROUGH THE DATABASE IN SORTED ORDER
   ' 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

   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 GoTo ExitOut
       
      ' 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
       
      errcode = xdbMove( dbfHandle, tagHandle1, %XDB_MOVENEXT, nRecNum )
      
      ' You can also 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( dbfHandle1, tagHandle1, %XDB_MOVENEXT_ATOMIC, nRecNum )
   Loop
       

   errcode = xdbGetTag( "fullname", idxHandle, tagHandle2 ) 
   If errcode Then GoTo exitout

   Print
   Print "Move through database based on FullName Tag"
   errcode = xdbMove( dbfHandle, tagHandle2, %XDB_MOVEFIRST, nRecNum )
      
   Do Until errcode <> 0   ' loop until end of file reached or error
       
      errcode = xdbGetRecord( dbfHandle, nRecNum )
      If errcode Then GoTo ExitOut
      
      ' 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 st2; ", "; st3; Spc(5); st1
      End If
       
      errcode = xdbMove( dbfHandle, tagHandle2, %XDB_MOVENEXT, nRecNum )
      
   Loop                     
   Print


   '// 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"
   
   While InKey$ = "": Wend
        
End Function

