

'//
'//  Set the value of a specified database record field
'//
Function ctx_IsMemoField_Internal( ByVal pField As DBF_FIELD_TYPE Ptr ) As Long

   ' Determines if the incoming field is a Memo field.
   
   Select Case @pField.FieldType
      Case "M", "G", "P" 
         Function = %TRUE
   End Select
         
End Function





'//
'//  Set the value of a specified database record field
'//
Function ctx_SetField_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long

   Local pDBF      As DBF_TYPE Ptr
   Local sData     As String
   Local nFieldNum As Long
   

   ' Do some tests to ensure that the parameters were correctly
   ' filled in when the call was made.
   If @xdb.nData    = 0 Then @xdb.errcode = %ERR_DATA: GoTo ExitOut
   If @xdb.reserved = 0 Then @xdb.errcode = %ERR_DATA: GoTo ExitOut
   
   pDBF = @xdb.reserved

   nFieldNum = @xdb.nData4byte - 1  ' b/c pointer array is zero based

   Select Case As Long Asc( @pDBF.@pFields[nFieldNum].FieldType )
      Case 67, 68   ' "C", "D"
         ' Make sure that the incoming field data is the correct length so that
         ' it will fully overwrite any existing data.
         If @xdb.nLen < @pDBF.@pFields[nFieldNum].FieldLength Then
            sData = LSet$( Peek$(@xdb.nData, @xdb.nLen), @pDBF.@pFields[nFieldNum].FieldLength )
            @xdb.nData = StrPtr(sData)
            @xdb.nLen  = Len(sData)
         End If
         MemCopyD @xdb.nData, _
                  @pDBF.pRecordBuffer + @pDBF.@pFields[nFieldNum].FDA, _
                  @xdb.nLen                          

      Case 78, 70  '"N", "F"
         sData = Format$( Val(Peek$(@xdb.nData, @xdb.nLen)), @pDBF.@pFields[nFieldNum].FormatMask) 
         ' rset the result in the Field
         sData = RSet$(sData, @pDBF.@pFields[nFieldNum].FieldLength)
         MemCopyD StrPtr(sData), _
                  @pDBF.pRecordBuffer + @pDBF.@pFields[nFieldNum].FDA, _
                  Len(sData)
     
      Case 76 'L
         sData = Peek$(@xdb.nData, @xdb.nLen)
         ' Only accept the following values TFYN. If Y/N is entered then change
         ' it to T/F.
         Select Case UCase$(sData)
            Case "T", "F"  ' these are okay as is.
            Case "Y": sData = "T"
            Case "N": sData = "F" 
            Case "1": sData = "T"
            Case "0": sData = "F"
            Case Else
               sData = " "
         End Select      
         MemCopyD StrPtr(sData), _
                  @pDBF.pRecordBuffer + @pDBF.@pFields[nFieldNum].FDA, _
                  Len(sData)                          
     

      Case 89, 84, 66  'Y, T, B
        @xdb.nLen = 8
        MemCopyD @xdb.nData, _
                 @pDBF.pRecordBuffer + @pDBF.@pFields[nFieldNum].FDA, _
                 @xdb.nLen                          
       
      Case 73  ' I
        @xdb.nLen = 4
        MemCopyD @xdb.nData, _
                 @pDBF.pRecordBuffer + @pDBF.@pFields[nFieldNum].FDA, _
                 @xdb.nLen                          

      Case 77 ' M  memo Field (save to temporary buffer rather than directly in record buffer
        ' The data is put into the temporary buffer and written to disk when the PutRecord
        ' call is made. A generic function is used that will load the memo buffer either
        ' based on user supplied data or from the memo file itself.
        ' %CTX_MEMO_USER = user supplied setField.
        ' %CTX_MEMO_DISK = get the data from disk file.
        Select Case @pDBF.nFileType
           Case %CTX_DBASE            
              If ctx_SetMemoBuffer_dBase_Internal( xdb, %CTX_MEMO_USER ) Then GoTo ExitOut
          
           Case %CTX_FOXPRO
              If ctx_SetMemoBuffer_FoxPro_Internal( xdb, %CTX_MEMO_USER ) Then GoTo ExitOut
          
        End Select   
       
            
   End Select
   
   
ExitOut:
   Function = @xdb.errcode 

End Function



'//
'//  Get the value of a specified database record field
'//
Function ctx_GetField_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long

   Local pDBF      As DBF_TYPE Ptr
   Local nFieldNum 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

   'Ensure that the Field number is valid.
   If (@xdb.nData4byte < 1) Or (@xdb.nData4byte > @pDBF.NumFields) Then
      @xdb.errcode = %ERR_FIELDNUMBER: GoTo ExitOut
   End If
   
   nFieldNum = @xdb.nData4byte - 1  ' b/c pointer array is zero based

   @xdb.nData = @pDBF.pRecordBuffer + @pDBF.@pFields[nFieldNum].FDA 

   Select Case Long Asc( @pDBF.@pFields[nFieldNum].FieldType )

      Case 67, 68, 78, 70, 76  ' "C", "D", "N", "F", "L"
         @xdb.nLen  = @pDBF.@pFields[nFieldNum].FieldLength
       
      Case 89, 84, 66  'Y, T, B
         @xdb.nData8byte = Peek(Double, @xdb.nData)
       
      Case 73  ' I
         @xdb.nData4byte = Peek(Long, @xdb.nData)
              
'// ******* NEEDS TO BE FINISHED !!!!!!! ********     
      Case 77  'M
      ' M - Memo      (4 bytes. memo files have extensions of .fpt)
      ' G - General   (4 bytes. Reference to an OLE object)
      ' C - Character (1 to 254 binary characters. Must set Field_Flag)
      ' M - Memo      (4 bytes. binary. Must set Field_Flag)
      ' P - Picture
         
         ' Get the memo from disk. Return the memory address and
         ' length to the calling program.
         Select Case @pDBF.nFileType
            Case %CTX_DBASE
               If ctx_SetMemoBuffer_dBase_Internal( xdb, %CTX_MEMO_DISK ) Then GoTo ExitOut
               @xdb.nData = @pDBF.@pFields[nFieldNum].pMemoText
               @xdb.nLen  = @pDBF.@pFields[nFieldNum].MemoTextLength - 2
               
            Case %CTX_FOXPRO
               If ctx_SetMemoBuffer_FoxPro_Internal( xdb, %CTX_MEMO_DISK ) Then GoTo ExitOut
               @xdb.nData = @pDBF.@pFields[nFieldNum].pMemoText + SizeOf(DBF_MEMOBLOCK_TYPE)
               @xdb.nLen  = @pDBF.@pFields[nFieldNum].MemoTextLength - SizeOf(DBF_MEMOBLOCK_TYPE) 
            
         End Select
              
      Case Else
         @xdb.errcode = %ERR_FIELDTYPE: GoTo ExitOut
     
   End Select
   
   
ExitOut:
   If @xdb.errcode Then 
      @xdb.nData = 0
      @xdb.nLen  = 0
      Function = @xdb.errcode
   End If
End Function



'//
'//  Retrieve information about a particular field type
'//
Function ctx_FieldInfo_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long
   
   Local pDBF       As DBF_TYPE Ptr
   Local pField     As DBF_FIELD_TYPE Ptr
   Local pFieldInfo As CHEETAH4_FIELD_TYPE Ptr
   Local nFieldNum  As Long
   
   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
   
   ' The Field Number must be valid otherwise throw an error.
   If (@xdb.nData4byte < 1) Or (@xdb.nData4byte > @pDBF.NumFields) Then
      @xdb.errcode = %ERR_FIELDNUMBER:  GoTo ExitOut
   End If   
   
   nFieldNum = @xdb.nData4byte - 1  'b/c indexed pointers are zero based

   pField     = @pDBF.pFields
   pFieldInfo = @xdb.nData
   
   @pFieldInfo.FieldName     = @pField[nFieldNum].FieldName
   @pFieldInfo.FieldType     = @pField[nFieldNum].FieldType
   @pFieldInfo.FieldLength   = @pField[nFieldNum].FieldLength
   @pFieldInfo.FieldDecimals = @pField[nFieldNum].DecimalCount

ExitOut:
   Function = @xdb.errcode 

End Function


'//
'//  Retrieve the Field number based on the Field name
'//
Function ctx_FieldNumber_Internal( ByVal xdb As CHEETAH4_TYPE Ptr ) As Long
   
   Local pDBF   As DBF_TYPE Ptr
   Local nFound As Long
   Local mData  As String
   
   ' 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
   If @xdb.reserved = 0 Then
      @xdb.errcode = %ERR_DATA: GoTo ExitOut
   End If
   
   mData = Space$(12)
      
   ' Insert the Field name into the lookup buffer. This is faster
   ' than creating a string through concatenation.
   Mid$(mData, 2, @xdb.nLen) = UCase$(Peek$(@xdb.nData, @xdb.nLen))
   
   pDBF = @xdb.reserved
   
   nFound = InStr(1, @pDBF.@pFieldLookup, mData) \ 12
   
   If nFound = 0 Then
      @xdb.errcode = %ERR_FIELDNUMBER: GoTo ExitOut
   Else
      @xdb.nData4byte = nFound
   End If   
   
   
ExitOut:
   Function = @xdb.errcode 

End Function


