home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 February / Chip_2003-02_cd1.bin / zkuste / delphi / kompon / d34567 / KADAO77.ZIP / KDaoDataBase.pas < prev    next >
Pascal/Delphi Source File  |  2002-09-15  |  120KB  |  3,421 lines
  1. unit KDaoDataBase;
  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 WITHOUT KDaoTable
  8. {$I KADaoCommonDirectives.pas}
  9. //****************************************** CHANGES ***************************
  10. // 30.05.2000 - Added a checking of database for supporting transactions
  11. //              If database does NOT support transactions
  12. //              NO DAO action is performed
  13. // 08.06.2000 - Adding support for Dynamycally setting DAO Version
  14. //
  15. // 12.06.2000 - Fixed a login bug for ISAM databases
  16. //
  17. // 14.06.2000 - Added support for creating autoincrement fields
  18. //              How to use:
  19. //                 Use constant dbAutoIncInteger for FieldType
  20. //              Restrictions: (This is a DAO restrictions not the component!)
  21. //                 No retrictions when creating new table (BUT ONLY ONE AutoInc
  22. //                    Field per table)
  23. //                 Only ONE AutoInc Field per table
  24. //
  25. // 14.06.2000 - Renamed F_RefreshDefinitions to RefreshDefinitions
  26. //
  27. // 18.06.2000 - Fixed a bug with setting Dao Version when TKADaoDatabase is
  28. //              created.
  29. //              WARNING!!! INITIAL VERSION OF KADAO IS SET TO 3.5 NOW!
  30. // 19.06.2000 - Fixed a minor bug when a database control is deleted
  31. //              Now all tables linked to KADaoDatabase control work properly
  32. //              when control is deleted
  33. //
  34. // 26.06.2000 - Added Idle method to acces DBEngine Idle
  35. //
  36. // 26.06.2000 - Rewrited DaoVersion and SystemDatabase properties
  37. //
  38. // 27.06.2000 - Rewrited EngineType property
  39. //
  40. // 28.06.2000 - Minor fix: now CoreWorkspace is closed each time a new workspace
  41. //              is created
  42. //
  43. // 28.06.2000 - Added read only property DatabaseLanguage for information
  44. //              purpouses. If you want a LocaleCode DatabaseLanguageInt contains
  45. //              them
  46. // 28.06.2000 - Added CompactAccessDatabaseEx - No comment see code
  47. //              Seee also new Language constants in DaoApi.pas
  48. //
  49. // 28.06.2000 - Added CreateAccessDatabaseEx2 - Seee new Language constants
  50. //              in DaoApi.pas
  51. //
  52. // 29.06.2000 - Added CheckEngines method for avoiding exceptions when checking
  53. //              available versions of DAO
  54. //
  55. // 29.06.2000 - Added F_FindWorkspace method for avoiding exceptions when
  56. //              creating a new workspace
  57. //
  58. // 03.07.2000  CreateTable and AddFieldsToTable rewrited
  59. //             Still problems with creating Paradox primary index - HELP NEEDED!
  60. // 05.07.2000 - Fixed a very rediculous bug with Version property
  61. //              It seems that a 4 July is a day of shame for me!
  62. //
  63. // 17.07.2000 - Added LinkExternalTable - Now Tables of various types can be
  64. //              linked to Access database
  65. //              See _PredefinedTableTypes in DaoApi
  66. //              for information about TableType parameter
  67. //
  68. // 20.07.2000 - Added Open and Close methods
  69. //
  70. // 20.07.2000 - Added OnLogin Event - same as Borland's
  71. //
  72. // 24.07.2000 - Added tynny support for ODBC - No more Support for ODBC in
  73. //              future versions. Remember that DAO allows use of ODBC only if
  74. //              it has no ISAM driver for that type of Database.
  75. //
  76. // 27.07.2000 - Finnaly KADao CAN make Paradox table with Indexes
  77. //              BORLAND RESTRICTIONS WHICH APPLY HERE:
  78. //                - First field must be Primary Index
  79. //                - Unique Indexes can be created only using Paradox 7.X ISAM
  80. //                  driver wich is available only with DAO 3.6
  81. //                - All fields that are in PrimaryKey index must follow the
  82. //                  first field
  83. //
  84. // 27.07.2000 - Added small code to read again List of ISAM drivers when
  85. //              changing from DAO 3.5 to 3.6 and vice versa
  86. //
  87. // 30.07.2000 - Changed CreateTable to support Required field property
  88. //
  89. // 30.07.2000 - Changed AddFieldstoTable to support Required field property
  90. //
  91. // 30.07.2000 - Added new class - TKADaoTableManager wich manages creating of
  92. //              fields and indexes like the TTable
  93. //              See Demos for more info
  94. // 31.07.2000 - Maybe a Problem with Access security is solved
  95. //              A few steps are required to set SystemDatabase and login
  96. //                 1. Set Username property to valid username
  97. //                 2. Set Password property to valid password
  98. //                 3. Select system database
  99. //                 4. Set other properties and finally set connected to true
  100. //             WARNING! It is reccomennded to set new property PrivateEngine to
  101. //                    TRUE if you will use more then one KADaoDatabase component
  102. //                    in your project
  103. //
  104. // 18.08.2000 - Fixed a bug with Username/Password protection when using global
  105. //              Database password. With many thanks to "Joop" for reporting the
  106. //              problem
  107. //
  108. // 22.08.2000 - F_FindWorkspace method moved to public methods as FindWorkspace
  109. //
  110. // 24.08.2000 - Added ChangeDatabasePassword method for changing DB password
  111. //              Note: This is global database password
  112. //
  113. // 29.08.2000  - Added some code for QueryDefTimeOut
  114. //
  115. // 30.08.2000  - Added New Property UsesDynadao - True when DYNADAO is DEFINED
  116. //
  117. // 31.08.2000  - Added new Property DatabasePassword for Databases protected
  118. //               with both User Level Password and Global Database Password
  119. //               Also a login dialog and ONLogin Event are changed to support
  120. //               this
  121. //               When Database is MSAccess Database both Password And
  122. //               DatabasePassword are used and DatabasePassword is used to
  123. //               open Database otherwise a Password is used to Open Database
  124. //
  125. // 31.08.2000  - Changes made to CompactAccessDatabase and
  126. //               RepairAccessDatabase to support Password (send as new parameter)
  127. //
  128. // 07.09.2000  - Added few fixes in Create method - Many thanks to Oliver HΣger
  129. //
  130. // 07.09.2000  - Added new method ChooseDatabase for displaying dialogs as in
  131. //               property editor - thanks again to Oliver HΣger
  132. //
  133. // 07.09.2000  - Fixed a bug in CompactAccessDatabase/CompactAccessDatabaseEx
  134. //               Many thanks to Ingmar Bode for reporting the problem
  135. //
  136. // 21.09.2000  - Added Params property similar to TDatabase.Params
  137. //
  138. // 21.09.2000  - Added CreateEmptyTable method - Creates an Empty table
  139. //
  140. // 22.09.2000  - Added new Property DSNFileNames (TStringList) containing
  141. //               File Names of the DSN's which have such
  142. //               Format is DSN=FullPathFileName
  143. //
  144. // 01.10.2000  - Adjusted number of calls to RecreateCore when component loads
  145. //               Now it is called two times not 10!
  146. //                  1. At setting workspace property
  147. //                  2. At connecting to database
  148. //
  149. // 02.10.2000  - Added Additional code for DAO testing
  150. //               Also added support for easy creation of DBEngine
  151. //               thanks to Oliver HΣger.
  152. //
  153. // 02.10.2000  - Added RefreshLink Method to support DAO method with
  154. //               the same name. It can refres a link to external table
  155. //               previously created by LinkExternalTable method
  156. //
  157. // 02.10.2000  - Added RegisterDatabase Method to support DAO method with
  158. //               the same name. It is useful for creating ODBC links
  159. //               If the database is already registered
  160. //               in the Windows Registry the connection information is updated.
  161. //
  162. // 02.10.2000  - Added Support for ODBCDirect workspaces (ONLY WITH DYNADAO!)
  163. //               Unfortunately DAO restricts enumerating of tables in
  164. //               ODBCDirect Connections
  165. //               To use ODBCDirect do the following
  166. //                 1. Set DatabaseType to ODBC
  167. //                 2. Set EngineType to dbUseODBC
  168. //                 3. Set Database property
  169. //                 4. Set Connected to TRUE
  170. //                 5. In KadaoTable set TableType to DynamicTable
  171. //                 6. In KadaoTable MANUALY type the Table name in TableName
  172. //                    property and enclose in squire brackets []
  173. //                 7. In KadaoTable set OpenOptions to none or only to options
  174. //                    supported by ODBCDirect connection (for more see DAO help)
  175. //                 8. In KadaoTable set Active to TRUE
  176. //
  177. // 05.10.2000  - Added Minor fixes in CheckEngines routine
  178. //
  179. // 09.10.2000  - Added six new methods supporting transactions at
  180. //               DBEngine and Workspace level
  181. //               The standart methods are at Database level
  182. //
  183. //                      DBEngineLevel_StartTransaction;
  184. //                      DBEngineLevel_Commit;
  185. //                      DBEngineLevel_Rollback;
  186. //                      WorkspaceLevel_StartTransaction;
  187. //                      WorkspaceLevel_Commit;
  188. //                      WorkspaceLevel_Rollback;
  189. //
  190. // 17.10.2000  - Added CloseDatasets method same as TDatabase.CloseDatasets
  191. //
  192. //******************************************************************************
  193. //
  194. // 25.10.2000  - Found a bug in Rollback method-table rasies 'No current record'
  195. //               after rollback - now fixed thanks to Sergey
  196. //
  197. // 25.10.2000  - RecreateCore is now Public method. It is usefull for
  198. //               console applications
  199. //
  200. // 27.10.2000  - Added a small patch in TKADaoTableManager.CreateIndex to avoid
  201. //               creation of PrimaryKeyIndex again - thanks to Leo Verd·
  202. //
  203. // 31.10.2000  - Fixed a bug in designtime of security - now all works fine
  204. //
  205. // 31.10.2000  - Added new property SaveUsername - default to true
  206. //               When set to True login dialog shows the Username otherwise
  207. //               Username is blank
  208. //
  209. // 31.10.2000  - PrivateEngine is now True by default
  210. //
  211. // 01.11.2000  - For VERY NOT ORIENTED people added property VersionInfo
  212. //               No more comments!!! 
  213. //
  214. // 14.11.2000  - Added changes to support reading the Registry in ReadOnly mode
  215. //
  216. //******************************************************************************
  217. //
  218. // 05.12.2000  - All Error messages are moved to resourcestring so you can
  219. //               localize your KADAO.
  220. //               Errors between 1000 and 1999 are rezerved for KADaoDatabase
  221. //               Errors between 2000 and 2999 are rezerved for KADaoTable
  222. //
  223. //******************************************************************************
  224. //
  225. // 05.12.2000  - Added two new methods
  226. //                 - GoOffline - it gives opportunity to set
  227. //                    UserName, Password, SystemDatabase, EngineType
  228. //                    and some other parameters BEFORE call to RecreateCore
  229. //                 - GoOnline - restores the standart database state
  230. //               See Help for details.
  231. //
  232. // 12.12.2000  - Fixed small bug in handling User logging to the database
  233. //
  234. //******************************************************************************
  235. //
  236. // 07.01.2001  - Fixed small bug on CreateEmptyTable
  237. //
  238. //******************************************************************************
  239. //
  240. // 14.01.2000 - Fixed a smal problem with Registry in Delphi5 without DYNADAO
  241. //                                                                                  
  242. //******************************************************************************
  243. //
  244. // 19.01.2001 - Fixed a bug in retrieving registry data in F_Get_DBTypesList
  245. // 19.01.2001 - Made changes to code - now exceptions are not raised on
  246. //              Non-MSAccess databases in Refresh Definitions
  247. //
  248. //******************************************************************************
  249. //
  250. // 28.01.2001 - Added new property MDBVersionAutoDetect
  251. //              False by default - When this property is True and DYNADAO
  252. //              is used then KADao automatically selects DAO 3.6 if
  253. //              MDB is Access 4.0 file. Based on Andrew Baylis Idea.
  254. //
  255. // 23.02.2001 - Fixed a DeleteField bug. Thanks to Simone.
  256. //
  257. //******************************************************************************
  258. //
  259. // 09.03.2001 - PrivateEngine Default value is now setto False.
  260. //
  261. // 11.03.2001 - Found a bug in processing PrimaryKey indexes - now fixed.
  262. //
  263. // 14.03.2001 - Added RepairAccessDatabaseEx method - thanks to Mark Hamilton
  264. //
  265. // 14.03.2001 - Added ModifyQueryDef method.
  266. //
  267. //******************************************************************************
  268. //
  269. // 28.03.2001 - Fixed a bug in the Destructor;
  270. //
  271. // 04.04.2001 - Fixed a bug in the Constructor - thanks to Thomas Seban for
  272. //              reporting the problem
  273. //              Bug appearcs when a line like
  274. //              db:=TKADaoDatabase.Create(Nil) is executed.
  275. //******************************************************************************
  276. //
  277. // 15.05.2001 - Fixed a bug in LinkExternalTable - thanks to Adam Abas
  278. //              for reporting the problem
  279. //
  280. //******************************************************************************
  281. //
  282. // 29.05.2001 - Fixed a bug in AddFieldsToTable
  283. //
  284. // 29.05.2001 - Now KADaoTableManages supports creation of Primarykey indexes
  285. //              with name different then "PrimaryKey"
  286. //
  287. //******************************************************************************
  288. // 24.07.2001 - Fixed a bug in StartTransaction, Rollback and Commit
  289. //              Bug appears only when using DAO 3.6 and not affecrs DAO 3.5
  290. //******************************************************************************
  291. //
  292. // 14.08.2001 - Fixed a bug in security system
  293. //              In special conditions users cannot set security parameters
  294. //              BEFORE all properties are set.
  295. //              Now after loading of the component RecreateCore is called to
  296. //              ensure that all properies are applyed to Workspace and Engine.
  297. //
  298. //******************************************************************************
  299. //
  300. // 25.09.2001 - Added 4 new events
  301. //                    - OnBeforeConnect
  302. //                    - OnAfterConnect
  303. //                    - OnBeforeDisconnect
  304. //                    - OnAfterDisconnect
  305. //
  306. //
  307. // 15.10.2001 - Added new property - SmartOpen - True by default
  308. //              When SmartOpen is true KADAODatabase first try to find mdb
  309. //              file with the filename specifyed in design time
  310. //              If filename does not exists KADAODatabase tryes to find same
  311. //              file in the program's startup folder.
  312. //
  313. //******************************************************************************
  314. //
  315. // 26.11.2001 - Added new property - DatabaseVersion - ReadOnly
  316. //              This property gives information for the version of DAO used to
  317. //              create opened database.
  318. //              For example you must use DAO 3.6 to open 3.51 database
  319. //              In this case:
  320. //                  Version property          = 3.6
  321. //                  DatabaseVersion  property = 3.5
  322. //
  323. // 27.11.2001 - Added new property - DatabaseParameters - String
  324. //              This property can contain some additional information for
  325. //              opening an database.
  326. //              For example when openning an Excel file
  327. //              DatabaseParameters can contain "HDR=NO; IMEX=1;"
  328. //
  329. //******************************************************************************
  330. //
  331. // 05.12.2001 - Added new method GetDAOEnginesInstalled:TStringList
  332. //              It returns all installed dao versions on the target computer.
  333. //
  334. //******************************************************************************
  335. //
  336. // 28.03.2002 - Added new method RefreshDatasets
  337. //              When called all tables connected to the database are refreshed
  338. //              using TKadaoTable.RefreshData method.
  339. //
  340. //******************************************************************************
  341. interface
  342. Uses
  343. DAOApi,
  344. ComObj,
  345. {$IFDEF DAO35}
  346. DAO35Api,
  347. {$ENDIF}
  348. {$IFDEF DAO36}
  349. DAO36Api,
  350. {$ENDIF}
  351. Windows, SysUtils, Classes, FileCtrl, DbLoginUnit, Registry, TypInfo, DaoAddOns
  352. {$IFDEF USEDB}, DB, KADaoDummyDataset, DaoUtils{$ENDIF}
  353. {$IFDEF D6UP}, Variants {$ENDIF};
  354. //******************************************************* DatabaseError Messages
  355. {$I ErrLangDB.pas}
  356. //******************************************************************************
  357.  
  358. Const
  359.   szUSERNAME   = 'USER NAME';
  360.   szPASSWORD   = 'PASSWORD';
  361.   szDBPASSWORD = 'DBPASSWORD';
  362. Type
  363.  TKADaoDatabase=Class;
  364.  
  365.  TDaoErrRec=Record
  366.             ErrNo       : Integer;
  367.             Source      : String;
  368.             Description : String;
  369.             HelpFile    : String;
  370.             HelpContext : Integer;
  371.           End;
  372.  PDaoErrRec=^TDaoErrRec;
  373.  
  374.  TLoginEvent    = procedure(Database: TKADaoDatabase; LoginParams: TStrings) of object;
  375.  TConnectEvent  = procedure(Database: TKADaoDatabase) of object;
  376.  TKADaoDatabase = Class(TComponent)
  377.        Private
  378.          F_RuntimeLicense     : String;
  379.          F_Database           : String;
  380.          F_DatabaseParameters : String;
  381.          F_SmartOpen          : Boolean;
  382.          F_EngineType         : Integer;
  383.          F_PrivateEngine      : Boolean;
  384.          F_DatabaseType       : String;
  385.          F_Workspace          : String;
  386.          F_CollatingOrder     : String;
  387.          F_DaoVersion         : String;
  388.          F_ActualDaoVersion   : String;
  389.          F_DatabaseVersion    : String;
  390.          F_VersionInfo        : String;
  391.          F_SystemDB           : String;
  392.          F_Active             : Boolean;
  393.          F_ReadOnly           : Boolean;
  394.          F_Exclusive          : Boolean;
  395.          F_LoginPrompt        : Boolean;
  396.          F_AutoDetectMDB      : Boolean;
  397.          F_Username           : String;
  398.          F_Password           : String;
  399.          F_DatabasePassword   : String;
  400.          F_SaveUserName       : Boolean;
  401.          F_MachineName        : String;
  402.          F_QueryTimeout       : Integer;
  403.          F_LoginDialog        : TDbLogin;
  404.          F_TableNames         : TStringList;
  405.          F_ActiveTableNames   : TStringList;
  406.          F_QueryDefNames      : TStringList;
  407.          F_DriverList         : TStringList;
  408.          F_SystemDSNs         : TStringList;
  409.          F_UserDSNs           : TStringList;
  410.          F_DSNFileNames       : TStringList;
  411.          F_Params             : TStringList;
  412.          F_OLE_ON             : Boolean;
  413.          F_OnLogin            : TLoginEvent;
  414.          F_BeforeConnect      : TConnectEvent;
  415.          F_AfterConnect       : TConnectEvent;
  416.          F_BeforeDisconnect   : TConnectEvent;
  417.          F_AfterDisconnect    : TConnectEvent;
  418.          F_DynaDao            : Boolean;
  419.          F_Offline            : Boolean;
  420.          F_ShowSysObjects     : Boolean;
  421.  
  422.          F_TransInfo          : TStringList;
  423.          F_TrackTransactions  : Boolean;
  424.  
  425.          F_ComponentVersion   : String;
  426.          F_DefaultCursorDriver: Integer;
  427.          F_UseODBCDialog      : Boolean;
  428.  
  429.          procedure F_Get_DBTypesList(List: TStrings);
  430.          Function  F_Get_DBTypeFileExtension(DBType:String):String;
  431.          Function  F_Get_DBTypeTableType(DBType:String):String;
  432.          Function  F_Get_ODBCFileName(DSN:String;SystemWideDSN:Boolean):String;
  433.          procedure F_FillDSNFileNames(List: TStrings);
  434.          procedure F_Get_OdbcDriverList(List: TStrings);
  435.          procedure F_Get_SystemDSNs(DSNs: TStrings);
  436.          procedure F_Get_UserDSNs(DSNs: TStrings);
  437.          Procedure F_Set_DaoVersion(Value : String);
  438.          Procedure F_Set_ActualDaoVersion(Value : String);
  439.          Procedure F_Set_DatabaseVersion(Value : String);
  440.          Procedure F_Set_VersionInfo(Value : String);
  441.          Procedure F_Set_Database(Value : String);
  442.          Procedure F_Set_DatabaseParameters(Value : String);
  443.          Function  F_Get_SystemDatabaseFromRegistry:String;
  444.          Procedure F_Set_SystemDatabase(Value : String);
  445.          Procedure F_Set_Workspace(Value : String);
  446.          Function  F_Get_DatabaseType:String;
  447.          Procedure F_Set_DatabaseType(Value : String);
  448.          Function  F_Get_CollatingOrder:String;
  449.          Procedure F_Set_EngineType(Value : Integer);
  450.          Procedure F_Set_PrivateEngine(Value : Boolean);
  451.          Procedure F_Set_ShowSysObjects(Value : Boolean);
  452.          Procedure F_Set_UserName(Value : String);
  453.          Procedure F_Set_Password(Value : String);
  454.          Procedure F_Set_DatabasePassword(Value : String);
  455.          Procedure F_Set_Exclusive(Value : Boolean);
  456.          Procedure F_Set_LoginPrompt(Value : Boolean);
  457.          Procedure F_Set_ReadOnly(Value : Boolean);
  458.          Procedure F_Set_DynaDao(Value: Boolean);
  459.          Procedure F_Set_ComponentVersion(Value: String);
  460.          Procedure F_Set_Params(Value : TStringList);
  461.          Procedure F_Set_DefaultCursorDriver(Value : Integer);
  462.          Procedure F_Set_Active(Value : Boolean);
  463.          Procedure F_Set_TrackTransactions(Value : Boolean);
  464.          Function  F_GetTableRN(Tables:String;TableName:String):String;
  465.  
  466.        Protected
  467.          Procedure                     CreateDBEngine(DaoVer:String);
  468.          Procedure                     Loaded; override;
  469.        Public
  470.          //********************************* Public for Property Editors request
  471.          F_DBTypesList               : TStringList;
  472.          F_DaoVersionList            : TStringList;
  473.          //*********************************************************************
  474.          DatabaseLanguageInt         : Integer;
  475.          {$IFDEF DYNADAO} //****************************************************
  476.          CoreDBEngine                : OleVariant;
  477.          CoreDatabase                : OleVariant;
  478.          CoreWorkspace               : OleVariant;
  479.          {$ENDIF}
  480.          {$IFDEF DAO35}
  481.          CoreDBEngine                : DAO35Api.DBEngine;
  482.          CoreDatabase                : DAO35Api.Database;
  483.          CoreWorkspace               : DAO35Api.Workspace;
  484.          {$ENDIF}
  485.          {$IFDEF DAO36}
  486.          CoreDBEngine                : DAO36Api.DBEngine;
  487.          CoreDatabase                : DAO36Api.Database;
  488.          CoreWorkspace               : DAO36Api.Workspace;
  489.          {$ENDIF}
  490.          Property    Params          : TStringList Read F_Params Write F_Set_Params;
  491.          Property    DSNFileNames    : TStringList Read F_DSNFileNames;
  492.          Property    QueryDefNames   : TStringList Read F_QueryDefNames;
  493.          Property    TableNames      : TStringList Read F_TableNames;
  494.          Property    ActiveTableNames: TStringList Read F_ActiveTableNames;
  495.          Property    DatabaseTypes   : TStringList Read F_DBTypesList;
  496.  
  497.          //********************************* Public for Property Editors request
  498.          Function  F_ChooseDatabase  : String;
  499.          //*********************************************************************
  500.  
  501.          {$IFDEF DYNADAO}
  502.          Function                      CreateOleDBEngine(const ClassName: string): IDispatch;
  503.          {$ELSE}
  504.          Function                      CreateOleDBEngine(const ClassID: TGUID): DBEngine;
  505.          {$ENDIF}
  506.          Function                      CreateOleDBEngine_II(const ClassName: string): IDispatch;
  507.          Function                      GetDAOEnginesInstalled:TStringList;
  508.          Procedure                     CheckEngines;
  509.          Procedure                     DetectMDB(DatabasePath:String);
  510.          Function                      GetLastDaoError:TDaoErrRec;
  511.          Constructor                   Create(AOwner : TComponent); override;
  512.          Destructor                    Destroy; override;
  513.  
  514.          //****************************************************** Online/Offline
  515.          Procedure   GoOffline;
  516.          Procedure   GoOnline;
  517.          //****************************************************** Transactions
  518.          Procedure                   StartTransaction;
  519.          Procedure                   Commit;
  520.          Procedure                   Rollback;
  521.          Procedure                   RollbackRefresh;
  522.          Procedure                   AddRNToTransaction(TableName : String;RN:Integer);
  523.  
  524.          Procedure                   DBEngineLevel_StartTransaction;
  525.          Procedure                   DBEngineLevel_Commit;
  526.          Procedure                   DBEngineLevel_Rollback;
  527.  
  528.          Procedure                   WorkspaceLevel_StartTransaction;
  529.          Procedure                   WorkspaceLevel_Commit;
  530.          Procedure                   WorkspaceLevel_Rollback;
  531.  
  532.          Function                    GetTransactionCount:Integer;
  533.  
  534.          //****************************************************** Utils
  535.          Procedure                   RepairAccessDatabase  (DatabaseName,Password:String);
  536.          Procedure                   RepairAccessDatabaseEx(DatabaseName : String;
  537.                                                             NewLocale    : String;
  538.                                                             Encrypt      : Boolean;
  539.                                                             Decrypt      : Boolean;
  540.                                                             NewVersion   : Integer;
  541.                                                             Password     : String);
  542.          Procedure                   CompactAccessDatabase  (DatabaseName,Password:String);
  543.          Procedure                   CompactAccessDatabaseEx(DatabaseName: String;
  544.                                                              NewLocale   : String;
  545.                                                              Encrypt     : Boolean;
  546.                                                              Decrypt     : Boolean;
  547.                                                              NewVersion  : Integer;
  548.                                                              Password    : String);
  549.  
  550.          Procedure                   CreateAccessDatabase    (DatabaseName:String);
  551.          Procedure                   CreateAccessDatabaseEx  (DatabaseName,LANGID,CP,COUNTRY,Password,Version:String;Encrypt:Boolean);
  552.          Procedure                   CreateAccessDatabaseEx2 (DatabaseName,Language,Password,Version:String;Encrypt:Boolean);
  553.          //****************************************************** Utils II
  554.          Function                    ChangeDatabasePassword(OldPassword,NewPassword:String):Boolean;
  555.          Function                    RegisterDatabase(DatabaseName, DriverName:String; Silent:Boolean; Attributes:String):Boolean;
  556.          Function                    CreateEmptyTable(TableName:String):Boolean;
  557.          Function                    CreateTable(TableName:String; FieldNames : Variant; FieldTypes : Variant; FieldSizes : Variant; FieldIndexes:Variant; FieldsRequired:Variant):Boolean;
  558.          Function                    AddFieldsToTable(TableName:String; FieldNames : Variant; FieldTypes : Variant; FieldSizes : Variant; FieldIndexes:Variant; FieldsRequired:Variant):Boolean;
  559.          Procedure                   LinkExternalTable(Database,TableName,TableType:String;TableAttributes:Integer);
  560.          Procedure                   LinkExternalTableEx(Database,TableName,TableFileName,TableType:String;TableAttributes:Integer);
  561.          Procedure                   RefreshLink(Database,TableName,TableType:String);
  562.  
  563.          Procedure                   RenameTable(OldTableName,NewTableName:String);
  564.          Function                    EmptyTable(TableName:String):Boolean;
  565.          Procedure                   DeleteTable(TableName:String);
  566.  
  567.          Function                    HasPrimaryKey(NewTable:OleVariant):Boolean;
  568.          Procedure                   DeletePrimaryKey(NewTable:OleVariant);
  569.  
  570.          Function                    CreateIndex(TableName,FieldName:String;IndexType:Integer):Boolean;
  571.          Procedure                   RenameIndex(TableName,OldIndexName,NewIndexName:String);
  572.          Procedure                   DeleteIndexByName(TableName,IndexName:String);
  573.          Procedure                   DeleteIndexByFieldName(TableName,FieldName:String);
  574.  
  575.          Procedure                   RenameField(TableName,OldFieldName,NewFieldName:String);
  576.          Procedure                   DeleteField(TableName,FieldName:String);
  577.  
  578.  
  579.  
  580.          Function                    CreateQueryDef(Name:String;SQL:String):Boolean;
  581.          Procedure                   ModifyQueryDef(Name:String;SQL:String);
  582.          Function                    GetQueryDefSQLText(Name:String):String;
  583.          Procedure                   RenameQueryDef(OldQueryName,NewQueryName:String);
  584.          Procedure                   DeleteQueryDef(QueryName:String);
  585.  
  586.          Function                    FindWorkspace(WS:String):Boolean;
  587.          Procedure                   RefreshDefinitions;
  588.          Procedure                   Idle;
  589.  
  590.          Procedure                   Open;
  591.          Procedure                   Close;
  592.          Procedure                   CloseDatasets;
  593.          Procedure                   RefreshDatasets;
  594.          Function                    ChooseDatabase: Boolean;
  595.  
  596.          Procedure                   RecreateCore;
  597.       Published
  598.          Property ComponentVersion     : String  Read F_ComponentVersion Write F_Set_ComponentVersion;
  599.          Property Exclusive            : Boolean Read F_Exclusive Write F_Set_Exclusive;
  600.          Property DatabaseLanguage     : String  Read F_Get_CollatingOrder Write F_CollatingOrder;
  601.          Property DatabaseType         : String  Read F_Get_DatabaseType Write F_Set_DatabaseType;
  602.          Property Database             : String  Read F_Database Write F_Set_Database;
  603.          Property DatabaseParameters   : String  Read F_DatabaseParameters Write F_Set_DatabaseParameters;
  604.          Property DatabaseVersionInfo  : String  Read F_DatabaseVersion   Write F_Set_DatabaseVersion;
  605.          Property ReadOnly             : Boolean Read F_ReadOnly Write F_Set_ReadOnly;
  606.          Property LoginPrompt          : Boolean Read F_LoginPrompt Write F_Set_LoginPrompt;
  607.          Property UserName             : String  Read F_Username  Write F_Set_UserName;
  608.          Property UseODBCDialog        : Boolean Read F_UseODBCDialog  Write F_UseODBCDialog;
  609.          Property Password             : String  Read F_Password  Write F_Set_Password;
  610.          Property DatabasePassword     : String  Read F_DatabasePassword Write F_Set_DatabasePassword;
  611.          Property SystemDatabase       : String  Read F_SystemDB Write F_Set_SystemDatabase;
  612.          Property SaveUserName         : Boolean Read F_SaveUserName Write F_SaveUserName;
  613.          Property ShowSystemObjects    : Boolean Read F_ShowSysObjects Write F_Set_ShowSysObjects;
  614.          Property SmartOpen            : Boolean Read F_SmartOpen Write F_SmartOpen;
  615.          Property EngineType           : Integer Read F_EngineType Write F_Set_EngineType;
  616.          Property PrivateEngine        : Boolean Read F_PrivateEngine Write F_Set_PrivateEngine;
  617.          Property TrackTransactions    : Boolean Read F_TrackTransactions Write F_Set_TrackTransactions;
  618.          Property UsesDynaDao          : Boolean Read F_DynaDao Write F_Set_DynaDao;
  619.          Property Version              : String  Read F_DaoVersion Write F_Set_DaoVersion;
  620.          Property VersionDetails       : String  Read F_ActualDaoVersion Write F_Set_ActualDaoVersion;
  621.          Property VersionInfo          : String  Read F_VersionInfo Write F_Set_VersionInfo;
  622.          Property Workspace            : String  Read F_Workspace Write F_Set_Workspace;
  623.          Property DefaultCursorDriver  : Integer Read F_DefaultCursorDriver Write F_Set_DefaultCursorDriver;
  624.          Property QueryTimeout         : Integer Read F_QueryTimeout Write F_QueryTimeout;
  625.          Property MdbVersionAutoDetect : Boolean Read F_AutoDetectMDB Write F_AutoDetectMDB;
  626.          Property OnLogin              : TLoginEvent   Read F_OnLogin Write F_OnLogin;
  627.          Property OnBeforeConnect      : TConnectEvent Read F_BeforeConnect Write F_BeforeConnect;
  628.          Property OnAfterConnect       : TConnectEvent Read F_AfterConnect Write F_AfterConnect;
  629.          Property OnBeforeDisconnect   : TConnectEvent Read F_BeforeDisconnect Write F_BeforeDisconnect;
  630.          Property OnAfterDisconnect    : TConnectEvent Read F_AfterDisconnect Write F_AfterDisconnect;
  631.          Property Connected            : Boolean       Read F_Active Write F_Set_Active Default False;
  632.       End;
  633.  
  634. {$IFDEF USEDB}
  635. TKADaoTableManager = Class(TObject)
  636.       Private
  637.          F_Database      : TKADaoDatabase;
  638.          F_DummyDataset  : TDummyDataset;
  639.          Function          CheckStatus:Boolean;
  640.          Procedure         StringToList(Items: String; List: TStringList);
  641.       Public
  642.          FieldDefs   : TFieldDefs;
  643.          IndexDefs   : TIndexDefs;
  644.          TableName   : String;
  645.          Procedure   CreateTable;
  646.          Procedure   AppendTable;
  647.          Procedure   CreateIndex(PreservePrimaryKeys:Boolean);
  648.          Constructor Create(Database : TKADaoDatabase);
  649.          Destructor  Destroy;override;
  650.       End;
  651. {$ENDIF}
  652.  
  653.       Procedure Register;
  654.  
  655. {$IFNDEF D5UP}
  656. var
  657.   //   ***************************************************
  658.   //   Defined only for Delphi3 and Delphi4
  659.   //   Delphi5 has buildin support for EmptyParam
  660.   //   ***************************************************
  661.   EmptyParam : OleVariant;
  662.   Unassigned : OleVariant;
  663. {$ENDIF}
  664.  
  665. //*************************************************************************************************
  666. implementation
  667. Uses Dialogs, Forms, ODBCDialogUnit, ActiveX{$IFDEF USEDB}, KDaoTable{$ENDIF};
  668.  
  669. Const
  670.   dbLangGeneral = ';LANGID=%s;CP=%s;COUNTRY=%s';
  671.  
  672. //******************************************************************************
  673.  
  674. {$IFNDEF USEDB}
  675. Procedure DatabaseError(Msg:String);
  676. Begin
  677.   Raise Exception.Create(Msg);
  678. End;
  679. {$ENDIF}
  680.  
  681. function GetExeDir: String;
  682. begin
  683.      SetLength(Result,1001);
  684.      GetModuleFileName(HInstance,PChar(Result),1000);
  685.      Result := ExtractFilePath(StrPas(PChar(Result)));
  686. end;
  687.  
  688. function GetWorkDir: String;
  689. begin
  690.      GetDir(0, Result);
  691.      if Result[Length(Result)] <> '\' Then Result:=Result+'\';
  692. end;
  693.  
  694. Function  TKADaoDatabase.GetLastDaoError:TDaoErrRec;
  695. Begin
  696.   Result.ErrNo         := 0;
  697.   Result.Source        := '';
  698.   Result.Description   := '';
  699.   Result.HelpFile      := '';
  700.   Result.HelpContext   := 0;
  701.   {$IFDEF DYNADAO}
  702.   if VarIsNull(CoreDBEngine) Then Exit;
  703.   if VarIsEmpty(CoreDBEngine) Then Exit;
  704.   {$ELSE}
  705.   if CoreDBEngine=NIL Then Exit;
  706.   {$ENDIF}
  707.   if CoreDBEngine.Errors.Count=0 Then Exit;
  708.   Result.ErrNo       := CoreDBEngine.Errors.Item[0].Number;
  709.   Result.Source      := CoreDBEngine.Errors.Item[0].Source;
  710.   Result.Description := CoreDBEngine.Errors.Item[0].Description;
  711.   Result.HelpFile    := CoreDBEngine.Errors.Item[0].HelpFile;
  712.   Result.HelpContext := CoreDBEngine.Errors.Item[0].HelpContext;
  713. End;
  714.  
  715. {$IFDEF DYNADAO}
  716. Function TKADaoDatabase.CreateOleDBEngine(const ClassName: string): IDispatch;
  717. {$ELSE}
  718. Function TKADaoDatabase.CreateOleDBEngine(const ClassID: TGUID): DBEngine;
  719. {$ENDIF}
  720. Const
  721.   DBEngine_TGUID: TGUID = '{00000021-0000-0010-8000-00AA006D2EA4}';
  722. Var
  723.   LicenseClass       : IClassFactory2;
  724.   DWReserved         : DWORD;
  725.   LicenseString      : Widestring;
  726. {$IFDEF DYNADAO}
  727.   ClassID : TGUID;
  728. Begin
  729.   ClassID := ProgIDToClassID(ClassName);
  730. {$ELSE}
  731. Begin
  732. {$ENDIF}
  733.   //****************************************************************************
  734.   LicenseClass := Nil;
  735.   OleCheck(CoGetClassObject(ClassID,CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, nil, IClassFactory2, LicenseClass));
  736.   if Assigned(LicenseClass) Then
  737.      Begin
  738.        SetLength(LicenseString,2000);
  739.        DWReserved:=0;
  740.        if F_RuntimeLicense <> '' Then
  741.           LicenseString := F_RuntimeLicense
  742.        Else
  743.           LicenseClass.RequestLicKey(DWReserved,LicenseString);
  744.        OleCheck(LicenseClass.CreateInstanceLic (nil, nil, DBEngine_TGUID, LicenseString, Result));
  745.      End;
  746.   //****************************************************************************
  747. End;
  748.  
  749. Function TKADaoDatabase.CreateOleDBEngine_II(const ClassName: string): IDispatch;
  750. Const
  751.   DBEngine_TGUID: TGUID = '{00000021-0000-0010-8000-00AA006D2EA4}';
  752. Var
  753.   LicenseClass       : IClassFactory2;
  754.   DWReserved         : DWORD;
  755.   LicenseString      : Widestring;
  756.   ClassID : TGUID;
  757. Begin
  758.   ClassID := ProgIDToClassID(ClassName);
  759.   //****************************************************************************
  760.   LicenseClass := Nil;
  761.   OleCheck(CoGetClassObject(ClassID,CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, nil, IClassFactory2, LicenseClass));
  762.   if Assigned(LicenseClass) Then
  763.      Begin
  764.        SetLength(LicenseString,2000);
  765.        DWReserved:=0;
  766.        if F_RuntimeLicense <> '' Then
  767.           LicenseString := F_RuntimeLicense
  768.        Else
  769.           LicenseClass.RequestLicKey(DWReserved,LicenseString);
  770.        OleCheck(LicenseClass.CreateInstanceLic (nil, nil, DBEngine_TGUID, LicenseString, Result));
  771.      End;
  772.   //****************************************************************************
  773. End;
  774.  
  775.  
  776. Procedure TKADaoDatabase.CheckEngines;
  777. Var
  778.  V35               : String;
  779.  V36               : String;
  780.  Reg               : TRegistry;
  781.  S                 : String;
  782.  TempDBEngine      : OleVariant;
  783. Begin
  784.   if F_PrivateEngine Then
  785.     Begin
  786.      V35:='DAO.PrivateDBEngine.35';
  787.      V36:='DAO.PrivateDBEngine.36';
  788.     End
  789.  Else
  790.     Begin
  791.      V35 := 'DAO.DBEngine.35';
  792.      V36 := 'DAO.DBEngine.36';
  793.     End;
  794.  
  795.   Reg := TRegistry.Create;
  796.   {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  797.   Reg.RootKey := HKEY_CLASSES_ROOT;
  798.   {$IFNDEF D4UP}
  799.   if Reg.OpenKey(V35,False) then
  800.   {$ELSE}
  801.   if Reg.OpenKeyReadOnly(V35) then
  802.   {$ENDIF}
  803.      Begin
  804.        Try
  805.         TempDBEngine               := CreateOleDBEngine_II(V35);
  806.         VarClear(TempDBEngine);
  807.         F_DaoVersionList.Add('3.5');
  808.        Except
  809.          on E:Exception do
  810.             Begin
  811.               S:=E.Message;
  812.               if Pos('80040112',S) > 0 Then
  813.                  Begin
  814.                    Reg.CloseKey;
  815.                    Reg.Free;
  816.                    DatabaseError(E1001);
  817.                  End;
  818.             End;
  819.        End;
  820.      End;
  821.   Reg.CloseKey;
  822.   Reg.Free;
  823.  
  824.   Reg := TRegistry.Create;
  825.   {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  826.   Reg.RootKey := HKEY_CLASSES_ROOT;
  827.   {$IFNDEF D4UP}
  828.   if Reg.OpenKey(V36,False) then
  829.   {$ELSE}
  830.   if Reg.OpenKeyReadOnly(V36) then
  831.   {$ENDIF}
  832.      Begin
  833.        Try
  834.         TempDBEngine               := CreateOleDBEngine_II(V36);
  835.         VarClear(TempDBEngine);
  836.         F_DaoVersionList.Add('3.6');
  837.        Except
  838.          on E:Exception do
  839.             Begin
  840.               S:=E.Message;
  841.               if Pos('80040112',S) > 0 Then
  842.                  Begin
  843.                    Reg.CloseKey;
  844.                    Reg.Free;
  845.                    DatabaseError(E1001);
  846.                  End;
  847.             End;
  848.        End;
  849.      End;
  850.   Reg.CloseKey;
  851.   Reg.Free;
  852.   If (Not VarIsNull(TempDBEngine)) And (Not VarIsEmpty(TempDBEngine)) Then VarClear(TempDBEngine);
  853. End;
  854.  
  855. //*************************************************************************************************
  856. Procedure TKADaoDatabase.CreateDBEngine(DaoVer:String);
  857. Var
  858.   V35 : String;
  859.   V36 : String;
  860. Begin
  861.  if F_PrivateEngine Then
  862.     Begin
  863.      V35:='DAO.PrivateDBEngine.35';
  864.      V36:='DAO.PrivateDBEngine.36';
  865.     End
  866.  Else
  867.     Begin
  868.      V35 := 'DAO.DBEngine.35';
  869.      V36 := 'DAO.DBEngine.36';
  870.     End;
  871.  
  872.  {$IFDEF DYNADAO}
  873.   F_DynaDao := True;
  874.   if DaoVer='3.5' Then
  875.      Begin
  876.        Try
  877.         CoreDBEngine               := CreateOleDBEngine(V35);
  878.         F_DaoVersion               := '3.5';
  879.        Except
  880.          Try
  881.           CoreDBEngine             := CreateOleDBEngine(V36);
  882.           F_DaoVersion             := '3.6';
  883.          Except
  884.           DatabaseError(E1002);
  885.          End;
  886.        End;
  887.    End;
  888.   if DaoVer='3.6' Then
  889.      Begin
  890.        Try
  891.         CoreDBEngine             := CreateOleDBEngine(V36);
  892.         F_DaoVersion             := '3.6';
  893.        Except
  894.         DatabaseError(E1002);
  895.        End;
  896.    End;
  897.   {$ELSE}
  898.   F_DynaDao := False;
  899.   CoreDBEngine               := Nil;
  900.   Try
  901.     if F_PrivateEngine Then
  902.        CoreDBEngine          := CreateOleDBEngine(Class_PrivDBEngine)
  903.     Else
  904.        CoreDBEngine          := CreateOleDBEngine(Class_DBEngine);
  905.   Except
  906.     on E:Exception do
  907.        Begin
  908.          if Pos('80040112',E.Message) > 0 Then
  909.             Begin
  910.               DatabaseError(E1001);
  911.             End
  912.           Else DatabaseError(E.Message);
  913.        End;
  914.   End;
  915.   {$ENDIF}
  916. End;                                                                
  917.  
  918. Function    TKADaoDatabase.GetDAOEnginesInstalled:TStringList;
  919. Begin
  920.   Result := GetAllDaoEngines(F_RuntimeLicense);
  921. End;
  922.  
  923. Constructor TKADaoDatabase.Create(AOwner : TComponent);
  924. Var
  925.   OLE_INIT : Integer;
  926.   X        : Integer;
  927.   Prop     : Pointer;
  928. Begin
  929.   Inherited Create(AOwner);
  930.   //*******************************************
  931.   F_ComponentVersion:='7.70';
  932.   //*******************************************
  933.   {$IFDEF DYNADAO}
  934.   //********************************************************************* Events
  935.   F_OnLogin            := Nil;
  936.   F_BeforeConnect      := Nil;
  937.   F_AfterConnect       := Nil;
  938.   F_BeforeDisconnect   := Nil;
  939.   F_AfterDisconnect    := Nil;
  940.   //********************************************************************* Events
  941.   F_RuntimeLicense              := '';
  942.   CoreWorkspace                 := Unassigned;
  943.   CoreDatabase                  := Unassigned;
  944.   CoreDBEngine                  := Unassigned;
  945.   {$ENDIF}
  946.   F_Offline := False;
  947.   F_OLE_ON  := False;
  948.   OLE_INIT  := CoInitialize(NIL);
  949.   if (OLE_INIT = S_OK) or (OLE_INIT = S_FALSE) then F_OLE_ON:= True
  950.   else DatabaseError(E1003);
  951.   F_PrivateEngine               := False;
  952.   F_DaoVersionList              := TStringList.Create;
  953.   F_DaoVersionList.Clear;
  954.   if Assigned(Owner) Then
  955.    Begin
  956.     For X := 0 To Owner.ComponentCount-1 do
  957.       Begin
  958.        Prop := GetPropInfo(Owner.Components[X].ClassInfo, 'DaoLicence');
  959.        if Prop <> Nil Then
  960.            Begin
  961.              F_RuntimeLicense := GetStrProp(Owner.Components[X], Prop);
  962.              Break;
  963.            End;
  964.       End;
  965.    End;
  966.   CheckEngines;
  967.   {$IFDEF DYNADAO}
  968.   if F_DaoVersionList.Count > 0 Then
  969.      Begin
  970.       if F_DaoVersionList.Strings[0]='3.5' Then F_DaoVersion := '3.5' Else F_DaoVersion := '3.6';
  971.      End
  972.   Else
  973.      Begin
  974.        DatabaseError(E1004);
  975.      End;
  976.   {$ENDIF}
  977.   {$IFDEF DAO35}
  978.   F_DaoVersion               := '3.5';
  979.   {$ENDIF}
  980.   {$IFDEF DAO36}
  981.   F_DaoVersion               := '3.6';
  982.   {$ENDIF}
  983.   //*******************************************
  984.   CreateDBEngine(F_DaoVersion);
  985.   //*******************************************
  986.   F_SystemDB                    := F_Get_SystemDatabaseFromRegistry;
  987.   if F_SystemDB <> '' Then
  988.   CoreDBEngine.SystemDB         := F_SystemDB;
  989.   F_Username                    := 'Admin';
  990.   F_Password                    := '';
  991.   F_DatabasePassword            := '';
  992.   F_DatabaseParameters          := '';
  993.   F_SaveUserName                := True;
  994.   F_SmartOpen                   := True;
  995.   CoreDBEngine.DefaultUser      := 'Admin';
  996.   CoreDBEngine.DefaultPassword  := '';
  997.   F_EngineType                  := dbUseJet;
  998.   CoreDBEngine.DefaultType      := F_EngineType;
  999.   F_DefaultCursorDriver         := dbUseDefaultCursor;
  1000.  
  1001.   //****************************************************************************
  1002.    F_Workspace                   := 'DaoWorkspace';
  1003.   //****************************************************************************
  1004.  
  1005.   F_ActualDaoVersion            := CoreDBEngine.Version;
  1006.   F_VersionInfo                 := '';
  1007.   F_DatabaseVersion             := '';
  1008.   if F_ActualDaoVersion[3]='5'  Then    F_VersionInfo:='(In Access''97 mode)';
  1009.   if F_ActualDaoVersion[3]='6'  Then    F_VersionInfo:='(In Access''2000 mode)';
  1010.   F_MachineName                 := '';
  1011.   F_DatabaseType                :='Access';
  1012.   F_Active                      := False;
  1013.   F_Database                    := '';
  1014.   F_ReadOnly                    := False;
  1015.   F_Exclusive                   := False;
  1016.   F_LoginPrompt                 := False;
  1017.   F_AutoDetectMDB               := False;
  1018.   F_ShowSysObjects              := False;
  1019.  
  1020.  
  1021.   F_TableNames             := TStringList.Create;
  1022.   F_ActiveTableNames       := TStringList.Create;
  1023.   F_QueryDefNames          := TStringList.Create;
  1024.   F_DBTypesList            := TStringList.Create;
  1025.   F_DriverList             := TStringList.Create;
  1026.   F_SystemDSNs             := TStringList.Create;
  1027.   F_UserDSNs               := TStringList.Create;
  1028.   F_DSNFileNames           := TStringList.Create;
  1029.   F_Params                 := TStringList.Create;
  1030.  
  1031.   F_QueryTimeout           := 60;
  1032.  
  1033.   F_TransInfo              := TStringList.Create;
  1034.   F_TrackTransactions      := True;
  1035.   F_UseODBCDialog          := True;
  1036.  
  1037.   F_Get_DBTypesList(F_DBTypesList);
  1038.   F_Get_OdbcDriverList(F_DriverList);
  1039.   F_Get_SystemDSNs(F_SystemDSNs);
  1040.   F_Get_UserDSNs(F_UserDSNs);
  1041.   F_FillDSNFileNames(F_DSNFileNames);
  1042. End;
  1043.  
  1044. Destructor  TKADaoDatabase.Destroy;
  1045. Begin
  1046.  If F_Active Then Connected := False;
  1047.  F_TableNames.Free;
  1048.  F_ActiveTableNames.Free;
  1049.  F_QueryDefNames.Free;
  1050.  F_DBTypesList.Free;
  1051.  F_DriverList.Free;
  1052.  F_SystemDSNs.Free;
  1053.  F_UserDSNs.Free;
  1054.  F_DaoVersionList.Free;
  1055.  F_DSNFileNames.Free;
  1056.  F_Params.Free;
  1057.  F_TransInfo.Free;
  1058.  
  1059.  {$IFDEF DYNADAO}
  1060.  If (Not VarIsNull(CoreWorkspace)) And (Not VarIsEmpty(CoreWorkspace)) Then CoreWorkspace.Close;
  1061.  VarClear(CoreDatabase);
  1062.  VarClear(CoreWorkspace);
  1063.  VarClear(CoreDBEngine);
  1064.  {$ELSE}
  1065.  if CoreWorkspace <> Nil Then CoreWorkspace.Close;
  1066.  CoreDatabase  := Nil;
  1067.  CoreWorkspace := Nil;
  1068.  CoreDBEngine  := Nil;
  1069.  {$ENDIF}
  1070.  if F_OLE_ON then CoUninitialize;
  1071.  Inherited Destroy;
  1072. End;
  1073.  
  1074. Procedure TKADaoDatabase.RecreateCore;
  1075. Var
  1076.   OLE_INIT     : Integer;
  1077.   TempPrivate  : Boolean;
  1078. Begin
  1079.   if F_Offline Then Exit;
  1080.  {$IFDEF DYNADAO}
  1081.    If (Not VarIsNull(CoreWorkspace)) And (Not VarIsEmpty(CoreWorkspace)) Then CoreWorkspace.Close;
  1082.    Try
  1083.      VarClear(CoreWorkspace);
  1084.    Except
  1085.    End;
  1086.    If Not VarIsEmpty(CoreDBEngine)  Then VarClear(CoreDBEngine);
  1087.   {$ELSE}
  1088.    If (Assigned(CoreWorkspace)) Then CoreWorkspace.Close;
  1089.    CoreWorkspace := Nil;
  1090.    CoreDBEngine  := Nil;
  1091.   {$ENDIF}
  1092.    if F_OLE_ON Then CoUninitialize;
  1093.    F_OLE_ON:=False;
  1094.    OLE_INIT:= CoInitialize(NIL);
  1095.    if (OLE_INIT = S_OK) or (OLE_INIT = S_FALSE) then F_OLE_ON:= True
  1096.    Else DatabaseError(E1003);
  1097.    //*************************************************** Borland, Microsoft ...
  1098.    TempPrivate:=True;
  1099.    if (csDesigning in ComponentState) And (F_EngineType=dbUseJet) Then
  1100.       Begin
  1101.         TempPrivate      := F_PrivateEngine;
  1102.         F_PrivateEngine  := True;
  1103.       End;
  1104.    CreateDBEngine(F_DaoVersion);
  1105.    if (csDesigning in ComponentState) And (F_EngineType=dbUseJet) Then F_PrivateEngine  := TempPrivate;
  1106.    //***************************************************************************
  1107.    CoreDBEngine.SystemDB         := F_SystemDB;
  1108.    F_ActualDaoVersion            := CoreDBEngine.Version;
  1109.    if F_ActualDaoVersion[3]='5'  Then    F_VersionInfo:='(In Access''97 mode)';
  1110.    if F_ActualDaoVersion[3]='6'  Then    F_VersionInfo:='(In Access''2000 mode)';
  1111.    CoreDBEngine.DefaultUser      := F_Username;
  1112.    CoreDBEngine.DefaultPassword  := F_Password;
  1113.    CoreWorkspace                 := CoreDBEngine.CreateWorkspace(F_Workspace,F_Username,F_Password,F_EngineType);
  1114.    CoreDBEngine.Workspaces.Append(CoreWorkspace);
  1115.    if F_EngineType=dbUseODBC Then
  1116.       Begin
  1117.        CoreWorkspace.DefaultCursorDriver:=F_DefaultCursorDriver;
  1118.       End;
  1119.    F_Workspace                   := CoreWorkspace.Name;
  1120. End;
  1121.  
  1122. Procedure TKADaoDatabase.Loaded;
  1123. Begin
  1124.   Try
  1125.     inherited Loaded;
  1126.     if Not F_Active Then RecreateCore;
  1127.   Except
  1128.   End;
  1129. End;
  1130.  
  1131. Procedure TKADaoDatabase.F_Set_ComponentVersion(Value: String);
  1132. Begin
  1133.  //******************************************************************** ReadOnly
  1134. End;
  1135.  
  1136. Procedure TKADaoDatabase.F_Set_Params(Value : TStringList);
  1137. Begin
  1138.   F_Params.SetText(Value.GetText);
  1139. End;
  1140.  
  1141. Procedure TKADaoDatabase.F_Set_DefaultCursorDriver(Value : Integer);
  1142. Begin
  1143.  F_DefaultCursorDriver:=Value;
  1144.  if csLoading in ComponentState Then Exit;
  1145.  if F_Offline Then Exit;
  1146.  if F_EngineType=dbUseODBC Then
  1147.     Begin
  1148.       CoreWorkspace.DefaultCursorDriver:=F_DefaultCursorDriver;
  1149.     End;
  1150. End;
  1151.  
  1152. Function TKADaoDatabase.F_Get_ODBCFileName(DSN:String;SystemWideDSN:Boolean):String;
  1153. Var
  1154.   Reg : TRegistry;
  1155. Begin
  1156.   Result:='';
  1157.   Reg := TRegistry.Create;
  1158.   {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  1159.   if SystemWideDSN Then
  1160.      Reg.RootKey := HKEY_LOCAL_MACHINE
  1161.   Else
  1162.      Reg.RootKey := HKEY_CURRENT_USER;
  1163.   {$IFNDEF D4UP}
  1164.   if Reg.OpenKey('SOFTWARE\ODBC\ODBC.INI\'+DSN,False) then
  1165.   {$ELSE}
  1166.   if Reg.OpenKeyReadOnly('SOFTWARE\ODBC\ODBC.INI\'+DSN) then
  1167.   {$ENDIF}
  1168.      Begin
  1169.        Result:=Reg.ReadString('DBQ');
  1170.      End;
  1171.   Reg.Free;
  1172. End;
  1173.  
  1174. procedure TKADaoDatabase.F_FillDSNFileNames(List: TStrings);
  1175. Var
  1176.   X : Integer;
  1177.   S : String;
  1178. Begin
  1179.   List.Clear;
  1180.   For X:=0 to F_UserDSNs.Count-1 do
  1181.       Begin
  1182.        S:=F_Get_ODBCFileName(F_UserDSNs.Strings[X],False);
  1183.        if Length(S) > 0 Then List.Add(F_UserDSNs.Strings[X]+'='+S);
  1184.       End;
  1185.   For X:=0 to F_SystemDSNs.Count-1 do
  1186.       Begin
  1187.        S:=F_Get_ODBCFileName(F_SystemDSNs.Strings[X],True);
  1188.        if Length(S) > 0 Then List.Add(F_SystemDSNs.Strings[X]+'='+S);
  1189.       End;
  1190. End;
  1191.  
  1192. procedure TKADaoDatabase.F_Get_OdbcDriverList(List: TStrings);
  1193. var
  1194.    Reg : TRegistry;
  1195. Begin
  1196.      Reg := TRegistry.Create;
  1197.      {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  1198.      try
  1199.      Begin
  1200.           Reg.RootKey := HKEY_LOCAL_MACHINE;
  1201.           {$IFNDEF D4UP}
  1202.           if Reg.OpenKey('SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers',False) then
  1203.           {$ELSE}
  1204.           if Reg.OpenKeyReadOnly('SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers') then
  1205.           {$ENDIF}
  1206.           Begin
  1207.                List.Clear;
  1208.                Reg.GetValueNames(List);
  1209.           End;
  1210.      End;
  1211.      finally
  1212.           Reg.Free;
  1213.      End;
  1214. End;
  1215.  
  1216. procedure TKADaoDatabase.F_Get_SystemDSNs(DSNs: TStrings);
  1217. var
  1218.   Reg: TRegistry;
  1219. begin
  1220.   DSNs.Clear;
  1221.   Reg:= TRegistry.Create;
  1222.   {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  1223.   Reg.RootKey:= HKEY_LOCAL_MACHINE;
  1224.   {$IFNDEF D4UP}
  1225.   Reg.OpenKey('\SOFTWARE\ODBC\odbc.ini\ODBC Data Sources', False);
  1226.   {$ELSE}
  1227.   Reg.OpenKeyReadOnly('\SOFTWARE\ODBC\odbc.ini\ODBC Data Sources');
  1228.   {$ENDIF}
  1229.   Reg.GetValueNames(DSNs);
  1230.   Reg.Free;
  1231. end;
  1232.  
  1233. procedure TKADaoDatabase.F_Get_UserDSNs(DSNs: TStrings);
  1234. var
  1235.   Reg: TRegistry;
  1236. begin
  1237.   DSNs.Clear;
  1238.   Reg:= TRegistry.Create;
  1239.   {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  1240.   Reg.RootKey:= HKEY_CURRENT_USER;
  1241.   {$IFNDEF D4UP}
  1242.   Reg.OpenKey('\SOFTWARE\ODBC\odbc.ini\ODBC Data Sources', False);
  1243.   {$ELSE}
  1244.   Reg.OpenKeyReadOnly('\SOFTWARE\ODBC\odbc.ini\ODBC Data Sources');
  1245.   {$ENDIF}
  1246.   Reg.GetValueNames(DSNs);
  1247.   Reg.Free;
  1248. end;
  1249.  
  1250. procedure TKADaoDatabase.F_Get_DBTypesList(List: TStrings);
  1251. var
  1252.    Reg : TRegistry;
  1253. Begin
  1254.      Reg := TRegistry.Create;
  1255.      {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  1256.      try
  1257.      Begin
  1258.           Reg.RootKey := HKEY_LOCAL_MACHINE;
  1259.           {$IFDEF DAO35}
  1260.           {$IFNDEF D4UP}
  1261.           if Reg.OpenKey('SOFTWARE\Microsoft\JET\3.5\ISAM Formats',False) then
  1262.           {$ELSE}
  1263.           if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\JET\3.5\ISAM Formats') then
  1264.           {$ENDIF}
  1265.              Begin
  1266.                List.Clear;
  1267.                Reg.GetKeyNames(List);
  1268.              End;
  1269.           {$ENDIF}
  1270.           {$IFDEF DAO36}
  1271.           {$IFNDEF D4UP}
  1272.           if Reg.OpenKey('SOFTWARE\Microsoft\JET\4.0\ISAM Formats',False) then
  1273.           {$ELSE}
  1274.           if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\JET\4.0\ISAM Formats') then
  1275.           {$ENDIF}
  1276.              Begin
  1277.                List.Clear;
  1278.                Reg.GetKeyNames(List);
  1279.              End;
  1280.           {$ENDIF}
  1281.           {$IFDEF DYNADAO}//****************************************************
  1282.           if F_DaoVersion='3.5' then
  1283.           {$IFNDEF D4UP}
  1284.           if Reg.OpenKey('SOFTWARE\Microsoft\JET\3.5\ISAM Formats',False) then
  1285.           {$ELSE}
  1286.           if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\JET\3.5\ISAM Formats') then
  1287.           {$ENDIF}
  1288.              Begin
  1289.                List.Clear;
  1290.                Reg.GetKeyNames(List);
  1291.              End;
  1292.           if F_DaoVersion='3.6' then
  1293.           {$IFNDEF D4UP}
  1294.           if Reg.OpenKey('SOFTWARE\Microsoft\JET\4.0\ISAM Formats',False) then
  1295.           {$ELSE}
  1296.           if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\JET\4.0\ISAM Formats') then
  1297.           {$ENDIF}
  1298.              Begin
  1299.                List.Clear;
  1300.                Reg.GetKeyNames(List);
  1301.              End;
  1302.           {$ENDIF}
  1303.      End;
  1304.      finally
  1305.           Reg.Free;
  1306.      End;
  1307.     List.Insert(0,'ODBC');
  1308.     List.Insert(0,'Access');
  1309. End;
  1310.  
  1311.  
  1312. Function TKADaoDatabase.F_Get_DBTypeFileExtension(DBType:String):String;
  1313. var
  1314.    Reg : TRegistry;
  1315. Begin
  1316.      Reg := TRegistry.Create;
  1317.      {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  1318.      try
  1319.      Begin
  1320.           Reg.RootKey := HKEY_LOCAL_MACHINE;
  1321.           {$IFDEF DAO35}
  1322.           {$IFNDEF D4UP}
  1323.           if Reg.OpenKey('SOFTWARE\Microsoft\JET\3.5\ISAM Formats\'+DBType,False) then
  1324.           {$ELSE}
  1325.           if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\JET\3.5\ISAM Formats\'+DBType) then
  1326.           {$ENDIF}
  1327.              Begin
  1328.                Result:=Reg.ReadString('ExportFilter');
  1329.                if Result='' Then Result:=Reg.ReadString('ImportFilter');
  1330.              End;
  1331.           {$ENDIF}
  1332.           {$IFDEF DAO36}
  1333.           {$IFNDEF D4UP}
  1334.           if Reg.OpenKey('SOFTWARE\Microsoft\JET\4.0\ISAM Formats\'+DBType,False) then
  1335.           {$ELSE}
  1336.           if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\JET\4.0\ISAM Formats\'+DBType) then
  1337.           {$ENDIF}
  1338.              Begin
  1339.                Result:=Reg.ReadString('ExportFilter');
  1340.                if Result='' Then Result:=Reg.ReadString('ImportFilter');
  1341.              End;
  1342.           {$ENDIF}
  1343.           {$IFDEF DYNADAO}
  1344.           if F_DaoVersion='3.5' then
  1345.           {$IFNDEF D4UP}
  1346.           if Reg.OpenKey('SOFTWARE\Microsoft\JET\3.5\ISAM Formats\'+DBType,False) then
  1347.           {$ELSE}
  1348.           if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\JET\3.5\ISAM Formats\'+DBType) then
  1349.           {$ENDIF}
  1350.              Begin
  1351.                Result:=Reg.ReadString('ExportFilter');
  1352.                if Result='' Then Result:=Reg.ReadString('ImportFilter');
  1353.              End;
  1354.           if F_DaoVersion='3.6' then
  1355.           {$IFNDEF D4UP}
  1356.           if Reg.OpenKey('SOFTWARE\Microsoft\JET\4.0\ISAM Formats\'+DBType,False) then
  1357.           {$ELSE}
  1358.           if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\JET\4.0\ISAM Formats\'+DBType) then
  1359.           {$ENDIF}
  1360.              Begin
  1361.                Result:=Reg.ReadString('ExportFilter');
  1362.                if Result='' Then Result:=Reg.ReadString('ImportFilter');
  1363.              End;
  1364.           {$ENDIF}
  1365.      End;
  1366.      finally
  1367.           Reg.Free;
  1368.      End;
  1369. End;
  1370.  
  1371. Function TKADaoDatabase.F_Get_DBTypeTableType(DBType:String):String;
  1372. var
  1373.    Reg : TRegistry;
  1374.    BUF  : Array[1..1000] of Byte;
  1375. Begin
  1376.      Reg := TRegistry.Create;
  1377.      {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  1378.      try
  1379.      Begin
  1380.           Reg.RootKey := HKEY_LOCAL_MACHINE;
  1381.           {$IFDEF DAO35}
  1382.           {$IFNDEF D4UP}
  1383.           if Reg.OpenKey('SOFTWARE\Microsoft\JET\3.5\ISAM Formats\'+DBType,False) then
  1384.           {$ELSE}
  1385.           if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\JET\3.5\ISAM Formats\'+DBType) then
  1386.           {$ENDIF}
  1387.              Begin
  1388.                Reg.ReadBinaryData('OneTablePerFile',BUF,1000);
  1389.                Result:=IntToStr(BUF[1]);
  1390.              End;
  1391.           {$ENDIF}
  1392.           {$IFDEF DAO36}
  1393.           {$IFNDEF D4UP}
  1394.           if Reg.OpenKey('SOFTWARE\Microsoft\JET\4.0\ISAM Formats\'+DBType,False) then
  1395.           {$ELSE}
  1396.           if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\JET\4.0\ISAM Formats\'+DBType) then
  1397.           {$ENDIF}
  1398.              Begin
  1399.                Reg.ReadBinaryData('OneTablePerFile',BUF,1000);
  1400.                Result:=IntToStr(BUF[1]);
  1401.              End;
  1402.           {$ENDIF}
  1403.           {$IFDEF DYNADAO}
  1404.           if F_DaoVersion='3.5' then
  1405.           {$IFNDEF D4UP}
  1406.           if Reg.OpenKey('SOFTWARE\Microsoft\JET\3.5\ISAM Formats\'+DBType,False) then
  1407.           {$ELSE}
  1408.           if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\JET\3.5\ISAM Formats\'+DBType) then
  1409.           {$ENDIF}
  1410.              Begin
  1411.                Reg.ReadBinaryData('OneTablePerFile',BUF,1000);
  1412.                Result:=IntToStr(BUF[1]);
  1413.              End;
  1414.           if F_DaoVersion='3.6' then
  1415.           {$IFNDEF D4UP}
  1416.           if Reg.OpenKey('SOFTWARE\Microsoft\JET\4.0\ISAM Formats\'+DBType,False) then
  1417.           {$ELSE}
  1418.           if Reg.OpenKeyReadOnly('SOFTWARE\Microsoft\JET\4.0\ISAM Formats\'+DBType) then
  1419.           {$ENDIF}
  1420.              Begin
  1421.                Reg.ReadBinaryData('OneTablePerFile',BUF,1000);
  1422.                Result:=IntToStr(BUF[1]);
  1423.              End;
  1424.           {$ENDIF}
  1425.      End;
  1426.      finally
  1427.           Reg.Free;
  1428.      End;
  1429. End;
  1430.  
  1431.  
  1432. Procedure TKADaoDatabase.DetectMDB(DatabasePath:String);
  1433. Var
  1434.   F   : File;
  1435.   S   : Array[0..160] of Char;
  1436.   NR  : Integer;
  1437.   OP  : Boolean;
  1438. Begin
  1439.  if F_DatabaseType <> 'Access' Then Exit;
  1440.  OP:=False;
  1441.  Try
  1442.   System.FileMode := 0;
  1443.   System.AssignFile(F,DatabasePath);
  1444.   System.Reset(F,1);
  1445.   OP:=True;
  1446.   System.BlockRead(F,S,160,NR);
  1447.   if NR < 160 Then Exit;
  1448.   if F_DaoVersionList.IndexOf('3.5') <> -1 Then //******************* 15.01.2002
  1449.      F_DaoVersion := '3.5';
  1450.   if     (S[156]='4')
  1451.      And (S[157]='.')
  1452.      And (F_DaoVersion='3.5')
  1453.      And (F_Dynadao) Then
  1454.      Begin
  1455.        F_DaoVersion := '3.6';
  1456.      End;
  1457.  Except
  1458.    if OP Then System.CloseFile(F);
  1459.    Exit;
  1460.  End;
  1461.  if OP Then System.CloseFile(F);
  1462. End;
  1463.  
  1464. Procedure TKADaoDatabase.F_Set_TrackTransactions(Value : Boolean);
  1465. Begin
  1466.   if F_Active  Then DatabaseError('Cannot set TrackTransactions property when Database is connected!');
  1467.   F_TrackTransactions := Value;
  1468. End;
  1469.  
  1470. Procedure TKADaoDatabase.F_Set_Active(Value : Boolean);
  1471. Label START;
  1472. Var
  1473.   Pwd          : String;
  1474.   LoginParams  : TStringList;
  1475.   BadPassword  : Boolean;
  1476.   ExitDB       : Boolean;
  1477. Begin
  1478.   if (F_Active) And (Value) Then Exit;
  1479.   if (F_Database='') And (Value) Then
  1480.       Begin
  1481.        DatabaseError(E1005);
  1482.        Exit;
  1483.      End;
  1484.   if (F_DatabaseType='') And (Value) Then
  1485.       Begin
  1486.        DatabaseError(E1006);
  1487.        Exit;
  1488.      End;
  1489.   if (F_Active) And (NOT Value) Then
  1490.      Begin
  1491.        if Assigned(F_BeforeDisconnect) Then F_BeforeDisconnect(Self);
  1492.        F_TableNames.Clear;
  1493.        F_QueryDefNames.Clear;
  1494.        {$IFDEF USEDB}
  1495.        CloseDatasets;
  1496.        {$ENDIF}
  1497.        F_ActiveTableNames.Clear;
  1498.        CoreDatabase.Close;
  1499.        {$IFDEF DYNADAO}
  1500.        VarClear(CoreDatabase); 
  1501.        {$ELSE}
  1502.        CoreDatabase := Nil;
  1503.        {$ENDIF}
  1504.        F_TransInfo.Clear;
  1505.        F_Active:=False;
  1506.        if Assigned(F_AfterDisconnect) Then F_AfterDisconnect(Self);
  1507.      End;
  1508.   if (NOT F_Active) And (Value) Then
  1509.      Begin
  1510.         if Assigned(F_BeforeConnect) Then F_BeforeConnect(Self);
  1511. START:
  1512.         ExitDB      := False;
  1513.         BadPassword := False;
  1514.         if F_LoginPrompt Then
  1515.            Begin
  1516.              F_LoginDialog   := TDbLogin.CreateParented(Application.Handle);
  1517.              if F_SaveUserName Then
  1518.                 F_LoginDialog.UserName.Text    := F_UserName
  1519.              Else
  1520.                 F_LoginDialog.UserName.Text    := '';
  1521.              F_LoginDialog.Password.Text    := '';
  1522.              F_LoginDialog.DbPassword.Text  := '';
  1523.              F_LoginDialog.DatabaseName.Caption:=F_Database;
  1524.              F_LoginDialog.ActiveControl:=F_LoginDialog.UserName;
  1525.              if Assigned(F_OnLogin) Then
  1526.                 Begin
  1527.                   LoginParams  := TStringList.Create;
  1528.                   LoginParams.Add(szUSERNAME+'='+F_Username);
  1529.                   LoginParams.Add(szPASSWORD+'='+F_Password);
  1530.                   LoginParams.Add(szDBPASSWORD+'='+F_DatabasePassword);
  1531.                   F_OnLogin(Self, LoginParams);
  1532.                   F_Username:=LoginParams.Values[szUSERNAME];
  1533.                   F_Password:=LoginParams.Values[szPASSWORD];
  1534.                   F_DatabasePassword:=LoginParams.Values[szDBPASSWORD];
  1535.                   LoginParams.Free;
  1536.                 End
  1537.              Else
  1538.                 Begin
  1539.                   if (F_Params.Count > 0) Then
  1540.                      Begin
  1541.                       if F_Params.IndexOfName(szUSERNAME) <> -1 Then
  1542.                          F_Username         := F_Params.Values[szUSERNAME];
  1543.                       if F_Params.IndexOfName(szPASSWORD) <> -1 Then
  1544.                          F_Password         := F_Params.Values[szPASSWORD];
  1545.                       if F_Params.IndexOfName(szDBPASSWORD) <> -1 Then
  1546.                          F_DatabasePassword := F_Params.Values[szDBPASSWORD];
  1547.                      End
  1548.                   Else
  1549.                   if F_LoginDialog.ShowModal=ID_OK Then
  1550.                      Begin
  1551.                       F_Username          := F_LoginDialog.UserName.Text;
  1552.                       F_Password          := F_LoginDialog.Password.Text;
  1553.                       F_DatabasePassword  := F_LoginDialog.DbPassword.Text;
  1554.                      End
  1555.                   Else
  1556.                      Begin
  1557.                        ShowMessage('If You not enter Username and Password You may not gain access to your data!');
  1558.                        F_Username         := '';
  1559.                        F_Password         := '';
  1560.                        F_DatabasePassword := '';
  1561.                        ExitDB:=True;
  1562.                      End;
  1563.                 End;
  1564.              F_LoginDialog.Free;
  1565.            End
  1566.         Else
  1567.            Begin
  1568.              if Assigned(F_OnLogin) Then
  1569.                 Begin
  1570.                   LoginParams  := TStringList.Create;
  1571.                   LoginParams.Add(szUSERNAME+'='+F_Username);
  1572.                   LoginParams.Add(szPASSWORD+'='+F_Password);
  1573.                   LoginParams.Add(szDBPASSWORD+'='+F_DatabasePassword);
  1574.                   F_OnLogin(Self, LoginParams);
  1575.                   F_Username:=LoginParams.Values[szUSERNAME];
  1576.                   F_Password:=LoginParams.Values[szPASSWORD];
  1577.                   F_DatabasePassword:=LoginParams.Values[szDBPASSWORD];
  1578.                   LoginParams.Free;
  1579.                 End
  1580.              Else
  1581.                 Begin
  1582.                   if (F_Params.Count > 0) Then
  1583.                      Begin
  1584.                       if F_Params.IndexOfName(szUSERNAME) <> -1 Then
  1585.                          F_Username         := F_Params.Values[szUSERNAME];
  1586.                       if F_Params.IndexOfName(szPASSWORD) <> -1 Then
  1587.                          F_Password         := F_Params.Values[szPASSWORD];
  1588.                       if F_Params.IndexOfName(szDBPASSWORD) <> -1 Then
  1589.                          F_DatabasePassword := F_Params.Values[szDBPASSWORD];
  1590.                      End
  1591.                 End;
  1592.            End;
  1593.         Try                                                               
  1594.           F_Offline := False;
  1595.           if F_AutoDetectMDB Then DetectMDB(F_Database);
  1596.           RecreateCore;
  1597.         Except
  1598.           On E:Exception do
  1599.              Begin
  1600.               if F_LoginPrompt Then
  1601.                  Begin
  1602.                    if ExitDB Then Exit;
  1603.                    ShowMessage(E.Message);
  1604.                    BadPassword :=True;
  1605.                  End
  1606.               Else
  1607.                  Begin
  1608.                    Raise;
  1609.                  End;
  1610.              End;
  1611.         End;
  1612.         if BadPassword Then Goto Start;
  1613.         if (AnsiCompareText(F_DatabaseType,'Access')=0) Then
  1614.            Begin
  1615.              Pwd:=F_DatabasePassword;
  1616.              if F_SmartOpen Then
  1617.                 Begin
  1618.                  if NOT FileExists(F_Database) Then
  1619.                     Begin
  1620.                       if csDesigning in ComponentState Then
  1621.                          F_Database := GetWorkDir+ExtractFileName(F_Database)
  1622.                       Else
  1623.                          F_Database := GetExeDir+ExtractFileName(F_Database);
  1624.                     End;
  1625.                 End;
  1626.              if NOT FileExists(F_Database) Then DatabaseError(E1038+#13#10+F_Database);
  1627.              if F_EngineType=dbUseJet Then
  1628.                 CoreDatabase := CoreWorkspace.OpenDatabase(F_Database,F_Exclusive,F_ReadOnly,Format(';UID=%s;PWD=%s;%s',[F_Username,Pwd,F_DatabaseParameters]))
  1629.              Else
  1630.                 DatabaseError(E1007);
  1631.            End
  1632.         Else
  1633.            Begin
  1634.              Pwd:=F_Password;
  1635.              if AnsiCompareText(F_DatabaseType,'ODBC')=0 Then
  1636.                 Begin
  1637.                   if F_EngineType=dbUseJet Then
  1638.                     Begin
  1639.                       if Pos('odbc;',AnsiLowerCase(F_Database))=1 Then
  1640.                          CoreDatabase := CoreWorkspace.OpenDatabase(F_Database,dbDriverNoPrompt,F_ReadOnly,Format('%s;%s',[F_Database,F_DatabaseParameters]))
  1641.                       Else
  1642.                          CoreDatabase := CoreWorkspace.OpenDatabase(F_Database,dbDriverNoPrompt,F_ReadOnly,Format('%s;UID=%s;PWD=%s;DSN=%s;%s',[F_DatabaseType,F_Username,Pwd,F_Database,F_DatabaseParameters]));
  1643.                     End
  1644.                  Else
  1645.                     Begin
  1646.                       {$IFDEF DYNADAO}
  1647.                         if Pos('odbc;',AnsiLowerCase(F_Database))=1 Then
  1648.                            CoreDatabase := CoreWorkspace.OpenConnection(F_Database,dbDriverNoPrompt,F_ReadOnly,Format('%s;%s',[F_Database,F_DatabaseParameters]))
  1649.                         Else
  1650.                            CoreDatabase := CoreWorkspace.OpenConnection(F_Database,dbDriverNoPrompt,F_ReadOnly,Format('%s;UID=%s;PWD=%s;DSN=%s;%s',[F_DatabaseType,F_Username,Pwd,F_Database,F_DatabaseParameters]));
  1651.                       {$ELSE}
  1652.                         DatabaseError(E1008);
  1653.                       {$ENDIF}
  1654.                     End;
  1655.                 End
  1656.              Else
  1657.                 Begin
  1658.                  if F_EngineType=dbUseJet Then
  1659.                     Begin
  1660.                       if (Pwd='') or (F_Username='')  Then
  1661.                          CoreDatabase := CoreWorkspace.OpenDatabase(F_Database,F_Exclusive,F_ReadOnly,Format('%s;%s',[F_DatabaseType,F_DatabaseParameters]))
  1662.                       Else
  1663.                          CoreDatabase := CoreWorkspace.OpenDatabase(F_Database,F_Exclusive,F_ReadOnly,Format('%s;UID=%s;PWD=%s;%s',[F_DatabaseType,F_Username,Pwd,F_DatabaseParameters]));
  1664.                     End
  1665.                  Else
  1666.                     DatabaseError(E1009);
  1667.                 End;
  1668.            End;
  1669.         if F_QueryTimeout <> 60 Then
  1670.            Begin
  1671.              CoreDatabase.QueryTimeout:=F_QueryTimeout;
  1672.            End;
  1673.         if F_DatabaseType<>'ODBC' Then
  1674.            F_DatabaseVersion := CoreDatabase.Version;
  1675.         RefreshDefinitions;
  1676.         F_CollatingOrder:=F_Get_CollatingOrder;
  1677.         F_Active:=True;
  1678.         Idle;
  1679.         if Assigned(F_AfterConnect) Then F_AfterConnect(Self);
  1680.     End;
  1681. End;
  1682.  
  1683. Procedure TKADaoDatabase.Open;
  1684. Begin
  1685.  Connected := True;
  1686. End;
  1687.  
  1688. Procedure TKADaoDatabase.Close;
  1689. Begin
  1690.   Connected := False;
  1691. End;
  1692.  
  1693. Procedure TKADaoDatabase.CloseDatasets;
  1694. {$IFDEF USEDB}
  1695. Var
  1696.   X            : Integer;
  1697.   ATable       : TKADaoTable;
  1698. {$ENDIF}
  1699. Begin
  1700. {$IFDEF USEDB}
  1701. For X:=0 to F_ActiveTableNames.Count-1 do
  1702.     Begin
  1703.      ATable:=TKADaoTable(F_ActiveTableNames.Objects[X]);
  1704.      Try
  1705.       ATable.MainDatabaseShutdown := True;
  1706.       ATable.Active:=False;
  1707.      Except
  1708.      End;
  1709.     End;
  1710. {$ENDIF}
  1711. F_ActiveTableNames.Clear;
  1712. End;
  1713.  
  1714. Procedure TKADaoDatabase.RefreshDatasets;
  1715. {$IFDEF USEDB}
  1716. Var
  1717.   X            : Integer;
  1718.   ATable       : TKADaoTable;
  1719. {$ENDIF}
  1720. Begin
  1721. Idle;
  1722. {$IFDEF USEDB}
  1723. For X:=0 to F_ActiveTableNames.Count-1 do
  1724.     Begin
  1725.      ATable:=TKADaoTable(F_ActiveTableNames.Objects[X]);
  1726.      Try
  1727.       ATable.RefreshData;
  1728.      Except
  1729.      End;
  1730.     End;
  1731. {$ENDIF}
  1732. End;
  1733.  
  1734. Function TKADaoDatabase.ChooseDatabase: Boolean;
  1735. Var
  1736.    NewDB    : String;
  1737. begin
  1738.   NewDB  := F_ChooseDatabase;
  1739.   Result := NewDB <> '';
  1740.   if Result Then Database := NewDB
  1741. end;
  1742.  
  1743.  
  1744. Procedure TKADaoDatabase.RefreshDefinitions;
  1745. Var
  1746.   X: Integer;
  1747. Begin
  1748.  F_TableNames.Clear;
  1749.  F_QueryDefNames.Clear;
  1750.  //*****************************************************************************
  1751.  Try
  1752.    if F_EngineType = dbUseJet Then CoreDatabase.TableDefs.Refresh;
  1753.  Except
  1754.  End;
  1755.  //*****************************************************************************
  1756.  Try
  1757.    CoreDatabase.QueryDefs.Refresh;
  1758.  Except
  1759.  End;
  1760.  //*****************************************************************************
  1761.  Try
  1762.    if F_DatabaseType='Access' Then
  1763.    CoreDatabase.Containers.Refresh;
  1764.  Except
  1765.  End;
  1766.  //*****************************************************************************
  1767.  Try
  1768.    if F_DatabaseType='Access' Then
  1769.    CoreDatabase.Relations.Refresh;
  1770.  Except
  1771.  End;
  1772.  //*****************************************************************************
  1773.  Try
  1774.    CoreDatabase.Recordsets.Refresh;
  1775.  Except
  1776.  End;
  1777.  //*****************************************************************************
  1778.  Try
  1779.    if F_EngineType = dbUseJet Then CoreDatabase.Properties.Refresh;
  1780.  Except
  1781.  End;
  1782.  //*****************************************************************************
  1783.  Try
  1784.    CoreDBEngine.Errors.Refresh;
  1785.  Except
  1786.  End;
  1787.  //*****************************************************************************
  1788.  Try
  1789.    CoreDBEngine.Workspaces.Refresh;
  1790.  Except
  1791.  End;
  1792.  //*****************************************************************************
  1793.  Try
  1794.    CoreDBEngine.Properties.Refresh;
  1795.  Except
  1796.  End;
  1797.  //*****************************************************************************
  1798.  Try
  1799.    GoOnline;
  1800.    if F_EngineType = dbUseJet Then CoreWorkspace.Users.Refresh;
  1801.  Except
  1802.  End;
  1803.  //*****************************************************************************
  1804.  Try
  1805.    GoOnline;
  1806.    if F_EngineType = dbUseJet Then CoreWorkspace.Groups.Refresh;
  1807.  Except
  1808.  End;
  1809.  //*****************************************************************************
  1810.  Try
  1811.    GoOnline;
  1812.    CoreWorkspace.Databases.Refresh;
  1813.  Except
  1814.  End;
  1815.  //*****************************************************************************
  1816.  Try
  1817.    GoOnline;
  1818.    CoreWorkspace.Properties.Refresh;
  1819.  Except
  1820.  End;
  1821.  //*****************************************************************************
  1822.  Try
  1823.  if F_EngineType = dbUseJet Then
  1824.     Begin
  1825.       For X:=0 To CoreDatabase.TableDefs.Count-1 do
  1826.           Begin
  1827.             if F_ShowSysObjects Then
  1828.                Begin
  1829.                  F_TableNames.Add(CoreDatabase.TableDefs.Item[X].Name);
  1830.                End
  1831.             Else
  1832.                Begin
  1833.                  if (CoreDatabase.TableDefs.Item[X].Attributes And dbSystemObject) = 0 Then
  1834.                     Begin
  1835.                       F_TableNames.Add(CoreDatabase.TableDefs.Item[X].Name);
  1836.                     End;
  1837.                End;
  1838.           End;
  1839.     End;
  1840.  Except
  1841.  End;
  1842.  //*****************************************************************************
  1843.  Try
  1844.  For X:=0 To CoreDatabase.QueryDefs.Count-1 do
  1845.      Begin
  1846.       F_QueryDefNames.Add(CoreDatabase.QueryDefs.Item[X].Name);
  1847.      End;
  1848.  Except
  1849.  End;
  1850. End;
  1851.  
  1852. Procedure TKADaoDatabase.Idle;
  1853. Begin                                               
  1854.  CoreDBEngine.Idle(DaoApi.dbFreeLocks);
  1855.  CoreDBEngine.Idle(dbRefreshCache);
  1856. End;
  1857.  
  1858. Procedure TKADaoDatabase.F_Set_Database(Value : String);
  1859. Begin
  1860.   if (F_Active) Then
  1861.      Begin
  1862.        DatabaseError(E1010);
  1863.        Exit;
  1864.      End;
  1865.   F_Database:=Value;
  1866. End;
  1867.  
  1868. Procedure TKADaoDatabase.F_Set_DatabaseParameters(Value : String);
  1869. Begin
  1870.   if (F_Active) Then
  1871.      Begin
  1872.        DatabaseError(E1037);                                                                                 
  1873.        Exit;
  1874.      End;
  1875.   F_DatabaseParameters:=Value;
  1876. End;
  1877.  
  1878. Procedure TKADaoDatabase.F_Set_SystemDatabase(Value : String);
  1879. Var
  1880.   Tmp : String;
  1881. Begin
  1882.   if (F_Active) Then
  1883.      Begin
  1884.        DatabaseError(E1011);
  1885.        Exit;
  1886.      End;
  1887.   Tmp:=F_SystemDB;
  1888.   F_SystemDB:=Value;
  1889.   if F_SystemDB = '' Then F_SystemDB := F_Get_SystemDatabaseFromRegistry;
  1890.   if csLoading In ComponentState then Exit;
  1891.   //*********************** RECREATE???
  1892.   Try
  1893.    RecreateCore;
  1894.   Except
  1895.    F_SystemDB:=Tmp;
  1896.    RecreateCore;
  1897.    Raise;
  1898.   End;
  1899. End;
  1900.  
  1901. Procedure TKADaoDatabase.F_Set_DaoVersion(Value : String);
  1902. {$IFDEF DYNADAO}
  1903. Var
  1904.   Tmp : String;
  1905. {$ENDIF}
  1906. Begin
  1907. {$IFDEF DYNADAO}
  1908.   if (F_Active) Then
  1909.      Begin
  1910.        DatabaseError(E1012);
  1911.        Exit;
  1912.      End;
  1913.   Tmp:=F_DaoVersion;
  1914.   F_DaoVersion:=Copy(Value,1,3);
  1915.   F_Get_DBTypesList(F_DBTypesList);
  1916.   if csLoading In ComponentState then Exit;
  1917.  //*********************** RECREATE???
  1918.  Try
  1919.    RecreateCore;
  1920.   Except
  1921.    F_DaoVersion:=Tmp;
  1922.    RecreateCore;
  1923.    Raise;
  1924.   End;
  1925. {$ELSE}
  1926.   //This property is read only for fixed DAO
  1927. {$ENDIF}
  1928.  F_ActualDaoVersion := CoreDBEngine.Version;
  1929. End;
  1930.  
  1931. Procedure TKADaoDatabase.F_Set_ActualDaoVersion(Value : String);
  1932. Begin
  1933.   //This property is read only
  1934. End;
  1935.  
  1936. Procedure TKADaoDatabase.F_Set_DatabaseVersion(Value : String);
  1937. Begin
  1938.   //This property is read only
  1939. End;
  1940.  
  1941.  
  1942.  
  1943. Procedure TKADaoDatabase.F_Set_VersionInfo(Value : String);
  1944. Begin
  1945.   //This property is read only
  1946. End;
  1947.  
  1948. Function TKADaoDatabase.F_Get_SystemDatabaseFromRegistry:String;
  1949. Var
  1950.   RS   : String;
  1951.   Reg : TRegistry;
  1952. Begin
  1953.   Result:='';
  1954.   RS:='3.5';
  1955.   if F_DaoVersion='3.5' Then RS:='3.5';
  1956.   if F_DaoVersion='3.6' Then RS:='4.0';
  1957.   Reg := TRegistry.Create;
  1958.   {$IFDEF VER130} Reg.Access:=KEY_READ; {$ENDIF}
  1959.   Try                                                               
  1960.     Reg.RootKey := HKEY_LOCAL_MACHINE;
  1961.     {$IFNDEF D4UP}
  1962.     if Reg.OpenKey(Format('SOFTWARE\Microsoft\JET\%s\Engines',[RS]),False) then
  1963.     {$ELSE}
  1964.     if Reg.OpenKeyReadOnly(Format('SOFTWARE\Microsoft\JET\%s\Engines',[RS])) then
  1965.     {$ENDIF}
  1966.        Begin
  1967.          Result:=Reg.ReadString('SystemDB');
  1968.        End;
  1969.   Finally
  1970.     Reg.Free;
  1971.   End;
  1972. End;
  1973.  
  1974. Function TKADaoDatabase.FindWorkspace(WS:String):Boolean;
  1975. Var
  1976.   X : Integer;
  1977. Begin
  1978.   Result := False;
  1979.   For X :=0 to CoreDBEngine.Workspaces.Count-1 do
  1980.       Begin
  1981.        if CoreDBEngine.Workspaces.Item[X].Name=WS Then
  1982.           Begin
  1983.             Result := True;
  1984.             Exit;
  1985.           End;
  1986.       End;
  1987. End;
  1988.  
  1989. Procedure TKADaoDatabase.F_Set_Workspace(Value : String);
  1990. Var
  1991.   Tmp : String;
  1992. Begin
  1993.   if (F_Active) Then
  1994.      Begin
  1995.        DatabaseError(E1013);
  1996.        Exit;
  1997.      End;
  1998.   Tmp:=F_Workspace;
  1999.   F_Workspace:=Value;
  2000.   if csLoading In ComponentState then Exit;
  2001.   //*********************** RECREATE???
  2002.   Try
  2003.    RecreateCore;
  2004.   Except
  2005.    F_Workspace:=Tmp;
  2006.    RecreateCore;
  2007.    Raise;
  2008.   End;
  2009. End;
  2010.  
  2011.  
  2012. Procedure TKADaoDatabase.F_Set_DatabaseType(Value : String);
  2013. Begin
  2014.   if (F_Active) Then
  2015.      Begin
  2016.        DatabaseError(E1014);
  2017.        Exit;
  2018.      End;
  2019.   F_Database:='';
  2020.   F_DatabaseType:=Value;
  2021. End;
  2022.  
  2023. Function TKADaoDatabase.F_Get_CollatingOrder:String;
  2024. Var
  2025.   CO : Integer;
  2026. Begin
  2027.   Result := '';
  2028.   DatabaseLanguageInt:=0;
  2029.   if Not F_Active Then Exit;
  2030.   CO:=dbSortUndefined;
  2031.   Try
  2032.    CO := CoreDatabase.CollatingOrder;
  2033.   Except
  2034.   End;
  2035.   DatabaseLanguageInt:=CO;
  2036.   Case CO of
  2037.      dbSortGeneral            : Result := 'General (English, French, German, Portuguese, Italian, and Modern Spanish)';
  2038.      dbSortArabic            : Result := 'Arabic';
  2039.      dbSortChineseSimplified    : Result := 'Simplified Chinese';
  2040.      dbSortChineseTraditional    : Result := 'Traditional Chinese';
  2041.      dbSortCyrillic            : Result := 'Bulgarian or Russian';
  2042.      dbSortCzech            : Result := 'Czech';
  2043.      dbSortDutch            : Result := 'Dutch';
  2044.      dbSortGreek            : Result := 'Greek';
  2045.      dbSortHebrew            : Result := 'Hebrew';
  2046.      dbSortHungarian            : Result := 'Hungarian';
  2047.      dbSortIcelandic            : Result := 'Icelandic';
  2048.      dbSortJapanese            : Result := 'Japanese';
  2049.      dbSortKorean            : Result := 'Korean';
  2050.      dbSortNeutral            : Result := 'Neutral';
  2051.      dbSortNorwDan            : Result := 'Norwegian or Danish';
  2052.      dbSortPolish            : Result := 'Polish';
  2053.      dbSortSlovenian            : Result := 'Slovenian';
  2054.      dbSortSpanish            : Result := 'Spanish';
  2055.      dbSortSwedFin            : Result := 'Swedish or Finnish';
  2056.      dbSortThai                    : Result := 'Thai';
  2057.      dbSortTurkish            : Result := 'Turkish';
  2058.      dbSortUndefined            : Result := 'Undefined or unknown';
  2059.   End;
  2060.   F_CollatingOrder:=Result;
  2061. End;
  2062.  
  2063.  
  2064. Procedure TKADaoDatabase.F_Set_EngineType(Value : Integer);
  2065. Var
  2066.   Tmp : Integer;
  2067. Begin
  2068.   if (F_Active) Then
  2069.      Begin
  2070.        DatabaseError(E1015);
  2071.        Exit;
  2072.      End;
  2073.   Tmp:=F_EngineType;
  2074.   F_EngineType:=Value;
  2075.   if csLoading In ComponentState then Exit;
  2076.   //*********************** RECREATE???
  2077.   Try
  2078.    RecreateCore;
  2079.   Except
  2080.    F_EngineType:=Tmp;
  2081.    RecreateCore;
  2082.    Raise;
  2083.   End;
  2084. End;
  2085.  
  2086. Procedure TKADaoDatabase.F_Set_PrivateEngine(Value : Boolean);
  2087. Var
  2088.   Tmp : Boolean;
  2089. Begin
  2090.   if (F_Active) Then
  2091.      Begin
  2092.        DatabaseError(E1016);
  2093.        Exit;
  2094.      End;
  2095.   Tmp:=F_PrivateEngine;
  2096.   F_PrivateEngine:=Value;
  2097.   if csLoading In ComponentState then Exit;
  2098.   //*********************** RECREATE???
  2099.   Try
  2100.    RecreateCore;
  2101.   Except
  2102.    F_PrivateEngine:=Tmp;
  2103.    RecreateCore;
  2104.    Raise;
  2105.   End;
  2106. End;
  2107.  
  2108. Procedure TKADaoDatabase.F_Set_ShowSysObjects(Value : Boolean);
  2109. Begin
  2110.  F_ShowSysObjects := Value;
  2111.  if F_Active Then RefreshDefinitions;
  2112. End;
  2113.  
  2114. Function  TKADaoDatabase.F_Get_DatabaseType:String;
  2115. Begin
  2116.   Result:=F_DatabaseType;
  2117. End;
  2118.  
  2119. Procedure TKADaoDatabase.F_Set_ReadOnly(Value : Boolean);
  2120. {$IFDEF USEDB}
  2121. Var
  2122.   X      : Integer;
  2123.   ATable : TKADaoTable;
  2124.  {$ENDIF}
  2125. Begin
  2126.  if (F_Active) Then
  2127.      Begin
  2128.        DatabaseError(E1017);
  2129.        Exit;
  2130.      End;
  2131.  F_ReadOnly:=Value;
  2132.  {$IFDEF USEDB}
  2133.  if F_ReadOnly Then
  2134.     Begin
  2135.      For X :=0 To F_ActiveTableNames.Count-1 do
  2136.       Begin
  2137.       ATable:=TKADaoTable(F_ActiveTableNames.Objects[X]);
  2138.       ATable.ReadOnly:=True;
  2139.      End;
  2140.     End;
  2141.  {$ENDIF}
  2142. End;
  2143.  
  2144. Procedure TKADaoDatabase.F_Set_DynaDao(Value: Boolean);
  2145. Begin
  2146.  //****************** READ ONLY
  2147. End;
  2148.  
  2149.  
  2150. Procedure TKADaoDatabase.F_Set_Exclusive(Value : Boolean);
  2151. Begin
  2152.  if (F_Active) Then
  2153.      Begin
  2154.        DatabaseError(E1018);
  2155.        Exit;
  2156.      End;
  2157.  F_Exclusive:=Value;
  2158. End;
  2159.  
  2160. Procedure TKADaoDatabase.F_Set_LoginPrompt(Value : Boolean);
  2161. Begin
  2162.  if (F_Active) Then
  2163.      Begin
  2164.        DatabaseError(E1019);
  2165.        Exit;
  2166.      End;
  2167.  F_LoginPrompt:=Value;
  2168. End;
  2169.  
  2170. Procedure TKADaoDatabase.F_Set_UserName(Value : String);
  2171. Begin
  2172.  if (F_Active) Then
  2173.      Begin
  2174.        DatabaseError(E1020);
  2175.        Exit;
  2176.      End;
  2177.  F_UserName:=Value;
  2178.  if csLoading in ComponentState Then Exit;
  2179.  Try
  2180.   RecreateCore;
  2181.  Except
  2182.  End;
  2183. End;
  2184.  
  2185. Procedure TKADaoDatabase.F_Set_Password(Value : String);
  2186. Begin
  2187.  if (F_Active) Then
  2188.      Begin
  2189.        DatabaseError(E1021);
  2190.        Exit;
  2191.      End;
  2192.  F_Password:=Value;
  2193.  if csLoading in ComponentState Then Exit;
  2194.  Try
  2195.   RecreateCore;
  2196.  Except
  2197.  End;
  2198. End;
  2199.  
  2200. Procedure TKADaoDatabase.F_Set_DatabasePassword(Value : String);
  2201. Begin
  2202.  if (F_Active) Then
  2203.      Begin
  2204.        DatabaseError(E1022);
  2205.        Exit;
  2206.      End;
  2207.  F_DatabasePassword:=Value;
  2208. End;
  2209.  
  2210. Procedure TKADaoDatabase.GoOffline;
  2211. Begin
  2212.  F_Offline := True;
  2213. End;
  2214.  
  2215. Procedure TKADaoDatabase.GoOnline;
  2216. Begin
  2217.  F_Offline := False;
  2218. End;
  2219.  
  2220. Procedure TKADaoDatabase.AddRNToTransaction(TableName : String;RN:Integer);
  2221. Var
  2222.  SL : TStringList;
  2223.  I  : Integer;
  2224. Begin
  2225.  if F_TransInfo.Count = 0 Then Exit;
  2226.  SL := TStringList.Create;
  2227.  Try
  2228.   SL.CommaText := F_TransInfo.Strings[F_TransInfo.Count-1];
  2229.   I := SL.IndexOfName(TableName);
  2230.   if I <> -1 Then
  2231.      Begin
  2232.        SL.Values[TableName] := IntToStr(RN);
  2233.      End
  2234.  Else
  2235.      Begin
  2236.       if F_TransInfo.Strings[F_TransInfo.Count-1] <> '' Then
  2237.          SL.Add(','+TableName+'='+IntToStr(RN))
  2238.       Else
  2239.          SL.Add(TableName+'='+IntToStr(RN))
  2240.      End;
  2241.  F_TransInfo.Strings[F_TransInfo.Count-1]:=SL.CommaText;
  2242.  Except
  2243.  End;
  2244.  SL.Free;
  2245. End;
  2246.  
  2247. Function TKADaoDatabase.F_GetTableRN(Tables:String;TableName:String):String;
  2248. Var
  2249.  SL : TStringList;
  2250.  I  : Integer;
  2251. Begin
  2252.  Result := '-1';
  2253.  SL := TStringList.Create;
  2254.  Try
  2255.   SL.CommaText := Tables;
  2256.   I := SL.IndexOfName(TableName);
  2257.   if I <> -1 Then Result := SL.Values[TableName];
  2258.  Except
  2259.  End;
  2260.  SL.Free;
  2261. End;
  2262.  
  2263.  
  2264.  
  2265. Procedure TKADaoDatabase.StartTransaction;
  2266. {$IFDEF USEDB}
  2267. Var
  2268.   X       : Integer;
  2269.   S       : String;
  2270.   ATable  : TKADaoTable;
  2271. {$ENDIF}
  2272. Begin
  2273.   if (NOT F_Active) Then
  2274.      Begin
  2275.        DatabaseError(E1023);
  2276.        Exit;
  2277.      End;
  2278.   CoreWorkspace.BeginTrans;
  2279.   {$IFDEF USEDB}
  2280.   if F_TrackTransactions Then
  2281.      Begin
  2282.        S:= '';
  2283.        For X := 0 To F_ActiveTableNames.Count-1 do
  2284.            Begin
  2285.              ATable:=TKADaoTable(F_ActiveTableNames.Objects[X]);
  2286.              if ATable.IsEmpty Then
  2287.                 Begin
  2288.                   S := S+ATable.Name+'=-1';
  2289.                 End
  2290.              Else
  2291.                 Begin
  2292.                   if (ATable.Bookmarkable) And (ATable.MasterSource = Nil) Then
  2293.                      S := S+ATable.Name+'='+IntToStr(PInteger(PChar(ATable.Bookmark))^)
  2294.                   Else
  2295.                      S := S+ATable.Name+'='+IntToStr(ATable.RecNo);
  2296.                 End;
  2297.              if X < F_ActiveTableNames.Count-1 Then S := S + ',';
  2298.            End;
  2299.        F_TransInfo.Add(S);
  2300.      End;
  2301.   {$ENDIF}
  2302. End;
  2303.                        
  2304. Procedure TKADaoDatabase.Commit;
  2305. Begin
  2306.  if (NOT F_Active) Then
  2307.      Begin
  2308.        DatabaseError(E1024);
  2309.        Exit;
  2310.      End;
  2311.  CoreWorkspace.CommitTrans(dbForceOSFlush);
  2312.  if F_TrackTransactions Then
  2313.     Begin
  2314.       if F_TransInfo.Count > 0 Then F_TransInfo.Delete(F_TransInfo.Count-1);
  2315.     End
  2316. End;
  2317.  
  2318. Procedure TKADaoDatabase.Rollback;
  2319. {$IFDEF USEDB}
  2320. Var
  2321.   X       : Integer;
  2322.   RN      : String;
  2323.   BKS     : Integer;
  2324.   PIN     : PInteger;
  2325.   ATable  : TKADaoTable;
  2326. {$ENDIF}
  2327. Begin
  2328.  CoreWorkspace.Rollback;
  2329.  {$IFDEF USEDB}
  2330.  For X := 0 to F_ActiveTableNames.Count-1 do
  2331.      Begin
  2332.       ATable:=TKADaoTable(F_ActiveTableNames.Objects[X]);
  2333.       ATable.RollbackRefresh;
  2334.       if F_TrackTransactions Then
  2335.          Begin
  2336.           if F_TransInfo.Count > 0 Then
  2337.              Begin
  2338.               RN := F_GetTableRN(F_TransInfo.Strings[F_TransInfo.Count-1],ATable.Name);
  2339.               if RN <> '-1' Then
  2340.                  Begin
  2341.                    Try
  2342.                      if NOT ATable.IsEmpty Then
  2343.                         Begin
  2344.                           if (ATable.Bookmarkable) And (ATable.MasterSource = Nil) Then
  2345.                              Begin
  2346.                                BKS := StrToInt(RN);
  2347.                                PIN := @BKS;
  2348.                                SetString(RN,PChar(PIN),4);
  2349.                                ATable.Bookmark := RN;
  2350.                              End
  2351.                           Else
  2352.                              Begin
  2353.                                ATable.RecNo := StrToInt(RN);
  2354.                              End;  
  2355.                         End;
  2356.                    Except
  2357.                    End;
  2358.                  End;
  2359.              End;
  2360.          End;
  2361.      End;
  2362.   if F_TrackTransactions Then
  2363.      Begin
  2364.       if F_TransInfo.Count > 0 Then F_TransInfo.Delete(F_TransInfo.Count-1);
  2365.      End;
  2366.  {$ENDIF}
  2367. End;
  2368.  
  2369. Function TKADaoDatabase.GetTransactionCount:Integer;
  2370. Begin
  2371.  Result := F_TransInfo.Count;
  2372. End;
  2373.  
  2374.  
  2375. Procedure TKADaoDatabase.RollbackRefresh;
  2376. {$IFDEF USEDB}
  2377. Var
  2378.   X       : Integer;
  2379.   ATable  : TKADaoTable;
  2380. {$ENDIF}
  2381. Begin
  2382.  {$IFDEF USEDB}
  2383.  For X :=0 To F_ActiveTableNames.Count-1 do
  2384.      Begin
  2385.       ATable:=TKADaoTable(F_ActiveTableNames.Objects[X]);
  2386.       ATable.RollbackRefresh;
  2387.      End;
  2388.  {$ENDIF}
  2389. End;
  2390.  
  2391.  
  2392.  
  2393. Procedure TKADaoDatabase.DBEngineLevel_StartTransaction;
  2394. Begin
  2395.  CoreDBEngine.BeginTrans;
  2396. End;
  2397.  
  2398. Procedure TKADaoDatabase.DBEngineLevel_Commit;
  2399. Begin
  2400.  CoreDBEngine.CommitTrans(dbForceOSFlush);
  2401. End;
  2402.  
  2403. Procedure TKADaoDatabase.DBEngineLevel_Rollback;
  2404. {$IFDEF USEDB}
  2405. Var
  2406.   X       : Integer;
  2407.   ATable  : TKADaoTable;
  2408. {$ENDIF}
  2409. Begin
  2410.  CoreDBEngine.Rollback;
  2411.  {$IFDEF USEDB}
  2412.  For X :=0 To F_ActiveTableNames.Count-1 do
  2413.      Begin
  2414.       ATable:=TKADaoTable(F_ActiveTableNames.Objects[X]);
  2415.       ATable.RollbackRefresh;
  2416.      End;
  2417.  {$ENDIF}
  2418. End;
  2419.  
  2420. Procedure TKADaoDatabase.WorkspaceLevel_StartTransaction;
  2421. Begin
  2422.  GoOnline;
  2423.  CoreWorkspace.BeginTrans;
  2424. End;
  2425.  
  2426. Procedure TKADaoDatabase.WorkspaceLevel_Commit;
  2427. Begin
  2428.  GoOnline;
  2429.  CoreWorkspace.CommitTrans(dbForceOSFlush);
  2430. End;
  2431.  
  2432. Procedure TKADaoDatabase.WorkspaceLevel_Rollback;
  2433. {$IFDEF USEDB}
  2434. Var
  2435.   X       : Integer;
  2436.   ATable  : TKADaoTable;
  2437. {$ENDIF}
  2438. Begin
  2439.  GoOnline;
  2440.  CoreWorkspace.Rollback;
  2441.  {$IFDEF USEDB}
  2442.  For X :=0 To F_ActiveTableNames.Count-1 do
  2443.      Begin
  2444.       ATable:=TKADaoTable(F_ActiveTableNames.Objects[X]);
  2445.       ATable.RollbackRefresh;
  2446.      End;
  2447.  {$ENDIF}
  2448. End;
  2449.  
  2450. //********************************************** WORKS ONLY ON DAO 3.5X
  2451. //                                              ON DAO 3.6 USE COMPACT DATABASE
  2452. //                                              WICH ALSO DOES REPAIR
  2453. //******************************************************************************
  2454. Procedure TKADaoDatabase.RepairAccessDatabase(DatabaseName,Password:String);
  2455. Begin
  2456.   if F_DaoVersion='3.5' Then
  2457.      CoreDBEngine.RepairDatabase(DatabaseName)
  2458.   Else
  2459.      CompactAccessDatabase(DatabaseName,Password);
  2460. End;
  2461.  
  2462. Procedure TKADaoDatabase.RepairAccessDatabaseEx(DatabaseName : String;
  2463.                                                NewLocale    : String;
  2464.                                                Encrypt      : Boolean;
  2465.                                                Decrypt      : Boolean;
  2466.                                                NewVersion   : Integer;
  2467.                                                Password     : String);
  2468. Begin
  2469.   if F_DaoVersion = '3.5' Then
  2470.      CoreDBEngine.RepairDatabase(DatabaseName)
  2471.   Else
  2472.      CompactAccessDatabaseEx(DatabaseName,NewLocale,Encrypt,Decrypt,NewVersion,Password);
  2473. End;
  2474.  
  2475. Procedure  TKADaoDatabase.CompactAccessDatabase(DatabaseName,Password:String);
  2476. Var
  2477.   TempName : Array[0..1000] of Char;
  2478.   TempPath : String;
  2479.   Name     : String;
  2480. Begin
  2481.   TempPath:=ExtractFilePath(DatabaseName);
  2482.   if TempPath='' Then TempPath:=GetCurrentDir;
  2483.   GetTempFileName(PChar(TempPath),'mdb',0,TempName);
  2484.   Name:=StrPas(TempName);
  2485.   DeleteFile(Name);
  2486.   if Password <> '' Then Password:=';pwd='+Password;
  2487.   OleVariant(CoreDBEngine).CompactDatabase(DatabaseName,Name,,,Password);
  2488.   DeleteFile(DatabaseName);
  2489.   RenameFile(Name,DatabaseName);
  2490. End;
  2491.  
  2492. Procedure  TKADaoDatabase.CompactAccessDatabaseEx(DatabaseName: String;
  2493.                                                   NewLocale   : String;
  2494.                                                   Encrypt     : Boolean;
  2495.                                                   Decrypt     : Boolean;
  2496.                                                   NewVersion  : Integer;
  2497.                                                   Password    : String);
  2498. Var
  2499.   TempName : Array[0..1000] of Char;
  2500.   TempPath : String;
  2501.   Name     : String;
  2502.   Options  : Integer;
  2503. Begin
  2504.   TempPath:=ExtractFilePath(DatabaseName);
  2505.   if TempPath='' Then TempPath:=GetCurrentDir;
  2506.   GetTempFileName(PChar(TempPath),'mdb',0,TempName);
  2507.   Name:=StrPas(TempName);
  2508.   DeleteFile(Name);
  2509.   Options:=0;
  2510.   if Encrypt Then Options := dbEncrypt;
  2511.   if Decrypt Then Options := dbDecrypt;
  2512.   if NewVersion <> 0 Then Options:=Options+NewVersion;
  2513.   if Password <> '' Then Password:=';pwd='+Password;
  2514.   CoreDBEngine.CompactDatabase(DatabaseName,Name,NewLocale,Options,Password);
  2515.   DeleteFile(DatabaseName);
  2516.   RenameFile(Name,DatabaseName);
  2517. End;
  2518.  
  2519. Procedure TKADaoDatabase.CreateAccessDatabase(DatabaseName:String);
  2520. Var
  2521.  CreateOptions : String;
  2522. Begin
  2523.  CreateOptions:=Format(dbLangGeneral,['0x0409','1252','0']);
  2524.  GoOnline;
  2525.  {$IFDEF DAO35}
  2526.  CoreWorkspace.CreateDatabase(DatabaseName,CreateOptions, dbVersion30);
  2527.  {$ENDIF}
  2528.  {$IFDEF DAO36}
  2529.  CoreWorkspace.CreateDatabase(DatabaseName,CreateOptions, dbVersion40);
  2530.  {$ENDIF}
  2531.  {$IFDEF DYNADAO}
  2532.  if F_DaoVersion='3.5' then CoreWorkspace.CreateDatabase(DatabaseName,CreateOptions, dbVersion30);
  2533.  if F_DaoVersion='3.6' then CoreWorkspace.CreateDatabase(DatabaseName,CreateOptions, dbVersion40);
  2534.  {$ENDIF}
  2535. End;
  2536.  
  2537. Procedure TKADaoDatabase.CreateAccessDatabaseEx(DatabaseName,LANGID,CP,COUNTRY,Password,Version:String;Encrypt:Boolean);
  2538. Var
  2539.  CreateOptions:String;
  2540. Begin
  2541.  CreateOptions:=Format(dbLangGeneral,[LANGID,CP,COUNTRY]);
  2542.  if Password <> '' Then CreateOptions:=CreateOptions+';PWD='+Password;
  2543.  GoOnline;
  2544.  {$IFDEF DAO35}
  2545.  if Encrypt Then
  2546.     CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30 OR dbEncrypt)
  2547.  Else
  2548.     CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30);
  2549.  {$ENDIF}
  2550.  {$IFDEF DAO36}
  2551.   if Version='30' Then
  2552.      if Encrypt Then
  2553.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30 OR dbEncrypt)
  2554.      Else
  2555.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30)
  2556.   Else
  2557.      if Encrypt Then
  2558.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion40 OR dbEncrypt)
  2559.      Else
  2560.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion40);
  2561.  {$ENDIF}
  2562.  {$IFDEF DYNADAO}
  2563.  if F_DaoVersion='3.5'  Then
  2564.  if Encrypt Then
  2565.     CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30 OR dbEncrypt)
  2566.  Else
  2567.     CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30);
  2568.  //*****************************************************************************
  2569.   if F_DaoVersion='3.6'  Then
  2570.   if Version='30' Then
  2571.      if Encrypt Then
  2572.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30 OR dbEncrypt)
  2573.      Else
  2574.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30)
  2575.   Else
  2576.      if Encrypt Then
  2577.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion40 OR dbEncrypt)
  2578.      Else
  2579.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion40);
  2580.  {$ENDIF}
  2581. End;
  2582.  
  2583. Procedure TKADaoDatabase.CreateAccessDatabaseEx2(DatabaseName,Language,Password,Version:String;Encrypt:Boolean);
  2584. Var
  2585.  CreateOptions:String;
  2586. Begin
  2587.  CreateOptions:=Language;
  2588.  if Password <> '' Then CreateOptions:=CreateOptions+';PWD='+Password;
  2589.  GoOnline;
  2590.  {$IFDEF DAO35}
  2591.  if Encrypt Then
  2592.     CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30 OR dbEncrypt)
  2593.  Else
  2594.     CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30);
  2595.  {$ENDIF}
  2596.  {$IFDEF DAO36}
  2597.   if Version='30' Then
  2598.      if Encrypt Then
  2599.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30 OR dbEncrypt)
  2600.      Else
  2601.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30)
  2602.   Else
  2603.      if Encrypt Then
  2604.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion40 OR dbEncrypt)
  2605.      Else
  2606.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion40);
  2607.  {$ENDIF}
  2608.  {$IFDEF DYNADAO}
  2609.  if F_DaoVersion='3.5'  Then
  2610.  if Encrypt Then
  2611.     CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30 OR dbEncrypt)
  2612.  Else
  2613.     CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30);
  2614.  //*****************************************************************************
  2615.   if F_DaoVersion='3.6'  Then
  2616.   if Version='30' Then
  2617.      if Encrypt Then
  2618.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30 OR dbEncrypt)
  2619.      Else
  2620.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30)
  2621.   Else
  2622.      if Encrypt Then
  2623.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion40 OR dbEncrypt)
  2624.      Else
  2625.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion40);
  2626.  {$ENDIF}
  2627. End;
  2628.  
  2629. Function TKADaoDatabase.ChangeDatabasePassword(OldPassword,NewPassword:String):Boolean;
  2630. Begin
  2631.   Result := False;
  2632.   if NOT F_Active Then DatabaseError(E1025);
  2633.   if NOt F_Exclusive Then DatabaseError(E1026);
  2634.   Try
  2635.     CoreDatabase.NewPassword(OldPassword,NewPassword);
  2636.   Except
  2637.    Exit;
  2638.   End;
  2639.   Result := True;
  2640. End;
  2641.  
  2642. Function TKADaoDatabase.RegisterDatabase(DatabaseName, DriverName:String; Silent:Boolean; Attributes:String):Boolean;
  2643. Begin
  2644.   Result := False;
  2645.   Try
  2646.     CoreDBEngine.RegisterDatabase(DatabaseName,DriverName,Silent,Attributes);
  2647.   Except
  2648.    Exit;
  2649.   End;
  2650.   Result := True;
  2651. End;
  2652.  
  2653. Procedure TKADaoDatabase.RenameTable(OldTableName,NewTableName:String);
  2654. Begin
  2655.  RefreshDefinitions;
  2656.  CoreDatabase.TableDefs.Item[OldTableName].Name:=NewTableName;
  2657.  RefreshDefinitions;
  2658. End;
  2659.  
  2660. Procedure TKADaoDatabase.DeleteTable(TableName:String);
  2661. Begin
  2662.  RefreshDefinitions;
  2663.  CoreDatabase.TableDefs.Delete(TableName);
  2664.  RefreshDefinitions;
  2665. End;
  2666.  
  2667. //******************************************************************************
  2668. //  1 = Primary index
  2669. //  2 = Unique
  2670. //  4 = NormalIndex
  2671. //******************************************************************************
  2672. Function TKADaoDatabase.HasPrimaryKey(NewTable:OleVariant):Boolean;
  2673. Var
  2674.   X:Integer;
  2675. Begin
  2676.  Result:=False;
  2677.  For X :=0 to NewTable.Indexes.Count-1 do
  2678.      Begin
  2679.        if NewTable.Indexes.Item[X].Primary Then
  2680.           Begin
  2681.             Result:=True;
  2682.             Exit;
  2683.           End;
  2684.      End;
  2685. End;
  2686.  
  2687. Procedure TKADaoDatabase.DeletePrimaryKey(NewTable:OleVariant);
  2688. Var
  2689.   X:Integer;
  2690. Begin
  2691.  For X :=0 to NewTable.Indexes.Count-1 do
  2692.      Begin
  2693.        if NewTable.Indexes.Item[X].Primary Then
  2694.           Begin
  2695.             NewTable.Indexes.Delete(NewTable.Indexes.Item[X].Name);
  2696.             Exit;
  2697.           End;
  2698.      End;
  2699. End;
  2700.  
  2701.  
  2702. Function TKADaoDatabase.CreateIndex(TableName,FieldName:String;IndexType:Integer):Boolean;
  2703. Var
  2704.   NewTable         : OleVariant;
  2705.   NewField         : OleVariant;
  2706.   NewIndex         : OleVariant;
  2707.   PrimIndex        : OleVariant;
  2708.   PrimaryKeyName   : String;
  2709. Begin
  2710.   Result:=False;
  2711.   RefreshDefinitions;
  2712.   Try
  2713.    NewTable  := CoreDatabase.TableDefs.Item[TableName];
  2714.    if Pos('paradox',AnsiLowerCase(F_DatabaseType)) > 0 Then PrimaryKeyName := TableName Else PrimaryKeyName:='PrimaryKey';
  2715.    if ((IndexType And 1) > 0) Then
  2716.       Begin
  2717.         if HasPrimaryKey(NewTable) Then DeletePrimaryKey(NewTable);
  2718.         PrimIndex          := NewTable.CreateIndex(PrimaryKeyName);
  2719.         PrimIndex.Primary  := True;
  2720.         PrimIndex.Unique   := True;
  2721.         NewField           := NewTable.CreateField(FieldName);
  2722.         PrimIndex.Fields.AppEnd(NewField);
  2723.         NewTable.Indexes.AppEnd(PrimIndex);
  2724.         if NOT ((IndexType And 2) > 0) Then IndexType:=IndexType+2;
  2725.       End;
  2726.    if ((IndexType And 2) > 0) or ((IndexType And 4) > 0) Then
  2727.       Begin
  2728.         NewIndex  := NewTable.CreateIndex(FieldName);
  2729.         if ((IndexType And 2) = 0) Then NewIndex.Unique  := False  Else  NewIndex.Unique  := True;
  2730.         NewField := NewTable.CreateField(FieldName);
  2731.         NewIndex.Fields.AppEnd(NewField);
  2732.         NewTable.Indexes.AppEnd(NewIndex);
  2733.       End;
  2734.   Except
  2735.    Exit;
  2736.   End;
  2737.   RefreshDefinitions;
  2738.   Result:=True;
  2739. End;
  2740.  
  2741. Procedure TKADaoDatabase.RenameIndex(TableName,OldIndexName,NewIndexName:String);
  2742. Begin
  2743.   RefreshDefinitions;
  2744.   CoreDatabase.TableDefs.Item[TableName].Indexes.Item[OldIndexName].Name:=NewIndexName;
  2745.   RefreshDefinitions;
  2746. End;
  2747.  
  2748. Procedure TKADaoDatabase.DeleteIndexByName(TableName,IndexName:String);
  2749. Begin
  2750.  RefreshDefinitions;
  2751.  CoreDatabase.TableDefs.Item[TableName].Indexes.Delete(IndexName);
  2752.  RefreshDefinitions;
  2753. End;
  2754.  
  2755. Procedure TKADaoDatabase.DeleteIndexByFieldName(TableName,FieldName:String);
  2756. Var
  2757.  X         : Integer;
  2758.  TmpName   : String;
  2759.  IndexName : String;
  2760.  NotFound  : Boolean;
  2761. Begin
  2762.  RefreshDefinitions;
  2763.  Try
  2764.   Repeat
  2765.    NotFound:=True;
  2766.    CoreDatabase.TableDefs.Refresh;
  2767.    For X:=0 To CoreDatabase.TableDefs.Item[TableName].Indexes.Count-1 do
  2768.        Begin
  2769.          TmpName:=CoreDatabase.TableDefs.Item[TableName].Indexes.Item[X].Fields.Item[0].Name;
  2770.          if TmpName=FieldName Then
  2771.             Begin
  2772.               IndexName:=CoreDatabase.TableDefs.Item[TableName].Indexes.Item[X].Name;
  2773.               DeleteIndexByName(TableName,IndexName);
  2774.               NotFound:=False;
  2775.               Break;
  2776.             End;
  2777.        End;
  2778.   Until NotFound;
  2779.  Except
  2780.  End;
  2781.  RefreshDefinitions;
  2782. End;
  2783.  
  2784. Procedure TKADaoDatabase.DeleteField(TableName,FieldName:String);
  2785. Var
  2786.  X,Y       : Integer;
  2787.  TmpName   : String;
  2788.  IndexName : String;
  2789.  Found     : Boolean;
  2790. Begin
  2791.  RefreshDefinitions;
  2792.  Try
  2793.   Repeat
  2794.    Found:=False;
  2795.    CoreDatabase.TableDefs.Refresh;
  2796.    For X:=0 To CoreDatabase.TableDefs.Item[TableName].Indexes.Count-1 do
  2797.        Begin
  2798.          For Y := 0 To CoreDatabase.TableDefs.Item[TableName].Indexes.Item[X].Fields.Count-1 do
  2799.              Begin
  2800.                TmpName:=CoreDatabase.TableDefs.Item[TableName].Indexes.Item[X].Fields.Item[Y].Name;
  2801.                if AnsiCompareText(TmpName,FieldName)=0 Then
  2802.                   Begin
  2803.                     IndexName:=CoreDatabase.TableDefs.Item[TableName].Indexes.Item[X].Name;
  2804.                     DeleteIndexByName(TableName,IndexName);
  2805.                     Found:=True;
  2806.                     Break;
  2807.                   End;
  2808.              End;
  2809.          if Found Then Break;
  2810.        End;
  2811.   Until NOT Found;
  2812.  Except
  2813.  End;
  2814.  CoreDatabase.TableDefs.Item[TableName].Fields.Delete(FieldName);
  2815.  RefreshDefinitions;
  2816. End;
  2817.  
  2818. Procedure TKADaoDatabase.RenameField(TableName,OldFieldName,NewFieldName:String);
  2819. Begin
  2820.   RefreshDefinitions;
  2821.   CoreDatabase.TableDefs.Item[TableName].Fields.Item[OldFieldName].Name:=NewFieldName;
  2822.   RefreshDefinitions;
  2823. End;
  2824.  
  2825. Function TKADaoDatabase.EmptyTable(TableName:String):Boolean;
  2826. Begin
  2827.   Result:=False;
  2828.   Try
  2829.     CoreDatabase.Execute('DELETE * FROM ['+TableName+'];',0);
  2830.   Except
  2831.     Exit;
  2832.   End;
  2833.   Result:=True;
  2834. End;
  2835.  
  2836. Function TKADaoDatabase.CreateEmptyTable(TableName:String):Boolean;
  2837. Var
  2838.   NewTable : OleVariant;
  2839.   NewField : OleVariant;
  2840. Begin
  2841.  Result:=False;
  2842.  Try
  2843.    NewTable  := OleVariant(CoreDatabase).CreateTableDef(TableName);
  2844.    NewField  := NewTable.CreateField('Temp',DAOApi.dbLong,0);
  2845.    NewTable.Fields.AppEnd(NewField);
  2846.  Except
  2847.    Exit;
  2848.  End;
  2849.  CoreDatabase.TableDefs.AppEnd(IDispatch(TVarData(NewTable).vDispatch));
  2850.  RefreshDefinitions;
  2851.  DeleteField(TableName,'Temp');
  2852.  Result:=True;
  2853. End;
  2854.  
  2855. //******************************************************************************
  2856. //  1 = Primary index
  2857. //  2 = Unique
  2858. //  4 = NormalIndex
  2859. //******************************************************************************
  2860. Function TKADaoDatabase.CreateTable(TableName:String; FieldNames : Variant; FieldTypes : Variant; FieldSizes : Variant; FieldIndexes:Variant; FieldsRequired:Variant):Boolean;
  2861. Var
  2862.   NewTable       : OleVariant;
  2863.   NewField       : OleVariant;
  2864.   NewIndex       : OleVariant;
  2865.   PrimIndex      : OleVariant;
  2866.   Primary        : Boolean;
  2867.   X              : Integer;
  2868.   Count          : Integer;
  2869.   AutoInc        : Boolean;
  2870.   IdxName        : String;
  2871.   PrimaryKeyName : String;
  2872. Begin
  2873.  if (NOT F_Active) Then
  2874.      Begin
  2875.        DatabaseError(E1027);
  2876.        CreateTable:=False;
  2877.        Exit;
  2878.      End;
  2879.  if TableName='' Then
  2880.     Begin
  2881.        DatabaseError(E1028);
  2882.        CreateTable:=False;
  2883.        Exit;
  2884.      End;
  2885.  Primary := False;
  2886.  NewTable:=OleVariant(CoreDatabase).CreateTableDef(TableName);
  2887.  Count:=VarArrayHighBound(FieldTypes,VarArrayDimCount(FieldTypes));
  2888.  if Pos('paradox',AnsiLowerCase(F_DatabaseType)) > 0 Then PrimaryKeyName := TableName Else PrimaryKeyName:='PrimaryKey';
  2889.  For X:=0 to Count do
  2890.      Begin
  2891.       AutoInc:=False;
  2892.       if FieldTypes[X]=dbAutoIncInteger Then
  2893.          Begin
  2894.            FieldTypes[X]:=dbLong;
  2895.            AutoInc:=True;
  2896.          End;
  2897.       NewField  := NewTable.CreateField(FieldNames[X],FieldTypes[X],FieldSizes[X]);
  2898.       NewTable.Fields.AppEnd(NewField);
  2899.       if AutoInc Then NewTable.Fields[FieldNames[X]].Attributes:=dbAutoIncrField;
  2900.       //************************************************************************
  2901.       // First Create Primary Key Indexes
  2902.       //************************************************************************
  2903.       if FieldIndexes[X] > 0 Then
  2904.          Begin
  2905.            if ((FieldIndexes[X] And 1) > 0) Then
  2906.                Begin
  2907.                  if Not Primary Then
  2908.                     Begin
  2909.                        PrimIndex          := NewTable.CreateIndex(PrimaryKeyName);
  2910.                        PrimIndex.Primary  := True;
  2911.                        PrimIndex.Unique   := True;
  2912.                        Primary:=True;
  2913.                     End;
  2914.                  NewField         := NewTable.CreateField(FieldNames[X],FieldTypes[X],FieldSizes[X]);
  2915.                  PrimIndex.Fields.AppEnd(NewField);
  2916.                End
  2917.          End;
  2918.      End;
  2919.  if Primary Then NewTable.Indexes.AppEnd(PrimIndex);
  2920.  //*****************************************************************************
  2921.  // Then create Unique and NonUnique indexes
  2922.  //*****************************************************************************
  2923.  For X:=0 to Count do
  2924.      Begin
  2925.         if (FieldIndexes[X] And 2 > 0) Or (FieldIndexes[X] And 4 > 0) Then
  2926.          Begin
  2927.            IdxName:=FieldNames[X];
  2928.            NewIndex:=NewTable.CreateIndex(IdxName);
  2929.            if ((FieldIndexes[X] And 2) > 0) Then NewIndex.Unique  := True;
  2930.            NewField  := NewTable.CreateField(FieldNames[X],FieldTypes[X],FieldSizes[X]);
  2931.            NewIndex.Fields.AppEnd(NewField);
  2932.            NewTable.Indexes.AppEnd(NewIndex);
  2933.          End;
  2934.      End;
  2935.  CoreDatabase.TableDefs.AppEnd(IDispatch(TVarData(NewTable).vDispatch));
  2936.  //*****************************************************************************
  2937.  // Then mark required fields
  2938.  //*****************************************************************************
  2939.  RefreshDefinitions;
  2940.  For X:=0 to Count do
  2941.      Begin
  2942.        if FieldsRequired[X]=1 Then
  2943.           CoreDatabase.TableDefs.Item[TableName].Fields.Item[FieldNames[X]].Required := True;
  2944.      End;
  2945.  RefreshDefinitions;
  2946.  CreateTable:=True;
  2947. End;
  2948.  
  2949. //******************************************************************************
  2950. //  1 = Primary index
  2951. //  2 = Unique
  2952. //  4 = NormalIndex
  2953. //******************************************************************************
  2954. Function TKADaoDatabase.AddFieldsToTable(TableName:String; FieldNames : Variant; FieldTypes : Variant; FieldSizes : Variant; FieldIndexes:Variant;  FieldsRequired:Variant):Boolean;
  2955. Var
  2956.   NewTable          : OleVariant;
  2957.   NewField          : OleVariant;
  2958.   PrimIndex         : OleVariant;
  2959.   NewIndex          : OleVariant;
  2960.   X                 : Integer;
  2961.   Count             : Integer;
  2962.   Primary           : Boolean;
  2963.   PrimaryKeyName    : String;
  2964.   IdxName           : String;
  2965. Begin
  2966. if (NOT F_Active) Then
  2967.      Begin
  2968.        DatabaseError(E1029);
  2969.        AddFieldsToTable:=False;
  2970.        Exit;
  2971.      End;
  2972.  if TableName='' Then
  2973.     Begin
  2974.        DatabaseError(E1030);
  2975.        AddFieldsToTable:=False;
  2976.        Exit;
  2977.      End;
  2978.  NewTable:=CoreDatabase.TableDefs.Item[TableName];
  2979.  //*****************************************************************************
  2980.  // Delete PrimaryKey if new Primary key is required
  2981.  //*****************************************************************************
  2982.  Primary := False;
  2983.  Count:=VarArrayHighBound(FieldTypes,VarArrayDimCount(FieldTypes));
  2984.  For X:=0 to Count do
  2985.      Begin
  2986.        if ((FieldIndexes[X] And 1) = 1) Then
  2987.           Begin
  2988.            Primary:=True;
  2989.           End;
  2990.      End;
  2991.  if Pos('paradox',AnsiLowerCase(F_DatabaseType)) > 0 Then PrimaryKeyName := TableName Else PrimaryKeyName:='PrimaryKey';
  2992.  if Primary then DeletePrimaryKey(NewTable);
  2993.  //*****************************************************************************
  2994.  Primary := False;
  2995.  For X:=0 to Count do
  2996.      Begin
  2997.       NewField  := NewTable.CreateField(FieldNames[X],FieldTypes[X],FieldSizes[X]);
  2998.       NewTable.Fields.AppEnd(NewField);
  2999.       //************************************************************************
  3000.       // First Create Primary Key Indexes
  3001.       //************************************************************************
  3002.       if FieldIndexes[X] > 0 Then
  3003.          Begin
  3004.            if ((FieldIndexes[X] And 1) = 1) Then
  3005.                Begin
  3006.                  if Not Primary Then
  3007.                     Begin
  3008.                        PrimIndex          := NewTable.CreateIndex(PrimaryKeyName);
  3009.                        PrimIndex.Primary  := True;
  3010.                        PrimIndex.Unique   := True;
  3011.                        Primary:=True;
  3012.                     End;
  3013.                  NewField         := NewTable.CreateField(FieldNames[X],FieldTypes[X],FieldSizes[X]);
  3014.                  PrimIndex.Fields.AppEnd(NewField);
  3015.                End
  3016.          End;
  3017.      End;
  3018.  if Primary Then NewTable.Indexes.AppEnd(PrimIndex);
  3019.  //*****************************************************************************
  3020.  // Then create Unique and NonUnique indexes
  3021.  //*****************************************************************************
  3022.  For X:=0 to Count do
  3023.      Begin
  3024.         if (FieldIndexes[X] And 2 > 0) Or (FieldIndexes[X] And 4 > 0) Then
  3025.          Begin
  3026.            IdxName:=FieldNames[X];
  3027.            NewIndex:=NewTable.CreateIndex(IdxName);
  3028.            if ((FieldIndexes[X] And 2) > 0) Then NewIndex.Unique  := True;
  3029.            NewField  := NewTable.CreateField(FieldNames[X],FieldTypes[X],FieldSizes[X]);
  3030.            NewIndex.Fields.AppEnd(NewField);
  3031.            NewTable.Indexes.AppEnd(NewIndex);
  3032.          End;
  3033.      End;
  3034.  RefreshDefinitions;
  3035.  //*****************************************************************************
  3036.  // Then mark required fields
  3037.  //*****************************************************************************
  3038.  For X:=0 to Count do
  3039.      Begin
  3040.        if FieldsRequired[X]=1 Then
  3041.           CoreDatabase.TableDefs.Item[TableName].Fields.Item[FieldNames[X]].Required := True;
  3042.      End;
  3043.  RefreshDefinitions;
  3044.  AddFieldsToTable:=True;
  3045. End;
  3046.  
  3047. //******************************************************************************
  3048. // See _PredefinedTableTypes in DaoApi for information about TableType
  3049. //******************************************************************************
  3050. Procedure TKADaoDatabase.LinkExternalTable(Database,TableName,TableType:String;TableAttributes:Integer);
  3051. Var
  3052.  NewTable : OleVariant;
  3053.  TDEFName : String;
  3054.  X, L     : Integer;
  3055. Begin
  3056.  TDEFName:=TableName;
  3057.  L := Length(TDEFName);
  3058.  For X := 1 to L do If TDEFName[X]='.' Then TDEFName[X]:='#';
  3059.  NewTable:=OleVariant(CoreDatabase).CreateTableDef(TDEFName);
  3060.  if Pos('%s',TableType) > 0 Then
  3061.     NewTable.Connect         := Format(TableType,[Database])
  3062.  Else
  3063.     NewTable.Connect         := TableType;
  3064.  if TableAttributes <> 0 Then NewTable.Attributes := TableAttributes;
  3065.  NewTable.SourceTableName := TableName;
  3066.  CoreDatabase.TableDefs.AppEnd(IDispatch(TVarData(NewTable).vDispatch));
  3067. End;
  3068.  
  3069. Procedure TKADaoDatabase.LinkExternalTableEx(Database,TableName,TableFileName,TableType:String;TableAttributes:Integer);
  3070. Var
  3071.  NewTable : OleVariant;
  3072. Begin
  3073.  NewTable:=OleVariant(CoreDatabase).CreateTableDef(TableName);
  3074.  if Pos('%s',TableType) > 0 Then
  3075.     NewTable.Connect         := Format(TableType,[Database])
  3076.  Else
  3077.     NewTable.Connect         := TableType;
  3078.  if TableAttributes <> 0 Then NewTable.Attributes := TableAttributes;
  3079.  NewTable.SourceTableName := TableFileName;
  3080.  CoreDatabase.TableDefs.AppEnd(IDispatch(TVarData(NewTable).vDispatch));
  3081. End;
  3082.  
  3083. Procedure TKADaoDatabase.RefreshLink(Database,TableName,TableType:String);
  3084. Var
  3085.  LinkedTable : OleVariant;
  3086. Begin
  3087.  LinkedTable:=OleVariant(CoreDatabase).TableDefs.Item[TableName];
  3088.  if Pos('%s',TableType) > 0 Then
  3089.     LinkedTable.Connect         := Format(TableType,[Database])
  3090.  Else
  3091.     LinkedTable.Connect         := TableType;
  3092.  LinkedTable.RefreshLink;
  3093. End;
  3094.  
  3095. Function TKADaoDatabase.CreateQueryDef(Name:String;SQL:String):Boolean;
  3096. Var
  3097.  {$IFDEF DYNADAO}
  3098.  Query : OleVariant;
  3099.  {$ELSE}                                                      
  3100.  Query : QueryDef;
  3101.  {$ENDIF}
  3102. Begin
  3103.  Query:=CoreDatabase.CreateQueryDef(Name,SQL);
  3104.  RefreshDefinitions;
  3105.  CreateQueryDef:=True;
  3106. End;
  3107.  
  3108. Procedure TKADaoDatabase.ModifyQueryDef(Name:String;SQL:String);
  3109. Begin
  3110.  RefreshDefinitions;
  3111.  CoreDatabase.QueryDefs.Item[Name].SQL:=SQL;
  3112.  RefreshDefinitions;
  3113. End;
  3114.  
  3115. Function TKADaoDatabase.GetQueryDefSQLText(Name:String):String;
  3116. Begin
  3117.  Try
  3118.    Result:=CoreDatabase.QueryDefs.Item[Name].SQL;
  3119.  Except
  3120.    Result:='';
  3121.  End;
  3122. End;
  3123.  
  3124. Procedure TKADaoDatabase.RenameQueryDef(OldQueryName,NewQueryName:String);
  3125. Begin
  3126.  RefreshDefinitions;
  3127.  CoreDatabase.QueryDefs.Item[OldQueryName].Name:=NewQueryName;
  3128.  RefreshDefinitions;
  3129. End;
  3130.  
  3131. Procedure TKADaoDatabase.DeleteQueryDef(QueryName:String);
  3132. Begin
  3133.  RefreshDefinitions;
  3134.  CoreDatabase.QueryDefs.Delete(QueryName);
  3135.  RefreshDefinitions;
  3136. End;
  3137.  
  3138. Function  TKADaoDatabase.F_ChooseDatabase: String;
  3139. var
  3140.    FileName              : String;
  3141.    Filter                : String;
  3142.    Temp                  : String;
  3143.    P                     : Integer;
  3144.    TableType             : String;
  3145.    DSN                   : String;
  3146.    DlgChooseOdbcDatabase : TODBCDialog;
  3147.    DlgChooseDatabase     : TOpenDialog;
  3148. Begin
  3149.   Result := '';
  3150.   If F_DatabaseType='' Then DatabaseError(E1031);
  3151.   If F_DatabaseType='ODBC' Then
  3152.     Begin
  3153.       DSN:=F_Database;
  3154.       F_Get_SystemDSNs(F_SystemDSNs);
  3155.       F_Get_UserDSNs(F_UserDSNs);
  3156.       Application.CreateForm(TODBCDialog,DlgChooseOdbcDatabase);
  3157.       if DlgChooseOdbcDatabase.Execute(F_SystemDSNs,F_UserDSNs,Dsn,F_UseODBCDialog) Then Result := DSN;
  3158.       DlgChooseOdbcDatabase.Free;
  3159.     End
  3160.   Else
  3161.     Begin
  3162.      DlgChooseDatabase := TOpenDialog.Create(Nil);
  3163.      FileName := Database;
  3164.      if FileName = '' then
  3165.         Begin
  3166.            DlgChooseDatabase.FileName   := '';
  3167.            if csDesigning in ComponentState Then
  3168.               DlgChooseDatabase.InitialDir := GetExeDir
  3169.            Else
  3170.               DlgChooseDatabase.InitialDir := GetExeDir;
  3171.         End
  3172.      Else
  3173.         Begin
  3174.            DlgChooseDatabase.FileName   := ExtractFileName(FileName);
  3175.            DlgChooseDatabase.InitialDir := ExtractFileDir(FileName);
  3176.         End;
  3177.      if F_DatabaseType='Access' Then
  3178.         Begin
  3179.          Filter:='Microsoft Access (*.mdb)|*.mdb';
  3180.          Filter:=Filter+'|All files (*.*)|*.*';
  3181.          DlgChooseDatabase.Title:='Choose '+F_DatabaseType+' Database:';
  3182.          DlgChooseDatabase.Options:=[ofPathMustExist,ofFileMustExist,ofHideReadOnly];
  3183.          DlgChooseDatabase.Filter :=Filter;
  3184.          DlgChooseDatabase.DefaultExt:='mdb';
  3185.          if DlgChooseDatabase.Execute then Result := DlgChooseDatabase.FileName;
  3186.         End
  3187.      Else
  3188.         Begin
  3189.          Filter:=F_Get_DBTypeFileExtension(F_DatabaseType);
  3190.          TableType:=F_Get_DBTypeTableType(F_DatabaseType);
  3191.          if TableType='1' Then
  3192.             Begin
  3193.               if SelectDirectory(FileName,[],0) Then Result := FileName;
  3194.             End
  3195.          Else
  3196.             Begin
  3197.              Temp:=Filter;
  3198.              P:=Pos('(',Temp);
  3199.              if P > 0 Then
  3200.                 Begin
  3201.                   Delete(Temp,1,P);
  3202.                   P:=Pos(')',Temp);
  3203.                   if P > 0 Then Temp:=Copy(Temp,1,P-1);
  3204.                   Filter:=Filter+'|'+Temp;
  3205.                 End;
  3206.              Filter:=Filter+'|All files (*.*)|*.*';
  3207.              DlgChooseDatabase.Title:='Choose '+F_DatabaseType+' Database:';
  3208.              DlgChooseDatabase.Options:=[ofFileMustExist,ofPathMustExist,ofHideReadOnly];
  3209.              DlgChooseDatabase.Filter :=Filter;
  3210.              if DlgChooseDatabase.Execute then Result :=DlgChooseDatabase.FileName;
  3211.             End;
  3212.         End;
  3213.       DlgChooseDatabase.Free;
  3214.     End;
  3215. end;
  3216.  
  3217. //******************************************************************************
  3218. // EASY WRAPPER TO CREATE TABLES USING METHODS SIMILAR TO BORLAND'S TTABLE
  3219. //******************************************************************************
  3220.  
  3221. {$IFDEF USEDB}
  3222. Constructor TKADaoTableManager.Create(Database : TKADaoDatabase);
  3223. Begin
  3224.   F_Database       := Database;
  3225.   F_DummyDataset   := TDummyDataset.Create(Nil);
  3226.   IndexDefs        := TIndexDefs.Create(F_DummyDataset);
  3227.   FieldDefs        := TFieldDefs.Create(F_DummyDataset);
  3228.   TableName        := '';
  3229. End;
  3230.  
  3231. Destructor  TKADaoTableManager.Destroy;
  3232. Begin
  3233.   FieldDefs.Free;
  3234.   IndexDefs.Free;
  3235.   F_DummyDataset.Free;
  3236.   Inherited Destroy;
  3237. End;
  3238.  
  3239. Function TKADaoTableManager.CheckStatus:Boolean;
  3240. Begin
  3241.  Result := False;
  3242.  if Not Assigned(F_Database) Then DatabaseError(E1032);
  3243.  if Not (F_Database.Connected) Then DatabaseError(E1025);
  3244.  if TableName='' Then
  3245.     Begin
  3246.       DatabaseError('Missing TableName!');
  3247.       Exit;
  3248.     End;
  3249.  Result := True;
  3250. End;
  3251.  
  3252. Procedure TKADaoTableManager.StringToList(Items: String; List: TStringList);
  3253. var
  3254.   X: Integer;
  3255. begin
  3256.   For X:= 1 To Length(Items) Do If Items[X] = ';' Then Items[X]:= #13;
  3257.   List.Clear;
  3258.   List.Text:=Items;
  3259.   For X:= 0 To List.Count - 1 Do List[X]:= Trim(List[X]);
  3260. end;
  3261.  
  3262. Procedure   TKADaoTableManager.AppendTable;
  3263. Var
  3264.   FN,FT,FS,FI,FR  : Variant;
  3265.   Count           : Integer;
  3266.   X               : Integer;
  3267.   Idx             : Integer;
  3268. Begin
  3269.   if Not CheckStatus Then Exit;
  3270.   Count:=FieldDefs.Count-1;
  3271.   FN:=VarArrayCreate([0, Count], varOleStr);
  3272.   FT:=VarArrayCreate([0, Count], varInteger);
  3273.   FS:=VarArrayCreate([0, Count], varInteger);
  3274.   FI:=VarArrayCreate([0, Count], varInteger);
  3275.   FR:=VarArrayCreate([0, Count], varInteger);
  3276.   For X :=0 To Count Do
  3277.       Begin
  3278.         FN[X]:=FieldDefs.Items[X].Name;
  3279.         FT[X]:=BDEToDao(FieldDefs.Items[X].DataType);
  3280.         FS[X]:=DaoSizeToBDESize(FT[X],FieldDefs.Items[X].Size);
  3281.         if FieldDefs.Items[X].Required Then FR[X]:=1 Else FR[X]:=0;
  3282.         Idx:=0;
  3283.         FI[X]:=Idx;
  3284.       End;
  3285.   F_Database.AddFieldsToTable(TableName,FN,FT,FS,FI,FR);
  3286.   VarClear(FN); FN:=NULL;
  3287.   VarClear(FT); FT:=NULL;
  3288.   VarClear(FS); FS:=NULL;
  3289.   VarClear(FI); FI:=NULL;
  3290.   VarClear(FR); FR:=NULL;
  3291.   CreateIndex(False);
  3292. End;
  3293.  
  3294.  
  3295. Procedure  TKADaoTableManager.CreateIndex(PreservePrimaryKeys:Boolean);
  3296. Var
  3297.   Count           : Integer;
  3298.   NT,NF,FI        : OleVariant;
  3299.   X,Y             : Integer;
  3300.   PrimaryKeyName  : String;
  3301.   Primary         : Boolean;
  3302.   FieldNames      : TStringList;
  3303.   INam            : String;
  3304. Begin
  3305.   Count:=IndexDefs.Count;
  3306.   if Count=0 Then Exit;
  3307.   if Not CheckStatus Then Exit;
  3308.   FieldNames:=TStringList.Create;
  3309.   Try
  3310.    NT := F_Database.CoreDatabase.TableDefs.Item[TableName];
  3311.    Primary:=False;
  3312.    For X :=0 To Count-1 Do
  3313.       Begin
  3314.        if ixPrimary in IndexDefs[X].Options Then
  3315.           Begin
  3316.             Primary := True;
  3317.             PrimaryKeyName:=IndexDefs[X].Name;
  3318.           End;
  3319.       End;
  3320.    if Pos('paradox',AnsiLowerCase(F_Database.F_DatabaseType)) > 0 Then PrimaryKeyName := TableName;
  3321.    if Primary Then
  3322.      Begin
  3323.        if F_Database.HasPrimaryKey(NT) Then F_Database.DeletePrimaryKey(NT);
  3324.        FI:=NT.CreateIndex(PrimaryKeyName);
  3325.        FI.Primary := True;
  3326.        For X :=0 To Count-1 Do
  3327.           Begin
  3328.            if ixPrimary in IndexDefs[X].Options Then
  3329.               Begin
  3330.                  StringToList(IndexDefs[X].Fields,FieldNames);
  3331.                  For Y := 0 To FieldNames.Count-1 do
  3332.                      Begin
  3333.                        NF:=FI.CreateField(FieldNames.Strings[Y]);
  3334.                        FI.Fields.AppEnd(NF);
  3335.                      End;
  3336.               End;
  3337.           End;
  3338.        NT.Indexes.AppEnd(FI);
  3339.      End;
  3340.    For X :=0 To Count-1 Do
  3341.       Begin
  3342.        if (IndexDefs[X].Options=[])
  3343.        or (IndexDefs[X].Options=[ixPrimary,ixUnique])
  3344.        or (IndexDefs[X].Options=[ixUnique])Then
  3345.           Begin
  3346.            StringToList(IndexDefs[X].Fields,FieldNames);
  3347.            if IndexDefs[X].Name='' Then
  3348.               INam:= FieldNames.Strings[0]
  3349.            Else
  3350.               INam:=IndexDefs[X].Name;
  3351.            if (AnsiCompareText(INam,PrimaryKeyName)=0) And (Primary) Then
  3352.                Begin
  3353.                  //******************* Don't Create again PRIMARY KEY
  3354.                End
  3355.            Else
  3356.                Begin
  3357.                 FI:=NT.CreateIndex(INam);
  3358.                 if ixUnique in IndexDefs[X].Options Then FI.Unique := True;
  3359.                 For Y := 0 To FieldNames.Count-1 do
  3360.                     Begin
  3361.                       NF:=FI.CreateField(FieldNames.Strings[Y]);
  3362.                       FI.Fields.AppEnd(NF);
  3363.                     End;
  3364.                 NT.Indexes.AppEnd(FI);
  3365.                End;
  3366.           End;
  3367.       End;
  3368.    F_Database.RefreshDefinitions;
  3369.   Finally
  3370.     FieldNames.Free;
  3371.   End;
  3372. End;
  3373.  
  3374. Procedure   TKADaoTableManager.CreateTable;
  3375. Var
  3376.   FN,FT,FS,FI,FR  : Variant;
  3377.   Count           : Integer;
  3378.   X               : Integer;
  3379.   Idx             : Integer;
  3380. Begin
  3381.   if Not CheckStatus Then Exit;
  3382.   Count:=FieldDefs.Count-1;
  3383.   FN:=VarArrayCreate([0, Count], varOleStr);
  3384.   FT:=VarArrayCreate([0, Count], varInteger);
  3385.   FS:=VarArrayCreate([0, Count], varInteger);
  3386.   FI:=VarArrayCreate([0, Count], varInteger);
  3387.   FR:=VarArrayCreate([0, Count], varInteger);
  3388.   For X :=0 To Count Do
  3389.       Begin
  3390.         FN[X]:=FieldDefs.Items[X].Name;
  3391.         FT[X]:=BDEToDao(FieldDefs.Items[X].DataType);
  3392.         FS[X]:=DaoSizeToBDESize(FT[X],FieldDefs.Items[X].Size);
  3393.         if FieldDefs.Items[X].Required Then FR[X]:=1 Else FR[X]:=0;
  3394.         Idx:=0;
  3395.         FI[X]:=Idx;
  3396.       End;
  3397.   F_Database.CreateTable(TableName,FN,FT,FS,FI,FR);
  3398.   VarClear(FN); FN:=NULL;
  3399.   VarClear(FT); FT:=NULL;
  3400.   VarClear(FS); FS:=NULL;
  3401.   VarClear(FI); FI:=NULL;
  3402.   VarClear(FR); FR:=NULL;
  3403.   CreateIndex(False);
  3404. End;
  3405. {$ENDIF}
  3406. //******************************************************************************
  3407. procedure Register;
  3408. Begin
  3409.   RegisterComponents('KA Dao', [TKADaoDatabase]);
  3410. End;
  3411.  
  3412. Initialization
  3413.  {$IFNDEF D5UP}
  3414.   TVarData(Unassigned).VType := varEmpty;
  3415.   TVarData(EmptyParam).VType := varError;
  3416.   TVarData(EmptyParam).VError := $80020004;
  3417.  {$ENDIF}
  3418. End.
  3419.  
  3420.  
  3421.