

'//
'//  Determine if the field being get/set is valid for the database type (dbase/foxpro)
'//
Function ctx_IsValidField_Internal( ByVal nFileType  As Long, _
                                    ByVal sFieldType As String _
                                    ) As Long

   '// FieldTYPE //      
   ' C - Character (1 to 254 ASCII characters)
   ' Y - Currency  (8 bytes)
   ' N - Numeric   (8 bytes in memory. 1 to 20 bytes in table.  -.9999999999E+19 to .9999999999E+20)
   ' F - Float     (included for compatibility reasons. Same as Numeric)
   ' D - Date      (8 bytes. e.g. 20040719   0001-01-01 to 9999-12-31)
   ' T - DateTime  (8 bytes)
   ' B - Double    (8 bytes)
   ' I - Integer   (4 bytes)
   ' L - Logical   (True .T. or False .F. (undefined = space))
   ' M - Memo      (4 bytes. memo files have extensions of .fpt)
   ' G - General   (4 bytes. Reference to an OLE object)
   ' X - Character (1 to 254 binary characters. Must set Field_Flag)
   ' Z - Memo      (4 bytes. binary. Must set Field_Flag)
   
   If nFileType = %CTX_FOXPRO Then 
   
      ' Verify valid FoxPro fields
      If Verify(sFieldType, "CYNFDTBILMGXZ") Then
         Function = %ERR_FIELDTYPE
      End If
   
   ElseIf nFileType = %CTX_DBASE Then
   
      ' Verify valid dBase fields
      If Verify(sFieldType, "CNDLM") Then
         Function = %ERR_FIELDTYPE
      End If
   End If

End Function    


'//
'//  Create the database disk file
'//
Function ctx_CreateDatabase_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long


   Local tHeader       As DBF_HEADER_TYPE
   Local Container     As DBF_CONTAINER_TYPE
   Local MemoHeader    As DBF_MEMOHEADER_TYPE

   Local sData         As String    'the incoming data
   Local sFilename     As String
   Local nFileType     As Long      '%CTX_DBASE or %CTX_FOXPRO
   Local FieldSt       As String
   Local sDate         As String
   Local st            As String
   Local sFilenameMEMO As String
   Local MemoFileExtension As String
   Local FieldName     As String
   Local FieldType     As String
   Local FieldLen      As String
   Local FieldDec      As String
   Local ElementName   As String
   Local ElementValue  As String
   
   Local errcode       As Long
   Local nParseCount   As Long
   Local NumFields     As Long
   Local x             As Long
   Local hFile         As Long
   Local nLength       As Long
   Local nDecimal      As Long    
   Local nMemoSize     As Long
   Local HasMemoFlag   As Long   'T/F: memo Field exists
   

   ' Do some tests to ensure that the parameters were correctly
   ' filled in when the call was made.
   If (@xdb.nData = 0) Or (@xdb.nLen = 0) Then 
      @xdb.errcode= %ERR_DATA: GoTo ExitOut
   End If
   
   sData = Peek$(@xdb.nData, @xdb.nLen)

   ' The data string contains the filename and a list of Field
   ' definitions all deliminated by $DELIMITER
   nParseCount = ParseCount(sData, $DELIMITER)
   
   ' There *must* be at least the filename and one Field definition in the data string.
   If nParseCount < 2 Then @xdb.errcode = %ERR_DATA: GoTo ExitOut
   
   ' Load the elements into an array so we can parse them
   ReDim Elements(1 To nParseCount) As String
   Parse sData, Elements(), $DELIMITER
   
   ' Create an array that will hold the Field definitions. There can only
   ' be a maximum of 255 Fields in a FoxPro database.
   ReDim sField(1 To 255) As DBF_FIELD_TYPE
   NumFields = 0                    
                       
   ' Analyze the elements that were passed to this routine.
   For x = 1 To nParseCount
       ElementName = Trim$( Parse$(Elements(x), "=", 1) )
       If Len(ElementName) = 0 Then Iterate For
       
       ElementValue = Trim$( Parse$(Elements(x), "=", 2) )
       
       
       Select Case Asc(ElementName)
       
          Case 68, 100  'Dd  Disk
             sFilename = ElementValue
          
          Case 84, 116  'Tt  Type (FoxPro or dBase)
             ' The valid file types are either the traditional dBase or
             ' the newer FoxPro formats.
             Select Case UCase$(ElementValue)
                Case "FOXPRO": nFileType = %CTX_FOXPRO
                Case "DBASE":  nFileType = %CTX_DBASE
                Case Else
                   @xdb.errcode= %ERR_FILETYPE: GoTo ExitOut
             End Select   
             
          Case 77, 109  'Mm  MemoSize
             nMemoSize = Val( ElementValue )


          Case 70, 102  'Ff  Field
             Incr NumFields
             ' Only allowed a maximum of 255 Fields
             If NumFields > 255 Then @xdb.errcode = %ERR_MAXFIELDS: GoTo ExitOut
             
              FieldSt    = UCase$(ElementValue)
              
              FieldName  = Trim$( Parse$(FieldSt, ",", 1) )
              FieldType  = Trim$( Parse$(FieldSt, ",", 2) )
              FieldLen   = Trim$( Parse$(FieldSt, ",", 3) )
              FieldDec   = Trim$( Parse$(FieldSt, ",", 4) )
              nLength    = Val(FieldLen)
              nDecimal   = Val(FieldDec)
              
              '// FIELDNAME //
              sField(NumFields).FieldName = FieldName
              If Len(FieldName) = 0 Then @xdb.errcode = %ERR_FIELDNAME: GoTo ExitOut
              
              ' The first letter of the FieldName can not be a number
              st = Left$(FieldName, 1)
              If IsCharAlpha(Asc(st)) = 0 Then
                 @xdb.errcode = %ERR_FIELDNAME: GoTo ExitOut
              End If
              
              ' Validate that the field is allowed to be used with the
              ' database file format (dbase/foxpro)
              errcode = ctx_IsValidField_Internal( nFileType, FieldType )
              If errcode Then
                 @xdb.errcode = %ERR_FIELDTYPE: GoTo ExitOut
              Else
                 sField(NumFields).FieldType = FieldType
              End If
              
                       
              Select Case FieldType
                  Case "C"       ' Character
                     If nLength > 254 Then nLength = -1
                     If nLength <= 0 Then @xdb.errcode= %ERR_FIELDLENGTH: GoTo ExitOut
                     sField(NumFields).FieldLength  = nLength
                     sField(NumFields).DecimalCount = 0
              
                  Case "N", "F"  ' Numeric, Float
                     If nLength > 20 Then nLength = -1
                     If nLength <= 0 Then @xdb.errcode= %ERR_FIELDLENGTH: GoTo ExitOut
                     If nDecimal < 0 Then @xdb.errcode= %ERR_FIELDDECIMALS: GoTo ExitOut
                     If nDecimal >= nLength Then @xdb.errcode= %ERR_FIELDDECIMALS: GoTo ExitOut
                     sField(NumFields).FieldLength  = nLength
                     sField(NumFields).DecimalCount = nDecimal
        
                  Case "Y"       ' Currency
                     sField(NumFields).FieldLength  = 8
                     sField(NumFields).DecimalCount = 4
                     
                  Case "D", "T"  ' Date, DateTime
                     sField(NumFields).FieldLength  = 8
                     sField(NumFields).DecimalCount = 0
        
                  Case "B"       ' Double
                     If nDecimal > 18 Then nDecimal = -1
                     If nDecimal < 0 Then @xdb.errcode= %ERR_FIELDDECIMALS: GoTo ExitOut
                     sField(NumFields).FieldLength  = 8
                     sField(NumFields).DecimalCount = nDecimal
        
                  Case "L"       ' Logical
                     sField(NumFields).FieldLength  = 1
                     sField(NumFields).DecimalCount = 0
        
                  Case "M"       ' Memo
                     Select Case nFileType 
                        Case %CTX_DBASE
                           sField(NumFields).FieldLength  = 10  'character
                           sField(NumFields).DecimalCount = 0
                        Case %CTX_FOXPRO
                           sField(NumFields).FieldLength  = 4   'binary
                           sField(NumFields).DecimalCount = 0
                     End Select   
                     HasMemoFlag = %TRUE
                     
                  Case "G", "I"  ' General, Integer
                     sField(NumFields).FieldLength  = 4
                     sField(NumFields).DecimalCount = 0

                  Case "Z"  ' FoxPro binary memo
                     ' Actually stored in the database as a "M" Fields but with
                     ' the binary Field indicator set.
                     sField(NumFields).FieldType    = "M"
                     sField(NumFields).FieldLength  = 4
                     sField(NumFields).DecimalCount = 0
                     sField(NumFields).Field_Flags  = 4 ' &01  System column (not visible to user)
                                                        ' &02  Column can store null values
                                                        ' &04  Binary column (for CHAR and MEMO only)
                     HasMemoFlag = %TRUE

                  Case "X"  ' Foxpro binary character Field
                     ' Actually stored in the database as a "C" Fields but with
                     ' the binary Field indicator set.
                     sField(NumFields).FieldType    = "C"
                     If nLength > 254 Then nLength = -1
                     If nLength <= 0 Then @xdb.errcode = %ERR_FIELDLENGTH: GoTo ExitOut
                     sField(NumFields).FieldLength  = nLength
                     sField(NumFields).DecimalCount = 0
                     sField(NumFields).Field_Flags  = 4 ' &01  System column (not visible to user)
                                                        ' &02  Column can store null values
                                                        ' &04  Binary column (for CHAR and MEMO only)
               End Select               
             
       End Select
       
   Next
                                                  
                                                  
   ' If no valid filename was specified then abort.
   If Len(sFilename) = 0 Then @xdb.errcode = %ERR_FILENAME: GoTo ExitOut

   ' If there was not at least one Field then we can not create the database.
   If NumFields = 0 Then @xdb.errcode = %ERR_DATA: GoTo ExitOut



   '// CREATE THE ACTUAL DATABASE ON DISK //
   Select Case nFileType 
     Case %CTX_DBASE 
        If HasMemoFlag Then
           tHeader.ver       = &H83
        Else
           tHeader.ver       = &H03
        End If
     Case %CTX_FOXPRO
        tHeader.ver          = &H30
        If HasMemoFlag Then
           tHeader.table_flags  = &H02   ' flag to indicate that a memo file exists
        End If
        tHeader.codepage     = &H03   ' Windows ANSI
   End Select     
   
   sDate               = Date$  'mm-dd-yyyy
   tHeader.year         = Val( Right$(sDate, 2) )
   tHeader.month        = Val( Left$(sDate, 2) )
   tHeader.day          = Val( Mid$(sDate, 4, 2) )
   tHeader.recordcount  = 0
   tHeader.headerlength = SizeOf(DBF_HEADER_TYPE) + _
                         ( 32 * NumFields) + _
                         IIf&(nFileType=%CTX_FOXPRO, SizeOf(Container), 0) _
                         + 1

   For x = 1 To NumFields
      tHeader.recsize = tHeader.recsize + sField(x).FieldLength 
   Next
   tHeader.recsize = tHeader.recsize + 1  'add the 1 for the deleted flag
   
   ' calculate the FDA's. FoxPro seems to do this.
   sField(1).FDA = 1  'first Field is always at offset 1 because the deleted flag is at zero. 
   For x = 2 To NumFields
      sField(x).FDA = sField(x-1).FDA + sField(x-1).FieldLength 
   Next


   st = tHeader 
   For x = 1 To NumFields
       st = st & Left$( sField(x), 32 )  ' bytes after 32 are internal use
   Next                     
   
   st = st & Chr$(&H0D)   ' Terminator (standard in all xbase files)
   ' dBase files must add a EOF character (chr$(26)), and FoxPro
   ' must add the Container string.
   st = st & IIf$(nFileType=%CTX_FOXPRO, Container, Chr$(&H1A) )
   
   
   '// Create the actual database on disk //            
   If Dir$(sFilename) > "" Then Kill sFilename: ErrClear
   
   If FOpen( sFilename, 2, 4, hFile ) Then
      'error occurred during creation
      @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
   Else
      If fWriteAt(hFile, 1, Len(st), StrPtr(st)) Then
         @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
      End If
      fclose hFile
   End If
                             
   ' If a Memo file needs to be created then do so now.
   If HasMemoFlag Then

       MemoFileExtension = IIf$(nFileType = %CTX_DBASE, ".dbt", ".fpt")

       x = InStr(-1, sFilename, ".") 
       If x Then
          sFilenameMEMO = Left$(sFilename, x-1) & MemoFileExtension
       Else
          sFilenameMEMO = sFilename & MemoFileExtension
       End If
       If Dir$(sFilenameMEMO) > "" Then Kill sFilenameMEMO
       
       If nFileType = %CTX_DBASE Then  
          MemoHeader.NextFreeBlock  = 1
          MemoHeader.BlockSize      = %MEMO_BLOCK_SIZE
          MemoHeader.MemVersion     = &H03
       ElseIf nFileType = %CTX_FOXPRO Then
          ' If the specified blocksize is zero then make it the default size.
          If nMemoSize <= 0 Then nMemoSize = 64  ' 64 bytes seems to be the default in Visual FoxPro
          If nMemoSize < 16 Then nMemoSize = 16  ' seems memos must be at least 16 bytes

          If nMemoSize > %MEMO_BLOCK_SIZE Then 
             MemoHeader.NextFreeBlock  = SwapBytesDWord( 1 )  'convert to Big endian
          Else   
             MemoHeader.NextFreeBlock  = SwapBytesDWord( %MEMO_BLOCK_SIZE \ nMemoSize)  'convert to Big endian
          End If
          MemoHeader.BlockSize = SwapBytesWord( nMemoSize)    'convert to Big endian. 
       End If
       
       If FOpen( sFilenameMEMO, 2, 4, hFile ) Then
          ' error occurred during creation
          @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
       Else    
          If fWriteAt(hFile, 1, SizeOf(MemoHeader), VarPtr(MemoHeader)) Then
             ' error occurred during writing the data
             @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
          End If
          ' dBase memo header is initially terminated by an eof &H1A character
          If nFileType = %CTX_DBASE Then                            
             st = Chr$( &H1A )
             If fWriteAt(hFile, SizeOf(MemoHeader) + 1, 1, StrPtr(st)) Then
                ' error occurred during writing the data
                @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
             End If   
          End If
          fclose hFile
       End If

   End If


ExitOut:
   Function = @xdb.errcode
         
End Function





'//
'//  Open the database disk file
'//
Function ctx_OpenDatabase_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long 

   Local Container     As DBF_CONTAINER_TYPE
   Local pDBF          As DBF_TYPE Ptr
   Local pField        As DBF_FIELD_TYPE Ptr
   
   Local sData          As String   'the incoming data
   Local sFilename      As String
   Local ElementName    As String
   Local ElementValue   As String
   Local FieldLookup    As String
                       
   Local x              As Long
   Local nParseCount    As Long
   Local hFile          As Long
   Local AccessMode     As Long
   Local ShareMode      As Long  
   
   
   ' Do some tests to ensure that the parameters were correctly
   ' filled in when the call was made.
   If (@xdb.nData = 0) Or (@xdb.nLen = 0) Then 
      @xdb.errcode = %ERR_DATA: GoTo ExitOut
   End If
   
   sData = Peek$(@xdb.nData, @xdb.nLen)
   
   ' The data string contains the filename and a list of Field
   ' definitions all deliminated by $DELIMITER
   nParseCount = ParseCount(sData, $DELIMITER)
   
   ' There *must* be at least the filename
   If nParseCount < 1 Then @xdb.errcode = %ERR_DATA: GoTo ExitOut
   
   ' Load the elements into an array so we can parse them
   ReDim Elements( 1 To nParseCount ) As String
   Parse sData, Elements(), $DELIMITER

   ' Set the default Access and Share modes in case they are
   ' not specified in the incoming string definition.
   AccessMode = 2             
   ShareMode  = 4

   
   ' Analyze the elements that were passed to this routine.
   For x = 1 To nParseCount
       ElementName = Trim$( Parse$(Elements(x), "=", 1) )
       If Len(ElementName) = 0 Then Iterate For
       
       ElementValue = Trim$( Parse$(Elements(x), "=", 2) )
       
       
       Select Case Asc(ElementName)

          Case 68, 100  'Dd  Disk
             '// FILENAME //
             sFilename = ElementValue

          Case 65, 97   'Aa  Access Mode
             AccessMode = Val( ElementValue )
             
          Case 83, 115  'Ss  Share Mode   
             ShareMode  = Val( ElementValue )

       End Select
   Next    

   
   ' Do some filename checks
   If Len(sFilename)  = 0  Then @xdb.errcode = %ERR_FILENAME: GoTo ExitOut
   If Dir$(sFilename) = "" Then @xdb.errcode = %ERR_FILENAME: GoTo ExitOut

   ' Do some mode checks
   If (AccessMode < 0) Or (AccessMode > 2) Then @xdb.errcode = %ERR_ACCESSMODE: GoTo ExitOut
   If (ShareMode < 1)  Or (ShareMode > 4)  Then @xdb.errcode = %ERR_SHAREMODE: GoTo ExitOut
   
   
   ' Open the database. 
   If fOpen( sFilename, AccessMode, ShareMode, hFile ) Then
      @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
   End If   

   
   ' A database has now been opened. Allocate a new DBF_TYPE struture to hold
   ' all of the information related to this database. Also allocate space in the
   ' system type that oversees all high level interaction.
   @xdb.reserved = MemAlloc( SizeOf(DBF_TYPE) )
   If @xdb.reserved = 0 Then @xdb.errcode = %ERR_MEMORYALLOC: GoTo ExitOut
   
   pDBF = @xdb.reserved
   
   @pDBF.hFile = hFile


   ' Get the Database header from disk.
   If ctx_ReadDBFHeader_Internal( xdb ) Then
      @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
   End If
   
   ' Determine is this is a valid file type for Cheetah to handle
   Select Case Long @pDBF.DBH.ver
      Case &H03, &H83  'dbase
         @pDBF.nFileType = %CTX_DBASE
         @pDBF.NumFields = (@pDBF.DBH.HeaderLength - SizeOf(@pDBF.DBH)) \ 32
      Case &H30        'foxpro
         @pDBF.nFileType = %CTX_FOXPRO
         @pDBF.NumFields = (@pDBF.DBH.HeaderLength - SizeOf(Container) - SizeOf(@pDBF.DBH)) \ 32
      Case Else
         @xdb.errcode = %ERR_FILETYPE: GoTo ExitOut
   End Select                         
   

   ' Valid last modified date?
   If (@pDBF.DBH.Year < 00) Or (@pDBF.DBH.Month > 12) Or _
      (@pDBF.DBH.Month = 0) Or (@pDBF.DBH.Day > 31) Or _
      (@pDBF.DBH.Day = 0) Then
       @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
   End If


   ' Establish number of Fields
   If @pDBF.NumFields < 1 Then
      @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
   Else
      @pDBF.pFields = MemAlloc( SizeOf(DBF_FIELD_TYPE) * @pDBF.NumFields )
   End If
                             
   ' Load the Field definitions 
   pField = @pDBF.pFields
   For x = 1 To @pDBF.NumFields 
       If fGetAt( hFile, _
                  SizeOf(@pDBF.DBH) + 1 + ( 32 * (x-1) ), _
                  32, _
                  pField ) Then
          @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
       End If                     
       Incr pField
   Next    
   
 
   ' Initialize the record buffer 
   MemString @pDBF.pRecordBuffer, Space$( @pDBF.DBH.RecSize ) & Chr$(26) 
   ' Make a copy of the record buffer
   MemString @pDBF.pRecordBuffer_original, @pDBF.@pRecordBuffer
   
   ' ctx_ClearBuffer_Internal xdb simply clears the RecordBuffer. It does
   ' not allocate any memory for the buffer itself - it assumes that the
   ' buffer already exists.
    
    
   ' Iterate the fields and create a formatting mask for all numeric
   ' fields (this saves a lot of time not having to generate the mask
   ' everytime an AssignField function is called). Also, create a lookup
   ' string based on the field name. Fieldnames to be found at least 50%
   ' faster than looping through the array using for/next. An Instr search is used.
   FieldLookup = Space$(12)                        
   pField = @pDBF.pFields
   For x = 1 To @pDBF.NumFields
      FieldLookup = FieldLookup & " " & LSet$(@pField.FieldName, 11)
       
      If InStr(1, "NF", @pField.FieldType) Then
         If @pField.DecimalCount = 0 Then
            @pField.FormatMask = "#"   
         Else
            @pField.FormatMask = "#" & "." & String$( @pField.DecimalCount, "0") 
         End If
      End If
   
      If InStr(1, "M", @pField.FieldType) Then
         Incr @pDBF.NumMemoFields 
      End If   
      Incr pField
   Next
   MemString @pDBF.pFieldLookup, FieldLookup


   ' If a memo Field exists then try to open the memo file. If the memo
   ' file does not exist then throw an error.
   If @pDBF.NumMemoFields Then

      'get the filename without the extension
      x = InStr(-1, sFilename, ".")
      If x Then
         sFilename = Left$(sFilename, x - 1) & _
                     IIf$(@pDBF.nFileType = %CTX_DBASE, ".dbt", ".fpt")
      End If

      ' If the memo file exists then open it
      If Dir$(sFilename) = "" Then
         @xdb.errcode = %ERR_MISSINGMEMO: GoTo ExitOut
      
      Else
      
         ' Open the memo file
         If fOpen(ByVal sFilename, 2, 4, hFile) Then
            @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
         End If
         
         ' Save the memo handle for future use
         @pDBF.hFileMemo = hFile
         
         ' Load the Memo header
         If ctx_ReadMemoHeader_Internal( xdb ) Then GoTo ExitOut
         
      End If

   End If


   ' Add this new database object into the linked list of other database objects.
   ' Link the current dbf to the dbf that was the previous first link. The previous
   ' first dbf is now the second dbf. This will add the database to the linked list.
   @pDBF.pNextDBF      = workspace.pFirstDBF
   workspace.pFirstDBF = @xdb.Reserved
   Incr workspace.NumOpenDatabases                              
   
ExitOut:
   If @xdb.errcode Then
      If pDBF Then 
         fClose @pDBF.hFile
         ctx_DeallocateDBFmemory pDBF
      End If   
      @xdb.reserved = 0
   End If
   Function = @xdb.errcode
    
End Function




Function ctx_CloseDatabase_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long 
   
   Local pDBF       As DBF_TYPE Ptr
   Local pSearchDBF As DBF_TYPE Ptr
   Local pNextDBF   As DBF_TYPE Ptr
   Local xdbtemp    As CHEETAH4_TYPE 
   Local pBTX       As BTX_TYPE Ptr
   
   ' It is possible that CloseDatabase can/will be called when no
   ' database has ever been opened. In that scenario then no pointer
   ' exists in .reserved. Simply exit without throwing an error.
   If @xdb.reserved = 0 Then GoTo ExitOut
   pDBF = @xdb.reserved
   
   ' Close the database file
   fClose @pDBF.hFile

   ' Close any associated Memo file
   fClose @pDBF.hFileMemo 
   
   ' Close any associated indexes    
   pBTX = @pDBF.pFirstBTX
   Do Until pBTX = 0
      xdbtemp.reserved = pBTX
      pBTX = @pBTX.pNextBTX
      If ctx_CloseIndex_Internal( VarPtr(xdbtemp) ) Then GoTo ExitOut
   Loop
   
   
   ' Adjust the linked list to remove this dbf.
   ' Because this is a single linked list, we need to find the node
   ' that is immediately before the dbf that we are interested in. Start
   ' at the Workspace variable.

   pNextDBF = @pDBF.pNextDBF  'next DBF in the chain
   
   If workspace.pFirstDBF = @xdb.reserved Then
      workspace.pFirstDBF = pNextDBF
   Else   
      pSearchDBF = workspace.pFirstDBF
      Do Until pSearchDBF = 0
         If @pSearchDBF.pNextDBF = @xdb.reserved Then
            ' Make the most previous dbf point to the dbf immediately after
            ' the dbf that we are deleting.
            @pSearchDBF.pNextDBF = pNextDBF
            Exit Do
         End If                          
         pSearchDBF = @pSearchDBF.pNextDBF
      Loop
   End If
   
   'DeAllocate any manually allocated memory.
   ctx_DeallocateDBFmemory pDBF              
   
   Decr workspace.NumOpenDatabases
       

ExitOut:
   Function = @xdb.errcode 
    
End Function



'//
'//  Write the database header to the disk file
'//
Function ctx_WriteDBFHeader_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long

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

   pDBF = @xdb.reserved

   ' Write the Header Last modified date
   sDate           = Date$  'mm-dd-yyyy
   @pDBF.DBH.year  = Val( Right$(sDate, 2) )
   @pDBF.DBH.month = Val( Left$(sDate, 2) )
   @pDBF.DBH.day   = Val( Mid$(sDate, 4, 2) )
   
   'write the header
   If fWriteAt( @pDBF.hFile, 1, SizeOf(@pDBF.DBH), VarPtr(@pDBF.DBH) ) Then
      @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
   End If


ExitOut:
   Function = @xdb.errcode 

End Function



'//
'//  Read the database header from the disk file
'//
Function ctx_ReadDBFHeader_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

   ' Read the header
   If fGetAt( @pDBF.hFile, 1, SizeOf(@pDBF.DBH), VarPtr(@pDBF.DBH) ) Then
      @xdb.errcode = %ERR_FILEACCESS: GoTo ExitOut
   End If
   

ExitOut:
   Function = @xdb.errcode 

End Function



