Liren Large Software Subsidy 9/09.iso/l/l041/2.ddi/MISC.ARC/TABUILD.PAS

Pascal/Delphi Source File | 1987-12-31 | 16.2 KB | 571 lines

(****************************************************************)
(*                     DATABASE TOOLBOX 4.0                     *)
(*     Copyright (c) 1984, 87 by Borland International, Inc.    *)
(*                                                              *)
(*                         TABuild                              *)
(*                                                              *)
(*  Purpose: Configures Turbo Access according to the data      *)
(*           record and key definitions in the input file.      *)
(*                                                              *)
(* The built-in editor that TABUILD uses was implemented with   *)
(* a unit called BINED.TPU, which is not included with the      *)
(* Database Toolbox.  The Turbo Pascal Editor Toolbox 4.0       *)
(* contains BINED.TPU along with full documentation about its   *)
(* capabilities.  If you have purchased the Editor Toolbox 4.0, *)
(* you can recompile TABUILD and link in BINED.TPU with the     *)
(* following steps in the integrated environment:               *)
(*                                                              *)
(* 1)  Load TABuild.pas (this file) into the Turbo Pascal       *)
(*     editor.                                                  *)
(*                                                              *)
(* 2)  Pull down the Options menu and select Compiler.          *)
(*                                                              *)
(* 3)  Select Conditional Defines and type in BINED, then       *)
(*     press return.  This conditional directive will tell      *)
(*     the compiler to link in BINED.TPU according to the       *)
(*     directives given below.                                  *)
(*                                                              *)
(* 4)  Copy BINED.TPU into your current directory or disk;      *)
(*     you can also set a Unit Directory path to BINED.TPU      *)
(*     in the Options menu.                                     *)
(*                                                              *)
(* 5)  Press F9 to make the TABuild program.                    *)
(*                                                              *)
(* With the command-line compiler (TPC.EXE), you may issue the  *)
(* following command at the dos prompt to make the necessary    *)
(* units and define the conditional symbol BINED:               *)
(*                                                              *)
(*   TPC TABUILD /M /DBINED                                     *)
(*                                                              *)
(* /DBINED defines the symbol BINED which is used to compile    *)
(*         the code for TABUILD's built-in editor.              *)
(*                                                              *)
(****************************************************************)
program TABuild;
{$M 6000, 4000, $16000}
uses CRT,
     DOS,
     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. }

     EditLn,
     FileUtil,
     SetConst

     {$IFDEF BINED} ,
      BinEd,
{     If a compiler error occurs here, you need the unit BINED.TPU
      from the Turbo Pascal Editor Toolbox 4.0.  See the documentation
      at the top of this file for detailed instructions. }

      TAEdit
     {$ENDIF};

{$V-}
{$I Paths.inc}
const
  Version = '4.00';
  CopyrightMsg = 'Copyright (C)';
  Year = '1987';
  Company = 'Borland International';
  EXE = '.EXE';
  PAS = '.PAS';
  TPU = '.TPU';
  TypeExt = '.TYP';
  SizeExt = '.SIZ';
  DefExt = '.DEF';
  ProgName = 'TABuild';
  InstallProg = 'TAInst';
  TPC = 'TPC';
  Turbo = 'TURBO';
  TAccess = 'TACCESS';
  TAHigh = 'TAHIGH';
  TAGenSizes = 'TASizes';

  DebugFlag = ' /dTADebug';

  SectionName = '"Configuring Turbo Pascal Access"';

  type
    Line = string[80];
    Options =  (UseWorkSheet, CompTAHigh, DebugInfo);
    OptionRec = record
                  OptStr : string[3];
                  FlagSet : boolean;
                  OptHelp : Line;
                end;
    CompOptions = record
                    OptStr : string[4];
                    OptHelp,
                    OptList : Line;
                  end;
  const
    BuildOptions : array[Options] of OptionRec =
                   ( (OptStr : '/W+'; FlagSet : false;
                     OptHelp : 'Use the TABuild Constants WorkSheet to calculate Turbo Access constants'),
                    (OptStr : '/H-'; FlagSet : true;
                     OptHelp : 'Do not compile the Turbo Access High-Level Unit'),
                    (OptStr : '/E-'; FlagSet : true;
                     OptHelp : 'No Turbo Access error messages and procedure names')
                   );
   CompilerOptions : CompOptions =
      (OptStr : '/$xx';
       OptHelp : 'Compile Turbo Access with directive xx';
       OptList : '');

var
  UserFileSpec : FileSpec;
  CurDir : PathName;

procedure ReportError(ErrorMsg,
                      ErrorHelp : Line);
begin
  Beep;
  Writeln;
  Writeln('Error: ', ErrorMsg);
  if ErrorHelp <> '' then
    Writeln(ErrorHelp);
end;

procedure ManualHelp(Subject : string);
begin
  Writeln('For more information on ', Subject, ', see the section ');
  Writeln(SectionName, ' in your Database Toolbox manual.');
end;

procedure SyntaxHelp;
const
  FlagColumn = 2;
  MsgColumn = 6;
var
  CurOpt : Options;
begin
  Writeln;
  Writeln(ProgName, ' configures Turbo Access with your data record and key type definitions.');
  Writeln;
  Writeln('Syntax: ', ProgName, ' [options] TypesFile');
  Writeln('Options:');
  for CurOpt := UseWorkSheet to DebugInfo do
    with BuildOptions[CurOpt] do
      Writeln('':FlagColumn, OptStr, '':MsgColumn - Length(OptStr), OptHelp);
  with CompilerOptions do
    Writeln('':FlagColumn, OptStr, '':MsgColumn - Length(OptStr), OptHelp);
  Writeln;
  ManualHelp(ProgName);
end;


procedure CheckParam(CurParamStr : String;
                     var TypesFile : FileName);
var
  CurOpt : Options;
begin
  if CurParamStr[1] <> '/' then
    TypesFile := CurParamStr
  else
  begin
    CurOpt := UseWorkSheet;
    repeat
      if CurParamStr = BuildOptions[CurOpt].OptStr then
      begin
        BuildOptions[CurOpt].flagSet := not BuildOptions[CurOpt].flagSet;
        Exit;
      end;
      CurOpt := succ(CurOpt);
    until (CurOpt > DebugInfo);
    if Pos('$', CurParamStr) > 0 then
       CompilerOptions.OptList := CompilerOptions.OptList + ' ' + CurParamStr;
  end;
end;

function GetParams(var TypesFile : FileName) : boolean;
var
  CurParamNum : integer;
  CurParamStr : string;
begin
  TypesFile := '';
  for CurParamNum := 1 to ParamCount do
  begin
    CurParamStr := UpCaseStr(ParamStr(CurParamNum));
    CheckParam(CurParamStr, TypesFile);
  end;
  GetParams := TypesFile <> '';
end;

function FoundUserFile(var TypesFile : FileName) : boolean;
var
  Found : boolean;
begin
  GetFileSpec(UserFileSpec, TypesFile);
  with UserFileSpec do
  begin
    Found := Exist(Path + Name + Ext);
    if not Found then
    if Ext = '' then
    begin
      Ext := TypeExt;
      Found := Exist(Path + Name + Ext);
    end;
    if not found then
    begin
      {$IFDEF BINED}
       Found := CreateTypeFile(UserFileSpec);
       if Found then
       begin
         ClrScr;
         Found := EditTypeFile(UserFileSpec);
       end;
       {$ELSE}
       ReportError('Could not find type definition file ', Path + Name + Ext);
       {$ENDIF}
    end;
  end;
  FoundUserFile := found;
end; { FoundUserFile }

function FoundCompiler : boolean;
var
  found : boolean;
  CurFile : FileName;
begin
  if TurboPath = '' then
    TurboPath := CurDir + '\';
  CurFile := TurboPath + TPC + EXE;
  found := Exist(CurFile);
  {$IFNDEF BINED}
  CurFile := TurboPath + TURBO + EXE;
  found := Exist(CurFile);
  {$ENDIF}
  if not found then
  begin
    ReportError('Could not find the compiler ' + CurFile,
                'Run '+InstallProg+' and install the Turbo Pascal Directory');
    Writeln;
    ManualHelp(InstallProg);
  end;
  FoundCompiler := found;
end; { FoundCompiler }

function FoundAccessFiles : boolean;
var
  found : boolean;
  CurFile : FileName;
begin
  if TAccessPath = '' then
    TAccessPath := CurDir + '\';
  CurFile := TAccessPath + TAccess + PAS;
  found := Exist(CurFile);;
  if found then
  begin
    CurFile := TAccessPath + TAGenSizes + PAS;
    found := Exist(CurFile);
  end;
  if not found then
  begin
    ReportError('Could not find the Turbo Access file ' + CurFile,
                'Run '+InstallProg+' and install the Turbo Access Directory');
    Writeln;
    ManualHelp(InstallProg);
  end;
  FoundAccessFiles := found;
end; { FoundAccessFiles }

function FoundFiles(var TypesFile : FileName) : boolean;
var
  Found : boolean;
begin
  Found := FoundCompiler;
  if Found then
    Found := FoundAccessFiles;
  if Found then
    Found := FoundUserFile(TypesFile);
  FoundFiles := Found;
end; { FoundFiles }

function GoodStartUp(var TypesFile : FileName) : boolean;
var
  StartOk : boolean;
begin
  GetDir(0, CurDir);
  Writeln(ProgName, ' version ', Version);
  Writeln(CopyrightMsg, ' ', Year, ' ', Company);
  StartOk := GetParams(TypesFile);
  if not StartOk then
    SyntaxHelp
  else
    StartOk := FoundFiles(TypesFile);
  GoodStartUp := StartOk;
end;

function AnswerYes : boolean;
var
  ch : char;
begin
  repeat
    ch := UpCase(ReadKey);
  until ch in ['Y', 'N'];
  Writeln(ch);
  AnswerYes := ch = 'Y';
end; { AnswerYes }

var
  CommandLine : string;


var
  CRTcbreakV : Pointer;

const
  CBreak = $1B;

function GetCBreakV : pointer;
var
  r : registers;
  p : LongInt;
begin
  FillChar(r, SizeOf(r), 0);
  r.AH := $35;
  r.AL := CBreak;
  MSDOS(r);
  with r do
    GetCBreakV := ptr(ES, BX);
end;

procedure SetCBreakV(p : pointer);
var
  r : registers;
begin
  FillChar(r, SizeOf(r), 0);
  r.AH := $25;
  r.AL := CBreak;
  r.ES := Seg(p^);
  r.bx := Ofs(p^);
  MSDos(r);
end;

procedure Invoke(ProgramName, CommandLine : String);
begin
  SetCbreakV(SaveInt1b);
  Exec(ProgramName, CommandLine);
  SetCbreakV(CRTcbreakV);
end; { Invoke }

procedure CompileUserTypes(var ConfigError : boolean);
var
  CompErrors : text;
  OutFileSpec : FileSpec;
begin
  repeat
    with UserFileSpec do
    begin
      CopyFile(Path + Name + Ext, TAccessPath + TAccess + TypeExt);
      Writeln;
      Writeln('Calculating data record and key sizes by compiling/running ', TAGenSizes);
      {$IFDEF BINED}
      with OutFileSpec do
      begin
        Path := TAccessPath;
        Name := 'TPC';
        Ext := '.Out';
        Redir(CompErrors, Path + Name + Ext);
      end;
      {$ENDIF}
      CommandLine := ' /I' + TAccessPath;
      Invoke(TurboPath + TPC + EXE,
             TAccessPath + TAGenSizes + PAS + CommandLine);
      ConfigError := (DosExitCode <> 0) or (DosError <> 0);
      {$IFDEF BINED}
      UnRedir;
      Close(CompErrors);
      {$ENDIF}
      if ConfigError then
      begin
        Writeln;
        Write('Error compiling ', TAGenSizes + PAS, ', Would you like to edit ', Name + Ext, '? ');
       if AnswerYes then
       begin
         {$IFDEF BINED}
         if not FixError(CompErrors, TAGenSizes + PAS,
                         OutFileSpec, UserFileSpec) then
           Exit;
         {$ELSE}
         Invoke(TurboPath + Turbo + EXE, Path + Name + Ext);
         if (DosExitCode <> 0) or (DosError <> 0) then
           Abort('Error invoking ' + TurboPath + Turbo + EXE);
         {$ENDIF}
       end
       else
         Exit;
      end;
    end;
  until (not ConfigError);
  Remove(TAccessPath + TAccess + TypeExt);
  {$IFDEF BINED}
  Erase(CompErrors);
  {$ENDIF}
end; { CompileUserTypes }

procedure StripBlanks(var CurLine : String);
var
  i : integer;
begin
  i := 1;
  while (i <= Length(CurLine)) do
  begin
    if CurLine[i] = ' ' then
      Delete(CurLine, i, 1)
    else
      Inc(i, 1);
  end;
end; { StripBlanks }

procedure GetSizes(var Sizes : text;
                   var MaxDataSize,
                       MaxKeyLen : integer);

function StripNum(CurLine : String) : integer;
var
  Code : integer;
  ReturnNum : integer;
  NumStr : string;
begin
  StripBlanks(CurLine);
  Code := Pos('=', CurLine);
  if Code > 0 then
  begin
    NumStr := Copy(CurLine, Code + 1, Length(CurLine) - Code);
    Val(NumStr, ReturnNum, Code);
  end
  else
    ReturnNum := Code;
  StripNum := ReturnNum;
end; { StripNum }

var
  CurLine : String;

begin
  Close(Sizes);
  Reset(Sizes);
  Readln(Sizes, CurLine);
  MaxDataSize := StripNum(CurLine);
  Readln(Sizes, CurLine);
  MaxKeyLen := StripNum(CurLine);
  Close(Sizes);
  Erase(Sizes);
end; { GetSizes }

procedure GenSizes(var MaxDataSize,
                   MaxKeyLen : integer;
                   var ConfigError : boolean);
var
  Sizes : Text;
begin
  with UserFileSpec do
  begin
    Redir(Sizes, TAccessPath + Name + SizeExt);
    Invoke(TAccessPath + TAGenSizes + EXE, '');
    ConfigError := (DOSExitCode <> 0) or (DosError <> 0);
    UnRedir;
    if (DOSError = 1) then
      Abort('TABuild terminated by user');
    if not ConfigError then
      GetSizes(Sizes, MaxDataSize, MaxKeyLen);
  end;
end;

procedure ConfigTAccess(var ConfigError : boolean);
begin
  CompileUserTypes(ConfigError);
  if not ConfigError then
  begin
    GenSizes(DefaultMaxRecSize, DefaultMaxKeyLen, ConfigError);
    if not ConfigError then
    begin
      with UserFileSpec do
        TypeFileNm := Name + Ext;
      DefFileNm := TAccessPath + TAccess + DefExt;
      UseDefaults := not(BuildOptions[UseWorkSheet].flagSet);
      TAConstants;
    end;
    Writeln('Successfully generated Turbo Access constants');
    Writeln;
  end;
end; { ConfigTAccess }

procedure CompileTAccess(var ConfigError : boolean);
var
  CommandLine : String;
begin
  Writeln('Compiling the Turbo Access Unit');
  CommandLine := ' /U' + TAccessPath;
  CommandLine := CommandLine + ' /I' + TAccessPath;
  CommandLine := CommandLine + CompilerOptions.OptList;
  if BuildOptions[DebugInfo].FlagSet then
    CommandLine := CommandLine + ' ' + DebugFlag;
  Invoke(TurboPath + TPC + EXE, TAccessPath + TAccess + PAS + ' ' + CommandLine);
  ConfigError := (DOSExitCode <> 0) or (DosError <> 0);
end; { CompileTAccess }

procedure CompileTAHigh(var ConfigError : boolean);
var
  CommandLine : string;
begin
  ConfigError := false;
  if BuildOptions[CompTAHigh].FlagSet then
    if Exist(TAccessPath + TAHigh + pas) then
    begin
      Writeln;
      Writeln('Compiling the Turbo Access High-Level calls');
      CommandLine := ' /U' + TAccessPath;
      CommandLine := CommandLine + ' /I' + TAccessPath;
      if BuildOptions[DebugInfo].FlagSet then
        CommandLine := CommandLine + ' ' + DebugFlag;
      Invoke(TurboPath + TPC + EXE, TAccessPath + TAHigh  + PAS + CommandLine);
      ConfigError := (DOSExitCode <> 0) and (DOSError <> 0);
      if not ConfigError and
        (TAccessPath <> UserFileSpec.Path) then
        MoveFile(TaccessPath + TAHigh + TPU, UserFileSpec.Path + TAHigh + TPU);
    end;
end; { CompileTAHigh }

procedure SignOff(ConfigError : boolean);
begin
  if not ConfigError then
  begin
    if (TAccessPath <> UserFileSpec.Path) then
    begin
      MoveFile(TaccessPath + TAccess + TPU, UserFileSpec.Path + TAccess + TPU);
      with UserFileSpec do
        MoveFile(TaccessPath + TAccess + DefExt, Path + Name + DefExt);
    end;
    Writeln;
    Write('Successfully configured ', TAccess);
    if BuildOptions[CompTAHigh].FlagSet then
      Write(' and ', TAHigh);
    Writeln(' for:');
    with UserFileSpec do
      Writeln('  ', Path, Name, Ext);
  end;
end; { SignOff }

var
  TypesFile : FileName;
  ConfigError : boolean;

begin
  CRTcbreakV := GetCBreakV;
  ConfigError := not GoodStartUp(TypesFile);
  if not ConfigError then
  begin
    ConfigTAccess(ConfigError);
    if not ConfigError then
      CompileTAccess(ConfigError);
    if not ConfigError then
      CompileTAHigh(ConfigError);
  end;
  SignOff(ConfigError);
end.