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.
|
Sign Up
