(*****************************************************************************)
(* MODULE: BTRCONV                                                           *)
(* RIGHTS: Reggatta Systems - COPYRIGHT 1995 - 2000                          *)
(* DESCR.: This module contains the data field conversion routines           *)
(*****************************************************************************)
Unit BtrConv;
{$I BSE.INC}
{$I BAPI.INC}
Interface
Uses
  Windows,
  BDE,

  BseTypes,
  BtrTypes;


Const
  TRANSACTIONSCONCURRENT  : Boolean  = TRUE;
  IGNORE_READFIELD_ERR    : Boolean  = FALSE;
  IGNORE_WRITEFIELD_ERR   : Boolean  = FALSE;
  PSQLBITFIELDMODE        : Boolean  = TRUE;

  SMALLINTASBYTE          : Boolean  = FALSE;
  IGNORESQLDATABASES      : Boolean  = FALSE;
  STRINGPADDEDSPACES      : Boolean  = TRUE;
  INTEGERSSHOWASZERO      : Boolean  = FALSE;
  TRUERECORDCOUNT         : Boolean  = TRUE;
  CLONETABLEEMPTY         : Boolean  = FALSE;

  TABLECREATE_FLAGS       : Smallint = 0;
  TABLECREATE_PAGESIZE    : SmallInt = 4096;
  TABLECREATE_OWNERMODE   : SmallInt = 0;

  
Procedure MapBtrToDbi(
            I              : Word;
            physSize       : Word;
            Var BdeType    : Word;
            Var BdeSubType : Word;
            Var LogSize    : Word;
            Var ActSize    : Word
          );

Procedure MapGet( Dtype, DSize, DDec, LSize : Word; BtrSrc, Dest : Pointer; Var Blank : Bool );
Procedure MapPut( Dtype, DSize, DDec, LSize : Word; Src, BtrDest : Pointer );

Procedure MapFieldDDFToDBIFieldInfo( Info : TFieldDDF; Count : Word; pRecBuff : PFLDDesc );
Procedure MapIndexDDFToDBIIndexDesc( var idx : idxDesc; var Info : TIndexDDF;
            var FldInfo : FldDesc; SegNo : SmallInt );
Function  GetBDEFieldBufferSize( BdeType, BtrieveType, DefaultLen : Word ) : Word;


Implementation
Uses

  SysUtils,
  Dialogs,
  Forms,

  BtrConst,

  BseUtils,
  BseConst,

  BtrErrs;

{$I BTRIEVE.INC}

Type
  DATE          = LongInt;
  TIME          = LongInt;

Const
  MAX_TEMP_STR   = 40;
  MAX_STRING_LEN = 255;
  SIGNS          : Array[ Boolean ] of Char = ( '+', '-' );
  TimeZoneBias   : LongInt = 0;


{ The physSize parameter is the physical (Btrieve) size for the field   }
{ The logsize parameter is set to the logical size for screen use, etc. }
{ The ActSize parameter is set to the size needed in the Delphi buffer  }
Procedure MapBtrToDbi(
            I              : Word;
            physSize       : Word;
            Var BdeType    : Word;
            Var BdeSubType : Word;
            Var LogSize    : Word;
            Var ActSize    : Word
          );

  Procedure ReturnFloat;
  begin
    BdeType := fldFLOAT;
    ActSize := SizeOf( Double );
  end;

begin
  BdeType    := fldUNKNOWN;
  BdeSubType := 0;
  LogSize    := physSize;
  ActSize    := physSize;
  Case i of
    btrFldSTRING:
      begin
        if ( physSize <= MAX_STRING_LEN ) then
          BdeType  := fldZSTRING
        else
        begin
          LogSize    := Pred( physSize );
          BdeType    := fldBLOB;
          BdeSubType := fldstMEMO;
        end;
      end;
    btrFldINTEGER:
      Case physSize of
        1 : begin
              if SMALLINTASBYTE then
              begin
                BdeType := fldUINT16;
                LogSize := SizeOf( Word );
              end
              else
              begin
                BdeType := fldINT16;
                LogSize := SizeOf( SmallInt );
              end;
            end;
        2 : begin
              BdeType := fldINT16;
              LogSize := SizeOf( SmallInt );
            end;
        4 : begin
              BdeType := fldINT32;
              LogSize := SizeOf( LongInt );
            end;
        8 : begin
              BdeType := fldINT64;
              LogSize := SizeOf( Int64 );
            end;
      end;
    btrFldFLOAT:
      ReturnFloat;
    btrFldDATE:
      begin
        BdeType := fldDATE;
        ActSize := SizeOf( TTimeStamp );
      end;
    btrFldTIME:
      begin
        BdeType := fldTIME;
        ActSize := SizeOf( TTimeStamp );
      end;
    btrFldDECIMAL:
      ReturnFloat;
    btrFldMONEY:
      begin
        ReturnFloat;
        BdeSubType := fldstMONEY;
      end;
    btrFldLOGICAL:
      begin
        BdeType := fldBOOL;
        LogSize := SizeOf( LongBool );
      end;
    btrFldNUMERIC,
    btrFldBFLOAT:
      ReturnFloat;
    btrFldLSTRING:
      begin
        LogSize := Pred( physSize );
        BdeType := fldZSTRING
      end;
    btrFldZSTRING:
      begin
        If ( physSize = 1 ) then
          BdeType := fldBytes
        else
        begin
          LogSize := Pred( physSize );
          if ( physSize <= Succ( MAX_STRING_LEN ) ) then
            BdeType  := fldZSTRING
          else
          begin
           BdeType    := fldBLOB;
           BdeSubType := fldstMEMO;
          end;
        end;
      end;
    btrFldNOTE:
      begin
        If ( physSize = 1 ) then
          BdeType := fldBytes
        else
        begin
          LogSize    := Pred( physSize );
          BdeType    := fldBLOB;
          BdeSubType := fldstMEMO;
        end;
      end;
    btrFldLVAR:
      BdeType := fldBytes;
    btrFldUBINARY:
      begin
        Case physSize of
          1   : begin
                  BdeType := fldUINT16;
                  LogSize := SizeOf( Word );
                end;
          2   : begin
                  BdeType := fldUINT16;
                end;
          4   : begin
                  BdeType := fldUINT32;
                end;
          6   : BdeType := fldBYTES;
          8   : begin
                  BdeType := fldUINT64;
                  LogSize := SizeOf( Int64 );
                end;
        end;
      end;
    btrFldAUTOINC:
      begin
        Case physSize of
          1   : begin
                  BdeType := fldINT16;
                  LogSize := SizeOf( SmallInt );
                end;
          2   : BdeType := fldINT16;
          4   : BdeType := fldINT32;
          6   : BdeType := fldBYTES;
          8   : BdeType := fldINT64;
        end;
        BdeSubType := fldstAUTOINC;
      end;
    btrFldBIT:
      begin
        BdeType := fldBOOL;
        LogSize := SizeOf( LongBool );
      end;
    btrFldNUMERICSTS,
    btrFldNUMERICSA:
      ReturnFloat;
    btrFldCURRENCY:
      begin
        ReturnFloat;
        BdeSubType := fldstMONEY;
      end;
    btrFldTIMESTAMP:
      begin
        BdeType := fldTIMESTAMP;
        ActSize    := SizeOf( TTimeStamp );
      end;
{$IFDEF SMITHWARE_EXTENDED}
    btrExtFldLONGDATE:
      BdeType := fldDATE;
    btrExtFldINTEL,
    btrExtFldBINRL,
    btrExtFldBINLR,
    btrExtFldNUMERICASCII:
      ReturnFloat;
    btrExtFldMAGICDATE_0001,
    btrExtFldCTIME:
      BdeType := fldDATE;
    btrExtFldMAGICNUM100:
      ReturnFloat;
    btrExtFldTASPROTIME:
      BdeType := fldTIME;
    btrExtFldMAGICPCDATE:
      BdeType := fldDATE;
    btrExtFldTASPROUNS,
    btrExtFldBCD10,
    btrExtFldCOBOLCOMP6,
    btrExtFldMAGICPCNUMERIC:
      ReturnFloat;
    btrExtFldMAGICPCTIME:
      BdeType := fldTIME;
    btrExtFldTASPRO3DATE:
      BdeType := fldDATE;
    btrExtFldTASPRO3NUMERIC,
    btrExtFldDELPHIREAL:
      ReturnFloat;
    btrExtFldVBCURRENCY:
      begin
        ReturnFloat;
        BdeSubType := fldstMONEY;
      end;
    btrExtFldVBDATE:
      begin
        BdeType := fldTIMESTAMP;
        ActSize := SizeOf( Comp );
      end;
    btrExtFldYMD,
    btrExtFldYYMMDD,
    btrExtFldYYYYMMDD:
      BdeType := fldDATE;
{$ENDIF SMITHWARE_EXTENDED}
  end;
end;


Function GetBDEFieldBufferSize( BdeType, BtrieveType, DefaultLen : Word ) : Word;
begin
  Case BdeType of
    fldFLOAT:
      Result := SizeOf( Double );
    fldBLOB:
      Result := MAX_STRING_LEN;
  else
    Result := DefaultLen;
  end;
end;


Procedure MapFieldDDFToDBIFieldInfo( Info : TFieldDDF; Count : Word; pRecBuff : PFLDDesc );
var
  ActSize : Word;
  LogSize : Word;
  buff    : ShortString;
begin
  if Assigned( pRecBuff ) then
  begin
    MoveZero( pRecBuff^, SizeOf( FLDDesc ) );
    Buff := ArrayToStrZ( Info.Xe_Name, SizeOf( Info.Xe_Name ) );
    with PRecBuff^ do
    begin
      iFldNum         := Count;
      MapBtrToDBI( Info.Xe_DataType, Info.Xe_Size, iFldType, iSubType, LogSize, ActSize );
      if ( iFldType = fldBLOB ) then
      begin
        iUnits1 := 0;
        if ( Pos( BTR_IMAGE_TOKEN, Buff ) > 0 ) then
          iSubType := fldstGRAPHIC
        else
          if ( Pos( BTR_BINARY_TOKEN, Buff ) > 0 ) then
            iSubType := fldstBINARY
          else
            iUnits1 := LogSize;
        iLen := Info.Xe_Size;
      end
      else
      begin
        iLen          := Info.Xe_Size;
        iUnits1       := SmallInt( LogSize );
      end;
      iUnits2         := SmallInt( Info.Xe_Dec );
      iOffset         := Word( Info.Xe_OffSet );
      efldvVchk       := fldvUNKNOWN;
      efldrRights     := fldrUNKNOWN;
      StrLCopy( @szName, @Buff[ 1 ], Pred( SizeOf( szName ) ) );
    end;
  end;
end;


Procedure MapIndexDDFToDBIIndexDesc( var idx : idxDesc; var Info : TIndexDDF;
            var FldInfo : FldDesc; SegNo : SmallInt );
begin
  With idx do
  begin
    iIndexId               := Info.Xi_Number;               { Index number }
    bPrimary               := ( iIndexId = 0 );             { True, if primary index }
    bMaintained            := TRUE;                         { True, if maintained index }
    aiKeyFld[ iFldsInKey ] := FldInfo.iFldNum;              { Array of fields }
    inc( iFldsInKey );                                      { Fields in the key (1 for Exp) }
    inc( iKeyLen, FldInfo.iLen );                           { Phy Key length in bytes (Key only) }
    iBlockSize             := iKeyLen;                      { Block size in bytes }

    if not bUnique then
      bUnique          := ( ( Info.Xi_Flags and btrIdxDuplicates      ) = 0 );

    if ( SegNo = 1 ) and not bDescending then
      bDescending      := ( ( Info.Xi_Flags and BtrIdxDescending      ) = BtrIdxDescending );

    if not bCaseInsensitive then
      bCaseInsensitive := ( ( Info.Xi_Flags and BtrIdxCaseInsensitive ) = BtrIdxCaseInsensitive );

  end;
end;


Procedure FieldReadError( P : Pointer; Size : Word );
begin
  if IGNORE_READFIELD_ERR then
    MoveZero( P^, Size )
  else
    ThrowBtrieveException( ISAM_FIELD_CONVERSION_ERROR );
end;


Procedure FieldWriteError;
begin
  if Not IGNORE_WRITEFIELD_ERR then
    ThrowBtrieveException( ISAM_FIELD_CONVERSION_ERROR );
end;


(*== Btrieve String Field Type 0 ============================================*)
{For Fixed Length Strings to C Strings}
Procedure BtrFStringToString( BtrData, Dest : Pointer; Size : Word );
var
  i         : Word;
  Source    : PChar;
  Target    : PChar;
  LastSpace : PChar;
begin
  Source    := BtrData;
  Target    := Dest;
  LastSpace := NIL;
  For i := 1 to Size do
  begin
    Target^ := Source^;
    Case Target^ of
      #0  : Break;
      ' ' : if ( LastSpace = NIL ) then
              LastSpace := Target;
    else
      LastSpace := NIL;
    end;
    Inc( Source );
    Inc( Target );
  end;
  If ( LastSpace <> NIL ) then
    LastSpace^ := #0
  else
    if ( Target^ <> #0 ) then
      Target^ := #0;
end;


{For Fixed Length Strings from C Strings - The result should be padded with spaces}
Procedure StringToBtrFString( BtrData : Pointer; Size : Word; Source : Pointer );
var
  i       : Word;
  Count   : Word;
  Target  : PChar;
begin
  Target := BtrData;
  Count  := 0;
  For i := 1 to Size do
  begin
    Target^ := PChar( Source )^;
    if ( Target^ <> #0 ) then
    begin
      Inc( PChar( Source ) );
      Inc( Target );
      Inc( Count );
    end
    else
      Break;
  end;
  i := Size - Count;
  If ( i > 0 ) then
    If STRINGPADDEDSPACES then
      FillChar( Target^, i, ' ' )
    else
      MoveZero( Target^, i );
end;


(*== Btrieve Integer Field Type 1 ============================================*)
{ Conversions handled in MapGet and MapPut }

(*== Btrieve IEEE Field Type 2 ===============================================*)
Procedure BtrSingleToDouble( BtrData, Dble : Pointer );
begin
  Double( Dble^ ) := Single( BtrData^ ) * 1.0;
end;

Procedure DoubleToBtrSingle( BtrData : Pointer; Value : Double );
var
  S : String[ MAX_TEMP_STR ];
  i : Integer;
begin
  { More Thanks to Steve Belkin }
  S := FloatToStrF( Value, ffFixed, 7, 7 );
  If ( DecimalSeparator <> '.' ) then
  begin
    i := PosOfCh( DecimalSeparator, S );   { Assuming only 1 occurrence }
    if ( i <> 0 ) then
      S[ i ] := '.';
  end;
  Val( S, Single( BtrData^ ), i );
  if ( i <> 0 ) then
  begin
    Single( BtrData^ ) := 0.0;
    FieldWriteError;
  end;
end;

Procedure BtrLongDoubleToDouble( BtrData, Dble : Pointer );
begin
  Double( Dble^ ) := StrToFloat( FloatToStr( Extended( BtrData^ ) ) );
end;

Procedure DoubleToBtrLongDouble( BtrData : Pointer; Value : Double );
begin
  Extended( BtrData^ ) := StrToFloat( FloatToStr( Value ) );
end;


(*== Btrieve Date Field Type 3 ===============================================*)
Function BtrieveDateToDelphiDate( Const Btr : BtrieveDateType ) : LongInt;
var
  tMonth    : Word;
  tDay      : Word;
  tYear     : Word;
  TimeStamp : TTimeStamp;
begin
  With Btr do
  begin
    tMonth := Month;
    tDay   := Day;
    tYear  := Year;
  end;
  If ( tMonth > 0 ) and ( tMonth < 13 ) and
     ( tDay   > 0 ) and ( tDay   < 32 ) and
     ( tYear  > 0 ) then
  begin
    Try
      TimeStamp := DateTimeToTimeStamp( EncodeDate( tYear, tMonth, tDay ) );
      Result    := TimeStamp.Date;
    Except
      On E:EConvertError do
        if IGNORE_READFIELD_ERR then
          Result := 0
        else
          Raise;
    end;
  end
  else
    Result := 0;
end;


Function DelphiDateToBtrieveDate( Const D : LongInt ) : BtrieveDateType;
var
  tMonth : Word;
  tDay   : Word;
  tYear  : Word;
  ts     : TTimeStamp;
  dt     : TDateTime;
begin
  Ts.Time := 0;
  Move( D, Ts.Date, SizeOf( Ts.Date ) );
  Try
    dt := TimeStampToDateTime( Ts );
    DecodeDate( dt, tYear, TMonth, tDay );
  Except
    on E:EconvertError do
      if IGNORE_WRITEFIELD_ERR then
      begin
        tMonth := 0;
        tDay   := 0;
        tYear  := 0;
      end
      else
        Raise;
  end;
  With Result do
  begin
    Month := tMonth;
    Day   := tDay;
    Year  := SmallInt( tYear );
  end;
end;


(*== Btrieve Time Field Type 4 ===============================================*)
Function BtrieveTimeToDelphiTime( Const Btr : BtrieveTimeType ) : Time;
var
  tHun      : Word;
  tSec      : Word;
  tMin      : Word;
  tHour     : Word;
  TimeStamp : TTimeStamp;
begin
  With Btr do
  begin
    tHun  := Hundredth;
    tSec  := Second;
    tMin  := Minute;
    tHour := Hour;
  end;
  Try
  TimeStamp := DateTimeToTimeStamp( EncodeTime( tHour, tMin, tSec, tHun * 10 ) );
  Result    := TimeStamp.Time;
  Except
    on E:EConvertError do
      Result := 0;
  end;
end;


Function DelphiTimeToBtrieveTime( Const T : Time ) : BtrieveTimeType;
var
  tmil  : Word;
  tSec  : Word;
  tMin  : Word;
  tHour : Word;
  tmp   : TDateTime;
  ts     : TTimeStamp;
begin
  Ts.Date := 0;
  Move( T, Ts.Time, SizeOf( Ts.Time ) );
  tmp := TimeStampToDateTime( Ts );
  DecodeTime( tmp, tHour, TMin, tSec, tMil );
  With Result do
  begin
    Hundredth := Lo( tMil div 10 );
    Second    := Lo( tSec  );
    Minute    := Lo( tMin  );
    Hour      := Lo( tHour );
  end;
end;


(* Special thanks to Tino Faustel for these conversion routines *)
Const
  MSECS_PER_SEC  = 1000;
  MSECS_PER_MIN  = MSECS_PER_SEC  * 60;
  MSECS_PER_HOUR = MSECS_PER_MIN  * 60;
  MSECS_PER_DAY  = MSECS_PER_HOUR * 24;


Function DelphiDateToBtrieveTimeStamp( Const Value : TDateTime ) : Comp;
Var
  thour     : Word;
  tmin      : Word;
  tsec      : Word;
  tmil      : Word;
  days      : Double;
  timestamp : TTimestamp;
Begin
  Timestamp := MSecsToTimeStamp( Value );
  days      := timestamp.date - 1;
  DecodeTime( TimestampToDateTime( Timestamp ), thour, tmin, tsec, tmil );
  Result := tmil + ( tsec * MSECS_PER_SEC ) + ( tmin * MSECS_PER_MIN ) +
            ( thour * MSECS_PER_HOUR ) + ( days* MSECS_PER_DAY );
  Result := ( Result + ( TimeZoneBias ) * 60000 ) * 10000.0;
end;


Function BtrieveTimeStampToDelphiDate( Const Value : Comp ) : TDateTime;
Var
  thour     : Word;
  tmin      : Word;
  tsec      : Word;
  tmil      : Word;
  timestamp : TTimeStamp;
  left      : Double;
  days      : Double;
Begin
  If ( Value <> 0 ) then
  begin
    left      := ( Value / 10000.0 ) - ( timeZoneBias ) * 60000;   { time zone correction }
    days      := Int( left / MSECS_PER_DAY );
    left      := left - ( days * MSECS_PER_DAY );
    thour     := Round( Int( left / MSECS_PER_HOUR ) );
    left      := left - ( thour * MSECS_PER_HOUR );
    tmin      := Round( int( left / MSECS_PER_MIN ) );
    left      := left - ( tmin * MSECS_PER_MIN );
    tsec      := Round( int( left / MSECS_PER_SEC ) );
    tmil      := Round( left - ( tsec * MSECS_PER_SEC ) );
    timeStamp := DateTimeToTimeStamp( EncodeTime( thour, tmin, tsec, tmil ) );
    timestamp.date := Round( days ) + 1;
    if ( days > 0 ) Then
      Result := TimeStampToMSecs( timestamp )
    else
      Result := 0;
  end
  else
    Result := 0;
end;

(*== Btrieve COBOL Decimal Comp-3 Field Type 5 ===============================*)
Procedure Get_Decimal( P : Pointer; Size, Dec : Word; D : Pointer );
var
  S : ShortString;
  i : integer;
  Z : PByte;
begin
  S := '';
  Z := PByte( P );
  for i := 1 to Pred( Size ) do
  begin
    AddChar( S, Chr( ( ( Z^ and $F0 ) Shr 4 ) + 48 ) );
    AddChar( S, Chr( ( Z^ and $0F ) + 48 ) );
    Inc( Z );
  end;
  AddChar( S, Chr( ( ( Z^ and $F0 ) Shr 4 ) + 48 ) );
  Size := Length( S );
  if ( Dec > 0 ) then
    S := Copy( S, 1, Size - Dec ) + '.' + Copy( S, Succ( Size ) - Dec, Dec );
  if ( ( Z^ and $0F ) = $D ) then
    S := '-' + S;
  Val( S, Double( D^ ), i );
  if ( i <> 0 ) then
    FieldReadError( D, SizeOf( Double ) );
end;


Procedure BtrDecimalToDouble( BtrData : Pointer; Size, Dec : Word; D : Pointer );
begin
  Get_Decimal( BtrData, Size, Dec, D );
end;


Procedure Set_Decimal( P : Pointer; Size, Decs : Word; Value : Double );
Const
  SignChar : Array[ Boolean ] of Byte = ( $F, $D );
type
  Memory = Array[1..$FFFE] of Byte;
  MemPtr = ^Memory;
var
  S   : ShortString;
  M   : MemPtr;
  i   : integer;
  j   : integer;
begin
  Str( Abs( Value ) : 0 : Decs, S );
  S := RemoveChar( S, '.' );
  (* Special Thanks to Doug Reilly for this fix!                          	*)
  (* DJR  Force the string to be formatted as a leading 0 number of the max	*)
  (*      possible characters for the source of this field (size*2)-1.		*)
  (*      The -1 subtracts the space for the sign nibble.					*)
  i := Pred( Size shl 1 );
  j := Length( S );
  If ( j < i ) then
  begin
    S := StringOf( '0', i - j ) + S;
    j := i;
  end;
  MoveZero( P^, Size );
  M := MemPtr( P );
  M^[ Size ] :=  ( ( Byte( S[ j ] ) - 48 ) shl 4 ) or SignChar[ ( Value < 0.0 ) ];
  i := j;
  while ( i > 1 ) do
  begin
    dec( i    );
    dec( Size );
    M^[ Size ] := ( Byte( S[ i ] ) - 48 );
    dec( i );
    if ( i > 0 ) then
      M^[ Size ] := M^[ Size ] or ( ( Byte( S[ i ] ) - 48 ) shl 4 );
  end;
end;


Procedure DoubleToBtrDecimal( BtrData : Pointer; Size, Dec : Word; Value : Double );
begin
  Set_Decimal( BtrData, Size, Dec, Value );
end;


(*== Btrieve COBOL Money Field Type 6 ========================================*)
{ Conversion handled in Field Type 5}

(*== Btrieve Logical Field Type 7 ============================================*)
{ Conversions handled in MapGet and MapPut }


(*== Btrieve COBOL Numeric EBCDIC Field Type 8 ===============================*)
Procedure Get_NumericSTS( P : Pointer; Size, Dec : Word; D : Pointer );
type
  Memory  = Array[1..$FFFE] of Byte;
  MemPtr  = ^Memory;
var
  S       : String[ MAX_TEMP_STR ];
  i       : Integer;
  LenSize : Word;
begin
  LenSize := Pred( Size );
  S[ 0 ]  := Chr( LenSize );
  Move( P^, S[ 1 ], LenSize );
  If ( Dec > 0 ) then
    S := Copy( S, 1, LenSize - Dec ) + '.' + Copy( S, Succ( LenSize ) - Dec, Dec );
  Val( S, Double( D^ ), i );
  if ( i <> 0 ) then
    FieldReadError( D, SizeOf( Double ) )
  else
    if ( MemPtr( P )^[ Size ] <> $2B ) then
      Double( D^ ) := Double( D^ ) * -1.0;
end;


Procedure Set_NumericSTS( P : Pointer; Size, Decs : Word; Value : Double );
type
  ChrMemory = Array[1..$FFFE] of Char;
  ChrMemPtr = ^ChrMemory;
var
  S      : ShortString;
  M      : ChrMemPtr;
  i      : Integer;
begin
  Str( Value : 0 : Decs, S );
  FillChar( P^, Size, '0' );
  M := ChrMemPtr( P );
  M^[ Size ] := SIGNS[ Value < 0.0 ];
  For i := Length( S ) downTo 1 do
  begin
    if not ( S[ i ] in [ '.', '-' ] ) then
    begin
      Dec( Size );
      if ( Size > 0 ) then
        M^[ Size ] := S[ i ];
    end;
  end;
end;


Procedure Get_Numeric( P : Pointer; Size, Dec : Word; D : Pointer );
var
  S     : ShortString;
  IsNeg : Boolean;
begin
  IsNeg := FALSE;
  SetLength( S, Size );
  Move( P^, S[ 1 ], Size );
  Case S[ Size ] of
    '0'..'9' :
      IsNeg := FALSE;
    'A'..'I' :
      begin
        S[ Size ] := Chr( Byte( S[ Size ] ) - Byte( 'A' ) + 49 );
        IsNeg := FALSE;
      end;
    '{', '}' :
      begin
        IsNeg := ( S[ Size ] = '}' );
        S[ Size ] := '0';
      end;
    'J'..'R' :
      begin
        S[ Size ] := Chr( Byte( S[ Size ] ) - Byte( 'J' ) + 49 );
        IsNeg := TRUE;
      end;
  end;
  AddChar( S, SIGNS[ IsNeg ] );
  Get_NumericSTS( @S[ 1 ], Succ( Size ), Dec, D );
end;


Procedure Set_Numeric( P : Pointer; Size, Dec : Word; Value : Double );
{ CURLYS below has been changed to return a '0' for a positive }
{ number rather than a '{'.  This is consistent with the spec  }
{ for this field type.                                         }
Const
  CURLYS : Array[ Boolean ] of Char = ( '0', '}' );
  VALS   : Array[ Boolean ] of Byte = ( 16, 25 );
var
  S     : String[ MAX_TEMP_STR ];
  isNeg : Boolean;
begin
  S[ 0 ] := Chr( Succ( Size ) );
  Set_NumericSTS( @S[ 1 ], Succ( Size ), Dec, Value );
  IsNeg  := ( S[ Succ( Size ) ] <> '+' );
  if ( S[ Size ] = '0' ) then
    S[ Size ] := CURLYS[ IsNeg ]
  else
    S[ Size ] := Chr( Ord( S[ Size ] ) + VALS[ IsNeg ] );
  Move( S[ 1 ], P^, Size );
end;


Procedure BtrNumericToDouble( BtrData : Pointer; Size, Dec : Word; D : Pointer );
begin
  Try
    Get_Numeric( BtrData, Size, Dec, D );
  Except
    FieldReadError( D, Size );
  end;
end;


Procedure DoubleToBtrNumeric( BtrData : Pointer; Size, Dec : Word; Value : Double );
begin
  Try
    Set_Numeric( BtrData, Size, Dec, Value );
  Except
    FieldWriteError;
  end;
end;


(*== Btrieve Basic BFloat Field Type 9 =======================================*)
Type
  BFloat4Rec =
  Record
    Mantissa1 : Byte;
    Mantissa2 : Byte;
    Exponent1 : Byte;
    Exponent2 : Byte;
  end;


Function BFloatToSingle( Var BFloat ) : Single;
Var
  Man23    : Byte;
  Exponent : Byte;
  Buffer   : BFloat4Rec Absolute Result;
begin
  Result   := Single( BFloat );
  Exponent := Buffer.Exponent2;
  if ( Exponent <> 0 ) then
  begin
    Man23            := Buffer.Exponent1 AND $80;           (* Get 23rd Bit *)
    Exponent         := Exponent - $81 + $7F;               (* Convert Bias *)
    Buffer.Exponent2 := Man23 OR Byte( Exponent SHR 1 );    (* Set Exponent *)
    Buffer.Exponent1 := Byte( Buffer.Exponent1 AND $7F ) OR Byte( Exponent SHL 7 ); (* Set the sign *)
  end;
end;


Procedure SingleToBFloat( Var BFloat; SGL : Single );
Var
  Man23    : Byte;
  Exponent : Byte;
  Buffer   : BFloat4Rec Absolute BFloat;
begin
  Single( BFloat ) := SGL;
  Exponent := Byte( Buffer.Exponent2 SHL 1 ) OR Byte( Buffer.Exponent1 SHR 7 );
  If ( Exponent <> 0 ) then
  begin
    Man23 := Buffer.Exponent2 AND $80;
    Exponent := Exponent - $7F + $81;
    Buffer.Exponent2 := Exponent;
    Buffer.Exponent1 := Man23 OR Byte( Buffer.Exponent1 AND $7F );
  end;
end;


Procedure Get_MBSingle( RawData, CookedData : Pointer );
begin
  Double( CookedData^ ) := BFloatToSingle( RawData^ );
end;


Procedure Set_MBSingle( RawData : Pointer; Value : Double );
Var
  tmp : Single;
begin
  tmp := StrToFloat( FloatToStr( Value ) );
  SingleToBFloat( RawData^, tmp );
end;


Function BFloatToDouble( Var BFloat ) : Double;
Var
  Buffer   : Array[1..8] of Byte Absolute Result;
  Exponent : SmallInt;
  Sign     : Array[1..2] of Byte Absolute Exponent;
  i        : Integer;
begin
  Exponent := MemArray( BFloat )[ 7 ];
  If ( Exponent <> 0 ) then
  begin
    Exponent := ( Exponent - $81 ) + $3FF;
    Buffer [ 8 ] := ( MemArray( BFloat )[ 6 ] AND $80 ) + Byte( Sign[ 1 ] SHR 4 ) + Byte( Sign[ 2 ] SHL 4 );
    Buffer [ 7 ] := Byte( Sign[ 1 ] SHL 4 ) + Byte( ( MemArray( BFloat )[ 6 ] AND $7F ) SHR 3 );
    For i := 6 Downto 1 do
      Buffer[ i ] := Byte( MemArray( BFloat )[ i ] SHL 5 ) + Byte( MemArray( BFloat )[ Pred( i ) ] SHR 3 );
  end
  else
    Result := 0.0;
end;


Procedure DoubleToBFloat( Var BFloat; DBL : Double );
Var
  Exponent : SmallInt;
  Buffer   : MemArray Absolute DBL;
  i        : Integer;
begin
  Exponent := Buffer[ 7 ] AND $7F;
  Exponent := ( Exponent SHL 4 ) + ( Buffer [ 6 ] SHR 4 );
  if ( Exponent <> 0 ) then
  begin
    Exponent := ( Exponent - $3FF ) + $81;
    MemArray( BFloat )[ 7 ] := Byte( Exponent );
    MemArray( BFloat )[ 6 ] := ( Buffer [ 7 ] AND $80 ) + Byte( ( Buffer [ 6 ] AND $0F ) SHL 3 ) +
                                Byte( Buffer [ 5 ] SHR 5 );
    For i := 5 Downto 1 do
      MemArray( BFloat )[ i ] := Byte( Buffer [ i ] SHL 3 ) + Byte( Buffer [ Pred( i ) ] SHR 5 );
    MemArray( BFloat )[ 0 ] := Byte (Buffer [ 0 ] SHL 3 );
  end
  else
    MoveZero( BFloat, SizeOf( Double ) );
end;


Procedure Get_MBDouble( RawData, CookedData : Pointer );
begin
  Double( CookedData^ ) := BFloatToDouble( RawData^ );
end;


Procedure Set_MBDouble( RawData : Pointer; Value : Double );
begin
  DoubleToBFloat( RawData^, Value );
end;


Procedure BtrMBSingleToDouble( BtrData, Dble : Pointer );
begin
  Get_MBSingle( BtrData, Dble );
end;


Procedure DoubleToBtrMBSingle( BtrData : Pointer; Value : Double );
begin
  Set_MBSingle( BtrData, Value );
end;


Procedure BtrMBDoubleToDouble( BtrData, Dble : Pointer );
begin
  Get_MBDouble( BtrData, Dble );
end;


Procedure DoubleToBtrMBDouble( BtrData : Pointer; Value : Double );
begin
  Set_MBDouble( BtrData, Value );
end;


(*== Btrieve Pascal LString Field Type 10 ====================================*)
{For Pascal Strings to C Strings}
Procedure BtrLStringToString( BtrData, Dest : Pointer; Size : Word );
begin
  StrPLCopy( Dest, ShortString( BtrData^ ), Pred( Size ) );
end;


{For Pascal Strings from C Strings}
Procedure StringToBtrLString( BtrData, Dest : Pointer; Size : Word );
begin
  Dec( Size ); {consider the length byte}
  ShortString( BtrData^ ) := Copy( StrPas( Dest ), 1, Size );
  TrailFill( ShortString( BtrData^ ), #0, Size );
end;


(*== Btrieve C ZString Field Type 11 =========================================*)
{For C Strings to C Strings}
Procedure BtrCStringToString( BtrData, Dest : Pointer; Size : Word );
begin
  Try
    StrLCopy( Dest, BtrData, Pred( Size ) );
  Except
    FieldReadError( Dest, Size );
  end;
end;


{For C Strings to C Strings}
Procedure StringToBtrCString( BtrData : Pointer; Size : Word; Dest : Pointer );
begin
  Try
    StrLCopy( BtrData, Dest, Pred( Size ) );
  Except
    FieldWriteError;
  end;
end;


(*== Btrieve Variable Length Note Field Type 12 ==============================*)
{ Conversions handled in Field Type 11 }

(*== Btrieve Variable Length LVar Field Type 13 ==============================*)
{ Conversions handled in MapGet and MapPut }

(*== Btrieve Binary Unsigned Field Type 14 ===================================*)
{ Conversions handled in MapGet and MapPut }

(*== Btrieve AutoIncrement Field Type 15 =====================================*)
{ Conversions handled in MapGet and MapPut }

(*== Btrieve Bit Field Field Type 16 =========================================*)
{ Conversions handled in MapGet and MapPut }

(*== Btrieve COBOL Numeric STS Field Type 17 =================================*)
Procedure BtrNumericSTSToDouble( BtrData : Pointer; Size, Dec : Word; D : Pointer );
begin
  Get_NumericSTS( BtrData, Size, Dec, D );
end;


Procedure DoubleToBtrNumericSTS( BtrData : Pointer; Size, Dec : Word; Value : Double );
begin
  Set_NumericSTS( BtrData, Size, Dec, Value );
end;

(*== Btrieve COBOL NumericSA Field Type 18 ===================================*)
Procedure Get_NumericSA( P : Pointer; Size, Dec : Word; D : Pointer );
var
  S     : ShortString;
  IsNeg : Boolean;
begin
  IsNeg := FALSE;
  SetLength( S, Size );
  Move( P^, S[ 1 ], Size );
  Case S[ Size ] of
    '0'..'9' :
      IsNeg := FALSE;
    'p'..'y' :
      begin
        S[ Size ] := Chr( Byte( S[ Size ] ) - Byte( 'p' ) + 48 );
        IsNeg := TRUE;
      end;
  end;
  AddChar( S, SIGNS[ IsNeg ] );
  Get_NumericSTS( @S[ 1 ], Succ( Size ), Dec, D );
end;


Procedure Set_NumericSA( P : Pointer; Size, Dec : Word; Value : Double );
var
  S     : ShortString;
  isNeg : Boolean;
begin
  SetLength( S, Succ( Size ) );
  Set_NumericSTS( @S[ 1 ], Succ( Size ), Dec, Value );
  IsNeg  := ( S[ Succ( Size ) ] <> '+' );
  If IsNeg then
    S[ Size ] := Chr( Ord( S[ Size ] ) - 48 + Ord( 'p' ) );
  Move( S[ 1 ], P^, Size );
end;


Procedure BtrNumericSAToDouble( BtrData : Pointer; Size, Dec : Word; D : Pointer );
begin
  Get_NumericSA( BtrData, Size, Dec, D );
end;

Procedure DoubleToBtrNumericSA( BtrData : Pointer; Size, Dec : Word; Value : Double );
begin
  Set_NumericSA( BtrData, Size, Dec, Value );
end;


{$IFDEF SMITHWARE_EXTENDED}
Type
  FuncGet1 = Function( P, D : Pointer ) : Word; StdCall;
  FuncSet1 = Function( P : Pointer; Value : Double ) : Word; StdCall;
  FuncGet2 = Function( P : Pointer; Size, Dec : Word; D : Pointer;
               Signed, Backwards : Integer ) : Word; StdCall;
  FuncSet2 = Function( P : Pointer; Size, Dec : Word; V : Double;
               Signed, Backwards : Integer ) : Word; StdCall;
  FuncGet3 = Function( P, D : Pointer; L : LongInt ) : Word; StdCall;
  FuncSet3 = Function( P : Pointer; Value : Double; L : LongInt ) : Word; StdCall;
  FuncGet4 = Function( P : Pointer; Size : Word; D : Pointer ) : Word; StdCall;
  FuncSet4 = Function( P : Pointer; Size : Word; D : Double ) : Word; StdCall;
  FuncGet5 = Function( P : Pointer; Size, Dec : Word; D : Pointer ) : Word; StdCall;
  FuncSet5 = Function( P : Pointer; Size, Dec : Word; Value : Double ) : Word; StdCall;

Type
  TConversionFunctions =
  Class( TObject )
    Private
      FHandle         : THandle;
    Public
      Get_LongYMD     : FuncGet1;
      Set_LongDate    : FuncSet1;
      Get_Binary      : FuncGet2;
      Set_Binary      : FuncSet2;
      Get_MagicDate   : FuncGet3;
      Set_MagicDate   : FuncSet3;
      Get_CTime       : FuncGet1;
      Set_CTime       : FuncSet1;
      Get_MagicNum100 : FuncGet4;
      Set_MagicNum100 : FuncSet4;
      Get_TasProTime  : FuncGet1;
      Set_TasProTime  : FuncSet1;
      Get_TasProNum   : FuncGet5;
      Set_TasProNum   : FuncSet5;
      Get_MagicTime   : FuncGet1;
      Set_MagicTime   : FuncSet1;
      Get_YMD         : FuncGet1;
      Set_YMD         : FuncSet1;
      Get_YYMMDD      : FuncGet1;
      Set_YYMMDD      : FuncSet1;
      Get_YYYYMMDD    : FuncGet1;
      Set_YYYYMMDD    : FuncSet1;
      Get_TasProDate  : FuncGet1;
      Set_TasProDate  : FuncSet1;
      Get_UDecimal    : FuncGet5;
      Set_UDecimal    : FuncSet5;
      Get_VBCurrency  : FuncGet1;
      Set_VBCurrency  : FuncSet1;
      Get_BtrieveDate : FuncGet1;
      Set_BtrieveDate : FuncSet1;
      Get_BtrieveTime : FuncGet1;
      Set_BtrieveTime : FuncSet1;
      Constructor Create;
      Destructor  Destroy; Override;
      Function    LoadDLL( DLLName : PChar ) : Boolean;
      Function    Loaded : Boolean;
  end;

Var
  ConversionDLL : TConversionFunctions;

Constructor TConversionFunctions.Create;
Const
   DLL2Name : PChar = 's2dtconv.dll';
   DLL1Name : PChar = 'titanc32.dll';
begin
  Inherited Create;
  FHandle := HINSTANCE_ERROR;
  if not LoadDLL( DLL1Name ) then
    LoadDLL( DLL2Name );
end;


Destructor TConversionFunctions.Destroy;
begin
  If Loaded then
    FreeLibrary( FHandle );
  Inherited Destroy;
end;


Function TConversionFunctions.Loaded : Boolean;
begin
  Result := ( FHandle <> HINSTANCE_ERROR );
end;


Function TConversionFunctions.LoadDLL( DLLName : PChar ) : Boolean;

  Function GetSmithProcAddress( ProcName : PChar ) : TFarProc;
  begin
    Result := GetProcAddress( FHandle, ProcName );
    If ( Result = NIL ) then
    begin
      MessageDlg( 'Error Loading Dynamic Function ' + StrPas( ProcName ) + ' from ' + StrPas( DLLNAME ), mtError, [mbOk], 0 );
      Application.Terminate;
    end;
  end;

begin
  Result     := FALSE;
  If Not Loaded then
  begin
    FHandle := LoadLibrary( DLLNAME );
    If ( FHandle > HINSTANCE_ERROR ) then
    begin
      @Get_LongYMD     := GetSmithProcAddress( 'Get_LongYMD' );
      @Set_LongDate    := GetSmithProcAddress( 'Set_LongDate' );
      @Get_Binary      := GetSmithProcAddress( 'Get_Binary' );
      @Set_Binary      := GetSmithProcAddress( 'Set_Binary' );
      @Get_MagicDate   := GetSmithProcAddress( 'Get_MagicDate' );
      @Set_MagicDate   := GetSmithProcAddress( 'Set_MagicDate' );
      @Get_CTime       := GetSmithProcAddress( 'Get_Ctime' );
      @Set_CTime       := GetSmithProcAddress( 'Set_Ctime' );
      @Get_MagicNum100 := GetSmithProcAddress( 'Get_MagicNum100' );
      @Set_MagicNum100 := GetSmithProcAddress( 'Set_MagicNum100' );
      @Get_TasProTime  := GetSmithProcAddress( 'Get_TasProTime' );
      @Set_TasProTime  := GetSmithProcAddress( 'Set_TasProTime' );
      @Get_TasProNum   := GetSmithProcAddress( 'Get_TasProNum' );
      @Set_TasProNum   := GetSmithProcAddress( 'Set_TasProNum' );
      @Get_MagicTime   := GetSmithProcAddress( 'Get_MagicTime' );
      @Set_MagicTime   := GetSmithProcAddress( 'Set_MagicTime' );
      @Get_YMD         := GetSmithProcAddress( 'Get_YMD' );
      @Set_YMD         := GetSmithProcAddress( 'Set_YMD' );
      @Get_YYMMDD      := GetSmithProcAddress( 'Get_YYMMDD' );
      @Set_YYMMDD      := GetSmithProcAddress( 'Set_YYMMDD' );
      @Get_YYYYMMDD    := GetSmithProcAddress( 'Get_YYYYMMDD' );
      @Set_YYYYMMDD    := GetSmithProcAddress( 'Set_YYYYMMDD' );
      @Get_TasProDate  := GetSmithProcAddress( 'Get_TasProDate' );
      @Set_TasProDate  := GetSmithProcAddress( 'Set_TasProDate' );
      @Get_UDecimal    := GetSmithProcAddress( 'Get_UDecimal' );
      @Set_UDecimal    := GetSmithProcAddress( 'Set_UDecimal' );
      @Get_VBCurrency  := GetSmithProcAddress( 'Get_VBCurrency' );
      @Set_VBCurrency  := GetSmithProcAddress( 'Set_VBCurrency' );
      @Get_BtrieveTime := GetSmithProcAddress( 'Get_BtrieveTime' );
      @Set_BtrieveDate := GetSmithProcAddress( 'Set_BtrieveDate' );
      @Get_BtrieveDate := GetSmithProcAddress( 'Get_BtrieveDate' );
      @Set_BtrieveTime := GetSmithProcAddress( 'Set_BtrieveTime' );
      Result := TRUE;
    end;
  end;
end;


Procedure InitializeConversionDLL;
Var
  FCSect : TRTLCriticalSection;
begin
  InitializeCriticalSection( FCSect );
  Try
    EnterCriticalSection( FCSect );
    Try
      ConversionDLL := TConversionFunctions.Create;
    Finally
      LeaveCriticalSection( FCSect );
    end;
  Finally
    DeleteCriticalSection( FCSect );
  end;
end;


Function CheckForConversionDLL : Boolean;
begin
  If ( ConversionDLL = NIL ) then
    InitializeConversionDLL;
  Result := ConversionDLL.Loaded;
end;


(*== Smithware YYYYMMDD LongInt Date Extended Field Type 228 =================*)
Procedure DoubleToBtrDate( BtrData : Pointer; Value : Double );
begin
  if Not CheckForConversionDLL or ( ConversionDLL.Set_BtrieveDate( BtrData, Value ) <> 0 ) then
    FieldWriteError;
end;


Procedure DoubleToDelphiDate( Dest : Pointer; Const D : Double );
var
  tmp : BtrieveDateType;
begin
  DoubleToBtrDate( @tmp, D );
  Date( Dest^ ) := BtrieveDateToDelphiDate( tmp );
end;


Procedure BtrLongYMDToDouble( BtrSrc, Dble : Pointer );
begin
  if Not CheckForConversionDLL or ( ConversionDLL.Get_LongYMD( BtrSrc, Dble ) <> 0 ) then
    FieldReadError( Dble, SizeOf( Double ) );
end;


Procedure DelphiDateToDouble( Dest : Pointer; Const D : LongInt );
var
  tmp : BtrieveDateType;
begin
  tmp := DelphiDateToBtrieveDate( D );
  if not CheckForConversionDLL or ( ConversionDLL.Get_BtrieveDate( @tmp, Dest ) <> 0 ) then
    FieldReadError( Dest, SizeOf( Double ) );
end;


Procedure DoubleToBtrLongYMD( BtrData : Pointer; Value : Double );
begin
  if not CheckForConversionDLL or ( ConversionDLL.Set_LongDate( BtrData, Value ) <> 0 ) then
    FieldWriteError;
end;


(*== Smithware Binary Intel Extended Field Type 229 ==========================*)
Procedure BtrBinaryToDouble( BtrData : Pointer; Size, Dec : Word;
           Dest : Pointer; Signed, Backwards : Integer );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Get_Binary( BtrData, Size, Dec, Dest, Signed, Backwards ) <> 0 ) then
    FieldReadError( Dest, SizeOf( Double ) );
end;


Procedure DoubleToBtrBinary( BtrData : Pointer; Size, Dec : Word; Value : Double;
           Signed, Backwards : Integer );
begin
  If not CheckForConversionDLL or ( ConversionDLL.Set_Binary( BtrData, Size, Dec, Value, Signed, Backwards ) <> 0 ) then
    FieldWriteError;
end;


(*== Smithware Binary RL Extended Field Type 230 =============================*)
{ Handled by Extended Field Type 229 }

(*== Smithware Binary LR Extended Field Type 231 =============================*)
{ Handled by Extended Field Type 229 }

(*== Smithware COBOL Numeric ASCII Extended Field Type 232 ===================*)
{ Handled by Field Type 8 }


(*== Smithware Magic Int Date 0001 Extended Field Type 233 ===================*)
Procedure BtrMagicDateToDouble( BtrData, Dble : Pointer; L : LongInt );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Get_MagicDate( BtrData, Dble, L ) <> 0 ) then
    FieldReadError( Dble, SizeOf( Double ) );
end;


Procedure DoubleToBtrMagicDate( BtrData : Pointer; Value : Double; L : LongInt );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Set_MagicDate( BtrData, Value, L ) <> 0 ) then
    FieldWriteError;
end;


(*== Smithware C Time Extended Field Type 234 ================================*)
Procedure BtrCTimeToDouble( BtrData, Dble : Pointer );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Get_Ctime( BtrData, Dble ) <> 0 ) then
    FieldReadError( Dble, SizeOf( Double ) );
end;


Procedure DoubleToBtrCTime( BtrData : Pointer; Value : Double );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Set_Ctime( BtrData, Value ) <> 0 ) then
    FieldWriteError;
end;


(*== Smithware Magic Number 100 Extended Field Type 235 ======================*)
Procedure BtrMagicNum100ToDouble( BtrData : Pointer; Size : Word; Dest : Pointer );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Get_MagicNum100( BtrData, Size, Dest ) <> 0 ) then
    FieldReadError( Dest, SizeOf( Double ) );
end;


Procedure DoubleToBtrMagicNum100( BtrData : Pointer; Size : Word; Value : Double );
begin
  if Not CheckForConversionDLL or ( ConversionDLL.Set_MagicNum100( BtrData, Size, Value ) <> 0 ) then
    FieldWriteError;
end;


(*== Smithware TAS Pro Time Extended Field Type 236 ==========================*)
Procedure BtrTasProTimeToDouble( BtrData, Dble : Pointer );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Get_TasProTime( BtrData, Dble ) <> 0 ) then
    FieldReadError( Dble, SizeOf( Double ) );
end;


Procedure DoubleToBtrTasProTime( BtrData : Pointer; Value : Double );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Set_TasProTime( BtrData, Value ) <> 0 ) then
    FieldWriteError;
end;


(*== Smithware TAS Pro Numeric Unsigned Extended Field Type 237 ==============*)
Procedure BtrTasProNumToDouble( BtrData : Pointer; Size, Dec : Word; D : Pointer );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Get_TasProNum( BtrData, Size, Dec, D ) <> 0 ) then
    FieldReadError( D, SizeOf( Double ) );
end;


Procedure DoubleToBtrTasProNum( BtrData : Pointer; Size, Dec : Word; Value : Double );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Set_TasProNum( BtrData, Size, Dec, Value ) <> 0 ) then
    FieldWriteError;
end;


(*== Smithware BCD10 Extended Field Type 238 =================================*)
Procedure Get_DecMath( P : Pointer; Size : Word; D : Pointer );
Const
  MAX_SIZE = 10;
Type
  BCDType = Array[ 0..Pred( MAX_SIZE ) ] of byte;
  PBCD    = ^BCDType;
Var
  V       : Double;
  st      : String[25];
  se      : String[04];
  exp     : Integer;
  i       : Integer;
  PB      : PBCD;
  Index   : Integer;
  IsShift : Boolean;

  Function IsNull : Boolean;
  var
    j : Integer;
  begin
    for j := 0 to Pred( MAX_SIZE ) do
      if ( PB^[ j ] <> 0 ) then
      begin
        Result := FALSE;
        Exit;
      end;
    Result := TRUE;
  end;

begin
  st := ' 0.0000000000000000E+0000';
  PB := P;
  if IsNull then
  begin
    v := 0.0;
    Move( v, D^, SizeOf( v ) );
    Exit;
  end;
  exp := ord( PB^[ 0 ] );
  if ( ( exp and $80 ) <> 0 ) then
  begin
    exp := exp and $7F;
    st[ 1 ] := '-';
  end;
  Dec( exp, $40 );
  if ( exp < 0 ) then
  begin
    exp := 0 - exp;
    st[21] := '-';
  end
  else
    st[ 21 ] := '+';
  Str( exp:4, se );
  for i := 1 to 4 do
    if ( se[ i ] = ' ' ) then
      se[ i ] := '0';
  Move( se[ 1 ], st[ 22 ], 4 );

  IsShift := TRUE;
  Index   := Pred( MAX_SIZE );
  for i := 2 to 19 do
    if ( i <> 3 ) then {Skip the '.'}
    begin
      if IsShift then
        st[ i ] := Chr( ( pb^[ Index ] shr 4   ) or Ord( '0' ) )
      else
      begin
        st[ i ] := Chr( ( pb^[ Index ] and $0F ) or Ord( '0' ) );
        Dec( Index );
      end;
      IsShift := not IsShift;
    end;
  Val( st, v, i );
  if ( Assigned( D ) and ( i = 0 ) ) then
    Move( v, D^, SizeOf( v ) )
  else
    FieldReadError( D, Size );
end;


Procedure Set_DecMath( P : Pointer; Size : Word; V : Double );
Const
  MAX_SIZE = 10;
Type
  BCDType = Array[ 0..Pred( MAX_SIZE ) ] of byte;
  PBCD    = ^BCDType;
var
  b     : BCDType;
  st    : string[ 25 ];
  exp   : Integer;
  i     : Integer;
  Index : Integer;
begin
  if ( Abs( V ) < 0.0000000000000001 ) then
  begin
    MoveZero( P^, MAX_SIZE );
    Exit;
  end;
  Str( V:25, st );
  if ( st[ 21 ] = '+' ) then
    st[ 21 ] := '0';
  Val( copy( st, 21, 5 ), exp, i );
  if ( i = 0 ) then
  begin
    Inc( exp, $40 );
    if ( st[ 1 ] = '-' ) then
      exp := ( exp or $80 );
    b[ 0 ]  := exp;
    st[ 3 ] := st[ 2 ];
    index := 3;
    For i := 9 DownTo 2 do
    begin
      b[ i ] := ( ord( st[ index ] ) shl 4 ) or ( ord( st[ succ( index ) ] ) and $0F );
      Inc( Index, 2 );
    end;
    b[ 1 ] := ( ord( st[ 19 ] ) shl 4 );
    Move( b, P^, MAX_SIZE );
  end
  else
    FieldWriteError;
end;


Procedure BtrDecMathToDouble( BtrData, Dest : Pointer; Size : Word );
begin
  Get_DecMath( BtrData, Size, Dest );
end;


Procedure DoubleToBtrDecMath( BtrData : Pointer; Size : Word; Value : Double );
begin
  Set_DecMath( BtrData, Size, Value );
end;


(*== Smithware Magic PC Number Extended Field Type 239 =======================*)
{ Handled by Extended Field 235 }


(*== Smithware Magic Time Extended Field Type 240 ============================*)
Procedure BtrMagicTimeToDouble( BtrData, Dble : Pointer );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Get_MagicTime( BtrData, Dble ) <> 0 ) then
    FieldReadError( Dble, SizeOf( Double ) );
end;


Procedure DoubleToBtrMagicTime( BtrData : Pointer; Value : Double );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Set_MagicTime( BtrData, Value ) <> 0 ) then
    FieldWriteError;
end;


(*== Smithware Magic Date Extended Field Type 241 ============================*)
{ Handled by Extended Field 233 }


(*== Smithware YMD 3 Byte Extended Field Type 242 ============================*)
Procedure BtrYMDToDouble( BtrData, Dble : Pointer );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Get_YMD( BtrData, Dble ) <> 0 ) then
    FieldReadError( Dble, SizeOf( Double ) );
end;

Procedure DoubleToBtrYMD( BtrData : Pointer; Value : Double );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Set_YMD( BtrData, Value ) <> 0 ) then
    FieldWriteError;
end;

(*== Smithware YYMMDD Date Extended Field Type 243 ===========================*)
Procedure BtrYYMMDDToDouble( BtrData, Dble : Pointer );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Get_YYMMDD( BtrData, Dble ) <> 0 ) then
    FieldReadError( Dble, SizeOf( Double ) );
end;

Procedure DoubleToBtrYYMMDD( BtrData : Pointer; Value : Double );
var
  tmp : Array[1..7] of Char;
begin
  If not CheckForConversionDLL or ( ConversionDLL.Set_YYMMDD( @tmp, Value ) <> 0 ) then
    FieldWriteError;
  Move( tmp, BtrData^, 6 );
end;

(*== Smithware YYYYMMDD Date Extended Field Type 244 =========================*)
Procedure BtrYYYYMMDDToDouble( BtrData, Dble : Pointer );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Get_YYYYMMDD( BtrData, Dble ) <> 0 ) then
    FieldReadError( Dble, SizeOf( Double ) );
end;


Procedure DoubleToBtrYYYYMMDD( BtrData : Pointer; Value : Double );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Set_YYYYMMDD( BtrData, Value ) <> 0 ) then
    FieldWriteError;
end;


(*== Smithware TAS Date Extended Field Type 245 ==============================*)
Procedure BtrTasProDateToDouble( BtrData, Dble : Pointer );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Get_TasProDate( BtrData, Dble ) <> 0 ) then
    FieldReadError( Dble, SizeOf( Double ) );
end;


Procedure DoubleToBtrTasProDate( BtrData : Pointer; Value : Double );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Set_TasProDate( BtrData, Value ) <> 0 ) then
   FieldWriteError;
end;


(*== Smithware TAS Num Extended Field Type 246 ===============================*)
{ Handled by Extended Field 237 }


(*== Smithware COBOL Decimal Comp6 Extended Field Type 247 ===================*)
Procedure BtrUDecimalToDouble( BtrData : Pointer; Size, Dec : Word; D : Pointer );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Get_UDecimal( BtrData, Size, Dec, D ) <> 0 ) then
    FieldReadError( D, SizeOf( Double ) );
end;


Procedure DoubleToBtrUDecimal( BtrData : Pointer; Size, Dec : Word; Value : Double );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Set_UDecimal( BtrData, Size, Dec, Value ) <> 0 ) then
    FieldWriteError;
end;


(*== Smithware VB Date Extended Field Type 253 ===============================*)
{ Handled by MapGet and MapPut }


(*== Smithware VB Currency Extended Field Type 254 ===========================*)
Procedure BtrVBCurrencyToDouble( BtrData, Dble : Pointer );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Get_VBCurrency( BtrData, Dble ) <> 0 ) then
    FieldReadError( Dble, SizeOf( Double ) );
end;


Procedure DoubleToBtrVBCurrency( BtrData : Pointer; Value : Double );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Set_VBCurrency( BtrData, Value ) <> 0 ) then
    FieldWriteError;
end;


(*== Smithware Pascal Real Extended Field Type 255 ===========================*)
Procedure BtrPascalRealToDouble( BtrData, Dble : Pointer );
begin
  Double( Dble^ ) := Real48( BtrData^ ) * 1.0;
end;


Procedure DoubleToBtrPascalReal( BtrData : Pointer; Value : Double );
var
  s : String[30];
  i : integer;
begin
  Str( Value, S );
  Val( S, Real48( BtrData^ ), i );
  if ( i <> 0 ) then
  begin
    Real48( BtrData^ ) := 0.0;
    FieldWriteError;
  end;
end;


Procedure DoubleToBtrTime( BtrData : Pointer; Value : Double );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Set_BtrieveTime( BtrData, Value ) <> 0 ) then
    FieldWriteError;
end;


Procedure DoubleToDelphiTime( Dest : Pointer; Const T : Double );
var
  tmp : BtrieveTimeType;
begin
  DoubleToBtrTime( @tmp, T );
  Time( Dest^ ) := BtrieveTimeToDelphiTime( tmp );
end;


Procedure BtrTimeToDouble( BtrData, Dble : Pointer );
begin
  If Not CheckForConversionDLL or ( ConversionDLL.Get_BtrieveTime( BtrData, Dble ) <> 0 ) then
    FieldReadError( Dble, SizeOf( Double ) );
end;


Procedure DelphiTimeToDouble( Dest : Pointer; Const T : Time );
var
  tmp : BtrieveTimeType;
begin
  tmp    := DelphiTimeToBtrieveTime( T );
  BtrTimeToDouble( @tmp, Dest );
end;

(*== End of Field Conversion Functions =======================================*)

{$ENDIF SMITHWARE_EXTENDED}


Procedure MapGet( Dtype, DSize, DDec, LSize : Word; BtrSrc, Dest : Pointer; Var Blank : Bool );
var
  tmp       : Double;
{$IFDEF SMITHWARE_EXTENDED}
  TimeStamp : TTimeStamp;
  DateTmp   : TDateTime;
{$ENDIF SMITHWARE_EXTENDED}

  Function BlankTest : Boolean;
  var
    i   : word;
    P   : PChar;
  begin
    P      := BtrSrc;
    Result := TRUE;
    for i := 1 to DSize do
      if ( P^ <> #0 ) then
      begin
        Result := FALSE;
        Break;
      end
      else
        Inc( P );
  end;

begin
  Blank  := FALSE;
  Case DType of
    btrFldSTRING:
      begin
        Blank := BlankTest;
        If Not Blank and ( Dest <> NIL ) then
          BtrFStringToString( BtrSrc, Dest, DSize );
      end;
    btrFldINTEGER,
    btrFldAUTOINC:
      begin
        Case DSize of
          1 : begin
                if SMALLINTASBYTE then
                  SmallInt( Dest^ ) := Byte( BtrSrc^ )
                else
                  SmallInt( Dest^ ) := ShortInt( BtrSrc^ );
                If not INTEGERSSHOWASZERO then
                  Blank := ( SmallInt( Dest^ ) = 0 );
              end;
          2 : begin
                SmallInt( Dest^ ) := SmallInt( BtrSrc^ );
                If not INTEGERSSHOWASZERO then
                  Blank := ( SmallInt( Dest^ ) = 0 );
              end;
          4 : begin
                LongInt( Dest^ )  := LongInt( BtrSrc^ );
                If not INTEGERSSHOWASZERO then
                  Blank := ( LongInt( Dest^ ) = 0 );
              end;
          8 : begin
                Int64( Dest^ )  := Int64( BtrSrc^ );
                If not INTEGERSSHOWASZERO then
                  Blank := ( Int64( Dest^ ) = 0 );
              end;
        else
          FieldReadError( Dest, DSize );
        end;
      end;
    btrFldFLOAT:
      begin
        Case DSize of
          4 : BtrSingleToDouble( BtrSrc, Dest );
          8 : Double( Dest^ ) := Double( BtrSrc^ );
         10 : BtrLongDoubleToDouble( BtrSrc, Dest );
        else
          FieldReadError( Dest, DSize );
        end;
      end;
    btrFldDATE:
      begin
        Blank := BlankTest;
        If Not Blank then
          LongInt( Dest^ ) := BtrieveDateToDelphiDate( BtrieveDateType( BtrSrc^ ) );
      end;
    btrFldTIME:
      begin
        Blank := BlankTest;
        If Not Blank then
          Time( Dest^ ) := BtrieveTimeToDelphiTime( BtrieveTimeType( BtrSrc^ ) );
      end;
    btrFldDECIMAL,
    btrFldMONEY:
    { Special code needed here since DDF Builder & DDF Maker have different }
    { ideas about when a field is zero.                                     }
      begin
        if ( DType = btrFLDMONEY ) then
          DDec := 2;
        if not IsBlank( BtrSrc, DSize ) then
          BtrDecimalToDouble( BtrSrc, Lo( DSize ), DDec, Dest )
        else
          Double( Dest^ ) := 0.0;
      end;
    btrFldLOGICAL:
      begin
        if Assigned( Dest ) then
          if not BlankTest then
            WordBool( Dest^ ) := TRUE  (* Don't optimize as BlankTest msut be called *)
          else
            WordBool( Dest^ ) := FALSE;
      end;
    btrFldNUMERIC:
      begin
        If not BlankTest then
          BtrNumericToDouble( BtrSrc, Lo( DSize ), DDec, Dest )
        else
          Double( Dest^ ) := 0.0;
      end;
    btrFldBFLOAT:
      begin
        if not BlankTest then
        begin
          Case DSize of
            4: BtrMBSingleToDouble( BtrSrc, Dest );
            8: BtrMBDoubleToDouble( BtrSrc, Dest );
          else
            FieldReadError( Dest, DSize );
          end;
        end
        else
          Double( Dest^ ) := 0.0;
      end;
    btrFldLSTRING:
      begin
        Blank  := BlankTest;
        if not Blank then
          BtrLStringToString( BtrSrc, Dest, Lo( DSize ) );
      end;
    btrFldZSTRING:
      begin
        Blank  := BlankTest;
        if not Blank then
          BtrCStringToString( BtrSrc, Dest, DSize );
      end;
    btrFldNOTE:
      begin
        { This routine is not really used to fetch the blob, GetBlob handles it. }
        if ( DSize > MAX_STRING_LEN ) then
          DSize := MAX_STRING_LEN;
        Blank  := BlankTest;
        BtrCStringToString( BtrSrc, Dest, DSize );
      end;
    btrFldLVAR:
      begin
        Try
          Move( BtrSrc^, Dest^, DSize );
        Except
          FieldReadError( Dest, DSize );
        end;
      end;
    btrFldUBINARY:
      begin
        Case DSize of
          1   : Word( Dest^ )    := Byte( BtrSrc^ ); 
          2   : Word( Dest^ )    := Word( BtrSrc^ );
          4   : LongInt( Dest^ ) := LongInt( BtrSrc^ );
          6,8 : Move( BtrSrc^, Dest^, Lo( DSize ) );
        else
          FieldReadError( Dest, DSize );
        end;
      end;
    btrFldBIT:
      begin
        If Assigned( Dest ) then
          If PSQLBITFIELDMODE then
            WordBool( Dest^ ) := ( ( Byte( BtrSrc^ ) AND DDec ) <> 0 )
          else
            WordBool( Dest^ ) := ( DDec in BtrieveBitSet( BtrSrc^ ) );
      end;
    btrFldNUMERICSTS:
      begin
        If not BlankTest then
          BtrNumericSTSToDouble( BtrSrc, Lo( DSize ), DDec, Dest )
        else
          Double( Dest^ ) := 0.0;
      end;
    btrFldNUMERICSA:
      begin
        If not BlankTest then
          BtrNumericSAToDouble( BtrSrc, Lo( DSize ), DDec, Dest )
        else
          Double( Dest^ ) := 0.0;
      end;
    btrFldCURRENCY:
      begin
        Blank := BlankTest;
        If Not Blank then
          Double( Dest^ ) := Currency( BtrSrc^ )
        else
          Double( Dest^ ) := 0.0;
      end;
    btrFldTIMESTAMP:
      begin
        Blank := BlankTest;
        If Not Blank then
          TDateTime( Dest^ ) := BtrieveTimeStampToDelphiDate( Comp( BtrSrc^) )
        else
          TDateTime( Dest^ ) := 0;
      end;
{$IFDEF SMITHWARE_EXTENDED}
    btrExtFldLONGDATE:
      begin
        Blank := BlankTest;
        If Not Blank then
        begin
          BtrLongYMDToDouble( BtrSrc, @tmp );
          DoubleToDelphiDate( Dest, tmp );
        end;
      end;
    btrExtFldINTEL:
      BtrBinaryToDouble( BtrSrc, Lo( DSize ), DDec, Dest, 1, 0 );
    btrExtFldBINLR:
      BtrBinaryToDouble( BtrSrc, Lo( DSize ), DDec, Dest, 0, 0 );
    btrExtFldBINRL:
      BtrBinaryToDouble( BtrSrc, Lo( DSize ), DDec, Dest, 0, 1 );
    btrExtFldNUMERICASCII:
      begin
        If not BlankTest then
          BtrNumericToDouble( BtrSrc, Lo( DSize ), DDec, Dest )
        else
          Double( Dest^ ) := 0.0;
      end;
    btrExtFldMAGICDATE_0001:
      begin
        Blank := BlankTest;
        If Not Blank then
        begin
          BtrMagicDateToDouble( BtrSrc, @tmp, LongInt( -693594 ) );
          DoubleToDelphiDate( Dest, tmp );
        end;
      end;
    btrExtFldCTIME:
      begin
        Blank := BlankTest;
        If Not Blank then
        begin
          BtrCTimeToDouble( BtrSrc, @tmp );
          DoubleToDelphiDate( Dest, tmp );
        end;
      end;
    btrExtFldMAGICNUM100,
    btrExtFldMAGICPCNUMERIC:
      begin
        If not BlankTest then
          BtrMagicNum100toDouble( BtrSrc, Lo( DSize ), Dest )
        else
          Double( Dest^ ) := 0.0;
      end;
    btrExtFldTASPROTIME:
      begin
        Blank := BlankTest;
        If Not Blank then
        begin
          BtrTasProTimeToDouble( BtrSrc, @tmp );
          DoubleToDelphiTime( Dest, tmp );
        end;
      end;
    btrExtFldTASPROUNS:
      begin
        If not BlankTest then
          BtrTasProNumToDouble( BtrSrc, Lo( DSize ), DDec, Dest )
        else
          Double( Dest^ ) := 0.0;
      end;
    btrExtFldBCD10:
      begin
        If not BlankTest then
          BtrDecMathToDouble( BtrSrc, Dest, Lo( DSize ) )
        else
          Double( Dest^ ) := 0.0;
      end;
    btrExtFldMAGICPCTIME:
      begin
        Blank := BlankTest;
        If Not Blank then
        begin
          BtrMagicTimeToDouble( BtrSrc, @tmp );
          DoubleToDelphiTime( Dest, tmp );
        end;
      end;
    btrExtFldMAGICPCDATE:
      begin
        Blank := BlankTest;
        If Not Blank then
        begin
          BtrMagicDateToDouble( BtrSrc, @tmp, LongInt( 367 ) );
          DoubleToDelphiDate( Dest, tmp );
        end;
      end;
    btrExtFldYMD:
      begin
        Blank := BlankTest;
        If Not Blank then
        begin
          BtrYMDToDouble( BtrSrc, @tmp );
          DoubleToDelphiDate( Dest, tmp );
        end;
      end;
    btrExtFldYYMMDD:
      begin
        Blank := BlankTest;
        If Not Blank then
        begin
          BtrYYMMDDToDouble( BtrSrc, @tmp );
          DoubleToDelphiDate( Dest, tmp );
        end;
      end;
    btrExtFldYYYYMMDD:
      begin
        Blank := BlankTest;
        If Not Blank then
        begin
          BtrYYYYMMDDToDouble( BtrSrc, @tmp );
          DoubleToDelphiDate( Dest, tmp );
        end;
      end;
    btrExtFldTASPRO3DATE:
      begin
        Blank := BlankTest;
        If Not Blank then
        begin
          BtrTasProDateToDouble( BtrSrc, @tmp );
          DoubleToDelphiDate( Dest, tmp );
        end;
      end;
    btrExtFldTASPRO3NUMERIC:
      begin
        If not BlankTest then
          BtrTasProNumToDouble( BtrSrc, Lo( DSize ), DDec, Dest )
        else
          Double( Dest^ ) := 0.0;
      end;
    btrExtFldCOBOLCOMP6:
      begin
        If not BlankTest then
          BtrUDecimalToDouble( BtrSrc, Lo( DSize ), DDec, Dest )
        else
          Double( Dest^ ) := 0.0;
      end;
    btrExtFldVBDATE:
      begin
        Blank := BlankTest;
        If Not Blank then
        begin
          DateTmp    := TDateTime( BtrSrc^ );
          TimeStamp  := DateTimeToTimeStamp( DateTmp );
          DateTmp    := TimeStampToMSecs( TimeStamp );
          Move( DateTmp, Dest^, DSize );
        end;
      end;
    btrExtFldVBCURRENCY:
      begin
        If not BlankTest then
          BtrVBCurrencyToDouble( BtrSrc, Dest )
        else
          Double( Dest^ ) := 0.0;
      end;
    btrExtFldDELPHIREAL:
      begin
        If not BlankTest then
          BtrPascalRealToDouble( BtrSrc, Dest )
        else
          Double( Dest^ ) := 0.0;
      end;
{$ENDIF SMITHWARE_EXTENDED}
  end;
end;


Procedure MapPut( Dtype, DSize, DDec, LSize : Word; Src, BtrDest : Pointer );
var
  tmp       : Double;
{$IFDEF SMITHWARE_EXTENDED}
  TimeStamp : TTimeStamp;
  DateTmp   : TDateTime;
{$ENDIF SMITHWARE_EXTENDED}

  Procedure ZeroFillField;
  begin
    if ( DType <> btrFldBIT ) then
      MoveZero( BtrDest^, DSize );
  end;

begin
  Case DType of
    btrFldSTRING:
      StringToBtrFString( BtrDest, DSize, Src );
    btrFldAUTOINC,
    btrFldINTEGER:
      Case DSize of
        1 : if SMALLINTASBYTE then
              Byte( BtrDest^ ) := Byte( Src^ )
            else
              ShortInt( BtrDest^ ) := ShortInt( Src^ );
        2 : SmallInt( BtrDest^ ) := SmallInt( Src^ );
        4 : LongInt( BtrDest^ )  := LongInt( Src^ );
      else
        begin
          ZeroFillField;
          FieldWriteError;
        end;
      end;
    btrFldFLOAT:
      Case DSize of
        4 : DoubleToBtrSingle( BtrDest, Double( Src^ ) );
        8 : Double( BtrDest^ ) := Double( Src^ );
       10 : DoubleToBtrLongDouble( BtrDest, Double( Src^ ) );
      else
        begin
          ZeroFillField;
          FieldWriteError;
        end;
      end;
    btrFldDATE:
      BtrieveDateType( BtrDest^ ) := DelphiDateToBtrieveDate( Date( Src^ ) );
    btrFldTIME:
      BtrieveTimeType( BtrDest^ ) := DelphiTimeToBtrieveTime( Time( Src^ ) );
    btrFldDECIMAL:
      DoubleToBtrDecimal( BtrDest, Lo( DSize ), DDec, Double( Src^ ) );
    btrFldMONEY:
      DoubleToBtrDecimal( BtrDest, Lo( DSize ), 2, Double( Src^ ) );
    btrFldLOGICAL:
      begin
        If WordBool( Src^ ) then
        begin
          Case DSize of
            1 : Byte( BtrDest^ )    := $01;
            2 : Word( BtrDest^ )    := $01;
            4 : LongInt( BtrDest^ ) := $01;
          else
            begin
              ZeroFillField;
              FieldWriteError;
            end;
          end;
	end
        else
          ZeroFillField;
      end;
    btrFldNUMERIC:
      DoubleToBtrNumeric( BtrDest, Lo( DSize ), DDec, Double( Src^ ) );
    btrFldBFLOAT:
      Case DSize of
        4 : DoubleToBtrMBSingle( BtrDest, Double( Src^ ) );
        8 : DoubleToBtrMBDouble( BtrDest, Double( Src^ ) );
      else
        begin
          ZeroFillField;
          FieldWriteError;
        end;
      end;
    btrFldLSTRING:
      StringToBtrLString( BtrDest, Src, Lo( DSize ) );
    btrFldZSTRING:
      StringToBtrCString( BtrDest, DSize, Src );
    btrFldNOTE:
      { PutBlob handles this field type }
      begin
        ZeroFillField;
        FieldWriteError;
      end;
    btrFldLVAR:
      begin
        Try
          Move( Src^, BtrDest^, DSize );
        Except
          ZeroFillField;
          FieldWriteError;
        end;
      end;
    btrFldUBINARY:
      begin
        Case DSize of
          1   : Byte( BtrDest^ )     := Byte( Src^ );
          2   : Word( BtrDest^ )     := Word( Src^ );
          4   : LongWord( BtrDest^ ) := LongWord( Src^ );
          6,8 : Move( Src^, BtrDest^, Lo( DSize ) );
        else
          begin
            ZeroFillField;
            FieldWriteError;
          end;
        end;
      end;
    btrFldBIT:
      begin
        If PSQLBITFIELDMODE then
        begin
          If WordBool( Src^ ) then
            Byte( BtrDest^ ) := Byte( BtrDest^ ) OR DDec
          else
            Byte( BtrDest^ ) := Byte( BtrDest^ ) AND NOT DDec;
        end
        else
        begin
          If WordBool( Src^ ) then
            BtrieveBitSet( BtrDest^ ) := BtrieveBitSet( BtrDest^ ) + [ DDec ]
          else
            BtrieveBitSet( BtrDest^ ) := BtrieveBitSet( BtrDest^ ) - [ DDec ];
        end;
      end;
    btrFldNUMERICSTS:
      DoubleToBtrNumericSTS( BtrDest, Lo( DSize ), DDec, Double( Src^ ) );
    btrFldNUMERICSA:
      DoubleToBtrNumericSA( BtrDest, Lo( DSize ), DDec, Double( Src^ ) );
    btrFldCURRENCY:
      Currency( BtrDest^ ) := Double( Src^ );
    btrFldTIMESTAMP:
      Comp( BtrDest^ ) := DelphiDateToBtrieveTimestamp( TDateTime( Src^ ) );
{$IFDEF SMITHWARE_EXTENDED}
      btrExtFldLONGDATE:
        begin
          DelphiDateToDouble( @tmp, Date( Src^ ) );
          DoubleToBtrLongYMD( BtrDest, tmp );
        end;
      btrExtFldINTEL:
        DoubleToBtrBinary( BtrDest, Lo( DSize ), DDec, Double( Src^ ), 1, 0 );
      btrExtFldBINLR:
        DoubleToBtrBinary( BtrDest, Lo( DSize ), DDec, Double( Src^ ), 0, 0 );
      btrExtFldBINRL:
        DoubleToBtrBinary( BtrDest, Lo( DSize ), DDec, Double( Src^ ), 0, 1 );
      btrExtFldNUMERICASCII:
        DoubleToBtrNumeric( BtrDest, Lo( DSize ), DDec, Double( Src^ ) );
      btrExtFldMAGICDATE_0001:
        begin
          DelphiDateToDouble( @tmp, Date( Src^ ) );
          DoubleToBtrMagicDate( BtrDest, tmp, LongInt( -693594 ) );
        end;
      btrExtFldCTIME:
        begin
          DelphiTimeToDouble( @tmp, Time( Src^ ) );
          DoubleToBtrCTime( BtrDest, tmp );
        end;
      btrExtFldMAGICNUM100:
        DoubleToBtrMagicNum100( BtrDest, Lo( DSize ), Double( Src^ ) );
      btrExtFldTASPROTIME:
        begin
          DelphiTimeToDouble( @tmp, Time( Src^ ) );
          DoubleToBtrTasProTime( BtrDest, tmp );
        end;
      btrExtFldTASPROUNS:
        DoubleToBtrTasProNum( BtrDest, Lo( DSize ), DDec, Double( Src^ ) );
      btrExtFldBCD10:
        DoubleToBtrDecMath( BtrDest, Lo( DSize ), Double( Src^ ) );
      btrExtFldMAGICPCNUMERIC:
        DoubleToBtrMagicNum100( BtrDest, Lo( DSize ), Double( Src^ ) );
      btrExtFldMAGICPCTIME:
        begin
          DelphiTimeToDouble( @tmp, Time( Src^ ) );
          DoubleToBtrMagicTime( BtrDest, tmp );
        end;
      btrExtFldMAGICPCDATE:
        begin
          DelphiDateToDouble( @tmp, Date( Src^ ) );
          DoubleToBtrMagicDate( BtrDest, tmp, LongInt( 367 ) );
        end;
      btrExtFldYMD:
        begin
          DelphiDateToDouble( @tmp, Date( Src^ ) );
          DoubleToBtrYMD( BtrDest, tmp );
        end;
      btrExtFldYYMMDD:
        begin
          DelphiDateToDouble( @tmp, Date( Src^ ) );
          DoubleToBtrYYMMDD( BtrDest, tmp );
        end;
      btrExtFldYYYYMMDD:
        begin
          DelphiDateToDouble( @tmp, Date( Src^ ) );
          DoubleToBtrYYYYMMDD( BtrDest, tmp );
        end;
      btrExtFldTASPRO3DATE:
        begin
          DelphiDateToDouble( @tmp, Date( Src^ ) );
          DoubleToBtrTasProDate( BtrDest, tmp );
        end;
      btrExtFldTASPRO3NUMERIC:
        DoubleToBtrTasProNum( BtrDest, Lo( DSize ), DDec, Double( Src^ ) );
      btrExtFldCOBOLCOMP6:
        DoubleToBtrUDecimal( BtrDest, Lo( DSize ), DDec, Double( Src^ ) );
      btrExtFldVBDATE:
        begin
          TimeStamp  := MSecsToTimeStamp( TDateTime( Src^ ) );
          DateTmp    := TimeStampToDateTime( TimeStamp );
          TDateTime( BtrDest^ ) := DateTmp;
        end;
      btrExtFldVBCURRENCY:
        DoubleToBtrVBCurrency( BtrDest, Double( Src^ ) );
      btrExtFldDELPHIREAL:
        DoubleToBtrPascalReal( BtrDest, Double( Src^ ) );
{$ENDIF SMITHWARE_EXTENDED}
  end;
end;


Procedure GetTimeZoneBias;
var
  tzinfo : TTimeZoneInformation;
Begin
  getTimeZoneInformation( tzInfo );
  TimeZoneBias := tzInfo.Bias + tzInfo.DayLightBias;
end;


{$IFDEF SMITHWARE_EXTENDED}
Procedure DoneSmithware; far;
begin
  If ( ConversionDLL <> NIL ) then
    ConversionDLL.Free;
end;


Initialization
  ConversionDLL := NIL;
  GetTimeZoneBias;
Finalization
  DoneSmithware;
{$ELSE}
Initialization
  GetTimeZoneBias;
{$ENDIF SMITHWARE_EXTENDED}
end.





