BDE Safe Configuration check

Problem/Question/Abstract:

Running the BDE in a safe mode requires some settings in the BDE Administrator tool. This unit checks if the BDE has been configured correctly (LocalShare=True, NetDir=\\...). Also the PrivDir will be managed by this unit, a unique PrivDir will be created and cleaned up every time the (your) program is run.

Answer:

unit modBDETools;

{ module Borland Database Engine Tools
  Author: E.J.Molendijk
  Mail: erwin@delphi-factory.com

  When this unit is linked into the project the PrivDir of
  the global Session variable will be set to a
  unique directory within the (local) system temp dir.
  When the application ends, this private dir
  will be cleaned up.

  Also a routine CheckBDEConfig() can be called to check if the
  BDE is configured for safe opperation.

Hint, for best performance set the BDE to:

  Setting                             Value
  -------------------------------------------------------------
  \System\INIT\LANGDRIVER             'ascii' ANSI (DBWINUS0)
  \System\INIT\MAXBUFSIZE             16384 KB
  \System\INIT\MINBUFSIZE             128 KB
  \System\INIT\MAXFILEHANDLES         100
}

interface

uses
  DB, DBTables, BDE, SysUtils, Windows, FileCtrl, ComObj;

{ This function returns True if the BDE is configured
  with a NetWork directory with an UNC path (\\server\share)
  and has LocalShare set to True.
  The Msg param will be filled with a msg describing the problem. }
function CheckBDEConfig(var Msg: string): Boolean;

implementation

const
  { Here are the parameters used to pass into the cfg functions.  These are only
    a small portion of what types can be passed in.  You need to call
    DbiOpenCfgInfoList with '\' into pszCfgPath to get all possible options if
    it is not found below. }

  { Paradox Driver Settings...  }
  PARADOXNETDIR = '\DRIVERS\PARADOX\INIT\;NET DIR';
  PARADOXVERSION = '\DRIVERS\PARADOX\INIT\;VERSION';
  PARADOXTYPE = '\DRIVERS\PARADOX\INIT\;TYPE';
  PARADOXLANGDRIVER = '\DRIVERS\PARADOX\INIT\;LANGDRIVER';
  PARADOXLEVEL = '\DRIVERS\PARADOX\TABLE CREATE\;LEVEL';
  PARADOXBLOCKSIZE = '\DRIVERS\PARADOX\TABLE CREATE\;BLOCK SIZE';
  PARADOXFILLFACTOR = '\DRIVERS\PARADOX\TABLE CREATE\;FILL FACTOR';
  PARADOXSTRICTINTEGRITY = '\DRIVERS\PARADOX\TABLE CREATE\;STRICTINTEGRITY';

  { System Initialization Settings...  }
  AUTOODBC = '\SYSTEM\INIT\;AUTO ODBC';
  DATAREPOSITORY = '\SYSTEM\INIT\;DATA REPOSITORY';
  DEFAULTDRIVER = '\SYSTEM\INIT\;DEFAULT DRIVER';
  LANGDRIVER = '\SYSTEM\INIT\;LANGDRIVER';
  LOCALSHARE = '\SYSTEM\INIT\;LOCAL SHARE';
  LOWMEMORYUSAGELIMIT = '\SYSTEM\INIT\;LOW MEMORY USAGE LIMIT';
  MAXBUFSIZE = '\SYSTEM\INIT\;MAXBUFSIZE';
  MAXFILEHANDLES = '\SYSTEM\INIT\;MAXFILEHANDLES';
  MEMSIZE = '\SYSTEM\INIT\;MEMSIZE';
  MINBUFSIZE = '\SYSTEM\INIT\;MINBUFSIZE';
  SHAREDMEMLOCATION = '\SYSTEM\INIT\;SHAREDMEMLOCATION';
  SHAREDMEMSIZE = '\SYSTEM\INIT\;SHAREDMEMSIZE';
  SQLQRYMODE = '\SYSTEM\INIT\;SQLQRYMODE';
  SYSFLAGS = '\SYSTEM\INIT\;SYSFLAGS';
  VERSION = '\SYSTEM\INIT\;VERSION';

type
  pword = ^word;

function GetBDEConfigParameter(Param: string; Count: pword): string;
var
  hCur: hDBICur;
  rslt: DBIResult;
  Config: CFGDesc;
  Path, Option: string[254];
  Temp: array[0..255] of char;

begin
  Result := '';
  hCur := nil;

  if Count <> nil then
    Count^ := 0;

  try

    if Pos(';', Param) = 0 then
      raise EDatabaseError.Create('Invalid parameter passed to function.  There must '
        +
        'be a semi-colon delimited sting passed');

    Path := Copy(Param, 0, Pos(';', Param) - 1);
    Option := Copy(Param, Pos(';', Param) + 1, Length(Param) - Pos(';', Param));

    Check(DbiOpenCfgInfoList(nil, dbiREADONLY, cfgPERSISTENT, StrPCopy(Temp, Path),
      hCur));
    Check(DbiSetToBegin(hCur));

    repeat
      rslt := DbiGetNextRecord(hCur, dbiNOLOCK, @Config, nil);
      if rslt = DBIERR_NONE then
      begin
        if StrPas(Config.szNodeName) = Option then
          Result := Config.szValue;
        if Count <> nil then
          Inc(Count^);
      end
      else if rslt <> DBIERR_EOF then
        Check(rslt);
    until rslt <> DBIERR_NONE;

  finally
    if hCur <> nil then
      Check(DbiCloseCursor(hCur));
  end;
end;

procedure PrepareBDEPrivDir;
{
  The PrivDirID constant is used to create the Session.PrivDir
  Complete private path:  TempPath\PrivDirID\RandomStr

  The RandomStr (GUI) will ensure a unique path every time the
  program is started.
  The PrivDirID can be used (by batchfile) to delete all junk RandomStr's
  left over from abnormal program terminations.

  Note: CleanupBDEPrivDir cleans up the dir created by this routine.
}
const
  PrivDirID = 'CharonPrivDir';
var
  Temp: string;
  I: Integer;
begin
  // Get a temp directory name for private dir
  I := GetTempPath(0, pchar(Temp)); // get length
  SetLength(Temp, I); // prepare for this length
  GetTempPath(I, pchar(Temp)); // retreive temp path
  SetLength(Temp, I - 1); // remove #0
  Temp := IncludeTrailingBackSlash(Temp); // inlcude a trailing slash

  // construct a unique temppath
  Temp := Temp + PrivDirID + '\' + CreateClassID;

  // create the directory
  ForceDirectories(Temp);

  // Set the PrivDir
  Session.PrivateDir := Temp;

  //  ShowMessage('Private directory: '+Temp);
end;

procedure CleanupBDEPrivDir;
{ Cleansup the Private dir.
  (all database connections will be closed!)
}
var
  CleanUpOK: Boolean;
begin
  // Close the session -- this will empty the PrivDir
  Session.Close;

  // Remove the PrivDir
  CleanUpOK := RemoveDir(Session.PrivateDir);

  Assert(CleanUpOK);
end;

function CheckBDEConfig(var Msg: string): Boolean;
const
  strTrue = 'TRUE'; { do not localize }

var
  NetDir, LocalShare: string;

begin
  // Get BDE settings
  NetDir := GetBDEConfigParameter(PARADOXNETDIR, nil);
  LocalShare := Uppercase(Trim(GetBDEConfigParameter(modBDETools.LOCALSHARE, nil)));

  Msg := '';

  if Pos('\\', NetDir) <> 1 then
    Msg := 'Set the NetDir option in the BDE Administrator to an UNC path.';

  if LocalShare <> strTrue then
    Msg := 'Set the LocalShare option in the BDE Administrator to TRUE.';

  // Check them
  Result := Msg = '';
end;

initialization
  PrepareBDEPrivDir;

finalization
  CleanupBDEPrivDir;

end.