function isAdmin: Boolean;
const
DOMAIN_ALIAS_RID_ADMINS = $00000220;
SECURITY_BUILTIN_DOMAIN_RID = $00000020;
SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
var
Admin: Boolean;
AdmGroup: PSID;
Begin
Admin := AllocateAndInitializeSid(SECURITY_NT_AUTHORITY,
2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS,
0, 0, 0, 0, 0, 0, AdmGroup);
If (Admin)
Then
Begin
If (
not CheckTokenMembership(0, AdmGroup, Admin))
Then
Admin := False;
FreeSid(AdmGroup);
end;
Result := Admin;
end;
// -------------------------------------------------------------
// rs_xxx are the Locale's .ENU, .DEU files. default is: ENU ...
// -------------------------------------------------------------
resourcestring
rs_Internal_Error = '
internal error.';
rs_BDE_notInstalled = '
No BDE Installation found !';
rs_BDE_Error = '
BDE Error:';
rs_BDE_AppStart_Rej = '
Aborted start.';
rs_App_First_Run = '
You run this Application at first race !' + #13#10 +
'
Would You do a Setup of needed Stuff ?';
rs_App_User_Mode = '
You run this Application with User rights !' + #13#10 +
'
If You confirm this Dialog with "Yes", it can be' + #13#10 +
'
that the Application does not work.' + #13#10 +
'
' + #13#10 +
'
Would You start the Application without Admin rights ?';
rs_ClassName = '
Class-Name: ';
rs_Message = '
Message: ';
rs_Exception_Error = '
Exception Error:';
rs_File_Exists = '
The file already exists !' + #13#10 +
'
Would you override the old Version ?';
rs_BDE_EClassName = '
Error-Class: ';
rs_BDE_ECode = '
Error-Code: ';
rs_BDE_EMessage = '
Error-Message: ';
rs_BDE_EFile = '
Error-File: ';
rs_BDE_EModule = '
Error-Module: ';
rs_BDE_EProc = '
Error-Proc: ';
rs_BDE_ELine = '
Error-Line: ';
rs_BDE_Error_TableDontExists = '
Table does not exists.';
rs_Win32_Registry_Error = '
Win32-Registry Error:';
procedure TForm1.FormCreate(Sender: TObject);
const
BDE_DLLs:
array [0..2]
of string = (
'
IDAPI32.DLL',
'
IDR20009.DLL',
'
IDR20009.DLL'
);
BDEAlias = '
DataBaseName';
BDECoTbl = '
test.dbf';
BDELevel = 0;
var
I,J : Integer;
text : WideString;
xpos, ypos : Integer;
row, col : Integer;
S :
String;
B : Boolean;
BDE_found : Boolean;
Index : Integer;
reg : TRegistry;
H : HDBISes;
letter1 : Char;
letter2 : Char;
buffer :
Array[0..MAX_PATH]
of Char;
BDEList : TStringList;
BDESession : TSession;
BdeAdmin : TDataBase;
BDETable : TTable;
BDEQuery : TQuery;
BDEDataSrc : TDataSource;
SystemFolder:
String;
SQLstmt :
String;
stmtParams : TParams;
procedure FreeBDESetup;
begin
if Assigned(BDEList)
then
begin
BDEList.Clear;
BDEList.Free;
BDEList :=
nil;
end;
if Assigned(BDEQuery)
then
begin
BDEQuery.SQL.Clear;
BDEQuery.Free;
BDEQuery :=
nil;
end;
if Assigned(BDETable)
then
begin
BDETable.Close;
BDETable.Free;
BDETable :=
nil;
end;
if Assigned(BDEAdmin)
then
begin
BDEAdmin.Close;
BDEAdmin.Free;
BDEAdmin :=
nil;
end;
if Assigned(BDESession)
then
begin
BDESession.Close;
BDESession.DeleteAlias(BDEAlias);
BDESession.Free;
BDESession :=
nil;
end;
if Assigned(reg)
then
begin
reg.Free;
reg :=
nil;
end;
if Assigned(h)
then
begin
DBICloseSession(h);
DBIExit;
h :=
nil;
end;
end;
begin
// -------------------------------------------------
// first, check if the BDE is installed.
// one step is, to locate the BDE Win32 Registry key
// second step, try to locate per path.
// -------------------------------------------------
BDE_found := true;
reg := Tregistry.Create;
try
try
reg.RootKey := HKEY_LOCAL_MACHINE;
B := reg.OpenKeyReadOnly('
SOFTWARE\Borland\Database Engine');
if not(B)
then
begin
GetSystemDirectory(buffer, SizeOf(buffer));
SystemFolder := StrPas(buffer);
for I := Low(BDE_DLLs)
to High(BDE_DLLs)
do
begin
if not FileExists(SystemFolder + '
\' + BDE_DLLs[I])
then
begin
BDE_found := false;
break;
end;
end;
end
except
on E:
Exception do
begin
ShowMessage(rs_Win32_Registry_Error
+ #13#10 + rs_ClassName + E.ClassName
+ #13#10 + rs_Message + E.
Message);
FreeBDESetup;
Close;
end;
end;
finally
FreeBDESetup;
if not(BDE_found)
then
begin
ShowMessage(
rs_BDE_notInstalled + #13#10 +
rs_BDE_AppStart_Rej);
Close;
end;
end;
// ------------------------------------
// look, if database is present, if not
// than try to create it ...
// ------------------------------------
BDEAdmin := TDataBase.Create(
nil);
BDE_found := false;
try
try
S := ExtractFilePath(Application.ExeName);
S := S + '
data';
// -----------------------------------------
// warn the user, if run with admin rights
// if true then check data + password, else
// continue as normal user.
// -----------------------------------------
if not(DirectoryExists(S))
then
begin
I := MessageDlg(rs_App_First_Run,
mtWarning,[mbYes, mbNo],0);
if I = mrNo
then
begin
Close;
end;
if not(isAdmin)
then
begin
I := MessageDlg(rs_App_User_Mode,
mtWarning,[mbYes, mbNo],0);
if I = mrNo
then
begin
Close;
end;
end;
CreateDir(S);
end;
// --------------------------------
// check, if 'databasename' exists
// --------------------------------
if not(Assigned(BDEList))
then
BDEList := TStringList.Create;
BDEList.Clear;
BDESession := TSession.Create(
nil);
BDESession.SessionName := BDEAlias;
// no, then create it
if BDEList.IndexOf(BDEAlias) < 0
then
begin
DBIInit(
nil);
DBIStartSession('
dummy',h,'
');
DBIAddAlias(
nil,
PChar(BDEAlias),
PChar('
DBASE'),
PChar('
PATH=' + S),
true);
DBICloseSession(h);
DBIExit;
h :=
nil;
end;
// -------------------------------
// sanity check ...
// -------------------------------
BDESession.Open;
BDESession.GetDatabaseNames(BDEList);
if BDEList.IndexOf(BDEAlias) < 0
then
raise Exception.Create(
'
BDE Error:' + #13#10 +
'
internal Error.');
if not(Assigned(BDEAdmin))
then
BDEAdmin := TDataBase.Create(
nil);
BDEAdmin.DatabaseName := BDEAlias;
BDEAdmin.Directory := S;
BDEAdmin.Open;
try
// -------------------------------
// check, if data table exists ...
// -------------------------------
BDEQuery := TQuery.Create(
nil);
BDEQuery.DatabaseName := BDEAlias;
BDEQuery.SQL.Text :=
'
SELECT COUNT(*) AS TableCount ' +
'
FROM SYSALIASES A ' +
'
INNER JOIN TABLES T ON A.PATH = T.PATH ' +
'
WHERE A.ALIASNAME = ''
' + BDEAlias + '
''
' + '
' +
'
AND T.TBLNAME = ''
' + S + '
\' + BDECoTbl + '
''
' ;
BDEQuery.Open;
except
on E: EDBEngineError
do
begin
BDE_found := true;
for I := 0
to E.ErrorCount - 1
do
begin
// table does not exists...
if E.Errors[I].ErrorCode = 10024
then
begin
BDE_found := false;
break;
end;
end;
if not(BDE_found)
then
begin
try
BDEQuery.Close;
BDEQuery.SQL.Clear;
BDEQuery.SQL.Text :=
'
CREATE TABLE ''
' + S + '
\' + BDECoTbl + '
''
(' +
'
COL1 int,' +
'
COL2 int)';
BDEQuery.ExecSQL;
except
on E: EDBEngineError
do
begin
for I := 0
to E.ErrorCount - 1
do
begin
case E.Errors[I].ErrorCode
of
0:
begin
// no error
break;
end;
10024,
13057:
begin
// table exists
break;
end else
begin
ShowMessage(rs_BDE_Error
+ #13#10 + rs_BDE_EClassName + E.ClassName
+ #13#10 + rs_BDE_ECode + IntToStr(E.Errors[i].ErrorCode)
+ #13#10 + rs_BDE_EMessage + E.Errors[i].
Message
+ #13#10 + rs_BDE_EFile + FileByLevel (BDELevel)
+ #13#10 + rs_BDE_EModule + ModuleByLevel(BDELevel)
+ #13#10 + rs_BDE_EProc + ProcByLevel (BDELevel)
+ #13#10 + rs_BDE_ELine + IntToStr(LineByLevel(BDELevel)));
FreeBDESetup;
Close;
end;
end;
end;
end;
end
end;
end;
end;
// -------------------------------
// sanity check ...
// -------------------------------
BDEList.Clear;
BDEAdmin.DatabaseName := BDEAlias;
BDEAdmin.Connected := true;
if not(Assigned(BDESession))
then
begin
BDESession := TSession.Create(
nil);
BDESession.SessionName := BDEAlias;
end;
if not(Assigned(BDETable))
then
BDETable := TTable.Create(
nil);
BDETable.DatabaseName := BDEAdmin .DatabaseName;
BDETable.SessionName := BDESession.SessionName;
BDETable.TableName := S + '
\test.dbf';
except
on E: EDBEngineError
do
begin
for i := 0
to E.ErrorCount - 1
do
begin
case E.Errors[i].ErrorCode
of
0:
begin {no error} BDE_found := true;
end;
else begin
ShowMessage(rs_BDE_Error
+ #13#10 + rs_BDE_EClassName + E.ClassName
+ #13#10 + rs_BDE_ECode + IntToStr(E.Errors[i].ErrorCode)
+ #13#10 + rs_BDE_EMessage + E.Errors[i].
Message
+ #13#10 + rs_BDE_EFile + FileByLevel (BDELevel)
+ #13#10 + rs_BDE_EModule + ModuleByLevel(BDELevel)
+ #13#10 + rs_BDE_EProc + ProcByLevel (BDELevel)
+ #13#10 + rs_BDE_ELine + IntToStr(LineByLevel(BDELevel)));
end;
end;
end;
FreeBDESetup;
Close;
end;
on E:
Exception do
begin
ShowMessage(rs_Exception_Error
+ #13#10 + rs_BDE_EClassName + E.ClassName
+ #13#10 + rs_BDE_EMessage + E.
Message
+ #13#10 + rs_BDE_EFile + FileByLevel (BDELevel)
+ #13#10 + rs_BDE_EModule + ModuleByLevel(BDELevel)
+ #13#10 + rs_BDE_EProc + ProcByLevel (BDELevel)
+ #13#10 + rs_BDE_ELine + IntToStr(LineByLevel(BDELevel)));
FreeBDESetup;
Close;
exit;
end;
end
finally
FreeBDESetup;
end;
end;