{ Important note about DLL memory management: ShareMem must be the
first unit
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
SysUtils,
Classes,
Windows,
BDE;
type
PrecBDEEntry
TrecBDEEntry = Record
sNodeName: string;
sDescription: string;
sValue: string;
bHasSubnodes: Boolean;
sPath: string;
end;
{$R
*.res}var
AList: TList;
sList: TStringList;
procedure ClearList(var AList: TList);
var
i: Integer;
p: PrecBDEEntry;
begin
begin
p := AList[i];
if p <> nil then Dispose(p);
end;
AList.Clear;
sList.Clear;
end;
procedure DllEntryPoint(dwReason: DWord);
begin
DLL_PROCESS_ATTACH:
begin
if not Assigned(AList) then
begin
AList := TList.Create;
sList := TStringList.Create;
end
else
begin
ClearList(AList);
AList.Free;
sList.Free;
end;
end;
DLL_PROCESS_DETACH:
begin
ClearList(AList);
end;
end;
end;
function CheckReadAll(var Index: Integer): Boolean;
var
sPath:
i: Integer;
p: PrecBDEEntry;
bFlag: Boolean;
begin
Result := False;
if (sList.Count = 1) and (sList[0] = '-1') then
begin
Index := -1;
Exit;
end;
if sList.Count >= 1 then
begin
Index := StrToInt(sList[0]);
Exit;
end
else
Result := True;
end;
procedure ReadNode(Index: Integer);
var
sPath:
p: PrecBDEEntry;
Cursor: HDBICur;
ConfigDesc: CFGDesc;
begin
if Index = -1 then
sPath := ''
else
begin
p := AList[Index];
sPath := p^.sPath;
end;
dbiOpenCfgInfoList(nil, dbiREADONLY, cfgPERSISTENT, PChar(sPath), Cursor);
While DbiGetNextRecord(Cursor, dbiWRITELOCK, @ConfigDesc, nil) = 0 do
begin
New(p);
p.sNodeName := ConfigDesc.szNodeName;
p.sDescription := ConfigDesc.szDescription;
p.sValue := ConfigDesc.szValue;
p.bHasSubnodes := ConfigDesc.bHasSubnodes;
p.sPath := sPath + p.sNodeName + '';
AList.Add(p);
if p.bHasSubnodes then sList.Add(IntToStr(AList.Count - 1));
end;
dbiCloseCursor(Cursor);
sList.Delete(sList.IndexOf(IntToStr(Index)));
end;
function ReadBDESettings: Integer;
var
pv: SysVersion;
i: Integer;
begin
Result := -1;
dbiInit(nil);
dbiGetSysVersion(pv);
sList.Add('-1');
while not CheckReadAll(i) do ReadNode(i);
dbiExit;
Result := 0;
finally
end;
end;
function GetDatabaseInfo(DatabaseName: PChar; var Info: PChar): Integer; cdecl;
var
sDatabaseName:
sInfo: string;
i: Integer;
p: PrecBDEEntry;
begin
Result := -1;
try
sDatabaseName := 'DATABASES' + Databasename + 'DB INFO';
if ReadBDESettings <> 0 then Exit;
sInfo := '';
for i := 0 to AList.Count - 1 do
begin
p := AList[i];
if (AnsiUpperCase(sDatabaseName) <> AnsiUpperCase(p.sPath)) and
(Pos(AnsiUpperCase(sDatabaseName), AnsiUpperCase(p.sPath)) = 1) then
begin
sInfo := sInfo + AnsiUpperCase(p^.sNodeName) + '=' + AnsiUpperCase(p^.sValue) + ';';
end;
end;
Info := PChar(sInfo);
Result := 0;
finally
end;
end;
exports
GetDatabaseInfo;
begin
DllProc :
DllEntryPoint(DLL_PROCESS_ATTACH);
end.
{ p: PrecBDEEntry;
pv: SYSVersion ;
Node: TTreeNode;
begin
dbiInit(NIL);
Label1.Caption :
Label2.Caption := '';
Label3.Caption := '';
dbiGetSysVersion(pv);}