
'//
'//  Check the currently loaded database record to determine if it is marked for deletion.
'//
Function ctx_IsDeleted_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long

   Local pDBF As DBF_TYPE Ptr
   
   If @xdb.reserved = 0 Then @xdb.errcode = %ERR_DATA: GoTo ExitOut

   pDBF  = @xdb.reserved

   ' Test to ensure that a vaild record has been loaded in the record buffer.
   If @pDBF.RecordBuffer_RecNum <= 0 Then @xdb.errcode = %ERR_RECORDNUMBER: GoTo ExitOut
   If @pDBF.RecordBuffer_RecNum > @pDBF.DBH.RecordCount Then @xdb.errcode = %ERR_RECORDNUMBER: GoTo ExitOut

   ' Store the result in the nLen element because the other elements
   ' are using when DeleteRecord/RecallRecord is called.
   @xdb.nLen = IIf( Peek( Byte, @pDBF.pRecordBuffer ) = 32, %FALSE, %TRUE )
         
ExitOut:
   Function = @xdb.errcode
   
End Function


'//
'//  UnDelete the currently loaded database record 
'//
Function ctx_RecallRecord_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long
   
   Local pDBF       As DBF_TYPE Ptr
   Local nRecOffset As Long
   Local nNumBytes  As Long
   Local IsDeleted  As Long
   
   If @xdb.reserved = 0 Then @xdb.errcode = %ERR_DATA: GoTo ExitOut

   pDBF  = @xdb.reserved
   
   ' Test to ensure that a vaild record has been loaded in the record buffer.
   If @pDBF.RecordBuffer_RecNum <= 0 Then @xdb.errcode = %ERR_RECORDNUMBER: GoTo ExitOut
   If @pDBF.RecordBuffer_RecNum > @pDBF.DBH.RecordCount Then @xdb.errcode = %ERR_RECORDNUMBER: GoTo ExitOut

   ' Check to see if the specified record is deleted.
   If ctx_IsDeleted_Internal( xdb ) Then GoTo ExitOut  ' error occurred
   IsDeleted = @xdb.nLen
   
   ' If marked for deletion then unmark it and write the data back to disk.
   If IsDeleted Then
      
      Poke Byte, @pDBF.pRecordBuffer, 32   ' space

      ' Attempt to copy the record buffer to the user defined TYPE address (if applicable)
      ctx_CopyRecordBuffer_internal xdb
      
      ' Write the record buffer back to disk
      nRecOffset = ((@pDBF.RecordBuffer_RecNum - 1) * @pDBF.DBH.RecSize) + @pDBF.DBH.HeaderLength + 1
      nNumBytes  = @pDBF.DBH.RecSize 
      If fWriteAt( @pDBF.hFile, nRecOffset, nNumBytes, @pDBF.pRecordBuffer ) Then
         @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
      End If
   
   End If
   

ExitOut:
   Function = @xdb.errcode 
   
End Function




'//
'//  Delete the currently loaded database record
'//
Function ctx_DeleteRecord_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long
   
   Local pDBF       As DBF_TYPE Ptr
   Local nRecOffset As Long
   Local nNumBytes  As Long
   Local IsDeleted  As Long
   
   If @xdb.reserved = 0 Then @xdb.errcode = %ERR_DATA: GoTo ExitOut

   pDBF  = @xdb.reserved
   
   ' Test to ensure that a vaild record has been loaded in the record buffer.
   If @pDBF.RecordBuffer_RecNum <= 0 Then @xdb.errcode = %ERR_RECORDNUMBER: GoTo ExitOut
   If @pDBF.RecordBuffer_RecNum > @pDBF.DBH.RecordCount Then @xdb.errcode = %ERR_RECORDNUMBER: GoTo ExitOut

   ' Check to see if the specified record is deleted.
   If ctx_IsDeleted_Internal( xdb ) Then GoTo ExitOut
   IsDeleted = @xdb.nLen
   
   ' If not marked for deletion then mark it and write the data back to disk.
   If IsDeleted = %FALSE Then
      
      Poke Byte, @pDBF.pRecordBuffer, 42  ' asterisk
      
      ' Attempt to copy the record buffer to the user defined TYPE address  
      ctx_CopyRecordBuffer_internal xdb
      
      ' Write the record buffer back to disk
      nRecOffset = ((@pDBF.RecordBuffer_RecNum - 1) * @pDBF.DBH.RecSize) + @pDBF.DBH.HeaderLength + 1
      nNumBytes  = @pDBF.DBH.RecSize 
      If fWriteAt( @pDBF.hFile, nRecOffset, nNumBytes, @pDBF.pRecordBuffer ) Then
         @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
      End If
   
   End If
   

ExitOut:
   Function = @xdb.errcode 

End Function


      

'//
'//  Remove deleted records from the database file.
'//
Function ctx_PackDatabase_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long
   
   Local pDBF         As DBF_TYPE Ptr  
   Local pField       As DBF_FIELD_TYPE Ptr 
   Local xdbtemp      As CHEETAH4_TYPE
   Local nGoodRecs    As Long
   Local nHad_Deleted As Long
   Local nRec         As Long 
   Local nRecOff      As Quad
   Local sBlankMemo   As String
   Local x            As Long
   
   
   ' Do some tests to ensure that the parameters were correctly
   ' filled in when the call was made.
   If @xdb.reserved = 0 Then @xdb.errcode = %ERR_DATA: GoTo ExitOut
   
   pDBF = @xdb.reserved


   ' Packing routine uses a smart packing technique where the good
   ' records are copied over the bad. Based on Ethan Winer's book.
   nGoodRecs    = 0
   nHad_Deleted = %FALSE


   For nRec = 1 To @pDBF.DBH.RecordCount

      @xdb.nData      = 0        ' prevent record from being copied to user TYPE
      @xdb.nData4byte = nRec     ' record number to get
      If ctx_GetRecord_Internal( xdb ) Then GoTo ExitOut
        
      ' Determine if the record is marked for deletion or not.
      If Peek( Byte, @pDBF.pRecordBuffer ) = 32 Then  'not deleted b/c it is a space.
         Incr nGoodRecs
           
         ' Only need to put the record if it is in a position
         ' different than from where it came.
         If nGoodRecs <> nRec Then
            @xdb.nData4byte = nGoodRecs  'record number to put
            If ctx_PutRecord_Internal( xdb ) Then GoTo ExitOut
         End If
              
      Else
         ' Set flag that one or more records were removed. This signals
         ' that we must re-index.
         nHad_Deleted = %TRUE
          
         ' The record was deleted so process any related memo entries.
         If @pDBF.NumMemoFields Then

            pField = @pDBF.pFields 

            For x = 1 To @pDBF.NumFields
               
               If ctx_IsMemoField_Internal( pField ) Then
                  sBlankMemo = ""
                  
                  @xdb.nData4byte = x
                  @xdb.nData      = StrPtr( sBlankMemo )
                  @xdb.nLen       = Len( sBlankMemo )                          
                  
                  If ctx_SetField_Internal( xdb ) Then GoTo ExitOut
   
                  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
               
               Incr pField
            Next
            
            
         End If

      End If

   Next

   If nHad_Deleted = %TRUE Then  
       ' Update the header and write it to disk.
      @pDBF.DBH.RecordCount = nGoodRecs        
    
      If ctx_WriteDBFHeader_Internal( xdb ) Then GoTo ExitOut
      
      nRecOff = (nGoodRecs * @pDBF.DBH.RecSize) + @pDBF.DBH.HeaderLength + 1

      @xdb.errcode = ctx_SetEndOfFile_Internal( @pDBF.hFile, nRecOff, %TRUE )
      If @xdb.errcode Then GoTo ExitOut
                         
      ' Must reindex if records were deleted
      xdbtemp.reserved = pDBF
      @xdb.errcode = ctx_Reindex_Internal( VarPtr(xdbtemp) )
      If @xdb.errcode Then GoTo ExitOut
      
   End If
   
   ' Invalidate the record buffer
   If ctx_ClearBuffer_Internal( xdb ) Then GoTo ExitOut
   
   
ExitOut:
   Function = @xdb.errcode 

End Function



'//
'//  Remove all records from the database file.
'//
Function ctx_ZapDatabase_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long
   
   Local pDBF       As DBF_TYPE Ptr
   Local nRecOff    As Quad
   Local nBlockSize As Long
   
   ' Do some tests to ensure that the parameters were correctly
   ' filled in when the call was made.
   If @xdb.reserved = 0 Then @xdb.errcode = %ERR_DATA: GoTo ExitOut
   
   pDBF = @xdb.reserved
   
   '// DATABASE 
      ' Update the database header and write it to disk.
      @pDBF.DBH.RecordCount = 0        
      If ctx_WriteDBFHeader_Internal( xdb ) Then ExitOut
                                  
      ' Truncate the database
      ' Set the end of file by chopping off the file at this point
      nRecOff = @pDBF.DBH.HeaderLength + 1
      
      @xdb.errcode = ctx_SetEndOfFile_Internal( @pDBF.hFile, nRecOff, IIf&(@pDBF.nFileType = %CTX_DBASE, %TRUE, %FALSE) )
      If @xdb.errcode Then GoTo ExitOut


   '// MEMO FILE
      If @pDBF.hFileMemo Then
         nBlockSize = SwapBytesWord( @pDBF.DBH_MEMO.BlockSize )

         ' Update the memo file header and write it to disk.
         Type Set @pDBF.DBH_MEMO = ""       ' clear the type
 
         If @pDBF.nFileType = %CTX_DBASE Then  
             @pDBF.DBH_MEMO.NextFreeBlock  = 1
             @pDBF.DBH_MEMO.BlockSize      = 512
             @pDBF.DBH_MEMO.MemVersion     = &H03
          ElseIf @pDBF.nFileType = %CTX_FOXPRO Then
             @pDBF.DBH_MEMO.NextFreeBlock  = SwapBytesDWord( %MEMO_BLOCK_SIZE / nBlockSize)  'convert to Big endian
             @pDBF.DBH_MEMO.BlockSize      = SwapBytesWord( nBlockSize)         'convert to Big endian. 64 bytes seems to be Visual FoxPro's default
          End If

         If ctx_WriteMemoHeader_Internal( xdb ) Then ExitOut
                                     
         ' Set the end of file by chopping off the file at this point
         nRecOff = SizeOf( @pDBF.DBH_MEMO ) + 1

         @xdb.errcode = ctx_SetEndOfFile_Internal( @pDBF.hFileMemo, nRecOff, IIf&(@pDBF.nFileType = %CTX_DBASE, %TRUE, %FALSE) )
         If @xdb.errcode Then GoTo ExitOut

      End If
      
   ' Invalidate the record buffer
   If ctx_ClearBuffer_Internal( xdb ) Then GoTo ExitOut

ExitOut:
   Function = @xdb.errcode 
   
End Function


'//
'//  Shutdown the entire Cheetah system by closing and deallocating 
'//  memory for all files.
'//
Function ctx_Shutdown_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long

   ' The Shutdown function will access the global WS (Workspace)
   ' variable and use it to deallocate any memory for all objects.
   Local pDBF       As DBF_TYPE Ptr
   Local pNextDBF   As DBF_TYPE Ptr
   Local dbf        As CHEETAH4_TYPE 

   ' Cycle through all active DBF's and deallocate any memory that
   ' was maually allocated via MemAlloc.
   pDBF = workspace.pFirstDBF
   Do Until pDBF = 0
      
      ' Get the pointer to the next DBF in the linked list.
      pNextDBF = @pDBF.pNextDBF

      ' pDBF is now a pointer to the DBF structure. DeAllocate any
      ' memory for this DBF
      dbf.reserved  = pDBF
      dbf.nAction   = %XDB_CLOSEDATABASE   ' will close all indexes as well
      ctx_CloseDatabase_Internal VarPtr( dbf )
      
      ' Go to the next DBF
      pDBF = pNextDBF
   Loop 
    

ExitOut:
   If @xdb.errcode Then 
      Function = -1
   Else
      Function = 0
   End If
    
End Function
                                            
                                            

'//
'//  Free memory held by a specific database
'//
Function ctx_DeallocateDBFmemory( ByVal pDBF As DBF_TYPE Ptr ) As Long
    
   Local pField As DBF_FIELD_TYPE Ptr
   Local x      As Long
    
   ' Free any memory associated with temporary memo entries.
   If @pDBF.NumMemoFields Then
      pField = @pDBF.pFields
      For x = 1 To @pDBF.NumMemoFields
          MemFree @pField.pMemoText
          Incr pField
      Next
   End If
    
   'Deallocate any memory that was allocated manually.
   MemFree @pDBF.pFieldLookup
   MemFree @pDBF.pRecordBuffer
   MemFree @pDBF.pRecordBuffer_original
   MemFree @pDBF.pFields 

   MemFree pDBF
    
End Function



'//
'//  Retrieves statistical performance information 
'//
Function ctx_Stats_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long

   Local pDBF    As DBF_TYPE Ptr
   Local stats   As CHEETAH4_STATS_TYPE Ptr

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

   pDBF  = @xdb.reserved
   stats = @xdb.nData
   
   ' Copy the stats to the user specified memory structure
   @stats.RecordCount      = @pDBF.DBH.RecordCount
   @stats.RecordSize       = @pDBF.DBH.RecSize
   @stats.FieldCount       = @pDBF.NumFields


ExitOut:
   Function = @xdb.errcode 

End Function
