home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kompon / d3456 / KADAO72.ZIP / KDaoDBEngine.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-26  |  24.8 KB  |  778 lines

  1. unit KDaoDBEngine;
  2. {$B-}
  3. //******************************************************************************
  4. //                           Delphi Dao Project
  5. //                 Copyright (c) 2000-2001 by Kiril Antonov
  6. //******************************************************************************
  7. {DEFINE USEDB}                            //DISABLE IF YOU WANT TO USE PURE DAO
  8. {$I KADaoCommonDirectives.pas}
  9.  
  10. interface
  11.  
  12. Uses
  13. DAOApi,
  14. ComObj,
  15. {$IFDEF DAO35}
  16. DAO35Api,
  17. {$ENDIF}
  18. {$IFDEF DAO36}
  19. DAO36Api,
  20. {$ENDIF}
  21. Windows, Messages, SysUtils, Classes, Forms, Dialogs, TypInfo
  22. {$IFDEF D6UP}, Variants{$ENDIF};
  23.  
  24. //******************************************************* DatabaseError Messages
  25. {$I ErrLangDB.pas}
  26. //******************************************************************************
  27.  
  28.  
  29. type
  30.   TKADaoDBEngine = class(TComponent)
  31.   private
  32.     { Private declarations }
  33.     F_OLE_ON               : Boolean;
  34.     F_Destroyng            : Boolean;
  35.     F_RuntimeLicense       : String;
  36.   protected
  37.     { Protected declarations }
  38.     F_DefaultPassword      : String;
  39.     F_DefaultUser          : String;
  40.     F_EngineType           : Integer;
  41.     F_IniPath              : String;
  42.     F_LoginTimeout         : Integer;
  43.     F_PrivateEngine        : Boolean;
  44.     F_SystemDB             : String;
  45.     F_UsesDynaDao          : Boolean;
  46.     F_DaoVersion           : String;
  47.     F_ActualDaoVersion     : String;
  48.     F_VersionInfo          : String;
  49.     F_ConnectedWorkspaces  : Integer;
  50.     F_Connected            : Boolean;
  51.     F_Workspaces           : TStringList;
  52.     F_ComponentVersion     : String;
  53.     Procedure F_Set_ComponentVersion   (Value: String);
  54.     Procedure F_Set_DefaultPassword    (Value : String);
  55.     Procedure F_Set_DefaultUser        (Value : String);
  56.     Procedure F_Set_EngineType         (Value : Integer);
  57.     Procedure F_Set_IniPath            (Value : String);
  58.     Procedure F_Set_LoginTimeout       (Value : Integer);
  59.     Procedure F_Set_PrivateEngine      (Value : Boolean);
  60.     Procedure F_Set_SystemDatabase     (Value : String);
  61.     Procedure F_Set_UsesDynaDao        (Value : Boolean);
  62.     Procedure F_Set_DaoVersion         (Value : String);
  63.     Procedure F_Set_ActualDaoVersion   (Value : String);
  64.     Procedure F_Set_VersionInfo        (Value : String);
  65.     Procedure F_Set_ConnectedWorkspaces(Value : Integer);
  66.     Procedure F_Set_Connected          (Value : Boolean);
  67.  
  68.     //**************************************************************************
  69.     {$IFDEF DYNADAO}
  70.     Function                      CreateOleDBEngine(const ClassName: string): IDispatch;
  71.     {$ELSE}
  72.     Function                      CreateOleDBEngine(const ClassID: TGUID): DBEngine;
  73.     {$ENDIF}
  74.     Function                      CreateOleDBEngine_II(const ClassName: string): IDispatch;
  75.     Procedure                     CheckEngines;
  76.     Procedure                     CreateDBEngine(DaoVer:String);
  77.     //**************************************************************************
  78.  
  79.     Procedure                     Loaded; override;
  80.   public
  81.     //******************************* Required to be public for Property Editors
  82.     F_DaoVersionList       : TStringList;
  83.     //**************************************************************************
  84.     { Public declarations }
  85.     {$IFDEF DYNADAO} //****************************************************
  86.     CoreDBEngine                 : OleVariant;
  87.     {$ENDIF}
  88.     {$IFDEF DAO35}
  89.     CoreDBEngine                 : DAO35Api.DBEngine;
  90.     {$ENDIF}
  91.     {$IFDEF DAO36}
  92.      CoreDBEngine                : DAO36Api.DBEngine;
  93.     {$ENDIF}
  94.      Function                      GetSystemDatabaseFromRegistry:String;
  95.      Procedure                     Attach(Name : String; Value : TComponent);
  96.      Procedure                     Detach(Name : String; Value : TComponent);
  97.      Procedure                     ReleaseCore;
  98.      Procedure                     RecreateCore;
  99.      Procedure                     Open;
  100.      Procedure                     Close;
  101.      Procedure                     StartTransaction;
  102.      Procedure                     Commit;
  103.      Procedure                     Rollback;
  104.  
  105.      Procedure                     RepairAccessDatabase  (DatabaseName,Password:String);
  106.      Procedure                     RepairAccessDatabaseEx(DatabaseName : String;
  107.                                                           NewLocale    : String;
  108.                                                           Encrypt      : Boolean;
  109.                                                           Decrypt      : Boolean;
  110.                                                           NewVersion   : Integer;
  111.                                                           Password     : String);
  112.      Procedure                     CompactAccessDatabase  (DatabaseName,Password:String);
  113.      Procedure                     CompactAccessDatabaseEx(DatabaseName: String;
  114.                                                            NewLocale   : String;
  115.                                                            Encrypt     : Boolean;
  116.                                                            Decrypt     : Boolean;
  117.                                                            NewVersion  : Integer;
  118.                                                            Password    : String);
  119.  
  120.      Function                      RegisterDatabase        (DatabaseName, DriverName:String; Silent:Boolean; Attributes:String):Boolean;
  121.      Procedure                     Idle;
  122.      Constructor                   Create(AOwner : TComponent); override;
  123.      Destructor                    Destroy; override;
  124.   published
  125.     { Published declarations }
  126.     Property ComponentVersion    : String  Read F_ComponentVersion    Write F_Set_ComponentVersion;
  127.     Property DefaultPassword     : String  Read F_DefaultPassword     Write F_Set_DefaultPassword;
  128.     Property DefaultUser         : String  Read F_DefaultUser         Write F_Set_DefaultUser;
  129.     Property EngineType          : Integer Read F_EngineType          Write F_Set_EngineType;
  130.     Property IniPath             : String  Read F_IniPath             Write F_Set_IniPath;
  131.     Property LoginTimeout        : Integer Read F_LoginTimeout        Write F_Set_LoginTimeout;
  132.     Property PrivateEngine       : Boolean Read F_PrivateEngine       Write F_Set_PrivateEngine;
  133.     Property SystemDatabase      : String  Read F_SystemDB            Write F_Set_SystemDatabase;
  134.     Property UsesDynaDao         : Boolean Read F_UsesDynaDao         Write F_Set_UsesDynaDao;
  135.     Property Version             : String  Read F_DaoVersion          Write F_Set_DaoVersion;
  136.     Property VersionDetails      : String  Read F_ActualDaoVersion    Write F_Set_ActualDaoVersion;
  137.     Property VersionInfo         : String  Read F_VersionInfo         Write F_Set_VersionInfo;
  138.     Property ConnectedWorkspaces : Integer Read F_ConnectedWorkspaces Write F_Set_ConnectedWorkspaces;
  139.     Property Connected           : Boolean Read F_Connected           Write F_Set_Connected;
  140.   end;
  141.  
  142. procedure Register;
  143.  
  144. implementation
  145. Uses ActiveX, Registry, KDaoWorkspace, KDaoDatabase{$IFDEF USEDB}, DB{$ENDIF};
  146.  
  147. {$IFNDEF USEDB}
  148. Procedure DatabaseError(Msg:String);
  149. Begin
  150.   Raise Exception.Create(Msg);
  151. End;
  152. {$ENDIF}
  153.  
  154. Constructor TKADaoDBEngine.Create(AOwner : TComponent);
  155. Var
  156.  OLE_INIT : Integer;
  157.  X        : Integer;
  158.  Prop     : Pointer;
  159. Begin
  160.  Inherited Create(AOwner);
  161.  OLE_INIT  := CoInitialize(NIL);
  162.  if (OLE_INIT = S_OK) or (OLE_INIT = S_FALSE) then F_OLE_ON:= True;
  163.  F_ComponentVersion     := '5.70';
  164.  F_Destroyng            := False;
  165.  {$IFDEF DYNADAO}
  166.  CoreDBEngine           := NULL;
  167.  {$ELSE}
  168.  CoreDBEngine           := Nil;
  169.  {$ENDIF}
  170.  F_RuntimeLicense       := '';
  171.  F_DefaultPassword      := '';
  172.  F_DefaultUser          := 'Admin';
  173.  F_EngineType           := DaoApi.dbUseJet;
  174.  F_PrivateEngine        := False;
  175.  F_ConnectedWorkspaces  := 0;
  176.  {$IFDEF DYNADAO}
  177.  F_UsesDynaDao          := True;
  178.  {$ELSE}
  179.  F_UsesDynaDao          := False;
  180.  {$ENDIF}
  181.  F_DaoVersionList       := TStringList.Create;
  182.  F_DaoVersionList.Clear;
  183.  F_Workspaces           := TStringList.Create;
  184.  F_Workspaces.Clear;
  185.  For X := 0 To Owner.ComponentCount-1 do
  186.       Begin
  187.        Prop := GetPropInfo(Owner.Components[X].ClassInfo, 'DaoLicence');
  188.        if Prop <> Nil Then
  189.            Begin
  190.              F_RuntimeLicense := GetStrProp(Owner.Components[X], Prop);
  191.              Break;
  192.            End;
  193.       End;
  194.  CheckEngines;
  195.  {$IFDEF DYNADAO}
  196.  if F_DaoVersionList.Count > 0 Then
  197.     Begin
  198.       if F_DaoVersionList.Strings[0]='3.5' Then F_DaoVersion := '3.5' Else F_DaoVersion := '3.6';
  199.     End
  200.   Else
  201.      Begin
  202.        DatabaseError(E1004);
  203.      End;
  204.  {$ENDIF}
  205.  {$IFDEF DAO35}
  206.  F_DaoVersion               := '3.5';
  207.  {$ENDIF}
  208.  {$IFDEF DAO36}
  209.  F_DaoVersion               := '3.6';
  210.  {$ENDIF}
  211.  F_Connected            := False;
  212.  CreateDBEngine(F_DaoVersion);
  213.  F_IniPath      := CoreDBEngine.IniPath;
  214.  F_EngineType   := CoreDBEngine.DefaultType;
  215.  F_SystemDB     := CoreDBEngine.SystemDB;
  216.  F_LoginTimeout := CoreDBEngine.LoginTimeout;
  217.  RecreateCore;
  218. End;
  219.  
  220. Destructor  TKADaoDBEngine.Destroy;
  221. Begin
  222.  F_Destroyng := True;
  223.  Connected   := False;
  224.  ReleaseCore;
  225.  F_DaoVersionList.Free;
  226.  F_Workspaces.Free;
  227.  if F_OLE_ON Then CoUninitialize;
  228.  F_OLE_ON:=False;
  229.  Inherited Destroy;
  230. End;
  231.  
  232. Procedure TKADaoDBEngine.Attach(Name : String; Value : TComponent);
  233. Begin
  234.   F_Workspaces.AddObject(Name,TObject(Value));
  235.   Inc(F_ConnectedWorkspaces);
  236. End;
  237.  
  238. Procedure TKADaoDBEngine.Detach(Name : String; Value : TComponent);
  239. Var
  240.   I : Integer;
  241. Begin
  242.   I := F_Workspaces.IndexOf(Name);
  243.   if I <> -1 Then
  244.      Begin
  245.        F_Workspaces.Delete(I);
  246.        Dec(F_ConnectedWorkspaces);
  247.      End;
  248. End;
  249.  
  250.  
  251.  
  252. {$IFDEF DYNADAO}
  253. Function TKADaoDBEngine.CreateOleDBEngine(const ClassName: string): IDispatch;
  254. {$ELSE}
  255. Function TKADaoDBEngine.CreateOleDBEngine(const ClassID: TGUID): DBEngine;
  256. {$ENDIF}
  257. Const
  258.   DBEngine_TGUID: TGUID = '{00000021-0000-0010-8000-00AA006D2EA4}';
  259. Var
  260.   LicenseClass       : IClassFactory2;
  261.   DWReserved         : DWORD;
  262.   LicenseString      : Widestring;
  263. {$IFDEF DYNADAO}
  264.   ClassID : TGUID;
  265. Begin
  266.   ClassID := ProgIDToClassID(ClassName);
  267. {$ELSE}
  268. Begin
  269. {$ENDIF}
  270.   //****************************************************************************
  271.   LicenseClass := Nil;
  272.   OleCheck(CoGetClassObject(ClassID,CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, nil, IClassFactory2, LicenseClass));
  273.   if Assigned(LicenseClass) Then
  274.      Begin
  275.        SetLength(LicenseString,2000);
  276.        DWReserved:=0;
  277.        if F_RuntimeLicense <> '' Then
  278.           LicenseString := F_RuntimeLicense
  279.        Else
  280.           LicenseClass.RequestLicKey(DWReserved,LicenseString);
  281.        OleCheck(LicenseClass.CreateInstanceLic (nil, nil, DBEngine_TGUID, LicenseString, Result));
  282.      End;
  283.   //****************************************************************************
  284. End;
  285.  
  286. Function TKADaoDBEngine.CreateOleDBEngine_II(const ClassName: string): IDispatch;
  287. Const
  288.   DBEngine_TGUID: TGUID = '{00000021-0000-0010-8000-00AA006D2EA4}';
  289. Var
  290.   LicenseClass       : IClassFactory2;
  291.   DWReserved         : DWORD;
  292.   LicenseString      : Widestring;
  293.   ClassID : TGUID;
  294. Begin
  295.   ClassID := ProgIDToClassID(ClassName);
  296.   //****************************************************************************
  297.   LicenseClass := Nil;
  298.   OleCheck(CoGetClassObject(ClassID,CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, nil, IClassFactory2, LicenseClass));
  299.   if Assigned(LicenseClass) Then
  300.      Begin
  301.        SetLength(LicenseString,2000);
  302.        DWReserved:=0;
  303.        if F_RuntimeLicense <> '' Then
  304.           LicenseString := F_RuntimeLicense
  305.        Else
  306.           LicenseClass.RequestLicKey(DWReserved,LicenseString);
  307.        OleCheck(LicenseClass.CreateInstanceLic (nil, nil, DBEngine_TGUID, LicenseString, Result));
  308.      End;
  309.   //****************************************************************************
  310. End;
  311.  
  312. Procedure TKADaoDBEngine.CheckEngines;
  313. Var
  314.  V35               : String;
  315.  V36               : String;
  316.  Reg               : TRegistry;
  317.  S                 : String;
  318.  TempDBEngine      : OleVariant;
  319. Begin
  320.   if F_PrivateEngine Then
  321.     Begin
  322.      V35:='DAO.PrivateDBEngine.35';
  323.      V36:='DAO.PrivateDBEngine.36';
  324.     End
  325.  Else
  326.     Begin
  327.      V35 := 'DAO.DBEngine.35';
  328.      V36 := 'DAO.DBEngine.36';
  329.     End;
  330.  
  331.   Reg := TRegistry.Create;
  332.   {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  333.   Reg.RootKey := HKEY_CLASSES_ROOT;
  334.   {$IFNDEF D4UP}
  335.   if Reg.OpenKey(V35,False) then
  336.   {$ELSE}
  337.   if Reg.OpenKeyReadOnly(V35) then
  338.   {$ENDIF}
  339.      Begin
  340.        Try
  341.         TempDBEngine               := CreateOleDBEngine_II(V35);
  342.         TempDBEngine               := NULL;
  343.         F_DaoVersionList.Add('3.5');
  344.        Except
  345.          on E:Exception do
  346.             Begin
  347.               S:=E.Message;
  348.               if Pos('80040112',S) > 0 Then
  349.                  Begin
  350.                    Reg.CloseKey;
  351.                    Reg.Free;
  352.                    DatabaseError(E1001);
  353.                  End;
  354.             End;
  355.        End;
  356.      End;
  357.   Reg.CloseKey;
  358.   Reg.Free;
  359.  
  360.   Reg := TRegistry.Create;
  361.   {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  362.   Reg.RootKey := HKEY_CLASSES_ROOT;
  363.   {$IFNDEF D4UP}
  364.   if Reg.OpenKey(V36,False) then
  365.   {$ELSE}
  366.   if Reg.OpenKeyReadOnly(V36) then
  367.   {$ENDIF}
  368.      Begin
  369.        Try
  370.         TempDBEngine               := CreateOleDBEngine_II(V36);
  371.         TempDBEngine               := NULL;
  372.         F_DaoVersionList.Add('3.6');
  373.        Except
  374.          on E:Exception do
  375.             Begin
  376.               S:=E.Message;
  377.               if Pos('80040112',S) > 0 Then
  378.                  Begin
  379.                    Reg.CloseKey;
  380.                    Reg.Free;
  381.                    DatabaseError(E1001);
  382.                  End;
  383.             End;
  384.        End;
  385.      End;
  386.   Reg.CloseKey;
  387.   Reg.Free;
  388.   If Not VarIsNull(TempDBEngine) Then TempDBEngine := NULL;
  389. End;
  390.  
  391. //*************************************************************************************************
  392. Procedure TKADaoDBEngine.CreateDBEngine(DaoVer:String);
  393. Var
  394.   V35 : String;
  395.   V36 : String;
  396. Begin
  397.  if F_PrivateEngine Then
  398.     Begin
  399.      V35:='DAO.PrivateDBEngine.35';
  400.      V36:='DAO.PrivateDBEngine.36';
  401.     End
  402.  Else
  403.     Begin
  404.      V35 := 'DAO.DBEngine.35';
  405.      V36 := 'DAO.DBEngine.36';
  406.     End;
  407.  
  408.  {$IFDEF DYNADAO}
  409.   if DaoVer='3.5' Then
  410.      Begin
  411.        Try
  412.         CoreDBEngine               := CreateOleDBEngine(V35);
  413.         F_DaoVersion               := '3.5';
  414.        Except
  415.          Try
  416.           CoreDBEngine             := CreateOleDBEngine(V36);
  417.           F_DaoVersion             := '3.6';
  418.          Except
  419.           DatabaseError(E1002);
  420.          End;
  421.        End;
  422.    End;
  423.   if DaoVer='3.6' Then
  424.      Begin
  425.        Try
  426.         CoreDBEngine             := CreateOleDBEngine(V36);
  427.         F_DaoVersion             := '3.6';
  428.        Except
  429.         DatabaseError(E1002);
  430.        End;
  431.    End;
  432.   {$ELSE}
  433.   CoreDBEngine               := Nil;
  434.   Try
  435.     if F_PrivateEngine Then
  436.        CoreDBEngine          := CreateOleDBEngine(Class_PrivDBEngine)
  437.     Else
  438.        CoreDBEngine          := CreateOleDBEngine(Class_DBEngine);
  439.   Except
  440.     on E:Exception do
  441.        Begin
  442.          if Pos('80040112',E.Message) > 0 Then
  443.             Begin
  444.               DatabaseError(E1001);
  445.             End
  446.           Else DatabaseError(E.Message);
  447.        End;
  448.   End;
  449.   {$ENDIF}
  450. End;
  451.  
  452. Function TKADaoDBEngine.GetSystemDatabaseFromRegistry:String;
  453. Var
  454.   RS   : String;
  455.   Reg : TRegistry;
  456. Begin
  457.   Result:='';
  458.   RS:='3.5';
  459.   if F_DaoVersion='3.5' Then RS:='3.5';
  460.   if F_DaoVersion='3.6' Then RS:='4.0';
  461.   Reg := TRegistry.Create;
  462.   {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  463.   Try                                                               
  464.     Reg.RootKey := HKEY_LOCAL_MACHINE;
  465.     {$IFNDEF D4UP}
  466.     if Reg.OpenKey(Format('SOFTWARE\Microsoft\JET\%s\Engines',[RS]),False) then
  467.     {$ELSE}
  468.     if Reg.OpenKeyReadOnly(Format('SOFTWARE\Microsoft\JET\%s\Engines',[RS])) then
  469.     {$ENDIF}
  470.        Begin
  471.          Result:=Reg.ReadString('SystemDB');
  472.        End;
  473.   Finally
  474.     Reg.Free;
  475.   End;
  476. End;
  477.  
  478. Procedure TKADaoDBEngine.ReleaseCore;
  479. Begin
  480.   {$IFDEF DYNADAO}
  481.   If Not VarIsNull(CoreDBEngine)  Then CoreDBEngine  := NULL;
  482.   {$ELSE}
  483.   CoreDBEngine  := Nil;
  484.   {$ENDIF}
  485.   if F_OLE_ON Then CoUninitialize;
  486.   F_OLE_ON:=False;
  487. End;
  488.  
  489. Procedure TKADaoDBEngine.RecreateCore;
  490. Var
  491.   OLE_INIT     : Integer;
  492.   TempPrivate  : Boolean;
  493. Begin
  494.    ReleaseCore;
  495.    OLE_INIT:= CoInitialize(NIL);
  496.    if (OLE_INIT = S_OK) or (OLE_INIT = S_FALSE) then F_OLE_ON:= True
  497.    Else DatabaseError(E1003);
  498.    //*************************************************** Borland, Microsoft ...
  499.    TempPrivate:=True;
  500.    if (csDesigning in ComponentState) And (F_EngineType=dbUseJet) Then
  501.       Begin
  502.         TempPrivate      := F_PrivateEngine;
  503.         F_PrivateEngine  := True;
  504.       End;
  505.    CreateDBEngine(F_DaoVersion);
  506.    if (csDesigning in ComponentState) And (F_EngineType=dbUseJet) Then F_PrivateEngine  := TempPrivate;
  507.    //***************************************************************************
  508.    CoreDBEngine.SystemDB         := F_SystemDB;
  509.    CoreDBEngine.DefaultUser      := F_DefaultUser;
  510.    CoreDBEngine.DefaultPassword  := F_DefaultPassword;
  511.    CoreDBEngine.IniPath          := F_IniPath;
  512.    CoreDBEngine.LoginTimeout     := F_LoginTimeout;
  513.    F_ActualDaoVersion            := CoreDBEngine.Version;
  514.    if F_ActualDaoVersion[3]='5'  Then    F_VersionInfo:='(In Access''97 mode)';
  515.    if F_ActualDaoVersion[3]='6'  Then    F_VersionInfo:='(In Access''2000 mode)';
  516. End;
  517.  
  518.  
  519. Procedure TKADaoDBEngine.Loaded;
  520. begin
  521.   try
  522.     inherited Loaded;
  523.     if F_Connected Then RecreateCore Else ReleaseCore;
  524.   except
  525.     Application.HandleException(Self)
  526.   end;
  527. end;
  528.  
  529. Procedure TKADaoDBEngine.F_Set_ComponentVersion(Value: String);
  530. Begin
  531.   //******************************************************************* ReadOnly
  532. End;
  533.  
  534. Procedure TKADaoDBEngine.F_Set_DefaultPassword(Value : String);
  535. Begin
  536.   if F_Connected Then DatabaseError(E1033);
  537.   F_DefaultPassword:=Value;
  538.   if csLoading in ComponentState Then Exit;
  539.   RecreateCore;
  540.   ReleaseCore;
  541. End;
  542.  
  543. Procedure TKADaoDBEngine.F_Set_DefaultUser(Value : String);
  544. Begin
  545.   if F_Connected Then DatabaseError(E1033);
  546.   F_DefaultUser:=Value;
  547.   if csLoading in ComponentState Then Exit;
  548.   RecreateCore;
  549.   ReleaseCore;
  550. End;
  551.  
  552. Procedure TKADaoDBEngine.F_Set_IniPath(Value : String);
  553. Begin
  554.   if F_Connected Then DatabaseError(E1033);
  555.   F_IniPath:=Value;
  556.   if csLoading in ComponentState Then Exit;
  557.   RecreateCore;
  558.   ReleaseCore;
  559. End;
  560.  
  561. Procedure TKADaoDBEngine.F_Set_LoginTimeout(Value : Integer);
  562. Begin
  563.   if F_Connected Then DatabaseError(E1033);
  564.   F_LoginTimeout:=Value;
  565.   if csLoading in ComponentState Then Exit;
  566.   RecreateCore;
  567.   ReleaseCore;
  568. End;
  569.  
  570. Procedure TKADaoDBEngine.F_Set_EngineType(Value : Integer);
  571. Begin
  572.   if F_Connected Then DatabaseError(E1033);
  573.   F_EngineType:=Value;
  574.   if csLoading in ComponentState Then Exit;
  575.   RecreateCore;
  576.   ReleaseCore;
  577. End;
  578.  
  579. Procedure TKADaoDBEngine.F_Set_PrivateEngine(Value : Boolean);
  580. Begin
  581.   if F_Connected Then DatabaseError(E1033);
  582.   F_PrivateEngine:=Value;
  583.   if csLoading in ComponentState Then Exit;
  584.   RecreateCore;
  585.   ReleaseCore;
  586. End;
  587.  
  588. Procedure TKADaoDBEngine.F_Set_SystemDatabase(Value : String);
  589. Begin
  590.   if F_Connected Then DatabaseError(E1033);
  591.   F_SystemDB:=Value;
  592.   if csLoading in ComponentState Then Exit;
  593.   RecreateCore;
  594.   ReleaseCore;
  595. End;
  596.  
  597. Procedure TKADaoDBEngine.F_Set_UsesDynaDao(Value : Boolean);
  598. Begin
  599.  //******************************************************************** ReadOnly
  600. End;
  601.  
  602. Procedure TKADaoDBEngine.F_Set_DaoVersion(Value : String);
  603. Begin
  604.   if NOT F_UsesDynaDao Then Exit;
  605.   if F_Connected Then DatabaseError(E1033);
  606.   F_DaoVersion:=Value;
  607.   if csLoading in ComponentState Then Exit;
  608.   RecreateCore;
  609.   ReleaseCore;
  610. End;
  611.  
  612. Procedure TKADaoDBEngine.F_Set_ActualDaoVersion(Value : String);
  613. Begin
  614.   //******************************************************************* ReadOnly
  615. End;
  616.  
  617. Procedure TKADaoDBEngine.F_Set_VersionInfo(Value : String);
  618. Begin
  619.   //******************************************************************* ReadOnly
  620. End;
  621.  
  622. Procedure TKADaoDBEngine.F_Set_ConnectedWorkspaces(Value : Integer);
  623. Begin
  624.   //******************************************************************* ReadOnly
  625. End;
  626.  
  627. Procedure TKADaoDBEngine.F_Set_Connected(Value : Boolean);
  628. Var
  629.   X : Integer;
  630. Begin
  631.   if Not Value Then
  632.      Begin
  633.         For X := 0 To F_Workspaces.Count-1 do
  634.             Begin
  635.               (F_Workspaces.Objects[X] as TKAdaoWorkspace).Connected := False;
  636.               if F_Destroyng Then (F_Workspaces.Objects[X] as TKAdaoWorkspace).DaoDbEngine := Nil;
  637.             End;
  638.      End;
  639.   if Value Then RecreateCore Else ReleaseCore;
  640.   F_Connected := Value;
  641.   if csLoading in ComponentState Then Exit;
  642. End;
  643.  
  644. Procedure TKADaoDBEngine.Open;
  645. Begin
  646.   Connected := True;
  647. End;
  648.  
  649. Procedure TKADaoDBEngine.Close;
  650. Begin
  651.   Connected := False;
  652. End;
  653.  
  654. Procedure TKADaoDBEngine.StartTransaction;
  655. Begin
  656.   if (NOT F_Connected) Then
  657.      Begin
  658.        DatabaseError(E1023);
  659.        Exit;
  660.      End;
  661.   CoreDBEngine.BeginTrans;
  662. End;
  663.  
  664. Procedure TKADaoDBEngine.Commit;
  665. Begin
  666.  if (NOT F_Connected) Then
  667.      Begin
  668.        DatabaseError(E1024);
  669.        Exit;
  670.      End;
  671.  CoreDBEngine.CommitTrans(dbForceOSFlush);
  672. End;
  673.  
  674. Procedure TKADaoDBEngine.Rollback;
  675. Var
  676.   X       : Integer;
  677.   ATable  : TKADaoWorkspace;
  678. Begin
  679.  CoreDBEngine.Rollback;
  680.  For X :=0 To F_Workspaces.Count-1 do
  681.      Begin
  682.       ATable:=TKADaoWorkspace(F_Workspaces.Objects[X]);
  683.       ATable.RollbackRefresh;
  684.      End;
  685. End;
  686.  
  687. //********************************************** WORKS ONLY ON DAO 3.5X
  688. //                                              ON DAO 3.6 USE COMPACT DATABASE
  689. //                                              WICH ALSO DOES REPAIR
  690. //******************************************************************************
  691. Procedure TKADaoDBEngine.RepairAccessDatabase(DatabaseName,Password:String);
  692. Begin
  693.   if F_DaoVersion='3.5' Then
  694.      CoreDBEngine.RepairDatabase(DatabaseName)
  695.   Else
  696.      CompactAccessDatabase(DatabaseName,Password);
  697. End;
  698.  
  699. Procedure TKADaoDBEngine.RepairAccessDatabaseEx(DatabaseName : String;
  700.                                                NewLocale    : String;
  701.                                                Encrypt      : Boolean;
  702.                                                Decrypt      : Boolean;
  703.                                                NewVersion   : Integer;
  704.                                                Password     : String);
  705. Begin
  706.   if F_DaoVersion = '3.5' Then
  707.      CoreDBEngine.RepairDatabase(DatabaseName)
  708.   Else
  709.      CompactAccessDatabaseEx(DatabaseName,NewLocale,Encrypt,Decrypt,NewVersion,Password);
  710. End;
  711.  
  712. Procedure  TKADaoDBEngine.CompactAccessDatabase(DatabaseName,Password:String);
  713. Var
  714.   TempName : Array[0..1000] of Char;
  715.   TempPath : String;
  716.   Name     : String;
  717. Begin
  718.   TempPath:=ExtractFilePath(DatabaseName);
  719.   if TempPath='' Then TempPath:=GetCurrentDir;
  720.   GetTempFileName(PChar(TempPath),'mdb',0,TempName);
  721.   Name:=StrPas(TempName);
  722.   DeleteFile(Name);
  723.   if Password <> '' Then Password:=';pwd='+Password;
  724.   OleVariant(CoreDBEngine).CompactDatabase(DatabaseName,Name,,,Password);
  725.   DeleteFile(DatabaseName);
  726.   RenameFile(Name,DatabaseName);
  727. End;
  728.  
  729. Procedure  TKADaoDBEngine.CompactAccessDatabaseEx(DatabaseName: String;
  730.                                                   NewLocale   : String;
  731.                                                   Encrypt     : Boolean;
  732.                                                   Decrypt     : Boolean;
  733.                                                   NewVersion  : Integer;
  734.                                                   Password    : String);
  735. Var
  736.   TempName : Array[0..1000] of Char;
  737.   TempPath : String;
  738.   Name     : String;
  739.   Options  : Integer;
  740. Begin
  741.   TempPath:=ExtractFilePath(DatabaseName);
  742.   if TempPath='' Then TempPath:=GetCurrentDir;
  743.   GetTempFileName(PChar(TempPath),'mdb',0,TempName);
  744.   Name:=StrPas(TempName);
  745.   DeleteFile(Name);
  746.   Options:=0;
  747.   if Encrypt Then Options := dbEncrypt;
  748.   if Decrypt Then Options := dbDecrypt;
  749.   if NewVersion <> 0 Then Options:=Options+NewVersion;
  750.   if Password <> '' Then Password:=';pwd='+Password;
  751.   CoreDBEngine.CompactDatabase(DatabaseName,Name,NewLocale,Options,Password);
  752.   DeleteFile(DatabaseName);
  753.   RenameFile(Name,DatabaseName);
  754. End;
  755.  
  756. Function TKADaoDBEngine.RegisterDatabase(DatabaseName, DriverName:String; Silent:Boolean; Attributes:String):Boolean;
  757. Begin
  758.   Result := False;
  759.   Try
  760.     CoreDBEngine.RegisterDatabase(DatabaseName,DriverName,Silent,Attributes);
  761.   Except
  762.    Exit;
  763.   End;
  764.   Result := True;
  765. End;
  766.  
  767. Procedure TKADaoDBEngine.Idle;
  768. Begin
  769.  CoreDBEngine.Idle(dbRefreshCache);
  770. End;
  771.  
  772. procedure Register;
  773. begin
  774.   RegisterComponents('KA Dao', [TKADaoDBEngine]);
  775. end;
  776.  
  777. end.
  778.