
' TypeRecords
' Code to show how to use a TYPE structure to hold the database
' record information.

' This demo uses the PowerBASIC Console compiler.

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


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


' Create a TYPE structure that will hold the information for
' each database record. The TYPE **MUST** mirror EXACTLY the
' structure of the database including the first byte which
' must always be the deleted field marker. If you change the
' structure of the database then the TYPE must also be updated.
' If you forget to match the TYPE structrue to the database 
' structure then unpredictable results will occur because
' Cheetah simply copies the data to the TYPE without doing any
' field validation.
Type CUSTOMER_TYPE Field = 1    
   deleted   As String * 1
   custid    As String * 8
   firstname As String * 20
   lastname  As String * 20
   amountdue As String * 12
   lastpymt  As String * 8
   isactive  As String * 1
   notes     As String * 10
End Type           


  
   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 cust       As CUSTOMER_TYPE
                            
   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
   
   ' Set the values for some of the database fields. 
   cust.custid    = "1000"
   cust.firstname = "Paul"
   cust.lastname  = "Squires"
   Rset cust.amountdue, "199.95"    ' numeric fields must be right aligned
   cust.lastpymt  = "20061231"
   cust.isactive  = "T"
   
   ' You must use the xdbSetField for all fields of Memo type.
   xdbSetField dbfHandle, "notes", 0, "This Is my note For record 1"
   
   ' Pass the entire TYPE to the xdbPutRecord function. We do this
   ' by passing the memory address of the TYPE variable.
   errcode = xdbPutRecord( dbfHandle, 0, VarPtr(cust) )
   If errcode Then GoTo exitout
   Print "Record added, index/tag updated."
      
      
   ' ADD A SECOND RECORD
   xdbClearBuffer dbfHandle
   
   cust.custid    = "2000"
   cust.firstname = "Bill"
   cust.lastname  = "Smith"
   Rset cust.amountdue, "500.00"    ' numeric fields must be right aligned
   cust.lastpymt  = "20050930"
   cust.isactive  = "T"
   
   ' You must use the xdbSetField for all fields of Memo type.
   xdbSetField dbfHandle, "notes", 0, "This Is my note For record 2"

   errcode = xdbPutRecord( dbfHandle, 0, VarPtr(cust) )
   If errcode Then GoTo exitout
   Print "Record added, index/tag updated."


   ' ADD A THIRD RECORD
   xdbClearBuffer dbfHandle
   
   cust.custid    = "1500"
   cust.firstname = "Mary"
   cust.lastname  = "Beckworth"
   Rset cust.amountdue, "0.00"    ' numeric fields must be right aligned
   cust.lastpymt  = "20060115"
   cust.isactive  = "T"
   
   ' You must use the xdbSetField for all fields of Memo type.
   xdbSetField dbfHandle, "notes", 0, "This Is my note For record 3"

   errcode = xdbPutRecord( dbfHandle, 0, VarPtr(cust) )
   If errcode Then GoTo exitout
   Print "Record added, index/tag updated."

   
   ' GET RECORD #2, MAKE A CHANGE, UPDATE THE DATABASE
   errcode = xdbGetRecord( dbfHandle, 2, VarPtr(cust) ) 
   If errcode Then GoTo exitout
   ' Change the CustId. This is a Tag index field so the correspnding
   ' index tag will also update its key.
   cust.Custid = "1555"
   errcode = xdbPutRecord( dbfHandle, 2, VarPtr(cust) ) 
   If errcode Then GoTo exitout
   Print "Record #2 updated."
   

   ' CLOSE THE DATABASE AND INDEX(ES)
   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
        

