
' DeleteRecords
' 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. A record is then deleted.

' 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 sData      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
   ' We must clear the existing record buffer prior to adding a 
   ' new record.
   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."

   
   '// DELETE THE SECOND RECORD
   ' When a record is deleted, it is simply flagging in the database to
   ' be removed when the xdbPack function is called by the user. Records
   ' marked for deletion have an asterisk "*" as the first character of
   ' the record. Keys are not automatically deleted from related index 
   ' tags when a record is deleted. They are removed when an xdbPack is
   ' performed because xdbPack also performs an xdbReindex on all open
   ' indexes. For this reason, when you are using a Tag to move through 
   ' the database, you will need to test the record to bypass any records
   ' marked for deletion (using xdbIsDeleted), assuming that you do not
   ' want to process the deleted record.
   errcode = xdbGetRecord( dbfHandle, 2 )
   If errcode Then GoTo exitout        
   
   errcode = xdbDeleteRecord( dbfHandle )
   If errcode Then GoTo exitout
   Print "Record #2 marked for deletion."
   
   errcode = xdbPack( dbfHandle )
   If errcode Then GoTo exitout
   Print "Database packed and indexes re-indexed."


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

