(****************************************************************)
(*                     DATABASE TOOLBOX 4.0                     *)
(*     Copyright (c) 1984, 87 by Borland International, Inc.    *)
(*                                                              *)
(*                          EXPORTR                             *)
(*                                                              *)
(*   Translates Turbo Pascal Access files and Turbo Pascal      *)
(*   Random Access files into the equivalent Reflex databases.  *)
(*                                                              *)
(****************************************************************)
program ExportR;
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,
     FieldDef,
     EditLn,
     RealConv,
     Reflex;

const
  Version = '4.00';
  CopyrightMsg = 'Copyright (C)';
  Year = '1987';
  Company = 'Borland International';
  ProgName = 'ExportR';
  Description = ' translates Turbo Access/Pascal files into Reflex databases.';

{$V-}

procedure ProgramInfo;
begin
  Writeln;
  Writeln(ProgName, ' version ', Version);
  Writeln(CopyrightMsg, ' ', Year, ' ', Company);
  Writeln;
  Writeln(ProgName, Description);
  Writeln;
end;

procedure SyntaxHelp;
begin
  Writeln('Syntax: ', ProgName, ' FieldDefFile');
end;

const
  FileChars : CharSet = [#32..#127];
  Terminators : CharSet = [CR, Esc];

function GetFileName(prompt : String;
                     var F : FileName;
                     ExistCheck: boolean) : boolean;
var
  SaveX,
  SaveY : byte;
  TC : Char;
  AllDone : boolean;

begin
  GetFileName := false;
  Write(Prompt, ' ');
  SaveX := WhereX; { Save Initial X coordinate }
  SaveY := WhereY;
  repeat
    EditLine(F, SizeOf(FileName) - 1, SaveX, SaveY,
             FileChars, Terminators, TC);
    case TC of
      CR : if ExistCheck then
             Alldone := Exist(F)
           else
             Alldone := true;
      Esc : Alldone := true;
    end;
    if not AllDone then
      Beep;
  until Alldone;
  GetFileName := TC <> Esc;
end; { GetFileName }

function GetFileNames(var FD : FieldDirectory;
                      var FDFileSpec : FileSpec;
                      var PascalFileNm,
                      ReflexFileNm : FileName) : boolean;
var
  OK :  boolean;
  Prompt : string;
begin
  GetFileNames := false;
  with FD, FDFileSpec do
  begin
    PascalFileNm := Path + Name + FileDefaults[DataFileType].Ext;
    if DataFileNm = '' then
      DataFileNm := PascalFileNm;
    if DataFileType = PascalFile then
      Prompt := 'Turbo Pascal random-access file:'
    else
      Prompt := 'Turbo Pascal Access data file:';
    OK := GetFileName(Prompt, DataFileNm, true);
    if not OK then
      Exit;
    PascalFileNm := DataFileNm;
    ReflexFileNm := Path + Name + FileDefaults[ReflexFile].Ext;
    Writeln;
    OK := GetFileName('Reflex Database:', ReflexFileNm, false);
  end;
  GetFileNames := OK;
end;

procedure TransToReflex(var FD : FieldDirectory;
                        var ReflexFileNm,
                        PascalFileNm : FileName);
var
  ReflexFile : ReflexRef;
  PascalRecSize : integer;
  BlocksRead : integer;
  TurboAccess : boolean;
  FirstRecord,
  CurrentRecord : LongInt;
  PascalFile : file;
  StatusF : boolean;
  PascalRec : ^byte;

begin
  MakeReflexFile(ReflexFile, ReflexFileNm, FD);
  PascalRecSize := FD.RecordSize;
  if PascalRecSize > 0 then
  with FD do
  begin
    GetMem(PascalRec, PascalRecSize);
    Assign(PascalFile, PascalFileNm);
    Reset(PascalFile, PascalRecSize);
    TurboAccess := DataFileType = TAccessFile;
    with FieldEntries[0]^ do
      StatusF := TurboAccess and
                 (XLateStatus = TAccessFile)
                 and (TFieldType = LongIntVal);
    Writeln;
    Write('Translating Turbo Pascal ');
    if TurboAccess then
      Write('Access ');
    Writeln('-> Reflex records:');
    if TurboAccess then
    begin
      FirstRecord := 1;
      Seek(PascalFile, 1);
    end
    else
      FirstRecord := 0;
    for CurrentRecord := FirstRecord to pred(FileSize(PascalFile)) do
    begin
      Write(CurrentRecord:10, #13);
      BlockRead(PascalFile, PascalRec^, 1, BlocksRead);
         { Get "generic" Pascal record }
      if not TurboAccess then
        AddReflexRec(ReflexFile, PascalRec^) { Add record to Reflex database }
      else
        if not StatusF or
          (LongInt(PascalRec^) = 0) then
            AddReflexRec(ReflexFile, PascalRec^)
               { Add record to Reflex database }
    end;
  end;
  CloseReflexFile(ReflexFile);
       { Save important reflex file header information and closes the file }
                   { This routine is required! when modifying reflex files }
  Writeln;
  Writeln('Closing ', ReflexFileNm);
  Close(PascalFile);
end; { TransToReflex }

var
  FDFileSpec : FileSpec;
  FD : FieldDirectory;
  PascalFileNm,
  ReflexFileNm : FileName;


begin { TurToRef }
  ProgramInfo;
  if ParamCount = 0 then
  begin
    SyntaxHelp;
    Halt;
  end
  else
  begin
    GetFileSpec(FDFileSpec, ParamStr(1));
    with FDFileSpec do
    begin
      if not Exist(Path + Name + Ext) then
        Ext := FDExt;
      if not Exist(Path + Name + Ext) then
        Abort('Could not find ' + Path + Name + Ext);
      LoadFD(FD, Path + Name + Ext);
    end;
    if GetFileNames(FD, FDFileSpec, PascalFileNm, ReflexFileNm) then
      TransToReflex(FD, ReflexFileNm, PascalFileNm);
  end;
end. { ExportR }
