Delphi 7 - BDE 32-Bit - Wie eine Datenbank und/oder Alias erstellen ?

[paule32.jk]

Hallo,
Danke Euch für Euer Feedback !
Ich habe mir aber mal erlaubt, doch mal bissl rumzubasteln und zu stöpseln ...
Es geht mir ja auch dadrum, eine Datenbank zu Haben, die von unbedarften Usern
installiert werden kann - Ihr wisst ja - GAUF - Größter Anzunehmender User Fehler...
Man braucht auch keine Admin Rechte, um die Registry zu wursteln, aber ich habe mal
im Code eine Abfrage eingetragen - sicher ist sicher ...
nur mal so, ein Snippet:

Delphi-Quellcode:

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;