Chip 2002 June/Chip_2002-06_cd1.bin/zkuste/delphi/kompon/d3456/KADAO72.ZIP/KDaoDBEngine.pas

Pascal/Delphi Source File | 2002-02-26 | 24.8 KB | 778 lines

unit KDaoDBEngine;
{$B-}
//******************************************************************************
//                           Delphi Dao Project
//                 Copyright (c) 2000-2001 by Kiril Antonov
//******************************************************************************
{DEFINE USEDB}                            //DISABLE IF YOU WANT TO USE PURE DAO
{$I KADaoCommonDirectives.pas}

interface

Uses
DAOApi,
ComObj,
{$IFDEF DAO35}
DAO35Api,
{$ENDIF}
{$IFDEF DAO36}
DAO36Api,
{$ENDIF}
Windows, Messages, SysUtils, Classes, Forms, Dialogs, TypInfo
{$IFDEF D6UP}, Variants{$ENDIF};

//******************************************************* DatabaseError Messages
{$I ErrLangDB.pas}
//******************************************************************************


type
  TKADaoDBEngine = class(TComponent)
  private
    { Private declarations }
    F_OLE_ON               : Boolean;
    F_Destroyng            : Boolean;
    F_RuntimeLicense       : String;
  protected
    { Protected declarations }
    F_DefaultPassword      : String;
    F_DefaultUser          : String;
    F_EngineType           : Integer;
    F_IniPath              : String;
    F_LoginTimeout         : Integer;
    F_PrivateEngine        : Boolean;
    F_SystemDB             : String;
    F_UsesDynaDao          : Boolean;
    F_DaoVersion           : String;
    F_ActualDaoVersion     : String;
    F_VersionInfo          : String;
    F_ConnectedWorkspaces  : Integer;
    F_Connected            : Boolean;
    F_Workspaces           : TStringList;
    F_ComponentVersion     : String;
    Procedure F_Set_ComponentVersion   (Value: String);
    Procedure F_Set_DefaultPassword    (Value : String);
    Procedure F_Set_DefaultUser        (Value : String);
    Procedure F_Set_EngineType         (Value : Integer);
    Procedure F_Set_IniPath            (Value : String);
    Procedure F_Set_LoginTimeout       (Value : Integer);
    Procedure F_Set_PrivateEngine      (Value : Boolean);
    Procedure F_Set_SystemDatabase     (Value : String);
    Procedure F_Set_UsesDynaDao        (Value : Boolean);
    Procedure F_Set_DaoVersion         (Value : String);
    Procedure F_Set_ActualDaoVersion   (Value : String);
    Procedure F_Set_VersionInfo        (Value : String);
    Procedure F_Set_ConnectedWorkspaces(Value : Integer);
    Procedure F_Set_Connected          (Value : Boolean);

    //**************************************************************************
    {$IFDEF DYNADAO}
    Function                      CreateOleDBEngine(const ClassName: string): IDispatch;
    {$ELSE}
    Function                      CreateOleDBEngine(const ClassID: TGUID): DBEngine;
    {$ENDIF}
    Function                      CreateOleDBEngine_II(const ClassName: string): IDispatch;
    Procedure                     CheckEngines;
    Procedure                     CreateDBEngine(DaoVer:String);
    //**************************************************************************

    Procedure                     Loaded; override;
  public
    //******************************* Required to be public for Property Editors
    F_DaoVersionList       : TStringList;
    //**************************************************************************
    { Public declarations }
    {$IFDEF DYNADAO} //****************************************************
    CoreDBEngine                 : OleVariant;
    {$ENDIF}
    {$IFDEF DAO35}
    CoreDBEngine                 : DAO35Api.DBEngine;
    {$ENDIF}
    {$IFDEF DAO36}
     CoreDBEngine                : DAO36Api.DBEngine;
    {$ENDIF}
     Function                      GetSystemDatabaseFromRegistry:String;
     Procedure                     Attach(Name : String; Value : TComponent);
     Procedure                     Detach(Name : String; Value : TComponent);
     Procedure                     ReleaseCore;
     Procedure                     RecreateCore;
     Procedure                     Open;
     Procedure                     Close;
     Procedure                     StartTransaction;
     Procedure                     Commit;
     Procedure                     Rollback;

     Procedure                     RepairAccessDatabase  (DatabaseName,Password:String);
     Procedure                     RepairAccessDatabaseEx(DatabaseName : String;
                                                          NewLocale    : String;
                                                          Encrypt      : Boolean;
                                                          Decrypt      : Boolean;
                                                          NewVersion   : Integer;
                                                          Password     : String);
     Procedure                     CompactAccessDatabase  (DatabaseName,Password:String);
     Procedure                     CompactAccessDatabaseEx(DatabaseName: String;
                                                           NewLocale   : String;
                                                           Encrypt     : Boolean;
                                                           Decrypt     : Boolean;
                                                           NewVersion  : Integer;
                                                           Password    : String);

     Function                      RegisterDatabase        (DatabaseName, DriverName:String; Silent:Boolean; Attributes:String):Boolean;
     Procedure                     Idle;
     Constructor                   Create(AOwner : TComponent); override;
     Destructor                    Destroy; override;
  published
    { Published declarations }
    Property ComponentVersion    : String  Read F_ComponentVersion    Write F_Set_ComponentVersion;
    Property DefaultPassword     : String  Read F_DefaultPassword     Write F_Set_DefaultPassword;
    Property DefaultUser         : String  Read F_DefaultUser         Write F_Set_DefaultUser;
    Property EngineType          : Integer Read F_EngineType          Write F_Set_EngineType;
    Property IniPath             : String  Read F_IniPath             Write F_Set_IniPath;
    Property LoginTimeout        : Integer Read F_LoginTimeout        Write F_Set_LoginTimeout;
    Property PrivateEngine       : Boolean Read F_PrivateEngine       Write F_Set_PrivateEngine;
    Property SystemDatabase      : String  Read F_SystemDB            Write F_Set_SystemDatabase;
    Property UsesDynaDao         : Boolean Read F_UsesDynaDao         Write F_Set_UsesDynaDao;
    Property Version             : String  Read F_DaoVersion          Write F_Set_DaoVersion;
    Property VersionDetails      : String  Read F_ActualDaoVersion    Write F_Set_ActualDaoVersion;
    Property VersionInfo         : String  Read F_VersionInfo         Write F_Set_VersionInfo;
    Property ConnectedWorkspaces : Integer Read F_ConnectedWorkspaces Write F_Set_ConnectedWorkspaces;
    Property Connected           : Boolean Read F_Connected           Write F_Set_Connected;
  end;

procedure Register;

implementation
Uses ActiveX, Registry, KDaoWorkspace, KDaoDatabase{$IFDEF USEDB}, DB{$ENDIF};

{$IFNDEF USEDB}
Procedure DatabaseError(Msg:String);
Begin
  Raise Exception.Create(Msg);
End;
{$ENDIF}

Constructor TKADaoDBEngine.Create(AOwner : TComponent);
Var
 OLE_INIT : Integer;
 X        : Integer;
 Prop     : Pointer;
Begin
 Inherited Create(AOwner);
 OLE_INIT  := CoInitialize(NIL);
 if (OLE_INIT = S_OK) or (OLE_INIT = S_FALSE) then F_OLE_ON:= True;
 F_ComponentVersion     := '5.70';
 F_Destroyng            := False;
 {$IFDEF DYNADAO}
 CoreDBEngine           := NULL;
 {$ELSE}
 CoreDBEngine           := Nil;
 {$ENDIF}
 F_RuntimeLicense       := '';
 F_DefaultPassword      := '';
 F_DefaultUser          := 'Admin';
 F_EngineType           := DaoApi.dbUseJet;
 F_PrivateEngine        := False;
 F_ConnectedWorkspaces  := 0;
 {$IFDEF DYNADAO}
 F_UsesDynaDao          := True;
 {$ELSE}
 F_UsesDynaDao          := False;
 {$ENDIF}
 F_DaoVersionList       := TStringList.Create;
 F_DaoVersionList.Clear;
 F_Workspaces           := TStringList.Create;
 F_Workspaces.Clear;
 For X := 0 To Owner.ComponentCount-1 do
      Begin
       Prop := GetPropInfo(Owner.Components[X].ClassInfo, 'DaoLicence');
       if Prop <> Nil Then
           Begin
             F_RuntimeLicense := GetStrProp(Owner.Components[X], Prop);
             Break;
           End;
      End;
 CheckEngines;
 {$IFDEF DYNADAO}
 if F_DaoVersionList.Count > 0 Then
    Begin
      if F_DaoVersionList.Strings[0]='3.5' Then F_DaoVersion := '3.5' Else F_DaoVersion := '3.6';
    End
  Else
     Begin
       DatabaseError(E1004);
     End;
 {$ENDIF}
 {$IFDEF DAO35}
 F_DaoVersion               := '3.5';
 {$ENDIF}
 {$IFDEF DAO36}
 F_DaoVersion               := '3.6';
 {$ENDIF}
 F_Connected            := False;
 CreateDBEngine(F_DaoVersion);
 F_IniPath      := CoreDBEngine.IniPath;
 F_EngineType   := CoreDBEngine.DefaultType;
 F_SystemDB     := CoreDBEngine.SystemDB;
 F_LoginTimeout := CoreDBEngine.LoginTimeout;
 RecreateCore;
End;

Destructor  TKADaoDBEngine.Destroy;
Begin
 F_Destroyng := True;
 Connected   := False;
 ReleaseCore;
 F_DaoVersionList.Free;
 F_Workspaces.Free;
 if F_OLE_ON Then CoUninitialize;
 F_OLE_ON:=False;
 Inherited Destroy;
End;

Procedure TKADaoDBEngine.Attach(Name : String; Value : TComponent);
Begin
  F_Workspaces.AddObject(Name,TObject(Value));
  Inc(F_ConnectedWorkspaces);
End;

Procedure TKADaoDBEngine.Detach(Name : String; Value : TComponent);
Var
  I : Integer;
Begin
  I := F_Workspaces.IndexOf(Name);
  if I <> -1 Then
     Begin
       F_Workspaces.Delete(I);
       Dec(F_ConnectedWorkspaces);
     End;
End;



{$IFDEF DYNADAO}
Function TKADaoDBEngine.CreateOleDBEngine(const ClassName: string): IDispatch;
{$ELSE}
Function TKADaoDBEngine.CreateOleDBEngine(const ClassID: TGUID): DBEngine;
{$ENDIF}
Const
  DBEngine_TGUID: TGUID = '{00000021-0000-0010-8000-00AA006D2EA4}';
Var
  LicenseClass       : IClassFactory2;
  DWReserved         : DWORD;
  LicenseString      : Widestring;
{$IFDEF DYNADAO}
  ClassID : TGUID;
Begin
  ClassID := ProgIDToClassID(ClassName);
{$ELSE}
Begin
{$ENDIF}
  //****************************************************************************
  LicenseClass := Nil;
  OleCheck(CoGetClassObject(ClassID,CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, nil, IClassFactory2, LicenseClass));
  if Assigned(LicenseClass) Then
     Begin
       SetLength(LicenseString,2000);
       DWReserved:=0;
       if F_RuntimeLicense <> '' Then
          LicenseString := F_RuntimeLicense
       Else
          LicenseClass.RequestLicKey(DWReserved,LicenseString);
       OleCheck(LicenseClass.CreateInstanceLic (nil, nil, DBEngine_TGUID, LicenseString, Result));
     End;
  //****************************************************************************
End;

Function TKADaoDBEngine.CreateOleDBEngine_II(const ClassName: string): IDispatch;
Const
  DBEngine_TGUID: TGUID = '{00000021-0000-0010-8000-00AA006D2EA4}';
Var
  LicenseClass       : IClassFactory2;
  DWReserved         : DWORD;
  LicenseString      : Widestring;
  ClassID : TGUID;
Begin
  ClassID := ProgIDToClassID(ClassName);
  //****************************************************************************
  LicenseClass := Nil;
  OleCheck(CoGetClassObject(ClassID,CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, nil, IClassFactory2, LicenseClass));
  if Assigned(LicenseClass) Then
     Begin
       SetLength(LicenseString,2000);
       DWReserved:=0;
       if F_RuntimeLicense <> '' Then
          LicenseString := F_RuntimeLicense
       Else
          LicenseClass.RequestLicKey(DWReserved,LicenseString);
       OleCheck(LicenseClass.CreateInstanceLic (nil, nil, DBEngine_TGUID, LicenseString, Result));
     End;
  //****************************************************************************
End;

Procedure TKADaoDBEngine.CheckEngines;
Var
 V35               : String;
 V36               : String;
 Reg               : TRegistry;
 S                 : String;
 TempDBEngine      : OleVariant;
Begin
  if F_PrivateEngine Then
    Begin
     V35:='DAO.PrivateDBEngine.35';
     V36:='DAO.PrivateDBEngine.36';
    End
 Else
    Begin
     V35 := 'DAO.DBEngine.35';
     V36 := 'DAO.DBEngine.36';
    End;

  Reg := TRegistry.Create;
  {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  Reg.RootKey := HKEY_CLASSES_ROOT;
  {$IFNDEF D4UP}
  if Reg.OpenKey(V35,False) then
  {$ELSE}
  if Reg.OpenKeyReadOnly(V35) then
  {$ENDIF}
     Begin
       Try
        TempDBEngine               := CreateOleDBEngine_II(V35);
        TempDBEngine               := NULL;
        F_DaoVersionList.Add('3.5');
       Except
         on E:Exception do
            Begin
              S:=E.Message;
              if Pos('80040112',S) > 0 Then
                 Begin
                   Reg.CloseKey;
                   Reg.Free;
                   DatabaseError(E1001);
                 End;
            End;
       End;
     End;
  Reg.CloseKey;
  Reg.Free;

  Reg := TRegistry.Create;
  {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  Reg.RootKey := HKEY_CLASSES_ROOT;
  {$IFNDEF D4UP}
  if Reg.OpenKey(V36,False) then
  {$ELSE}
  if Reg.OpenKeyReadOnly(V36) then
  {$ENDIF}
     Begin
       Try
        TempDBEngine               := CreateOleDBEngine_II(V36);
        TempDBEngine               := NULL;
        F_DaoVersionList.Add('3.6');
       Except
         on E:Exception do
            Begin
              S:=E.Message;
              if Pos('80040112',S) > 0 Then
                 Begin
                   Reg.CloseKey;
                   Reg.Free;
                   DatabaseError(E1001);
                 End;
            End;
       End;
     End;
  Reg.CloseKey;
  Reg.Free;
  If Not VarIsNull(TempDBEngine) Then TempDBEngine := NULL;
End;

//*************************************************************************************************
Procedure TKADaoDBEngine.CreateDBEngine(DaoVer:String);
Var
  V35 : String;
  V36 : String;
Begin
 if F_PrivateEngine Then
    Begin
     V35:='DAO.PrivateDBEngine.35';
     V36:='DAO.PrivateDBEngine.36';
    End
 Else
    Begin
     V35 := 'DAO.DBEngine.35';
     V36 := 'DAO.DBEngine.36';
    End;

 {$IFDEF DYNADAO}
  if DaoVer='3.5' Then
     Begin
       Try
        CoreDBEngine               := CreateOleDBEngine(V35);
        F_DaoVersion               := '3.5';
       Except
         Try
          CoreDBEngine             := CreateOleDBEngine(V36);
          F_DaoVersion             := '3.6';
         Except
          DatabaseError(E1002);
         End;
       End;
   End;
  if DaoVer='3.6' Then
     Begin
       Try
        CoreDBEngine             := CreateOleDBEngine(V36);
        F_DaoVersion             := '3.6';
       Except
        DatabaseError(E1002);
       End;
   End;
  {$ELSE}
  CoreDBEngine               := Nil;
  Try
    if F_PrivateEngine Then
       CoreDBEngine          := CreateOleDBEngine(Class_PrivDBEngine)
    Else
       CoreDBEngine          := CreateOleDBEngine(Class_DBEngine);
  Except
    on E:Exception do
       Begin
         if Pos('80040112',E.Message) > 0 Then
            Begin
              DatabaseError(E1001);
            End
          Else DatabaseError(E.Message);
       End;
  End;
  {$ENDIF}
End;

Function TKADaoDBEngine.GetSystemDatabaseFromRegistry:String;
Var
  RS   : String;
  Reg : TRegistry;
Begin
  Result:='';
  RS:='3.5';
  if F_DaoVersion='3.5' Then RS:='3.5';
  if F_DaoVersion='3.6' Then RS:='4.0';
  Reg := TRegistry.Create;
  {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  Try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    {$IFNDEF D4UP}
    if Reg.OpenKey(Format('SOFTWARE\Microsoft\JET\%s\Engines',[RS]),False) then
    {$ELSE}
    if Reg.OpenKeyReadOnly(Format('SOFTWARE\Microsoft\JET\%s\Engines',[RS])) then
    {$ENDIF}
       Begin
         Result:=Reg.ReadString('SystemDB');
       End;
  Finally
    Reg.Free;
  End;
End;

Procedure TKADaoDBEngine.ReleaseCore;
Begin
  {$IFDEF DYNADAO}
  If Not VarIsNull(CoreDBEngine)  Then CoreDBEngine  := NULL;
  {$ELSE}
  CoreDBEngine  := Nil;
  {$ENDIF}
  if F_OLE_ON Then CoUninitialize;
  F_OLE_ON:=False;
End;

Procedure TKADaoDBEngine.RecreateCore;
Var
  OLE_INIT     : Integer;
  TempPrivate  : Boolean;
Begin
   ReleaseCore;
   OLE_INIT:= CoInitialize(NIL);
   if (OLE_INIT = S_OK) or (OLE_INIT = S_FALSE) then F_OLE_ON:= True
   Else DatabaseError(E1003);
   //*************************************************** Borland, Microsoft ...
   TempPrivate:=True;
   if (csDesigning in ComponentState) And (F_EngineType=dbUseJet) Then
      Begin
        TempPrivate      := F_PrivateEngine;
        F_PrivateEngine  := True;
      End;
   CreateDBEngine(F_DaoVersion);
   if (csDesigning in ComponentState) And (F_EngineType=dbUseJet) Then F_PrivateEngine  := TempPrivate;
   //***************************************************************************
   CoreDBEngine.SystemDB         := F_SystemDB;
   CoreDBEngine.DefaultUser      := F_DefaultUser;
   CoreDBEngine.DefaultPassword  := F_DefaultPassword;
   CoreDBEngine.IniPath          := F_IniPath;
   CoreDBEngine.LoginTimeout     := F_LoginTimeout;
   F_ActualDaoVersion            := CoreDBEngine.Version;
   if F_ActualDaoVersion[3]='5'  Then    F_VersionInfo:='(In Access''97 mode)';
   if F_ActualDaoVersion[3]='6'  Then    F_VersionInfo:='(In Access''2000 mode)';
End;


Procedure TKADaoDBEngine.Loaded;
begin
  try
    inherited Loaded;
    if F_Connected Then RecreateCore Else ReleaseCore;
  except
    Application.HandleException(Self)
  end;
end;

Procedure TKADaoDBEngine.F_Set_ComponentVersion(Value: String);
Begin
  //******************************************************************* ReadOnly
End;

Procedure TKADaoDBEngine.F_Set_DefaultPassword(Value : String);
Begin
  if F_Connected Then DatabaseError(E1033);
  F_DefaultPassword:=Value;
  if csLoading in ComponentState Then Exit;
  RecreateCore;
  ReleaseCore;
End;

Procedure TKADaoDBEngine.F_Set_DefaultUser(Value : String);
Begin
  if F_Connected Then DatabaseError(E1033);
  F_DefaultUser:=Value;
  if csLoading in ComponentState Then Exit;
  RecreateCore;
  ReleaseCore;
End;

Procedure TKADaoDBEngine.F_Set_IniPath(Value : String);
Begin
  if F_Connected Then DatabaseError(E1033);
  F_IniPath:=Value;
  if csLoading in ComponentState Then Exit;
  RecreateCore;
  ReleaseCore;
End;

Procedure TKADaoDBEngine.F_Set_LoginTimeout(Value : Integer);
Begin
  if F_Connected Then DatabaseError(E1033);
  F_LoginTimeout:=Value;
  if csLoading in ComponentState Then Exit;
  RecreateCore;
  ReleaseCore;
End;

Procedure TKADaoDBEngine.F_Set_EngineType(Value : Integer);
Begin
  if F_Connected Then DatabaseError(E1033);
  F_EngineType:=Value;
  if csLoading in ComponentState Then Exit;
  RecreateCore;
  ReleaseCore;
End;

Procedure TKADaoDBEngine.F_Set_PrivateEngine(Value : Boolean);
Begin
  if F_Connected Then DatabaseError(E1033);
  F_PrivateEngine:=Value;
  if csLoading in ComponentState Then Exit;
  RecreateCore;
  ReleaseCore;
End;

Procedure TKADaoDBEngine.F_Set_SystemDatabase(Value : String);
Begin
  if F_Connected Then DatabaseError(E1033);
  F_SystemDB:=Value;
  if csLoading in ComponentState Then Exit;
  RecreateCore;
  ReleaseCore;
End;

Procedure TKADaoDBEngine.F_Set_UsesDynaDao(Value : Boolean);
Begin
 //******************************************************************** ReadOnly
End;

Procedure TKADaoDBEngine.F_Set_DaoVersion(Value : String);
Begin
  if NOT F_UsesDynaDao Then Exit;
  if F_Connected Then DatabaseError(E1033);
  F_DaoVersion:=Value;
  if csLoading in ComponentState Then Exit;
  RecreateCore;
  ReleaseCore;
End;

Procedure TKADaoDBEngine.F_Set_ActualDaoVersion(Value : String);
Begin
  //******************************************************************* ReadOnly
End;

Procedure TKADaoDBEngine.F_Set_VersionInfo(Value : String);
Begin
  //******************************************************************* ReadOnly
End;

Procedure TKADaoDBEngine.F_Set_ConnectedWorkspaces(Value : Integer);
Begin
  //******************************************************************* ReadOnly
End;

Procedure TKADaoDBEngine.F_Set_Connected(Value : Boolean);
Var
  X : Integer;
Begin
  if Not Value Then
     Begin
        For X := 0 To F_Workspaces.Count-1 do
            Begin
              (F_Workspaces.Objects[X] as TKAdaoWorkspace).Connected := False;
              if F_Destroyng Then (F_Workspaces.Objects[X] as TKAdaoWorkspace).DaoDbEngine := Nil;
            End;
     End;
  if Value Then RecreateCore Else ReleaseCore;
  F_Connected := Value;
  if csLoading in ComponentState Then Exit;
End;

Procedure TKADaoDBEngine.Open;
Begin
  Connected := True;
End;

Procedure TKADaoDBEngine.Close;
Begin
  Connected := False;
End;

Procedure TKADaoDBEngine.StartTransaction;
Begin
  if (NOT F_Connected) Then
     Begin
       DatabaseError(E1023);
       Exit;
     End;
  CoreDBEngine.BeginTrans;
End;

Procedure TKADaoDBEngine.Commit;
Begin
 if (NOT F_Connected) Then
     Begin
       DatabaseError(E1024);
       Exit;
     End;
 CoreDBEngine.CommitTrans(dbForceOSFlush);
End;

Procedure TKADaoDBEngine.Rollback;
Var
  X       : Integer;
  ATable  : TKADaoWorkspace;
Begin
 CoreDBEngine.Rollback;
 For X :=0 To F_Workspaces.Count-1 do
     Begin
      ATable:=TKADaoWorkspace(F_Workspaces.Objects[X]);
      ATable.RollbackRefresh;
     End;
End;

//********************************************** WORKS ONLY ON DAO 3.5X
//                                              ON DAO 3.6 USE COMPACT DATABASE
//                                              WICH ALSO DOES REPAIR
//******************************************************************************
Procedure TKADaoDBEngine.RepairAccessDatabase(DatabaseName,Password:String);
Begin
  if F_DaoVersion='3.5' Then
     CoreDBEngine.RepairDatabase(DatabaseName)
  Else
     CompactAccessDatabase(DatabaseName,Password);
End;

Procedure TKADaoDBEngine.RepairAccessDatabaseEx(DatabaseName : String;
                                               NewLocale    : String;
                                               Encrypt      : Boolean;
                                               Decrypt      : Boolean;
                                               NewVersion   : Integer;
                                               Password     : String);
Begin
  if F_DaoVersion = '3.5' Then
     CoreDBEngine.RepairDatabase(DatabaseName)
  Else
     CompactAccessDatabaseEx(DatabaseName,NewLocale,Encrypt,Decrypt,NewVersion,Password);
End;

Procedure  TKADaoDBEngine.CompactAccessDatabase(DatabaseName,Password:String);
Var
  TempName : Array[0..1000] of Char;
  TempPath : String;
  Name     : String;
Begin
  TempPath:=ExtractFilePath(DatabaseName);
  if TempPath='' Then TempPath:=GetCurrentDir;
  GetTempFileName(PChar(TempPath),'mdb',0,TempName);
  Name:=StrPas(TempName);
  DeleteFile(Name);
  if Password <> '' Then Password:=';pwd='+Password;
  OleVariant(CoreDBEngine).CompactDatabase(DatabaseName,Name,,,Password);
  DeleteFile(DatabaseName);
  RenameFile(Name,DatabaseName);
End;

Procedure  TKADaoDBEngine.CompactAccessDatabaseEx(DatabaseName: String;
                                                  NewLocale   : String;
                                                  Encrypt     : Boolean;
                                                  Decrypt     : Boolean;
                                                  NewVersion  : Integer;
                                                  Password    : String);
Var
  TempName : Array[0..1000] of Char;
  TempPath : String;
  Name     : String;
  Options  : Integer;
Begin
  TempPath:=ExtractFilePath(DatabaseName);
  if TempPath='' Then TempPath:=GetCurrentDir;
  GetTempFileName(PChar(TempPath),'mdb',0,TempName);
  Name:=StrPas(TempName);
  DeleteFile(Name);
  Options:=0;
  if Encrypt Then Options := dbEncrypt;
  if Decrypt Then Options := dbDecrypt;
  if NewVersion <> 0 Then Options:=Options+NewVersion;
  if Password <> '' Then Password:=';pwd='+Password;
  CoreDBEngine.CompactDatabase(DatabaseName,Name,NewLocale,Options,Password);
  DeleteFile(DatabaseName);
  RenameFile(Name,DatabaseName);
End;

Function TKADaoDBEngine.RegisterDatabase(DatabaseName, DriverName:String; Silent:Boolean; Attributes:String):Boolean;
Begin
  Result := False;
  Try
    CoreDBEngine.RegisterDatabase(DatabaseName,DriverName,Silent,Attributes);
  Except
   Exit;
  End;
  Result := True;
End;

Procedure TKADaoDBEngine.Idle;
Begin
 CoreDBEngine.Idle(dbRefreshCache);
End;

procedure Register;
begin
  RegisterComponents('KA Dao', [TKADaoDBEngine]);
end;

end.