Author: Erwin Molendijk
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:
1
2 unit modBDETools;
3
4 { module Borland Database Engine Tools
5 Author: E.J.Molendijk
6 Mail: erwin@delphi-factory.com
7
8 When this unit is linked into the project the PrivDir of
9 the global Session variable will be set to a
10 unique directory within the (local) system temp dir.
11 When the application ends, this private dir
12 will be cleaned up.
13
14 Also a routine CheckBDEConfig() can be called to check if the
15 BDE is configured for safe opperation.
16
17 Hint, for best performance set the BDE to:
18
19 Setting Value
20 -------------------------------------------------------------
21 \System\INIT\LANGDRIVER 'ascii' ANSI (DBWINUS0)
22 \System\INIT\MAXBUFSIZE 16384 KB
23 \System\INIT\MINBUFSIZE 128 KB
24 \System\INIT\MAXFILEHANDLES 100
25 }
26
27 interface
28
29 uses
30 DB, DBTables, BDE, SysUtils, Windows, FileCtrl, ComObj;
31
32 { This function returns True if the BDE is configured
33 with a NetWork directory with an UNC path (\\server\share)
34 and has LocalShare set to True.
35 The Msg param will be filled with a msg describing the problem. }
36 function CheckBDEConfig(var Msg: string): Boolean;
37
38 implementation
39
40 const
41 { Here are the parameters used to pass into the cfg functions. These are only
42 a small portion of what types can be passed in. You need to call
43 DbiOpenCfgInfoList with '\' into pszCfgPath to get all possible options if
44 it is not found below. }
45
46 { Paradox Driver Settings... }
47 PARADOXNETDIR = '\DRIVERS\PARADOX\INIT\;NET DIR';
48 PARADOXVERSION = '\DRIVERS\PARADOX\INIT\;VERSION';
49 PARADOXTYPE = '\DRIVERS\PARADOX\INIT\;TYPE';
50 PARADOXLANGDRIVER = '\DRIVERS\PARADOX\INIT\;LANGDRIVER';
51 PARADOXLEVEL = '\DRIVERS\PARADOX\TABLE CREATE\;LEVEL';
52 PARADOXBLOCKSIZE = '\DRIVERS\PARADOX\TABLE CREATE\;BLOCK SIZE';
53 PARADOXFILLFACTOR = '\DRIVERS\PARADOX\TABLE CREATE\;FILL FACTOR';
54 PARADOXSTRICTINTEGRITY = '\DRIVERS\PARADOX\TABLE CREATE\;STRICTINTEGRITY';
55
56 { System Initialization Settings... }
57 AUTOODBC = '\SYSTEM\INIT\;AUTO ODBC';
58 DATAREPOSITORY = '\SYSTEM\INIT\;DATA REPOSITORY';
59 DEFAULTDRIVER = '\SYSTEM\INIT\;DEFAULT DRIVER';
60 LANGDRIVER = '\SYSTEM\INIT\;LANGDRIVER';
61 LOCALSHARE = '\SYSTEM\INIT\;LOCAL SHARE';
62 LOWMEMORYUSAGELIMIT = '\SYSTEM\INIT\;LOW MEMORY USAGE LIMIT';
63 MAXBUFSIZE = '\SYSTEM\INIT\;MAXBUFSIZE';
64 MAXFILEHANDLES = '\SYSTEM\INIT\;MAXFILEHANDLES';
65 MEMSIZE = '\SYSTEM\INIT\;MEMSIZE';
66 MINBUFSIZE = '\SYSTEM\INIT\;MINBUFSIZE';
67 SHAREDMEMLOCATION = '\SYSTEM\INIT\;SHAREDMEMLOCATION';
68 SHAREDMEMSIZE = '\SYSTEM\INIT\;SHAREDMEMSIZE';
69 SQLQRYMODE = '\SYSTEM\INIT\;SQLQRYMODE';
70 SYSFLAGS = '\SYSTEM\INIT\;SYSFLAGS';
71 VERSION = '\SYSTEM\INIT\;VERSION';
72
73 type
74 pword = ^word;
75
76 function GetBDEConfigParameter(Param: string; Count: pword): string;
77 var
78 hCur: hDBICur;
79 rslt: DBIResult;
80 Config: CFGDesc;
81 Path, Option: string[254];
82 Temp: array[0..255] of char;
83
84 begin
85 Result := '';
86 hCur := nil;
87
88 if Count <> nil then
89 Count^ := 0;
90
91 try
92
93 if Pos(';', Param) = 0 then
94 raise EDatabaseError.Create('Invalid parameter passed to function. There
95 must '
96 +
97 'be a semi-colon delimited sting passed');
98
99 Path := Copy(Param, 0, Pos(';', Param) - 1);
100 Option := Copy(Param, Pos(';', Param) + 1, Length(Param) - Pos(';', Param));
101
102 Check(DbiOpenCfgInfoList(nil, dbiREADONLY, cfgPERSISTENT, StrPCopy(Temp, Path),
103 hCur));
104 Check(DbiSetToBegin(hCur));
105
106 repeat
107 rslt := DbiGetNextRecord(hCur, dbiNOLOCK, @Config, nil);
108 if rslt = DBIERR_NONE then
109 begin
110 if StrPas(Config.szNodeName) = Option then
111 Result := Config.szValue;
112 if Count <> nil then
113 Inc(Count^);
114 end
115 else if rslt <> DBIERR_EOF then
116 Check(rslt);
117 until rslt <> DBIERR_NONE;
118
119 finally
120 if hCur <> nil then
121 Check(DbiCloseCursor(hCur));
122 end;
123 end;
124
125 procedure PrepareBDEPrivDir;
126 {
127 The PrivDirID constant is used to create the Session.PrivDir
128 Complete private path: TempPath\PrivDirID\RandomStr
129
130 The RandomStr (GUI) will ensure a unique path every time the
131 program is started.
132 The PrivDirID can be used (by batchfile) to delete all junk RandomStr's
133 left over from abnormal program terminations.
134
135 Note: CleanupBDEPrivDir cleans up the dir created by this routine.
136 }
137 const
138 PrivDirID = 'CharonPrivDir';
139 var
140 Temp: string;
141 I: Integer;
142 begin
143 // Get a temp directory name for private dir
144 I := GetTempPath(0, pchar(Temp)); // get length
145 SetLength(Temp, I); // prepare for this length
146 GetTempPath(I, pchar(Temp)); // retreive temp path
147 SetLength(Temp, I - 1); // remove #0
148 Temp := IncludeTrailingBackSlash(Temp); // inlcude a trailing slash
149
150 // construct a unique temppath
151 Temp := Temp + PrivDirID + '\' + CreateClassID;
152
153 // create the directory
154 ForceDirectories(Temp);
155
156 // Set the PrivDir
157 Session.PrivateDir := Temp;
158
159 // ShowMessage('Private directory: '+Temp);
160 end;
161
162 procedure CleanupBDEPrivDir;
163 { Cleansup the Private dir.
164 (all database connections will be closed!)
165 }
166 var
167 CleanUpOK: Boolean;
168 begin
169 // Close the session -- this will empty the PrivDir
170 Session.Close;
171
172 // Remove the PrivDir
173 CleanUpOK := RemoveDir(Session.PrivateDir);
174
175 Assert(CleanUpOK);
176 end;
177
178 function CheckBDEConfig(var Msg: string): Boolean;
179 const
180 strTrue = 'TRUE'; { do not localize }
181
182 var
183 NetDir, LocalShare: string;
184
185 begin
186 // Get BDE settings
187 NetDir := GetBDEConfigParameter(PARADOXNETDIR, nil);
188 LocalShare := Uppercase(Trim(GetBDEConfigParameter(modBDETools.LOCALSHARE, nil)));
189
190 Msg := '';
191
192 if Pos('\\', NetDir) <> 1 then
193 Msg := 'Set the NetDir option in the BDE Administrator to an UNC path.';
194
195 if LocalShare <> strTrue then
196 Msg := 'Set the LocalShare option in the BDE Administrator to TRUE.';
197
198 // Check them
199 Result := Msg = '';
200 end;
201
202 initialization
203 PrepareBDEPrivDir;
204
205 finalization
206 CleanupBDEPrivDir;
207
208 end.
|
