'//
'//  Clear the record buffer for the specified database
'//
Function ctx_ClearBuffer_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long
   
   Local pDBF    As DBF_TYPE Ptr
   Local pField  As DBF_FIELD_TYPE Ptr
   Local x       As Long
   
   If @xdb.reserved = 0 Then
      @xdb.errcode = %ERR_DATA: GoTo ExitOut
   End If

   pDBF = @xdb.reserved
   
   ' Clear the buffer. Will need to clear the buffer based on
   ' the Field type rather than use just spaces.
   ' Clear the whole buffer assumming that every Field is ASCII. We
   ' will deal with the non-ASCII Fields after the initial clear.
   
   ' The record buffer is set to +1 length in order to accommodate
   ' an end of file character, chr$(26), that must exist after
   ' an appended record. The RecordBuffer already exists so we
   ' simply need to reset it. Use spaces up to the last character
   ' which will remain a &H1A (do not overwrite it).

   ' The ClearBuffer function does not need to ZeroMemory the record 
   ' buffer if the action is %XDB_GETRECORD because retrieving a record
   ' will overwrite it anyway, therefore the filling the record buffer
   ' with spaces is redundant.
   If @xdb.nAction <> %XDB_GETRECORD Then
      FillMemory @pDBF.pRecordBuffer, @pDBF.DBH.RecSize, 32
   End If 
   
   ' If this is a FoxPro database then there may be certain
   ' binary Fields that will need to be set to zero. We also need
   ' to reset any memo field allocated memory and block information.
   
   If (@pDBF.nFileType = %CTX_FOXPRO) Or (@pDBF.NumMemoFields > 0) Then
   
      pField = @pDBF.pFields
      
      For x = 1 To @pDBF.NumFields
          
         Select Case @pField.FieldType
            Case "Y", "T", "B"   'Currency, DateTime, Double
               Poke Double, @pDBF.pRecordBuffer + @pField.FDA, 0
        
            Case "M", "G", "I"
               Poke Long, @pDBF.pRecordBuffer + @pField.FDA, 0
    
         End Select 
         
         ' Clear any manually allocated memory in the memo field buffers
         If @pDBF.NumMemoFields Then
            MemFree @pField.pMemoText
            @pField.OrigFirstBlock = 0  ' reset
            @pField.OrigNumBlocks  = 0  ' reset
            @pField.MemoDirty      = %FALSE  ' reset
         End If
                       
         Incr pField
      Next
   
   End If
   
   ' Make an exact copy of the cleared buffer
   MemCopyD @pDBF.pRecordBuffer, @pDBF.pRecordBuffer_Original, @pDBF.DBH.RecSize


ExitOut:
   Function = @xdb.errcode 

End Function



'//
'//  Append or Update a record to the database disk file
'//
Function ctx_PutRecord_Internal( ByVal xdb As CHEETAH4_TYPE Ptr) As Long

   Local pDBF       As DBF_TYPE Ptr
   Local pBTX       As BTX_TYPE Ptr  
   Local pTAG       As INDEX_TAG_TYPE_MEMORY Ptr
   Local xdbtemp    As CHEETAH4_TYPE
   Local nRecOffset As Quad            
   Local nRecNum    As Long
   Local nNumBytes  As Long
   Local AppendFlag As Long
   Local sIndexKey  As String
   

   If @xdb.reserved = 0 Then @xdb.errcode = %ERR_DATA: GoTo ExitOut
   
   pDBF = @xdb.reserved

   ' This is a regular Put record
   nRecNum = @xdb.nData4byte
   
   ' Do a check to see if the Record Number is valid. If the number is
   ' not valid then simply append the record.
   If (nRecNum < 1) Or (nRecNum > @pDBF.DBH.RecordCount) Then
      nRecNum = @pDBF.DBH.RecordCount + 1
      AppendFlag = %TRUE
   End If   
                              
                              
   ' Copy the data being pointed at in @xdb.nData directly to the record buffer. This
   ' would be the case when a TYPE variable is used in the application. Only do this
   ' if the action is XDB_PUTRECORD. Any other function will set/modify the record
   ' buffer.
   Select Case @xdb.nAction
      Case %XDB_PUTRECORD
         If @xdb.nData Then
            MemCopyD @xdb.nData, @pDBF.pRecordBuffer, @pDBF.DBH.RecSize
            @pDBF.RecordBuffer_RecNum = nRecNum
            ' Ensure that the first byte of the record buffer is valid. Copying in
            ' a Type from the user can put an invalid byte for the 'deleted' flag.
            ' For example, a Type with an element Deleted As String * 1 will have
            ' a default value of chr$(0).
            Select Case As Long Peek( Byte, @pDBF.pRecordBuffer )
               Case 32, 42     ' space/asterisk (these are okay)
               Case Else
                  Poke Byte, @pDBF.pRecordBuffer, 32  ' change the value to a space
            End Select                 
         End If
   End Select

   
   ' Save all memo Fields to the memo file. The WriteMemo function will
   ' also write the starting memo block to the record buffer.
   If @pDBF.NumMemoFields Then
      Select Case @pDBF.nFileType
         Case %CTX_DBASE
            If ctx_WriteMemoBuffer_dBase_Internal( xdb ) Then GoTo ExitOut
         Case %CTX_FOXPRO
            If ctx_WriteMemoBuffer_FoxPro_Internal( xdb ) Then GoTo ExitOut
      End Select
   End If
         
   nRecOffset = ((nRecNum - 1) * @pDBF.DBH.RecSize) + @pDBF.DBH.HeaderLength + 1
   nNumBytes  = @pDBF.DBH.RecSize 
    
   ' Because we are appending we need to write @pDBF.DBH.RecSize + 1 in order
   ' to ensure that the chr$(26) at the end of the record buffer is written.
   If AppendFlag Then 
      If @pDBF.nFileType = %CTX_DBASE Then Incr nNumBytes
   End If   
    
   If fWriteAt( @pDBF.hFile, nRecOffset, nNumBytes, @pDBF.pRecordBuffer ) Then
      @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
   End If


   If AppendFlag Then 
      ' update the header after the successful write.
      Incr @pDBF.DBH.RecordCount 
      ctx_WriteDBFHeader_Internal xdb 
   End If
    
   ' The database record has now been added/updated so we now need to 
   ' add/update the index key (if applicable).
   pBTX = @pDBF.pFirstBTX
   Do Until pBTX = 0
       
      ' Iterate all TAGS in the index.
      pTAG = @pBTX.pFirstTAG
      
      Do Until pTAG = 0  
          
         ' Determine the original the index key for this Tag.
         sIndexKey = ctx_GenerateIndexKey_Internal( pDBF, pTAG, %TRUE )
         
         ' If we are not appending then we need to delete any
         ' existing key in the Tag that may exist for this index key.
         ' If we are appending then simply add the new key.
         If AppendFlag = %FALSE Then
            ' Attempt to delete existing key.
            @xdb.errcode = ctx_DeleteTagKey_Internal( xdb, pBTX, pTAG, sIndexKey, nRecNum )
         End If
          
         ' Create the new index key for this Tag.
         sIndexKey = ctx_GenerateIndexKey_Internal( pDBF, pTAG, %FALSE )

         ' Add the new key
         xdbtemp.nData      = StrPtr( sIndexKey )
         xdbtemp.nlen       = Len( sIndexKey )
         xdbtemp.nData4byte = nRecNum
         xdbtemp.reserved   = pTAG
         
         @xdb.errcode = ctx_InsertKey_Internal( VarPtr(xdbtemp) )
         If @xdb.errcode Then GoTo ExitOut
                
         pTAG = @pTAG.pNextTAG
      Loop
       
      pBTX = @pBTX.pNextBTX
   Loop
        
   ' Update the record buffer copy with the newly saved record information
   MemCopyD @pDBF.pRecordBuffer, @pDBF.pRecordBuffer_Original, @pDBF.DBH.RecSize
   
ExitOut:
   Function = @xdb.errcode 

End Function



'//
'//  Copy the record buffer to the user defined TYPE address
'//
Function ctx_CopyRecordBuffer_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long

   Local pDBF As DBF_TYPE Ptr

   If @xdb.nData Then
      pDBF = @xdb.reserved
      MemCopyD @pDBF.pRecordBuffer, @xdb.nData, @pDBF.DBH.RecSize
   End If                
End Function



'//
'//  Retrieve a record from the database file
'//
Function ctx_GetRecord_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long

   Local pDBF      As DBF_TYPE Ptr
   Local pField    As DBF_FIELD_TYPE Ptr
   Local RecOffset As Quad            
   Local x         As Long
   
   If @xdb.reserved = 0 Then @xdb.errcode = %ERR_DATA: GoTo ExitOut
   
   pDBF = @xdb.reserved
   
   'The Record Number is stored in @xdb.DataNumber
   If @xdb.nData4byte <= 0 Then @xdb.errcode = %ERR_RECORDNUMBER: GoTo ExitOut
   If @xdb.nData4byte > @pDBF.DBH.RecordCount Then @xdb.errcode = %ERR_RECORDNUMBER: GoTo ExitOut
   
   ' Call the ClearBuffer function in order to deallocate any existing 
   ' allocated memo memory (if applicable). The ClearBuffer function
   ' does not need to ZeroMemory the record buffer because record being
   ' read will overwrite it anyway, therefore the %XDB_GETRECORD action 
   ' checked in the ClearBuffer function.
   If ctx_ClearBuffer_Internal( xdb ) Then GoTo ExitOut
   
   ' Get the record from disk
   RecOffset = ((@xdb.nData4byte - 1) * @pDBF.DBH.RecSize) + @pDBF.DBH.HeaderLength + 1
   If fGetAt( @pDBF.hFile, RecOffset, @pDBF.DBH.RecSize, @pDBF.pRecordBuffer) Then
      @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
   End If
   @pDBF.RecordBuffer_RecNum = @xdb.nData4byte
   
   ' Make an exact copy of the record just loaded. This copy remains unchanged for
   ' the time that the record is loaded. If fields in a record are changed then we 
   ' need to use the copy of the original record in order to calculate the index
   ' key(s) that will have to be deleted prior to storing the new key(s)
   MemCopyD @pDBF.pRecordBuffer, @pDBF.pRecordBuffer_Original, @pDBF.DBH.RecSize
   
   
   ' If the user wants a copy of the record buffer then copy it now. Only do this
   ' if we are not currently in a delete/pack/zap, etc., therefore, only test for
   ' valid actions that want the buffer copied now. The other actions will have
   ' the buffer copied when their action is complete.
   Select Case @xdb.nAction
      Case %XDB_GETRECORD
         ctx_CopyRecordBuffer_Internal xdb
   End Select

   
   ' Update the Field array with information regarding any memo fields
   ' that exist in the retrieved record.
   If @pDBF.NumMemoFields Then
      
      pField = @pDBF.pFields
      
      For x = 1 To @pDBF.NumFields
   
         Select Case @pField.FieldType
            Case "M", "Z"    ' memo fields
               
               Select Case @pDBF.nFileType
                  Case %CTX_DBASE
                     @pField.OrigFirstBlock = Val(Peek$(@pDBF.pRecordBuffer + @pField.FDA, 10))
                     
                  Case %CTX_FOXPRO
                     @pField.OrigFirstBlock = Peek(Long, @pDBF.pRecordBuffer + @pField.FDA) 
               End Select
               
         End Select 
         
         Incr pField
      Next
      
   End If


ExitOut:

   Function = @xdb.errcode 

End Function

   

