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

' This demo uses the PowerBASIC Console compiler.

#Compile Exe

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

'JPRO_COMPILER=PB/CC

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


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

