home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 February / Chip_2003-02_cd1.bin / zkuste / delphi / kompon / d34567 / KADAO77.ZIP / KDaoDBEngine.pas < prev    next >
Pascal/Delphi Source File  |  2002-08-15  |  26KB  |  795 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 D5UP}
  148. var
  149.   //   ***************************************************
  150.   //   Defined only for Delphi3 and Delphi4
  151.   //   Delphi5 has buildin support for EmptyParam
  152.   //   ***************************************************
  153.   EmptyParam : OleVariant;
  154.   Unassigned : OleVariant;
  155. {$ENDIF}
  156.  
  157.  
  158. {$IFNDEF USEDB}
  159. Procedure DatabaseError(Msg:String);
  160. Begin
  161.   Raise Exception.Create(Msg);
  162. End;
  163. {$ENDIF}
  164.  
  165. Constructor TKADaoDBEngine.Create(AOwner : TComponent);
  166. Var
  167.  OLE_INIT : Integer;
  168.  X        : Integer;
  169.  Prop     : Pointer;
  170. Begin
  171.  Inherited Create(AOwner);
  172.  OLE_INIT  := CoInitialize(NIL);
  173.  if (OLE_INIT = S_OK) or (OLE_INIT = S_FALSE) then F_OLE_ON:= True;
  174.  F_ComponentVersion     := '5.70';
  175.  F_Destroyng            := False;
  176.  {$IFDEF DYNADAO}
  177.  CoreDBEngine           := Unassigned;
  178.  {$ELSE}
  179.  CoreDBEngine           := Nil;
  180.  {$ENDIF}
  181.  F_RuntimeLicense       := '';
  182.  F_DefaultPassword      := '';
  183.  F_DefaultUser          := 'Admin';
  184.  F_EngineType           := DaoApi.dbUseJet;
  185.  F_PrivateEngine        := False;
  186.  F_ConnectedWorkspaces  := 0;
  187.  {$IFDEF DYNADAO}
  188.  F_UsesDynaDao          := True;
  189.  {$ELSE}
  190.  F_UsesDynaDao          := False;
  191.  {$ENDIF}
  192.  F_DaoVersionList       := TStringList.Create;
  193.  F_DaoVersionList.Clear;
  194.  F_Workspaces           := TStringList.Create;
  195.  F_Workspaces.Clear;
  196.  For X := 0 To Owner.ComponentCount-1 do
  197.       Begin
  198.        Prop := GetPropInfo(Owner.Components[X].ClassInfo, 'DaoLicence');
  199.        if Prop <> Nil Then
  200.            Begin
  201.              F_RuntimeLicense := GetStrProp(Owner.Components[X], Prop);
  202.              Break;
  203.            End;
  204.       End;
  205.  CheckEngines;
  206.  {$IFDEF DYNADAO}
  207.  if F_DaoVersionList.Count > 0 Then
  208.     Begin
  209.       if F_DaoVersionList.Strings[0]='3.5' Then F_DaoVersion := '3.5' Else F_DaoVersion := '3.6';
  210.     End
  211.   Else
  212.      Begin
  213.        DatabaseError(E1004);
  214.      End;
  215.  {$ENDIF}
  216.  {$IFDEF DAO35}
  217.  F_DaoVersion               := '3.5';
  218.  {$ENDIF}
  219.  {$IFDEF DAO36}
  220.  F_DaoVersion               := '3.6';
  221.  {$ENDIF}
  222.  F_Connected            := False;
  223.  CreateDBEngine(F_DaoVersion);
  224.  F_IniPath      := CoreDBEngine.IniPath;
  225.  F_EngineType   := CoreDBEngine.DefaultType;
  226.  F_SystemDB     := CoreDBEngine.SystemDB;
  227.  F_LoginTimeout := CoreDBEngine.LoginTimeout;
  228.  RecreateCore;
  229. End;
  230.  
  231. Destructor  TKADaoDBEngine.Destroy;
  232. Begin
  233.  F_Destroyng := True;
  234.  Connected   := False;
  235.  ReleaseCore;
  236.  F_DaoVersionList.Free;
  237.  F_Workspaces.Free;
  238.  if F_OLE_ON Then CoUninitialize;
  239.  F_OLE_ON:=False;
  240.  Inherited Destroy;
  241. End;
  242.  
  243. Procedure TKADaoDBEngine.Attach(Name : String; Value : TComponent);
  244. Begin
  245.   F_Workspaces.AddObject(Name,TObject(Value));
  246.   Inc(F_ConnectedWorkspaces);
  247. End;
  248.  
  249. Procedure TKADaoDBEngine.Detach(Name : String; Value : TComponent);
  250. Var
  251.   I : Integer;
  252. Begin
  253.   I := F_Workspaces.IndexOf(Name);
  254.   if I <> -1 Then
  255.      Begin
  256.        F_Workspaces.Delete(I);
  257.        Dec(F_ConnectedWorkspaces);
  258.      End;
  259. End;
  260.  
  261.  
  262.  
  263. {$IFDEF DYNADAO}
  264. Function TKADaoDBEngine.CreateOleDBEngine(const ClassName: string): IDispatch;
  265. {$ELSE}
  266. Function TKADaoDBEngine.CreateOleDBEngine(const ClassID: TGUID): DBEngine;
  267. {$ENDIF}
  268. Const
  269.   DBEngine_TGUID: TGUID = '{00000021-0000-0010-8000-00AA006D2EA4}';
  270. Var
  271.   LicenseClass       : IClassFactory2;
  272.   DWReserved         : DWORD;
  273.   LicenseString      : Widestring;
  274. {$IFDEF DYNADAO}
  275.   ClassID : TGUID;
  276. Begin
  277.   ClassID := ProgIDToClassID(ClassName);
  278. {$ELSE}
  279. Begin
  280. {$ENDIF}
  281.   //****************************************************************************
  282.   LicenseClass := Nil;
  283.   OleCheck(CoGetClassObject(ClassID,CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, nil, IClassFactory2, LicenseClass));
  284.   if Assigned(LicenseClass) Then
  285.      Begin
  286.        SetLength(LicenseString,2000);
  287.        DWReserved:=0;
  288.        if F_RuntimeLicense <> '' Then
  289.           LicenseString := F_RuntimeLicense
  290.        Else
  291.           LicenseClass.RequestLicKey(DWReserved,LicenseString);
  292.        OleCheck(LicenseClass.CreateInstanceLic (nil, nil, DBEngine_TGUID, LicenseString, Result));
  293.      End;
  294.   //****************************************************************************
  295. End;
  296.  
  297. Function TKADaoDBEngine.CreateOleDBEngine_II(const ClassName: string): IDispatch;
  298. Const
  299.   DBEngine_TGUID: TGUID = '{00000021-0000-0010-8000-00AA006D2EA4}';
  300. Var
  301.   LicenseClass       : IClassFactory2;
  302.   DWReserved         : DWORD;
  303.   LicenseString      : Widestring;
  304.   ClassID : TGUID;
  305. Begin
  306.   ClassID := ProgIDToClassID(ClassName);
  307.   //****************************************************************************
  308.   LicenseClass := Nil;
  309.   OleCheck(CoGetClassObject(ClassID,CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, nil, IClassFactory2, LicenseClass));
  310.   if Assigned(LicenseClass) Then
  311.      Begin
  312.        SetLength(LicenseString,2000);
  313.        DWReserved:=0;
  314.        if F_RuntimeLicense <> '' Then
  315.           LicenseString := F_RuntimeLicense
  316.        Else
  317.           LicenseClass.RequestLicKey(DWReserved,LicenseString);
  318.        OleCheck(LicenseClass.CreateInstanceLic (nil, nil, DBEngine_TGUID, LicenseString, Result));
  319.      End;
  320.   //****************************************************************************
  321. End;
  322.  
  323. Procedure TKADaoDBEngine.CheckEngines;
  324. Var
  325.  V35               : String;
  326.  V36               : String;
  327.  Reg               : TRegistry;
  328.  S                 : String;
  329.  TempDBEngine      : OleVariant;
  330. Begin
  331.   if F_PrivateEngine Then
  332.     Begin
  333.      V35:='DAO.PrivateDBEngine.35';
  334.      V36:='DAO.PrivateDBEngine.36';
  335.     End
  336.  Else
  337.     Begin
  338.      V35 := 'DAO.DBEngine.35';
  339.      V36 := 'DAO.DBEngine.36';
  340.     End;
  341.  
  342.   Reg := TRegistry.Create;
  343.   {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  344.   Reg.RootKey := HKEY_CLASSES_ROOT;
  345.   {$IFNDEF D4UP}
  346.   if Reg.OpenKey(V35,False) then
  347.   {$ELSE}
  348.   if Reg.OpenKeyReadOnly(V35) then
  349.   {$ENDIF}
  350.      Begin
  351.        Try
  352.         TempDBEngine               := CreateOleDBEngine_II(V35);
  353.         VarClear(TempDBEngine);
  354.         F_DaoVersionList.Add('3.5');
  355.        Except
  356.          on E:Exception do
  357.             Begin
  358.               S:=E.Message;
  359.               if Pos('80040112',S) > 0 Then
  360.                  Begin
  361.                    Reg.CloseKey;
  362.                    Reg.Free;
  363.                    DatabaseError(E1001);
  364.                  End;
  365.             End;
  366.        End;
  367.      End;
  368.   Reg.CloseKey;
  369.   Reg.Free;
  370.  
  371.   Reg := TRegistry.Create;
  372.   {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  373.   Reg.RootKey := HKEY_CLASSES_ROOT;
  374.   {$IFNDEF D4UP}
  375.   if Reg.OpenKey(V36,False) then
  376.   {$ELSE}
  377.   if Reg.OpenKeyReadOnly(V36) then
  378.   {$ENDIF}
  379.      Begin
  380.        Try
  381.         TempDBEngine               := CreateOleDBEngine_II(V36);
  382.         VarClear(TempDBEngine);
  383.         F_DaoVersionList.Add('3.6');
  384.        Except
  385.          on E:Exception do
  386.             Begin
  387.               S:=E.Message;
  388.               if Pos('80040112',S) > 0 Then
  389.                  Begin
  390.                    Reg.CloseKey;
  391.                    Reg.Free;
  392.                    DatabaseError(E1001);
  393.                  End;
  394.             End;
  395.        End;
  396.      End;
  397.   Reg.CloseKey;
  398.   Reg.Free;
  399.   If (Not VarIsNull(TempDBEngine)) And (Not VarIsEmpty(TempDBEngine)) Then VarClear(TempDBEngine);
  400. End;
  401.  
  402. //*************************************************************************************************
  403. Procedure TKADaoDBEngine.CreateDBEngine(DaoVer:String);
  404. Var
  405.   V35 : String;
  406.   V36 : String;
  407. Begin
  408.  if F_PrivateEngine Then
  409.     Begin
  410.      V35:='DAO.PrivateDBEngine.35';
  411.      V36:='DAO.PrivateDBEngine.36';
  412.     End
  413.  Else
  414.     Begin
  415.      V35 := 'DAO.DBEngine.35';
  416.      V36 := 'DAO.DBEngine.36';
  417.     End;
  418.  
  419.  {$IFDEF DYNADAO}
  420.   if DaoVer='3.5' Then
  421.      Begin
  422.        Try
  423.         CoreDBEngine               := CreateOleDBEngine(V35);
  424.         F_DaoVersion               := '3.5';
  425.        Except
  426.          Try
  427.           CoreDBEngine             := CreateOleDBEngine(V36);
  428.           F_DaoVersion             := '3.6';
  429.          Except
  430.           DatabaseError(E1002);
  431.          End;
  432.        End;
  433.    End;
  434.   if DaoVer='3.6' Then
  435.      Begin
  436.        Try
  437.         CoreDBEngine             := CreateOleDBEngine(V36);
  438.         F_DaoVersion             := '3.6';
  439.        Except
  440.         DatabaseError(E1002);
  441.        End;
  442.    End;
  443.   {$ELSE}
  444.   CoreDBEngine               := Nil;
  445.   Try
  446.     if F_PrivateEngine Then
  447.        CoreDBEngine          := CreateOleDBEngine(Class_PrivDBEngine)
  448.     Else
  449.        CoreDBEngine          := CreateOleDBEngine(Class_DBEngine);
  450.   Except
  451.     on E:Exception do
  452.        Begin
  453.          if Pos('80040112',E.Message) > 0 Then
  454.             Begin
  455.               DatabaseError(E1001);
  456.             End
  457.           Else DatabaseError(E.Message);
  458.        End;
  459.   End;
  460.   {$ENDIF}
  461. End;
  462.  
  463. Function TKADaoDBEngine.GetSystemDatabaseFromRegistry:String;
  464. Var
  465.   RS   : String;
  466.   Reg : TRegistry;
  467. Begin
  468.   Result:='';
  469.   RS:='3.5';
  470.   if F_DaoVersion='3.5' Then RS:='3.5';
  471.   if F_DaoVersion='3.6' Then RS:='4.0';
  472.   Reg := TRegistry.Create;
  473.   {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  474.   Try                                                               
  475.     Reg.RootKey := HKEY_LOCAL_MACHINE;
  476.     {$IFNDEF D4UP}
  477.     if Reg.OpenKey(Format('SOFTWARE\Microsoft\JET\%s\Engines',[RS]),False) then
  478.     {$ELSE}
  479.     if Reg.OpenKeyReadOnly(Format('SOFTWARE\Microsoft\JET\%s\Engines',[RS])) then
  480.     {$ENDIF}
  481.        Begin
  482.          Result:=Reg.ReadString('SystemDB');
  483.        End;
  484.   Finally
  485.     Reg.Free;
  486.   End;
  487. End;
  488.  
  489. Procedure TKADaoDBEngine.ReleaseCore;
  490. Begin
  491.   {$IFDEF DYNADAO}
  492.   If (Not VarIsNull(CoreDBEngine))  And (Not VarIsEmpty(CoreDBEngine))  Then VarClear(CoreDBEngine);
  493.   {$ELSE}
  494.   CoreDBEngine  := Nil;
  495.   {$ENDIF}
  496.   if F_OLE_ON Then CoUninitialize;
  497.   F_OLE_ON:=False;
  498. End;
  499.  
  500. Procedure TKADaoDBEngine.RecreateCore;
  501. Var
  502.   OLE_INIT     : Integer;
  503.   TempPrivate  : Boolean;
  504. Begin
  505.    ReleaseCore;
  506.    OLE_INIT:= CoInitialize(NIL);
  507.    if (OLE_INIT = S_OK) or (OLE_INIT = S_FALSE) then F_OLE_ON:= True
  508.    Else DatabaseError(E1003);
  509.    //*************************************************** Borland, Microsoft ...
  510.    TempPrivate:=True;
  511.    if (csDesigning in ComponentState) And (F_EngineType=dbUseJet) Then
  512.       Begin
  513.         TempPrivate      := F_PrivateEngine;
  514.         F_PrivateEngine  := True;
  515.       End;
  516.    CreateDBEngine(F_DaoVersion);
  517.    if (csDesigning in ComponentState) And (F_EngineType=dbUseJet) Then F_PrivateEngine  := TempPrivate;
  518.    //***************************************************************************
  519.    CoreDBEngine.SystemDB         := F_SystemDB;
  520.    CoreDBEngine.DefaultUser      := F_DefaultUser;
  521.    CoreDBEngine.DefaultPassword  := F_DefaultPassword;
  522.    CoreDBEngine.IniPath          := F_IniPath;
  523.    CoreDBEngine.LoginTimeout     := F_LoginTimeout;
  524.    F_ActualDaoVersion            := CoreDBEngine.Version;
  525.    if F_ActualDaoVersion[3]='5'  Then    F_VersionInfo:='(In Access''97 mode)';
  526.    if F_ActualDaoVersion[3]='6'  Then    F_VersionInfo:='(In Access''2000 mode)';
  527. End;
  528.  
  529.  
  530. Procedure TKADaoDBEngine.Loaded;
  531. begin
  532.   try
  533.     inherited Loaded;
  534.     if F_Connected Then RecreateCore Else ReleaseCore;
  535.   except
  536.     Application.HandleException(Self)
  537.   end;
  538. end;
  539.  
  540. Procedure TKADaoDBEngine.F_Set_ComponentVersion(Value: String);
  541. Begin
  542.   //******************************************************************* ReadOnly
  543. End;
  544.  
  545. Procedure TKADaoDBEngine.F_Set_DefaultPassword(Value : String);
  546. Begin
  547.   if F_Connected Then DatabaseError(E1033);
  548.   F_DefaultPassword:=Value;
  549.   if csLoading in ComponentState Then Exit;
  550.   RecreateCore;
  551.   ReleaseCore;
  552. End;
  553.  
  554. Procedure TKADaoDBEngine.F_Set_DefaultUser(Value : String);
  555. Begin
  556.   if F_Connected Then DatabaseError(E1033);
  557.   F_DefaultUser:=Value;
  558.   if csLoading in ComponentState Then Exit;
  559.   RecreateCore;
  560.   ReleaseCore;
  561. End;
  562.  
  563. Procedure TKADaoDBEngine.F_Set_IniPath(Value : String);
  564. Begin
  565.   if F_Connected Then DatabaseError(E1033);
  566.   F_IniPath:=Value;
  567.   if csLoading in ComponentState Then Exit;
  568.   RecreateCore;
  569.   ReleaseCore;
  570. End;
  571.  
  572. Procedure TKADaoDBEngine.F_Set_LoginTimeout(Value : Integer);
  573. Begin
  574.   if F_Connected Then DatabaseError(E1033);
  575.   F_LoginTimeout:=Value;
  576.   if csLoading in ComponentState Then Exit;
  577.   RecreateCore;
  578.   ReleaseCore;
  579. End;
  580.  
  581. Procedure TKADaoDBEngine.F_Set_EngineType(Value : Integer);
  582. Begin
  583.   if F_Connected Then DatabaseError(E1033);
  584.   F_EngineType:=Value;
  585.   if csLoading in ComponentState Then Exit;
  586.   RecreateCore;
  587.   ReleaseCore;
  588. End;
  589.  
  590. Procedure TKADaoDBEngine.F_Set_PrivateEngine(Value : Boolean);
  591. Begin
  592.   if F_Connected Then DatabaseError(E1033);
  593.   F_PrivateEngine:=Value;
  594.   if csLoading in ComponentState Then Exit;
  595.   RecreateCore;
  596.   ReleaseCore;
  597. End;
  598.  
  599. Procedure TKADaoDBEngine.F_Set_SystemDatabase(Value : String);
  600. Begin
  601.   if F_Connected Then DatabaseError(E1033);
  602.   F_SystemDB:=Value;
  603.   if csLoading in ComponentState Then Exit;
  604.   RecreateCore;
  605.   ReleaseCore;
  606. End;
  607.  
  608. Procedure TKADaoDBEngine.F_Set_UsesDynaDao(Value : Boolean);
  609. Begin
  610.  //******************************************************************** ReadOnly
  611. End;
  612.  
  613. Procedure TKADaoDBEngine.F_Set_DaoVersion(Value : String);
  614. Begin
  615.   if NOT F_UsesDynaDao Then Exit;
  616.   if F_Connected Then DatabaseError(E1033);
  617.   F_DaoVersion:=Value;
  618.   if csLoading in ComponentState Then Exit;
  619.   RecreateCore;
  620.   ReleaseCore;
  621. End;
  622.  
  623. Procedure TKADaoDBEngine.F_Set_ActualDaoVersion(Value : String);
  624. Begin
  625.   //******************************************************************* ReadOnly
  626. End;
  627.  
  628. Procedure TKADaoDBEngine.F_Set_VersionInfo(Value : String);
  629. Begin
  630.   //******************************************************************* ReadOnly
  631. End;
  632.  
  633. Procedure TKADaoDBEngine.F_Set_ConnectedWorkspaces(Value : Integer);
  634. Begin
  635.   //******************************************************************* ReadOnly
  636. End;
  637.  
  638. Procedure TKADaoDBEngine.F_Set_Connected(Value : Boolean);
  639. Var
  640.   X : Integer;
  641. Begin
  642.   if Not Value Then
  643.      Begin
  644.         For X := 0 To F_Workspaces.Count-1 do
  645.             Begin
  646.               (F_Workspaces.Objects[X] as TKAdaoWorkspace).Connected := False;
  647.               if F_Destroyng Then (F_Workspaces.Objects[X] as TKAdaoWorkspace).DaoDbEngine := Nil;
  648.             End;
  649.      End;
  650.   if Value Then RecreateCore Else ReleaseCore;
  651.   F_Connected := Value;
  652.   if csLoading in ComponentState Then Exit;
  653. End;
  654.  
  655. Procedure TKADaoDBEngine.Open;
  656. Begin
  657.   Connected := True;
  658. End;
  659.  
  660. Procedure TKADaoDBEngine.Close;
  661. Begin
  662.   Connected := False;
  663. End;
  664.  
  665. Procedure TKADaoDBEngine.StartTransaction;
  666. Begin
  667.   if (NOT F_Connected) Then
  668.      Begin
  669.        DatabaseError(E1023);
  670.        Exit;
  671.      End;
  672.   CoreDBEngine.BeginTrans;
  673. End;
  674.  
  675. Procedure TKADaoDBEngine.Commit;
  676. Begin
  677.  if (NOT F_Connected) Then
  678.      Begin
  679.        DatabaseError(E1024);
  680.        Exit;
  681.      End;
  682.  CoreDBEngine.CommitTrans(dbForceOSFlush);
  683. End;
  684.  
  685. Procedure TKADaoDBEngine.Rollback;
  686. Var
  687.   X       : Integer;
  688.   ATable  : TKADaoWorkspace;
  689. Begin
  690.  CoreDBEngine.Rollback;
  691.  For X :=0 To F_Workspaces.Count-1 do
  692.      Begin
  693.       ATable:=TKADaoWorkspace(F_Workspaces.Objects[X]);
  694.       ATable.RollbackRefresh;
  695.      End;
  696. End;
  697.  
  698. //********************************************** WORKS ONLY ON DAO 3.5X
  699. //                                              ON DAO 3.6 USE COMPACT DATABASE
  700. //                                              WICH ALSO DOES REPAIR
  701. //******************************************************************************
  702. Procedure TKADaoDBEngine.RepairAccessDatabase(DatabaseName,Password:String);
  703. Begin
  704.   if F_DaoVersion='3.5' Then
  705.      CoreDBEngine.RepairDatabase(DatabaseName)
  706.   Else
  707.      CompactAccessDatabase(DatabaseName,Password);
  708. End;
  709.  
  710. Procedure TKADaoDBEngine.RepairAccessDatabaseEx(DatabaseName : String;
  711.                                                NewLocale    : String;
  712.                                                Encrypt      : Boolean;
  713.                                                Decrypt      : Boolean;
  714.                                                NewVersion   : Integer;
  715.                                                Password     : String);
  716. Begin
  717.   if F_DaoVersion = '3.5' Then
  718.      CoreDBEngine.RepairDatabase(DatabaseName)
  719.   Else
  720.      CompactAccessDatabaseEx(DatabaseName,NewLocale,Encrypt,Decrypt,NewVersion,Password);
  721. End;
  722.  
  723. Procedure  TKADaoDBEngine.CompactAccessDatabase(DatabaseName,Password:String);
  724. Var
  725.   TempName : Array[0..1000] of Char;
  726.   TempPath : String;
  727.   Name     : String;
  728. Begin
  729.   TempPath:=ExtractFilePath(DatabaseName);
  730.   if TempPath='' Then TempPath:=GetCurrentDir;
  731.   GetTempFileName(PChar(TempPath),'mdb',0,TempName);
  732.   Name:=StrPas(TempName);
  733.   DeleteFile(Name);
  734.   if Password <> '' Then Password:=';pwd='+Password;
  735.   OleVariant(CoreDBEngine).CompactDatabase(DatabaseName,Name,,,Password);
  736.   DeleteFile(DatabaseName);
  737.   RenameFile(Name,DatabaseName);
  738. End;
  739.  
  740. Procedure  TKADaoDBEngine.CompactAccessDatabaseEx(DatabaseName: String;
  741.                                                   NewLocale   : String;
  742.                                                   Encrypt     : Boolean;
  743.                                                   Decrypt     : Boolean;
  744.                                                   NewVersion  : Integer;
  745.                                                   Password    : String);
  746. Var
  747.   TempName : Array[0..1000] of Char;
  748.   TempPath : String;
  749.   Name     : String;
  750.   Options  : Integer;
  751. Begin
  752.   TempPath:=ExtractFilePath(DatabaseName);
  753.   if TempPath='' Then TempPath:=GetCurrentDir;
  754.   GetTempFileName(PChar(TempPath),'mdb',0,TempName);
  755.   Name:=StrPas(TempName);
  756.   DeleteFile(Name);
  757.   Options:=0;
  758.   if Encrypt Then Options := dbEncrypt;
  759.   if Decrypt Then Options := dbDecrypt;
  760.   if NewVersion <> 0 Then Options:=Options+NewVersion;
  761.   if Password <> '' Then Password:=';pwd='+Password;
  762.   CoreDBEngine.CompactDatabase(DatabaseName,Name,NewLocale,Options,Password);
  763.   DeleteFile(DatabaseName);
  764.   RenameFile(Name,DatabaseName);
  765. End;
  766.  
  767. Function TKADaoDBEngine.RegisterDatabase(DatabaseName, DriverName:String; Silent:Boolean; Attributes:String):Boolean;
  768. Begin
  769.   Result := False;
  770.   Try
  771.     CoreDBEngine.RegisterDatabase(DatabaseName,DriverName,Silent,Attributes);
  772.   Except
  773.    Exit;
  774.   End;
  775.   Result := True;
  776. End;
  777.  
  778. Procedure TKADaoDBEngine.Idle;
  779. Begin
  780.  CoreDBEngine.Idle(dbRefreshCache);
  781. End;                                                
  782.  
  783. procedure Register;
  784. begin
  785.   RegisterComponents('KA Dao', [TKADaoDBEngine]);
  786. end;
  787.  
  788. Initialization
  789.  {$IFNDEF D5UP}
  790.   TVarData(Unassigned).VType := varEmpty;
  791.   TVarData(EmptyParam).VType := varError;
  792.   TVarData(EmptyParam).VError := $80020004;
  793.  {$ENDIF}
  794. end.
  795.