(****************************************************************)
(*                     DATABASE TOOLBOX 4.0                     *)
(*     Copyright (c) 1984, 87 by Borland International, Inc.    *)
(*                                                              *)
(*                       FieldDef Unit                          *)
(* Purpose: Routines that input and output field definition     *)
(* which are used in the translation of Reflex and Turbo        *)
(* Pascal Access files.                                         *)
(*                                                              *)
(****************************************************************)
unit FieldDef;
interface
uses DOS,
     CRT,
     MiscTool,
{    If a compiler error occurs here, you need to unpack the source
     to the MiscTool unit from the archived file Tools.arc.  See the
     README file on disk 1 for detailed instructions. }

     FileUtil;

{$V-}
const
  MaxField   = 249;
  MaxKeys    =   9;
  MaxSubKeys =   4;

type
  FileType = (ReflexFile, TAccessFile, PascalFile, Translate);
  FileDefaultsRec = record
                      Symbol : string[2];
                      Ext : FileExt;
                    end;
const
  FDExt = '.FD';
  TypExt = '.TYP';
  FileDefaults : array[FileType] of FileDefaultsRec =
                  ((Symbol : 'R'; Ext : '.RXD'),
                   (Symbol : 'T'; Ext : '.DAT'),
                   (Symbol : 'P'; Ext : '.BIN'),
                   (Symbol : 'X'; Ext : '')
                 );
type
  Line = String[80];
  Ident = String[74];
  FieldTypes = (untyped, TextVal, RepText, RDateVal, DoubleVal, IntegerVal,
                CharVal, ByteVal, LongIntVal,  RealVal,
                StringVal, DateVal, Block);
  ReflexTypes = Untyped..IntegerVal;
  FieldTypeRec = record
                   TypeName : String[7];
                   TypeSize : integer;
                 end;
const
  FieldDefaults : array[FieldTypes] of FieldTypeRec =
                   ((TypeName : 'untyped'; TypeSize : 0),
                    (TypeName : 'text'; TypeSize : 2),
                    (TypeName : 'RepText'; TypeSize : 2),
                    (TypeName : 'Rdate'; TypeSize : 2),
                    (TypeName : 'double'; TypeSize : 8),
                    (TypeName : 'integer'; TypeSize : 2),
                    (TypeName : 'char'; TypeSize : 1),
                    (TypeName : 'byte'; TypeSize : 1),
                    (TypeName : 'LongInt'; TypeSize : 4),
                    (TypeName : 'real'; TypeSize : 6),
                    (TypeName : 'string'; TypeSize : 256),
                    (TypeName : 'Date'; TypeSize : 9), { 'mm/dd/yy' }
                    (TypeName : 'Block'; TypeSize : 0)
                   );
type
  FieldInfoPtr = ^FieldInfo;
  FieldInfo = record
                FieldName : Ident;
                ReflexType : ReflexTypes;
                TFieldType : FieldTypes;
                TFieldLength,
                RecOffset  : integer;
                XLateStatus : FileType;
              end;
const
  StatusField : FieldInfo =
                 (FieldName : 'RecStatus';
                  ReflexType : Untyped;
                  TFieldType : LongIntVal;
                  TFieldLength : 4;
                  RecOffset : 0;
                  XLateStatus : TAccessFile);

type
  FieldDir = array[0..MaxField] of FieldInfoPtr;
  KeyInfoPtr = ^KeyInfo;
  SubKeyInfo = record
                 FieldNum,
                 NumBytes : integer;
               end;
  KeyInfo = record
              KeyName : Ident;
              IndexFileNm : FileName;
              Status : integer;
              Size : integer;
              NumSubKeys : integer;
              SubKeys : array[0..MaxSubKeys] of SubKeyInfo;
            end;

  KeyDir = array[0..MaxKeys] of KeyInfoPtr;

  type
    ErrorInfo = record
                  Num : integer;
                  Line : String[80];
                end;

  FieldCounts = array[FileType] of integer;

  FieldDirectory = record
                     DataFileType : FileType;
                     DataFileNm : FileName;
                     RecordName : Ident;
                     RecordSize : integer;
                     TotalFields : integer;
                     FieldTotals : FieldCounts;
                     FieldEntries : FieldDir;
                     NumberOfKeys : integer;
                     KeyEntries : KeyDir;
                     LoadError : ErrorInfo;
                   end;
const
  IndexStatusStr : array[0..1] of string[12] =
                     ('NoDuplicates',
                      'Duplicates');

procedure CopyFD(var Source, Dest : FieldDirectory);

procedure DisposeFD(var Fields : FieldDirectory);

procedure GetFieldInfo(var Fields : FieldDirectory;
                       FieldNum : integer;
                       var F : FieldInfo);

function GetFieldName(var Fields : FieldDirectory;
                           Num : integer) : Ident;

procedure GenPascalTypeDef(var Fields : FieldDirectory;
                           DefFileNm : FileName);

function GetPascalRecSize(var Fields : FieldDirectory) : word;

procedure LoadFD(var Fields : FieldDirectory;
                        DefFileNm : FileName);

procedure RefToTurboType(var F : FieldInfo);

procedure SetFieldInfo(var Fields : FieldDirectory;
                       FieldNum : integer;
                       var F : FieldInfo);

procedure StoreFD(var Fields : FieldDirectory;
                      DefFileNm : FileName);

procedure TurboToRefType(var F : FieldInfo);

implementation


procedure ReportLoadError(var Err : ErrorInfo;
                          LookingFor : Line);
begin
  with Err do
  begin
    GotoXY(1, 23);
    ClrEOL;
    Writeln('Error Loading field definition file');
    ClrEOL;
    WriteLn('Line ', Num, ':', Line);
    ClrEOL;
    Writeln('Looking for ', LookingFor);
    Halt(1);
  end;
end;

const
  Null = #0;
  Space = #32;

type
  CharSet = set of char;

procedure Strip(var S : Line; StripChars : CharSet);
var
  i : byte;
begin
  i := 1;
  repeat
    if S[i] in StripChars then
      Delete(S, i, 1)
    else
      i := Succ(i);
  until i > Length(S);
end; { Strip }

function NumStr(S : Line; var i : integer) : boolean;
var
  Temp,
  Code : integer;
begin
  if S = '' then
  begin
    NumStr := false;
    Exit;
  end;
  Val(S, Temp, Code);
  if Code = 0 then
    i := temp;
  NumStr := Code = 0;
end; { NumStr }

procedure StripComment(var S : Line);
const
  Marker = ';';
var
  StartPos : byte;
begin
  StartPos := Pos(Marker, S);
  if (StartPos > 0) then
    Delete(S, StartPos, Succ(Length(S) - StartPos));
end;

procedure StripLeadBlanks(var S : Line);
{ Removes leading blanks from the string }
var
  i : byte;
begin
  i := 1;
  while (i < Length(S)) and (S[i] in [' ', ^I]) do
    Delete(S, i, 1);
end; { StripLeadBlanks }

procedure StripTrailBlanks(var S : Line);
{ Removes trailing blanks from the string }
var
  i : byte;
begin
  i := Length(S);
  repeat
    if not (S[i] in [' ', ^I]) then
      i := 0
    else
    begin
      Delete(S, i, 1);
      i := pred(i);
    end;
  until (i = 0);
end; { StripTrailBlanks }

procedure NextLine(var Fields : FieldDirectory;
                   var F : text;
                   var S : Line);
{  Keeps reading lines from the definition file removing
   blanks and comments (which start with a ';') until
   we get a candidate for the next field item.
}

begin { NextLine }
  {$ifdef debug}
   Write('Entering NextLine');
   Readln;
  {$endif}
  with Fields.LoadError do
  repeat
    Inc(Num, 1);
    Readln(F, S);
    {$ifdef debug}
    Write('CurLine: ', S);
    Readln;
    {$endif}
    Line := S;
    StripComment(S);
    if S <> '' then
      StripLeadBlanks(S);
    if S <> '' then
      StripTrailBlanks(S);
  until (length(S) > 0) or Eof(F);
  (* S := UpCaseStr(S); *)
  {$ifdef debug}
   Write('Exiting NextLine');
   Readln;
  {$endif}
end; { NextLine }

const
  Delimeters : CharSet = [Space, ':', '[', ']'];

function NextToken(var S : Line;
                   var Delim : char) : Ident;
var
  Start : byte;
  found : boolean;
begin
  Start := 1;
  found := false;
  while (Start <= Length(S)) and not found do
  begin
    found := S[Start] in Delimeters;
    if not found then
      Inc(Start, 1);
  end;
  if Found then
  begin
    Delim := S[Start];
    NextToken := Copy(S, 1, Start - 1);
    Delete(S, 1, Start);
  end
  else
  begin
    NextToken := S;
    S := '';
    Delim := Null;
  end;
end; { NextToken }

procedure GetFileType(var Fields : FieldDirectory;
                      var DefFile : text);
var
  S : Line;
  FTypeMarker : String[4];
  found : boolean;
  Delim : char;

begin
  NextLine(Fields, DefFile, S);
  FTypeMarker := NextToken(S, Delim);
  {$IFDEF DEBUG}
  Writeln('File type marker ', FTypeMarker);
  Write('Rest of str ', S);
  Readln;
  {$ENDIF}
  with Fields, LoadError do
  begin
    DataFileType := ReflexFile;
    repeat
      found := Pos(UpCaseStr(FTypeMarker), FileDefaults[DataFileType].Symbol) = 1;
      if (not found) then
        if (DataFileType < Translate) then
          DataFileType:= succ(DataFileType)
        else
          DataFileType := ReflexFile;
    until Found or (DataFileType = ReflexFile);
    if not Found then
      ReportLoadError(LoadError, 'File type symbol');
    if Delim <> Null then
      DataFileNm := S;
  end;
  {$ifdef debug}
  Write('Exiting GetFileType');
  Readln;
  {$endif}
end; { GetFileType }

procedure LoadFieldInfo(var Fields : FieldDirectory;
                        var DefFile : Text;
                        CurField : integer);
var
  S : Line;
  Delim : char;
  FieldTypeStr : Line;
  found : boolean;

begin
  New(Fields.FieldEntries[CurField]);
  FillChar(Fields.FieldEntries[CurField]^, SizeOf(Fields.FieldEntries[CurField]^), 0);
  with Fields, FieldEntries[CurField]^ do
  begin
    NextLine(Fields, DefFile, S);
    Strip(S, [Space]);
    FieldName := NextToken(S, Delim);
    {$IFDEF Debug}
      Writeln('FieldName ', FieldName);
      Writeln('Rest of Str ', S);
      Readln;
    {$ENDIF}
    if (Delim = Null) then
      ReportLoadError(Fields.LoadError,  'the field type for ' + FieldName);
    FieldTypeStr := UpCaseStr(NextToken(S, Delim));
    {$IFDEF Debug}
      Write('FieldType ', FieldTypeStr);
      Readln;
    {$ENDIF}
    TFieldType := Untyped;
    repeat
      with FieldDefaults[TFieldType] do
        found := Pos(FieldTypeStr, UpCaseStr(TypeName)) = 1;
      if not found then
      if TFieldType < Block then
        TFieldType := succ(TFieldType)
      else
        TFieldType := Untyped;
    until found or (TFieldType = Untyped);
    if not found then
      ReportLoadError(LoadError, 'a valid field type for ' + FieldName);
    TFieldLength := FieldDefaults[TFieldType].TypeSize;
    if ((TFieldType = StringVal) or (TFieldType = Block)) and
       (Delim = '[') then
      if not NumStr(NextToken(S, Delim), TFieldLength) then
        ReportLoadError(LoadError, 'valid string length')
      else
        Inc(TFieldLength, 1);
    RecordSize := RecordSize + TFieldLength;
    NextLine(Fields, DefFile, S);
    XLateStatus := ReflexFile;
    repeat
      found := Pos(UpcaseStr(S), FileDefaults[XLateStatus].Symbol) = 1;
      if (not found) then
        if (XLateStatus < Translate) then
          XLateStatus := succ(XLateStatus)
        else
          XLateStatus := ReflexFile;
    until Found or (XLateStatus = ReflexFile);
    if not Found then
      ReportLoadError(LoadError, 'the translate status of this field');
    Inc(FieldTotals[XLateStatus]);
  end;
end; { LoadFieldInfo }

procedure GetFieldDescriptions(var Fields : FieldDirectory;
                               var DefFile : Text);
var
  CurField : integer;
  FieldNumStr : Line;

begin
  {$ifdef debug}
  Write('Entering GetFieldDescriptions');
  Readln;
  {$endif}
  with Fields do
  begin
    NextLine(Fields, DefFile, FieldNumStr);
    if not NumStr(FieldNumStr, Fields.TotalFields) then
      ReportLoadError(Fields.LoadError, 'The number of data fields');
    for CurField := 0 to pred(TotalFields) do
      LoadFieldInfo(Fields, DefFile, CurField);
  end;
  {$ifdef debug}
  Write('Exiting GetFieldDescriptions');
  Readln;
  {$endif}
end; { GetFieldDescriptions }

procedure LoadSubKeyInfo(var Fields : FieldDirectory;
                             var DefFile : text;
                         CurKey : integer);
var
  S : Ident;
  Delim : char;
  CurSubKey : integer;
  SubKeyName : Ident;
  CurField : integer;
  found : boolean;

begin
  with Fields, Fields.KeyEntries[CurKey]^ do
  begin
    NextLine(Fields, DefFile, S);
    if not NumStr(S, NumSubKeys) then
      ReportLoadError(LoadError, 'number of subkeys');
    for CurSubKey := 0 to pred(NumSubKeys) do
      with SubKeys[CurSubKey] do
      begin
        NextLine(Fields, DefFile, S);
        SubKeyName := UpCaseStr(NextToken(S, Delim));
        CurField := 0;
        repeat
           found := UpCaseStr(GetFieldName(Fields, CurField)) = SubKeyName;
           if not found then
             Inc(CurField, 1);
        until found or (CurField = TotalFields);
        if not found then
          ReportLoadError(LoadError, SubKeyName + ' did not match any of the data fields')
        else
        begin
          FieldNum := CurField;
          if Delim = '[' then
          begin
            if not NumStr(NextToken(S, Delim), NumBytes) then
              ReportLoadError(LoadError, 'valid string length')
          end
          else
            NumBytes := 255;
        end;
    end;
  end;
end; { LoadSubKeyInfo }

procedure LoadKeyInfo(var Fields : FieldDirectory;
                             var DefFile : text;
                       CurKey : integer);
var
  S : Line;
  Delim : char;
  found : boolean;

begin
  new(Fields.KeyEntries[CurKey]);
  FillChar(Fields.KeyEntries[CurKey]^, SizeOf(Fields.KeyEntries[CurKey]^), 0);
  with Fields, Fields.KeyEntries[CurKey]^ do
  begin
    NextLine(Fields, DefFile, S);
    KeyName := NextToken(S, Delim);
    if Delim = '[' then
    begin
      if NumStr(NextToken(S, Delim), Size) then
        Inc(Size, 1)
      else
        ReportLoadError(LoadError, 'valid string length')
    end
    else
      Size := 256;
    if S <> '' then
    begin
      Strip(S, [Space]);
      if S <> '' then
        IndexFileNm := S;
    end;
    NextLine(Fields, DefFile, S);
    Status := 0;
    repeat
      found := Pos(UpCaseStr(S), UpCaseStr(IndexStatusStr[Status])) = 1;
      if not found then
        Inc(Status, 1);
    until found or (Status > 1);
    if not found then
      ReportLoadError(LoadError, 'Key status (Duplicates or NoDuplicates) indicator');
    LoadSubKeyInfo(Fields, DefFile, CurKey);
  end;
end; { LoadKeyInfo }

procedure GetKeyDescriptions(var Fields : FieldDirectory;
                             var DefFile : text);
var
  KeyNumStr : Line;
  CurKey : integer;
begin
  NextLine(Fields, DefFile, KeyNumStr);
  if EOF(DefFile) then
     Fields.NumberOfKeys := 0
  else
    if not NumStr(KeyNumStr, Fields.NumberOfKeys) then
      ReportLoadError(Fields.LoadError, 'The number of keys');
  for CurKey := 0 to pred(Fields.NumberOfKeys) do
    LoadKeyInfo(Fields, DefFile, CurKey);
end; { GetKeyDescriptions }


procedure LoadFD(var Fields : FieldDirectory;
                        DefFileNm : FileName);
var
  DefFile : Text;

begin
  with Fields, LoadError do
  begin
    if not Exist(DefFileNm) then
      Abort('Could not open ' + DefFileNm)
    else
    begin
      Assign(DefFile, DefFileNm);
      Reset(DefFile);
    end;
    FillChar(Fields, SizeOf(Fields), 0);
    GetFileType(Fields, DefFile);
    {$ifdef debug}
    Write('After GetFileType');
    Readln;
    {$endif}
    NextLine(Fields, DefFile, RecordName);
    GetFieldDescriptions(Fields, DefFile);
    if (DataFileType = TAccessFile) then
      GetKeyDescriptions(Fields, DefFile);
    Close(DefFile);
  end;
end; { LoadFD }

procedure GetFieldInfo(var Fields : FieldDirectory;
                       FieldNum : integer;
                       var F : FieldInfo);
begin
  with Fields do
    if (FieldNum >= 0) and (FieldNum < TotalFields) then
      F := FieldEntries[FieldNum]^;
end; { GetFieldInfo }

function GetFieldName(var Fields : FieldDirectory;
                           Num : integer) : Ident;
begin
  with Fields do
  begin
    if (Num < TotalFields) then
      GetFieldName := FieldEntries[Num]^.FieldName
    else
      GetFieldName := '';
  end;
end; { GetFieldName }

procedure SetFieldInfo(var Fields : FieldDirectory;
                       FieldNum : integer;
                       var F : FieldInfo);
begin
  with Fields do
    if (FieldNum >= 0) and (FieldNum < TotalFields) then
      FieldEntries[FieldNum]^ := F;
end; { SetFieldInfo }

procedure StoreFieldInfo(var OutFile : text;
                         F : FieldInfo;
                         FieldNum : integer);
begin
  with F do
  begin
    if FieldNum = 0 then
      Writeln(OutFile, '; Field name : Field Type');
    Write(OutFile, FieldName, ' : ');
    Write(OutFile, FieldDefaults[TFieldType].TypeName);
    if TFieldType = StringVal then
    begin
      if TFieldLength <> 256 then
        Writeln(OutFile, '[', pred(TFieldLength), ']')
      else
        Writeln(OutFile);
    end
    else
      Writeln(OutFile);
    if FieldNum = 0 then
    Writeln(OutFile, '; Translate Status');
    Writeln(OutFile, FileDefaults[XLateStatus].Symbol);
  end;
end; { StoreFieldInfo }

procedure StoreKeyInfo(var OutFile : text;
                       var Fields : FieldDirectory;
                       var K : KeyInfo;
                       KeyNum : integer);
var
  CurField : integer;
begin
  with K do
  begin
    if KeyNum = 0 then
      Writeln(OutFile, '; Key name[Size]  [Index file name]');
    Write(OutFile, KeyName);
    if Size <> 256 then
      Write(OutFile, '[', pred(size), ']')
    else
      Write(OutFile);
    if IndexFileNm <> '' then
      Writeln(OutFile, ' ', IndexFileNm)
    else
      Writeln(OutFile);
    if KeyNum = 0 then
      Writeln(OutFile, '; Index file status');
    Writeln(OutFile, IndexStatusStr[Status]);
    if KeyNum = 0 then
      Writeln(OutFile, '; Number of fields this key is built from');
    Writeln(OutFile, NumSubKeys);
    if NumSubKeys > 0 then
      for CurField := 0 to (NumSubKeys - 1) do
      with SubKeys[CurField] do
      begin
        if (KeyNum = 0) and (CurField = 0) then
          Writeln(OutFile, '; Field name [Number of characters to use]');
        Write(OutFile, GetFieldName(Fields, FieldNum));
        if NumBytes <> 255 then
          Writeln(OutFile, '[', NumBytes, ']')
        else
          Writeln(OutFile);
      end;
  end;
end; { StoreKeyInfo }

procedure StoreFD(var Fields : FieldDirectory;
                        DefFileNm : FileName);
var
  DefFile : text;
  CurField : integer;
begin
  with Fields do
  begin
    if TotalFields > 0 then
    begin
      Assign(DefFile, DefFileNm);
      Rewrite(DefFile);
      Writeln(DefFile, '; Data File Type [Data file name]');
      Write(DefFile, FileDefaults[DataFileType].Symbol);
      if Length(DataFileNm) > 0 then
        Writeln(DefFile, ' ', DataFileNm)
      else
        Writeln(DefFile);
      Writeln(DefFile, '; Record name');
      Writeln(DefFile, RecordName);
      Writeln(DefFile, '; Number Of Fields');
      Writeln(DefFile, TotalFields);
      for CurField := 0 to (TotalFields - 1) do
        StoreFieldInfo(DefFile, FieldEntries[CurField]^, CurField);
      if (DataFileType = TAccessFile) then
      begin
        Writeln(DefFile, '; Number of keys');
        Writeln(DefFile, NumberOfKeys);
        if NumberOfKeys > 0 then
          for CurField := 0 to (NumberOfKeys - 1) do
            StoreKeyInfo(DefFile, Fields, KeyEntries[CurField]^, CurField);
      end;
      Close(DefFile);
    end;
  end;
end; { StoreFD }

function ConvertToIdent(FieldName : Ident): Ident;
begin
  Strip(FieldName, [#0..#255] - ['a'..'z', 'A'..'Z', '0'..'9', '_']);
  if Length(FieldName) > 0 then
  begin
    if not (FieldName[1] in ['a'..'z', 'A'..'Z']) then
      if Length(FieldName) < 255 then
        Insert('X', FieldName, 1)
      else
        FieldName[1] := 'X';
    FieldName[1] := UpCase(FieldName[1]);
  end;
  ConvertToIdent := FieldName;
end; { ConvertToIdent }

function DateFields(var Fields : FieldDirectory) : boolean;
var
  CurField : integer;
begin
  DateFields := true;
  with Fields do
    for CurField := 0 to pred(TotalFields) do
      with Fields.FieldEntries[CurField]^ do
      if (XLateStatus = DataFileType) or
         (XLateStatus = Translate) then
      begin
        if TFieldType = DateVal then
          Exit;
      end;
  DateFields := false;
end;

procedure GenPascalTypeDef(var Fields : FieldDirectory;
                           DefFileNm : FileName);
const
 Indent = 2;
var
  DefFile : text;
  CurField : integer;
  FieldStartX : integer;
  MaxKeyType : Ident;
  MaxKeySize : integer;
begin
  with Fields do
  begin
    Assign(DefFile, DefFileNm);
    {$I-}
    Rewrite(DefFile);
    {$I+}
    if IOResult <> 0 then
      Abort('Could not create '  + DefFileNm);
    Writeln(DefFile, 'type');
    if DateFields(Fields) then
      with FieldDefaults[DateVal] do
      begin
        Write(DefFile, ' ':Indent, TypeName);
        Writeln(DefFile,' = string[', TypeSize - 1, ']; { mm/dd/yy }');
      end;
    Writeln(DefFile, ' ':Indent, RecordName, ' = record');
    FieldStartX := Indent + Length(RecordName) + 5;
    for CurField := 0 to pred(TotalFields) do
      with Fields.FieldEntries[CurField]^ do
      if (XLateStatus = DataFileType) or
         (XLateStatus = Translate) then
      begin
        Write(DefFile, ' ':FieldStartX,
             ConvertToIdent(FieldName), ' : ');
        Write(DefFile, FieldDefaults[TFieldType].TypeName);
        if TFieldType = StringVal then
          if TFieldLength <> 256 then
            Write(DefFile, '[', pred(TFieldLength), ']');
        Writeln(DefFile, ';');
      end;
    Writeln(DefFile, ' ':FieldStartX - 2, 'end;');
    if (DataFileType = TAccessFile) then
    begin
      MaxKeyType := 'string';
      MaxKeySize := 0;
      if NumberOfKeys > 0 then
        for CurField := 0 to pred(NumberOfKeys) do
          with KeyEntries[CurField]^ do
          begin
            Write(DefFile, ' ':Indent, KeyName, ' = string');
            if Size <> 256 then
              Write(DefFile, '[', pred(Size), ']');
            Writeln(DefFile, ';');
            if Size > MaxKeySize then
            begin
              MaxKeySize := Size;
              MaxKeyType := KeyName;
            end;
          end;
      Writeln(DefFile, ' ':Indent, 'MaxKeyType = ', MaxKeyType, ';');
      Writeln(DefFile, ' ':Indent, 'MaxDataType = ', RecordName, ';');
    end;
  end;
  Close(DefFile);
end; { GenPascalTypeDef }

procedure CopyFD(var Source, Dest : FieldDirectory);
var
  CurField : integer;

begin
  FillChar(Dest, SizeOf(Dest), 0);
  Move(Source, Dest, SizeOf(Dest));
  with Source do
  begin
    if TotalFields > 0 then
      for CurField := 0 to pred(TotalFields) do
      begin
        New(Dest.FieldEntries[CurField]);
        Dest.FieldEntries[CurField]^ := FieldEntries[CurField]^;
      end;
    if NumberOfKeys > 0 then
      for CurField := 0 to pred(NumberOfKeys) do
      begin
        New(Dest.KeyEntries[CurField]);
        Dest.KeyEntries[CurField]^ := KeyEntries[CurField]^;
      end;
  end;
end; { CopyFD }

procedure DisposeFD(var Fields : FieldDirectory);
var
  CurField : integer;
begin
  with Fields do
  begin
    if TotalFields > 0 then
      for CurField := 0 to pred(TotalFields) do
        Dispose(FieldEntries[CurField]);
    if NumberOfKeys > 0 then
       for CurField := 0 to pred(NumberOfKeys) do
         Dispose(KeyEntries[CurField]);
  end;
  FillChar(Fields, SizeOf(Fields), 0);
end; { DisposeFD }

procedure TurboToRefType(var F : FieldInfo);
begin
  with F do
    if XLateStatus = TAccessFile then
      ReflexType := Untyped
    else
    begin
      case TFieldType of
        DoubleVal,
        IntegerVal : ReflexType := TFieldType;
        CharVal : ReflexType := TextVal;
        ByteVal : ReflexType := IntegerVal;
        LongIntVal,
        RealVal : ReflexType := DoubleVal;
        StringVal : ReflexType := TextVal;
        DateVal,
        RDateVal : ReflexType := RDateVal;
        Block : ReflexType := Untyped;
      end;
    end;
end; { TurboToRefType }

procedure RefToTurboType(var F : FieldInfo);
begin
  with F do
  begin
    if XLateStatus = ReflexFile then
      TFieldType := UnTyped
    else
    begin
      case ReflexType of
        untyped,
        IntegerVal : TFieldType := ReflexType;
        TextVal,
        RepText : TFieldType := StringVal;
        RDateVal : TFieldType := DateVal;
        DoubleVal : TFieldType := RealVal;
      end;
    end;
    TFieldLength := FieldDefaults[TFieldType].TypeSize;
  end;
end; { RefToTurboType }

function GetPascalRecSize(var Fields : FieldDirectory) : word;
var
  CurField : integer;
begin
  with Fields do
  begin
    RecordSize := 0;
    for CurField := 0 to TotalFields - 1 do
      with FieldEntries[CurField]^ do
        if (XLateStatus <> ReflexFile) then
        begin
          RecOffset := RecordSize;
          Inc(RecordSize, TFieldLength);
        end;
    GetPascalRecSize := RecordSize;
  end;
end; { GetPascalRecSize }

end. { FieldDef }