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

Pascal/Delphi Source File | 1987-12-31 | 19.1 KB | 772 lines

(****************************************************************)
(*                     DATABASE TOOLBOX 4.0                     *)
(*     Copyright (c) 1984, 87 by Borland International, Inc.    *)
(*                                                              *)
(*                        SetConst                              *)
(*                                                              *)
(*  Purpose: Calculates Turbo Access configuration constants    *)
(*           for specified Record and Key Sizes.  SetConst      *)
(*           is used by the TABuild program.                    *)
(*                                                              *)
(****************************************************************)
unit SetConst;

interface
uses
  CRT,
  MiscTool,
{ If a compiler error occurs here, the Turbo Pascal compiler cannot
  find the TAccess unit.  You can compile and configure the TAccess
  unit for your database project by using the TABuild utility. See
  the manual for detailed instructions. }

  EditLn;

const
  UseDefaults : boolean = true;
  TypeFileNm : string = '';
  DefFileNm : String = '';
  LargestVar = 65521;

var
  DefaultMaxRecSize,
  DefaultMaxKeyLen : integer;
  MaxMemory : Word;

procedure TAConstants;

implementation

type
  Rectangle = record
                X1, Y1, X2, Y2 : byte;
              end;

  WindowRec = record
                Border,
                Vis : Rectangle;
                ForeColor,
                BackColor : byte;
                WTitle : String;
              end;

type
  LineStr = String;

const
  EmptyStr = '';
  Space = ' ';
  Tab = ^I;
  Blanks : CharSet = [Space, Tab];
  EndPunct : CharSet = ['!', '?', '.'];
  Delimeters  : CharSet = [Space, Tab, '!', '?', ',', ';'];

procedure SetColor(Fore, Back : byte);
begin
  TextColor(Fore);
  TextBackground(Back);
end; { SetColor }

procedure SetWindowColor(var W : WindowRec);
begin
  SetColor(W.ForeColor, W.BackColor);
end;

function Center(Len, Left, Right : integer) : integer;
begin
  Center := (succ(Right - Left) div 2) - (Len div 2);
end;

procedure Box(var W : WindowRec);
const
  UpLeft = #201;
  UpRight = #187;
  LoLeft =  #200;
  LoRight = #188;
  HWall = #205;
  VWall = #186;

var
  x, y : integer;

begin
  with W, Border do
  begin
    Window(X1, Y1, X2, Y2);
    TextColor(Yellow);
    TextBackground(BackColor);
    ClrScr;
    Window(1, 1, 80, 25);
    GotoXY(X1, Y1);
    Write(UpLeft);
    for x := succ(X1) to pred(X2) do
      Write(HWall);
    GotoXY(X2, Y1);
    Write(UpRight);
    for Y := succ(Y1) to pred(Y2) do
    begin
      GotoXY(X2, y);
      Write(VWall);
    end;
    GotoXY(X1, Y2);
    Write(LoLeft);
    for x := succ(X1) to pred(X2) do
      Write(HWall);
    Write(LoRight);
    for Y := pred(Y2) downto succ(Y1) do
    begin
      GotoXY(X1, y);
      Write(VWall);
    end;
    Window(X1, Y1, X2, Y2);
    GotoXY(Center(Length(WTitle) + 2, X1, X2), 1);
    TextColor(Yellow);
    Write(' ', WTitle, ' ');
    SetWindowColor(W);
  end;
end; { Box }

procedure DisplayWindow(var W : WindowRec);
begin
  with W, Vis do
  begin
    Box(W);
    Window(X1, Y1, X2, Y2);
    GotoXY(1, 1);
  end;
end; { DisplayWindow }

procedure EraseWindow(var W : WindowRec);
begin
  with W, Border do
  begin
    Window(X1, Y1, X2, Y2);
    NormVideo;
    ClrScr;
  end;
  Window(1, 1, 80, 25);
end; { EraseWindow }

procedure NewWindow(var W : WindowRec;
                    Title : String;
                    X1, Y1, X2, Y2 : integer;
                    Fore, Back : byte);
begin
  FillChar(W, SizeOf(W), 0);
  with W do
  begin
    Border.X1 := X1; Border.Y1 := Y1;
    Border.X2 := x2; Border.Y2 := Y2;
    Vis.X1 := X1 + 2; Vis.X2 := x2 - 2;
    Vis.Y1 := y1 + 1;
    if Y2 > succ(Vis.Y1) then
      Vis.Y2 := y2 - 1
    else
      Vis.Y2 := y2;
    ForeColor := Fore; BackColor := Back;
    WTitle := Title;
    DisplayWindow(W);
  end;
end; { NewWindow }

procedure SetWindow(var W : WindowRec);
begin
  with W.Vis do
    Window(X1, Y1, X2, Y2);
  SetWindowColor(W);
end;

function GlobToLocX(var W : WindowRec; GlobalX : byte) : byte;
begin
  with W.Vis do
    GlobToLocX := succ(GlobalX - X1);
end;

function GlobToLocY(var W : WindowRec; GlobalY : byte) : byte;
begin
  with W.Vis do
    GlobToLocY := succ(GlobalY - Y1);
end;


type
  ConstIndex = (MaxRecords, PSize, PStackSize, DataFSize, IndexFSize,
                StackMemory, KeySearch, InMem, OnDisk);
  ParamIndex = MaxRecords..PStackSize;
  DispIndex = DataFSize..OnDisk;

  DBoxParameters = record
                     case integer of
                     0 : ( MaxRecs        : real;
                           PageSize       : real;
                           PageStackSize  : real;

                           DxSize         : real;
                           IxSize         : real;
                           StackMem       : real;

                           MaxSearch      : real;
                           MemSearch      : real;
                           DiskSearch     : real;

                           MaxDataRecSize : integer;
                           MaxKeyLen      : integer;
                           Order          : integer;
                           MaxHeight      : integer
                         );
                     1 : ( ItemIndex : array[ConstIndex] of real;
                           MaxData        : integer;
                           MaxKey         : integer;
                           TOrder         : integer;
                           TMaxHeight     : integer
                         )
                   end;
var
  DBoxParams :  DBoxParameters;



const
  DefaultMaxRecs        =  1000;
  DefaultPageSize       =  24;
  DefaultPageStackSize  =  10;
  DefaultOrder          =  10;
  DefaultMaxHeight      =   5;


procedure StoreDefaults(var DBoxParams :  DBoxParameters);

function CheckResults(MaxKeyLen, PageSize, PageStackSize : real;
                      var StackMem : real) : real;
const
  Density        = 0.75;

var
  M    : real;
  Temp : Real;
  I    : Integer;
  NumRecs : real;

  PerPage,
  MaxSearch,
  MemSearch,
  IrSize,
  TotalPages : real;

begin
  CheckResults := 0;
  IrSize:=(MaxKeyLen+9) * PageSize + 5;
  StackMem := (IrSize + 9) * PageStackSize;
  if StackMem > MaxMemory then
    Exit;
  PerPage:=PageSize*Density;
  NumRecs := 1000;
  MaxSearch := Ln(NumRecs)/Ln(PerPage);
  TotalPages:=Int(NumRecs/PerPage+1.0);
  Temp:=1.0;
  M:=PerPage;
  I:=1;
  while Temp+M<PageStackSize do
  begin
    Temp:=Temp + M;
    I:= succ(I);
    M:=Exp(Ln(PerPage) * I);
  End;
  If Temp + M > TotalPages
   then M:= TotalPages - Temp + 1;
  MemSearch:= I + (PageStackSize-Temp)/M;
  MemSearch := (MemSearch / MaxSearch);
  if MemSearch > 1 then
    MemSearch := 0.990;
  CheckResults := MemSearch / (MaxSearch * 100);
end;  { CheckResults }

procedure CalcDefaults(var DBoxParams : DBoxParameters);
const
  Density        = 0.75;

var
  BestResult,
  CurResult,
  CurPSize,
  CurPStack,
  CurStackMem : real;

begin
  with DBoxParams do
  begin
    CurPSize := 4;
    CurPStack := 3;
    CurStackMem := 0;
    BestResult := 0;
    while (CurStackMem <= MaxMemory) do
    begin
      CurResult := CheckResults(MaxKeyLen, CurPSize, CurPStack, CurStackMem);
      if CurResult > BestResult then
      begin
        BestResult := CurResult;
        PageSize := CurPSize;
        PageStackSize := CurPStack;
      end;
      CurPStack := CurPStack + 1;
      CurPSize := CurPSize + 2;
    end;
  end;
end; { CalcDefaults }

begin { StoreDefaults }
  with DBoxParams do
  begin
    MaxDataRecSize := DefaultMaxRecSize;
    MaxKeyLen := DefaultMaxKeyLen;
    PageSize := DefaultPageSize;
    PageStackSize := DefaultPageStackSize;
    Order := DefaultOrder;
    MaxHeight := DefaultMaxHeight;
    MaxRecs := DefaultMaxRecs;
  end;
  CalcDefaults(DBoxParams);
end; { StoreDefaults }

var
  MaxMaxHeight   : integer;
  PerPage        : real;
  TotalPages     : real;
  IrSize         : real;

function GetMaxHeight(DBoxParams : DBoxParameters) : integer;
var
  MaxMaxHeight   : integer;
  i : integer;
  NumRecs : real;
begin
  MaxMaxHeight := 0;
  for i := 2 to 4 do
  with DBoxParams do
  begin
     Order:= Trunc(PageSize / 2.0);
     PerPage:=PageSize* (i * 0.25);
    if MaxRecs < 1000.0 then
      NumRecs := 1000.0
    else
      NumRecs := MaxRecs;
    MaxSearch := Ln(NumRecs)/Ln(PerPage);
    MaxHeight :=Trunc(MaxSearch+1.0);
    if MaxHeight > MaxMaxHeight then
      MaxMaxHeight := MaxHeight;
  end;
  GetMaxHeight := MaxMaxHeight;
end;

procedure DoCalculations(var DBoxParams : DBoxParameters);
const
  Density        = 0.75;

var
  M    : real;
  Temp : Real;
  I    : Integer;
  NumRecs : real;

begin
  with DBoxParams do
  begin
    Order:= Trunc(PageSize / 2.0);
    PerPage:=PageSize*Density;
    if MaxRecs < 1000.0 then
      NumRecs := 1000.0
    else
      NumRecs := MaxRecs;
    MaxSearch := Ln(NumRecs)/Ln(PerPage);
    MaxHeight:=Trunc(MaxSearch+1.0);
    TotalPages:=Int(NumRecs/PerPage+1.0);
    Temp:=1.0;
    M:=PerPage;
    I:=1;
    while Temp+M<PageStackSize do
    begin
      Temp:=Temp + M;
      I:=I + 1;
      M:=Exp(Ln(PerPage) * I);
    End;
    If Temp+M>TotalPages Then M:=TotalPages-Temp+1;
    MemSearch:=I+(PageStackSize-Temp)/M;
    DiskSearch:=MaxSearch-MemSearch;
    IrSize:=(MaxKeyLen+9) * PageSize + 5;
    IxSize:=IrSize*TotalPages;
    DxSize:=MaxDataRecSize*(MaxRecs+1);
    StackMem:= IrSize * PageStackSize;
    MemSearch := (MemSearch / MaxSearch) * 100.0;
    DiskSearch := (DiskSearch / MaxSearch)  * 100.0;
    if MemSearch > 100.0 then
     begin
       MemSearch := 99.00;
       DiskSearch := 1.00;
     end;
    MaxHeight := GetMaxHeight(DBoxParams);
  end;
end;  { DoCalculations }

procedure SaveConstants(var Results : text;
                        DBoxParams : DBoxParameters);
const
  Tab = 2;
begin
  Write(Results, '{ Turbo Access constants ');
  Write(Results, 'for ', TypeFileNm, ' ');
  Writeln(Results, '}');
  Writeln(Results , 'const');
  with DBoxParams do
  begin
    Writeln(Results, ' ':Tab, 'MaxDataRecSize = ', MaxDataRecSize:5, ';');
    Writeln(Results, ' ':Tab, 'MaxKeyLen      = ', MaxKeyLen:5, ';');
    Writeln(Results, ' ':Tab, 'PageSize       = ', PageSize:5:0, ';');
    Writeln(Results, ' ':Tab, 'PageStackSize  = ', PageStackSize:5:0, ';');
    Writeln(Results, ' ':Tab, 'Order          = ', Order:5, ';');
    Writeln(Results, ' ':Tab, 'MaxHeight      = ', MaxHeight:5, ';');
  end;
  Close(Results);
end; { SaveConstants }

procedure Wait;
var
  ch : char;
begin
  ch := ScanKey;
end; { wait }

procedure FinishUp;
var
  t : text;
begin
  Assign(t, DefFileNm);
  Rewrite(t);
  SaveConstants(t, DBOXParams);
end; { FinishUp }

procedure Error(var W : WindowRec; Message : String);
var
  StartX,
  HomeX, HomeY : integer;

begin
  HomeX := WhereX;
  HomeY := WhereY;
  Beep;
  SetColor(White, Red);
  with W.Vis do
  begin
    StartX := Center(Length(Message) + 2, X1, X2);
    GotoXY(StartX, Y2 - 3);
    Write(' ', Message, ' ');
    GotoXY(HomeX, HomeY);
    Wait;
    SetWindowColor(W);
    GotoXY(X1, Y2 - 3);
    Write(' ':succ(X2 - X1));
  end;
end; { Error }

procedure LightFirst(var W : WindowRec;
                     S : String; NumChars : integer);
var
  i : integer;
begin
  SetColor(Black, White);
  for i := 1 to NumChars do
    Write(S[i]);
  SetWindowColor(W);
  for i := NumChars + 1 to Length(S) do
    Write(S[i]);
end; { LightFirst }

const
  LeftCol = 12;
  TopRow = 2;

procedure InitWorkSheet(var W : WindowRec;
                        var DBoxParams : DBoxParameters);
const
  Prompts : array[1..9] of String =
   ('Estimated total records in the Database',
    'Max. Record Size          Data File Size',
    'Max. Key Length           Index File Size',
    'Page Size - Max. number of keys on a page',
    'Page Stack Size - Max. pages in memory',
    'Page Stack memory requirements',
    'Avg. comparisons in a key search',
    'Searches satisfied in memory',
    'Disk searches needed');
var
  i : integer;

begin
  NewWindow(W, 'TABuild Constants WorkSheet', 1, 1, 80, 24, white, Blue);
  GotoXY(LeftCol, TopRow);
  for i := 1 to 9 do
  begin
    Write(Prompts[i]);
    GotoXY(LeftCol, WhereY + 2);
  end;
  GotoXY(LeftCol - 5, WhereY + 2);
  LightFirst(W, 'Defaults', 1);
  GotoXY(WhereX + 5, WhereY);
  LightFirst(W, 'F2 - Save and Quit', 2);
  GotoXY(WhereX + 5, WhereY);
  LightFirst(W, 'Esc - Exit', 3);
  GotoXY(WhereX + 6, WhereY);
  LightFirst(W, 'Calculate', 1);
  SetColor(Yellow, W.BackColor);
  with DBoxParams do
  begin
    GotoXY(LeftCol + 16, TopRow + 2);
    Write(MaxDataRecSize:6);
    GotoXY(LeftCol + 16, TopRow + 4);
    Write(MaxKeyLen:6);
  end;
  SetWindowColor(W);
end; { InitWorkSheet }


type
  ParamRec = record
                x, y : byte;
                Min,
                Max,
                MaxLen : LongInt;
                Value : real;  { change to LongInt later }
                ErrorStr : string;
             end;

const
  ConstParams : array[ParamIndex] of ParamRec =
    ((x : 55; y : 2; Min : 1; Max : MaxLongInt;
      MaxLen : 8; Value : DefaultMaxRecs;
      ErrorStr : 'The maximum records must be greater than 0'),
     (x : 60; y : 8; Min : 4; Max : 254;
      MaxLen : 3; Value : DefaultPageSize;
      ErrorStr : 'The Page Size must be an even number between 4 and 254'),
     (x : 60; y : 10; Min : 3; Max : 255;
      MaxLen : 3; Value :DefaultPageStackSize;
      ErrorStr : 'The Page Stack size must be between 3 and 255'));

type
  DisplayRec = record
                 x, y, Prec  : byte;
                 Units : string[5];
               end;
  DisplayDialog = array[DispIndex] of DisplayRec;

const
  ConstDialog : DisplayDialog =
                 ((x : 55; y : 4; Prec  : 0; Units : 'bytes'),
                  (x : 55; y : 6; Prec  : 0; Units : 'bytes'),
                  (x : 55; y : 12; Prec : 0; Units : 'bytes'),
                  (x : 55; y : 14; Prec : 2; Units : ''),
                  (x : 55; y : 16; Prec : 2; Units : '%'),
                  (x : 55; y : 18; Prec : 2; Units : '%'));

procedure DisplayResults(var WorkSheet : WindowRec;
                         var DBoxParams : DBoxParameters);
var
  CurIndex :  ConstIndex;
  Prec : integer;
begin
  with WorkSheet, Vis do
  begin
    SetColor(Yellow, BackColor);
    for CurIndex := DataFSize to OnDisk do
    with ConstDialog[CurIndex] do
    begin
      GotoXY(x, y);
      Write(DBoxParams.ItemIndex[CurIndex]:8:Prec, ' ', Units);
      Write(' ':X2 - WhereX);
    end;
    SetWindowColor(WorkSheet);
  end;
end; { DisplayResults }

procedure ShowDefaults(var WorkSheet : WindowRec);
var
  CurIndex : ConstIndex;
begin
  SetColor(Black, White);
  for CurIndex := MaxRecords to PStackSize do
  begin
    GotoXY(ConstParams[CurIndex].x, ConstParams[CurIndex].y);
    Write(' ':ConstParams[CurIndex].MaxLen);
    GotoXY(ConstParams[CurIndex].x, ConstParams[CurIndex].y);
    Write(ConstParams[CurIndex].Value:1:0);
  end;
  SetWindowColor(WorkSheet);
end; { ShowDefaults }

procedure ReadNum(CurParam : ConstIndex;
                  Terminators : CharSet;
                  var TC : char);
var
  NumStr : String;
  Code : integer;
begin
  with ConstParams[CurParam] do
  begin
    Str(Value:1:0, NumStr);
    EditLine(NumStr, MaxLen, x, y, ['0'..'9'],
             Terminators, TC);
    if Length(NumStr) > 0 then
      Val(NumStr, Value, Code)
  end;
end; { ReadNum }

procedure ParamToDialog;
begin
  with DBoxParams do
  begin
    ConstParams[MaxRecords].Value := MaxRecs;
    ConstParams[PSize].Value := PageSize;
    ConstParams[PStackSize].Value := PageStackSize;
  end;
end;

procedure ResetDefaults(var WorkSheet : WindowRec);
begin
  StoreDefaults(DBoxParams);
  ParamToDialog;
  ShowDefaults(WorkSheet);
  DoCalculations(DBoxParams);
  DisplayResults(WorkSheet, DBoxParams);
end;

procedure DialogToParam;
begin
  with DBoxParams do
  begin
    MaxRecs := ConstParams[MaxRecords].Value;
    PageSize := ConstParams[PSize].Value;
    PageStackSize := ConstParams[PStackSize].Value;
  end;
end; { DialogToParam }

function OkStackMem(DBoxParams : DBoxParameters ) : boolean;
begin
  with DBoxParams do
  begin
    IrSize := (MaxKeyLen + 9) * PageSize+5;
    StackMem := (IrSize + 9) * PageStackSize;
    OkStackMem := StackMem <= LargestVar;
  end;
end;

function LegalValues(var ErrorS : String) : boolean;
const
  PageS = 5;
var
  Legal : boolean;
  Index : ConstIndex;
begin
  Legal := true;
  index := MaxRecords;
  while (Index <= PStackSize) and Legal do
  with ConstParams[index] do
  begin
    Legal := (Value >= Min) and (Value <= Max);
    if Legal and (index = PSize) then
      Legal := not odd(trunc(Value));
    if Legal then
      Index := succ(Index);
  end;
  if Legal then
  begin
    Legal := OkStackMem(DBoxParams);
    if not Legal then
    begin
      Str(MaxMemory, ErrorS);
      ErrorS := 'Page Stack is greater than ' + ErrorS;
      ErrorS := ErrorS +  '  Reduce the Page or Page Stack Size.';
    end;
  end
  else
    ErrorS := ConstParams[index].ErrorStr;
  LegalValues := Legal;
end;

function Calculate(var WorkSheet : WindowRec) : boolean;
var
  ErrorStr : string;
begin
  DialogToParam;
  if not LegalValues(ErrorStr) then
  begin
    Calculate := false;
    Error(WorkSheet, ErrorStr)
  end
  else
  begin
    DoCalculations(DBoxParams);
    DisplayResults(WorkSheet, DBoxParams);
    Calculate := true;
  end;
end; { Calculate }

const
  CalcKey = 'C';
  DefaultsKey = 'D';
  Terminators : CharSet = [CR, UpKey, DownKey, CalcKey, DefaultsKey, F2, Esc];

procedure SetConstants(var WorkSheet : WindowRec;
                       var DBoxParams : DBoxParameters);

var
  TermChar : char;
  CurItem : ConstIndex;
  Ok : boolean;

begin
  InitWorkSheet(WorkSheet, DBoxParams);
  ResetDefaults(WorkSheet);
  CurItem := MaxRecords;
  repeat
    with ConstParams[CurItem] do
    begin
      SetColor(Black, White);
      ReadNum(CurItem, Terminators, TermChar);
      case TermChar of
        DownKey,
        CR : if CurItem = PStackSize then
                CurItem := MaxRecords
              else
                CurItem := Succ(CurItem);
        UpKey : if CurItem = MaxRecords then
                  CurItem := PStackSize
                else
                  CurItem := pred(CurItem);
        DefaultsKey : ResetDefaults(WorkSheet);
        CalcKey,
        F2 : OK := Calculate(WorkSheet);
        Esc : Abort('');
      end;
    end;
  until (TermChar = F2) and OK;
  EraseWindow(WorkSheet);
end; { SetConstants }

procedure InitSetConst;
begin
  StoreDefaults(DBoxParams);
  DoCalculations(DBoxParams);
end; { InitSetConst }

var
  WorkSheet : WindowRec;

procedure TAConstants;
begin
  InitSetConst;
  if not UseDefaults then
    SetConstants(WorkSheet, DBoxParams);
  FinishUp;
end; { TAConstants }

begin
  MaxMemory := LargestVar;
end.