home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / kompon / d34567 / KADAO.ZIP / KDaoDataBase.pas < prev    next >
Pascal/Delphi Source File  |  2002-08-16  |  119KB  |  3,394 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):Integer;
  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.50';
  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 (Not VarIsNull(CoreWorkspace)) And (Not VarIsEmpty(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):Integer;
  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 := StrToInt(SL.Values[TableName]);
  2258.  Except
  2259.  End;
  2260.  SL.Free;
  2261. End;
  2262.  
  2263. Procedure TKADaoDatabase.StartTransaction;
  2264. {$IFDEF USEDB}
  2265. Var
  2266.   X       : Integer;
  2267.   S       : String;
  2268.   ATable  : TKADaoTable;
  2269. {$ENDIF}
  2270. Begin
  2271.   if (NOT F_Active) Then
  2272.      Begin
  2273.        DatabaseError(E1023);
  2274.        Exit;
  2275.      End;
  2276.   CoreWorkspace.BeginTrans;
  2277.   {$IFDEF USEDB}
  2278.   if F_TrackTransactions Then
  2279.      Begin
  2280.        S:= '';
  2281.        For X := 0 To F_ActiveTableNames.Count-1 do
  2282.            Begin
  2283.              ATable:=TKADaoTable(F_ActiveTableNames.Objects[X]);
  2284.              S := S+ATable.Name+'='+IntToStr(ATable.RecNo);
  2285.              if X < F_ActiveTableNames.Count-1 Then S := S + ',';
  2286.            End;
  2287.        F_TransInfo.Add(S);
  2288.      End;
  2289.   {$ENDIF}
  2290. End;
  2291.  
  2292. Procedure TKADaoDatabase.Commit;
  2293. Begin
  2294.  if (NOT F_Active) Then
  2295.      Begin
  2296.        DatabaseError(E1024);
  2297.        Exit;
  2298.      End;
  2299.  CoreWorkspace.CommitTrans(dbForceOSFlush);
  2300.  if F_TrackTransactions Then
  2301.     Begin
  2302.       if F_TransInfo.Count > 0 Then F_TransInfo.Delete(F_TransInfo.Count-1);
  2303.     End
  2304. End;
  2305.  
  2306. Procedure TKADaoDatabase.Rollback;
  2307. {$IFDEF USEDB}
  2308. Var
  2309.   X       : Integer;
  2310.   RN      : Integer;
  2311.   ATable  : TKADaoTable;
  2312. {$ENDIF}
  2313. Begin
  2314.  CoreWorkspace.Rollback;
  2315.  {$IFDEF USEDB}
  2316.  For X :=0 To F_ActiveTableNames.Count-1 do
  2317.      Begin
  2318.       ATable:=TKADaoTable(F_ActiveTableNames.Objects[X]);
  2319.       ATable.RollbackRefresh;
  2320.       if F_TrackTransactions Then
  2321.          Begin
  2322.           if F_TransInfo.Count > 0 Then
  2323.              Begin
  2324.               RN := F_GetTableRN(F_TransInfo.Strings[F_TransInfo.Count-1],ATable.Name);
  2325.               if RN > -1 Then
  2326.                  Begin
  2327.                    Try
  2328.                      if NOT ATable.IsEmpty Then ATable.RecNo := RN;
  2329.                    Except
  2330.                    End;
  2331.                  End;
  2332.              End;
  2333.          End;
  2334.      End;
  2335.   if F_TrackTransactions Then
  2336.      Begin
  2337.       if F_TransInfo.Count > 0 Then F_TransInfo.Delete(F_TransInfo.Count-1);
  2338.      End;
  2339.  {$ENDIF}
  2340. End;
  2341.  
  2342. Function TKADaoDatabase.GetTransactionCount:Integer;
  2343. Begin
  2344.  Result := F_TransInfo.Count;
  2345. End;
  2346.  
  2347.  
  2348. Procedure TKADaoDatabase.RollbackRefresh;
  2349. {$IFDEF USEDB}
  2350. Var
  2351.   X       : Integer;
  2352.   ATable  : TKADaoTable;
  2353. {$ENDIF}
  2354. Begin
  2355.  {$IFDEF USEDB}
  2356.  For X :=0 To F_ActiveTableNames.Count-1 do
  2357.      Begin
  2358.       ATable:=TKADaoTable(F_ActiveTableNames.Objects[X]);
  2359.       ATable.RollbackRefresh;
  2360.      End;
  2361.  {$ENDIF}
  2362. End;
  2363.  
  2364.  
  2365.  
  2366. Procedure TKADaoDatabase.DBEngineLevel_StartTransaction;
  2367. Begin
  2368.  CoreDBEngine.BeginTrans;
  2369. End;
  2370.  
  2371. Procedure TKADaoDatabase.DBEngineLevel_Commit;
  2372. Begin
  2373.  CoreDBEngine.CommitTrans(dbForceOSFlush);
  2374. End;
  2375.  
  2376. Procedure TKADaoDatabase.DBEngineLevel_Rollback;
  2377. {$IFDEF USEDB}
  2378. Var
  2379.   X       : Integer;
  2380.   ATable  : TKADaoTable;
  2381. {$ENDIF}
  2382. Begin
  2383.  CoreDBEngine.Rollback;
  2384.  {$IFDEF USEDB}
  2385.  For X :=0 To F_ActiveTableNames.Count-1 do
  2386.      Begin
  2387.       ATable:=TKADaoTable(F_ActiveTableNames.Objects[X]);
  2388.       ATable.RollbackRefresh;
  2389.      End;
  2390.  {$ENDIF}
  2391. End;
  2392.  
  2393. Procedure TKADaoDatabase.WorkspaceLevel_StartTransaction;
  2394. Begin
  2395.  GoOnline;
  2396.  CoreWorkspace.BeginTrans;
  2397. End;
  2398.  
  2399. Procedure TKADaoDatabase.WorkspaceLevel_Commit;
  2400. Begin
  2401.  GoOnline;
  2402.  CoreWorkspace.CommitTrans(dbForceOSFlush);
  2403. End;
  2404.  
  2405. Procedure TKADaoDatabase.WorkspaceLevel_Rollback;
  2406. {$IFDEF USEDB}
  2407. Var
  2408.   X       : Integer;
  2409.   ATable  : TKADaoTable;
  2410. {$ENDIF}
  2411. Begin
  2412.  GoOnline;
  2413.  CoreWorkspace.Rollback;
  2414.  {$IFDEF USEDB}
  2415.  For X :=0 To F_ActiveTableNames.Count-1 do
  2416.      Begin
  2417.       ATable:=TKADaoTable(F_ActiveTableNames.Objects[X]);
  2418.       ATable.RollbackRefresh;
  2419.      End;
  2420.  {$ENDIF}
  2421. End;
  2422.  
  2423. //********************************************** WORKS ONLY ON DAO 3.5X
  2424. //                                              ON DAO 3.6 USE COMPACT DATABASE
  2425. //                                              WICH ALSO DOES REPAIR
  2426. //******************************************************************************
  2427. Procedure TKADaoDatabase.RepairAccessDatabase(DatabaseName,Password:String);
  2428. Begin
  2429.   if F_DaoVersion='3.5' Then
  2430.      CoreDBEngine.RepairDatabase(DatabaseName)
  2431.   Else
  2432.      CompactAccessDatabase(DatabaseName,Password);
  2433. End;
  2434.  
  2435. Procedure TKADaoDatabase.RepairAccessDatabaseEx(DatabaseName : String;
  2436.                                                NewLocale    : String;
  2437.                                                Encrypt      : Boolean;
  2438.                                                Decrypt      : Boolean;
  2439.                                                NewVersion   : Integer;
  2440.                                                Password     : String);
  2441. Begin
  2442.   if F_DaoVersion = '3.5' Then
  2443.      CoreDBEngine.RepairDatabase(DatabaseName)
  2444.   Else
  2445.      CompactAccessDatabaseEx(DatabaseName,NewLocale,Encrypt,Decrypt,NewVersion,Password);
  2446. End;
  2447.  
  2448. Procedure  TKADaoDatabase.CompactAccessDatabase(DatabaseName,Password:String);
  2449. Var
  2450.   TempName : Array[0..1000] of Char;
  2451.   TempPath : String;
  2452.   Name     : String;
  2453. Begin
  2454.   TempPath:=ExtractFilePath(DatabaseName);
  2455.   if TempPath='' Then TempPath:=GetCurrentDir;
  2456.   GetTempFileName(PChar(TempPath),'mdb',0,TempName);
  2457.   Name:=StrPas(TempName);
  2458.   DeleteFile(Name);
  2459.   if Password <> '' Then Password:=';pwd='+Password;
  2460.   OleVariant(CoreDBEngine).CompactDatabase(DatabaseName,Name,,,Password);
  2461.   DeleteFile(DatabaseName);
  2462.   RenameFile(Name,DatabaseName);
  2463. End;
  2464.  
  2465. Procedure  TKADaoDatabase.CompactAccessDatabaseEx(DatabaseName: String;
  2466.                                                   NewLocale   : String;
  2467.                                                   Encrypt     : Boolean;
  2468.                                                   Decrypt     : Boolean;
  2469.                                                   NewVersion  : Integer;
  2470.                                                   Password    : String);
  2471. Var
  2472.   TempName : Array[0..1000] of Char;
  2473.   TempPath : String;
  2474.   Name     : String;
  2475.   Options  : Integer;
  2476. Begin
  2477.   TempPath:=ExtractFilePath(DatabaseName);
  2478.   if TempPath='' Then TempPath:=GetCurrentDir;
  2479.   GetTempFileName(PChar(TempPath),'mdb',0,TempName);
  2480.   Name:=StrPas(TempName);
  2481.   DeleteFile(Name);
  2482.   Options:=0;
  2483.   if Encrypt Then Options := dbEncrypt;
  2484.   if Decrypt Then Options := dbDecrypt;
  2485.   if NewVersion <> 0 Then Options:=Options+NewVersion;
  2486.   if Password <> '' Then Password:=';pwd='+Password;
  2487.   CoreDBEngine.CompactDatabase(DatabaseName,Name,NewLocale,Options,Password);
  2488.   DeleteFile(DatabaseName);
  2489.   RenameFile(Name,DatabaseName);
  2490. End;
  2491.  
  2492. Procedure TKADaoDatabase.CreateAccessDatabase(DatabaseName:String);
  2493. Var
  2494.  CreateOptions : String;
  2495. Begin
  2496.  CreateOptions:=Format(dbLangGeneral,['0x0409','1252','0']);
  2497.  GoOnline;
  2498.  {$IFDEF DAO35}
  2499.  CoreWorkspace.CreateDatabase(DatabaseName,CreateOptions, dbVersion30);
  2500.  {$ENDIF}
  2501.  {$IFDEF DAO36}
  2502.  CoreWorkspace.CreateDatabase(DatabaseName,CreateOptions, dbVersion40);
  2503.  {$ENDIF}
  2504.  {$IFDEF DYNADAO}
  2505.  if F_DaoVersion='3.5' then CoreWorkspace.CreateDatabase(DatabaseName,CreateOptions, dbVersion30);
  2506.  if F_DaoVersion='3.6' then CoreWorkspace.CreateDatabase(DatabaseName,CreateOptions, dbVersion40);
  2507.  {$ENDIF}
  2508. End;
  2509.  
  2510. Procedure TKADaoDatabase.CreateAccessDatabaseEx(DatabaseName,LANGID,CP,COUNTRY,Password,Version:String;Encrypt:Boolean);
  2511. Var
  2512.  CreateOptions:String;
  2513. Begin
  2514.  CreateOptions:=Format(dbLangGeneral,[LANGID,CP,COUNTRY]);
  2515.  if Password <> '' Then CreateOptions:=CreateOptions+';PWD='+Password;
  2516.  GoOnline;
  2517.  {$IFDEF DAO35}
  2518.  if Encrypt Then
  2519.     CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30 OR dbEncrypt)
  2520.  Else
  2521.     CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30);
  2522.  {$ENDIF}
  2523.  {$IFDEF DAO36}
  2524.   if Version='30' Then
  2525.      if Encrypt Then
  2526.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30 OR dbEncrypt)
  2527.      Else
  2528.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30)
  2529.   Else
  2530.      if Encrypt Then
  2531.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion40 OR dbEncrypt)
  2532.      Else
  2533.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion40);
  2534.  {$ENDIF}
  2535.  {$IFDEF DYNADAO}
  2536.  if F_DaoVersion='3.5'  Then
  2537.  if Encrypt Then
  2538.     CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30 OR dbEncrypt)
  2539.  Else
  2540.     CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30);
  2541.  //*****************************************************************************
  2542.   if F_DaoVersion='3.6'  Then
  2543.   if Version='30' Then
  2544.      if Encrypt Then
  2545.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30 OR dbEncrypt)
  2546.      Else
  2547.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30)
  2548.   Else
  2549.      if Encrypt Then
  2550.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion40 OR dbEncrypt)
  2551.      Else
  2552.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion40);
  2553.  {$ENDIF}
  2554. End;
  2555.  
  2556. Procedure TKADaoDatabase.CreateAccessDatabaseEx2(DatabaseName,Language,Password,Version:String;Encrypt:Boolean);
  2557. Var
  2558.  CreateOptions:String;
  2559. Begin
  2560.  CreateOptions:=Language;
  2561.  if Password <> '' Then CreateOptions:=CreateOptions+';PWD='+Password;
  2562.  GoOnline;
  2563.  {$IFDEF DAO35}
  2564.  if Encrypt Then
  2565.     CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30 OR dbEncrypt)
  2566.  Else
  2567.     CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30);
  2568.  {$ENDIF}
  2569.  {$IFDEF DAO36}
  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.  {$IFDEF DYNADAO}
  2582.  if F_DaoVersion='3.5'  Then
  2583.  if Encrypt Then
  2584.     CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30 OR dbEncrypt)
  2585.  Else
  2586.     CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30);
  2587.  //*****************************************************************************
  2588.   if F_DaoVersion='3.6'  Then
  2589.   if Version='30' Then
  2590.      if Encrypt Then
  2591.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30 OR dbEncrypt)
  2592.      Else
  2593.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion30)
  2594.   Else
  2595.      if Encrypt Then
  2596.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion40 OR dbEncrypt)
  2597.      Else
  2598.         CoreWorkspace.CreateDatabase(DatabaseName, CreateOptions, dbVersion40);
  2599.  {$ENDIF}
  2600. End;
  2601.  
  2602. Function TKADaoDatabase.ChangeDatabasePassword(OldPassword,NewPassword:String):Boolean;
  2603. Begin
  2604.   Result := False;
  2605.   if NOT F_Active Then DatabaseError(E1025);
  2606.   if NOt F_Exclusive Then DatabaseError(E1026);
  2607.   Try
  2608.     CoreDatabase.NewPassword(OldPassword,NewPassword);
  2609.   Except
  2610.    Exit;
  2611.   End;
  2612.   Result := True;
  2613. End;
  2614.  
  2615. Function TKADaoDatabase.RegisterDatabase(DatabaseName, DriverName:String; Silent:Boolean; Attributes:String):Boolean;
  2616. Begin
  2617.   Result := False;
  2618.   Try
  2619.     CoreDBEngine.RegisterDatabase(DatabaseName,DriverName,Silent,Attributes);
  2620.   Except
  2621.    Exit;
  2622.   End;
  2623.   Result := True;
  2624. End;
  2625.  
  2626. Procedure TKADaoDatabase.RenameTable(OldTableName,NewTableName:String);
  2627. Begin
  2628.  RefreshDefinitions;
  2629.  CoreDatabase.TableDefs.Item[OldTableName].Name:=NewTableName;
  2630.  RefreshDefinitions;
  2631. End;
  2632.  
  2633. Procedure TKADaoDatabase.DeleteTable(TableName:String);
  2634. Begin
  2635.  RefreshDefinitions;
  2636.  CoreDatabase.TableDefs.Delete(TableName);
  2637.  RefreshDefinitions;
  2638. End;
  2639.  
  2640. //******************************************************************************
  2641. //  1 = Primary index
  2642. //  2 = Unique
  2643. //  4 = NormalIndex
  2644. //******************************************************************************
  2645. Function TKADaoDatabase.HasPrimaryKey(NewTable:OleVariant):Boolean;
  2646. Var
  2647.   X:Integer;
  2648. Begin
  2649.  Result:=False;
  2650.  For X :=0 to NewTable.Indexes.Count-1 do
  2651.      Begin
  2652.        if NewTable.Indexes.Item[X].Primary Then
  2653.           Begin
  2654.             Result:=True;
  2655.             Exit;
  2656.           End;
  2657.      End;
  2658. End;
  2659.  
  2660. Procedure TKADaoDatabase.DeletePrimaryKey(NewTable:OleVariant);
  2661. Var
  2662.   X:Integer;
  2663. Begin
  2664.  For X :=0 to NewTable.Indexes.Count-1 do
  2665.      Begin
  2666.        if NewTable.Indexes.Item[X].Primary Then
  2667.           Begin
  2668.             NewTable.Indexes.Delete(NewTable.Indexes.Item[X].Name);
  2669.             Exit;
  2670.           End;
  2671.      End;
  2672. End;
  2673.  
  2674.  
  2675. Function TKADaoDatabase.CreateIndex(TableName,FieldName:String;IndexType:Integer):Boolean;
  2676. Var
  2677.   NewTable         : OleVariant;
  2678.   NewField         : OleVariant;
  2679.   NewIndex         : OleVariant;
  2680.   PrimIndex        : OleVariant;
  2681.   PrimaryKeyName   : String;
  2682. Begin
  2683.   Result:=False;
  2684.   RefreshDefinitions;
  2685.   Try
  2686.    NewTable  := CoreDatabase.TableDefs.Item[TableName];
  2687.    if Pos('paradox',AnsiLowerCase(F_DatabaseType)) > 0 Then PrimaryKeyName := TableName Else PrimaryKeyName:='PrimaryKey';
  2688.    if ((IndexType And 1) > 0) Then
  2689.       Begin
  2690.         if HasPrimaryKey(NewTable) Then DeletePrimaryKey(NewTable);
  2691.         PrimIndex          := NewTable.CreateIndex(PrimaryKeyName);
  2692.         PrimIndex.Primary  := True;
  2693.         PrimIndex.Unique   := True;
  2694.         NewField           := NewTable.CreateField(FieldName);
  2695.         PrimIndex.Fields.AppEnd(NewField);
  2696.         NewTable.Indexes.AppEnd(PrimIndex);
  2697.         if NOT ((IndexType And 2) > 0) Then IndexType:=IndexType+2;
  2698.       End;
  2699.    if ((IndexType And 2) > 0) or ((IndexType And 4) > 0) Then
  2700.       Begin
  2701.         NewIndex  := NewTable.CreateIndex(FieldName);
  2702.         if ((IndexType And 2) = 0) Then NewIndex.Unique  := False  Else  NewIndex.Unique  := True;
  2703.         NewField := NewTable.CreateField(FieldName);
  2704.         NewIndex.Fields.AppEnd(NewField);
  2705.         NewTable.Indexes.AppEnd(NewIndex);
  2706.       End;
  2707.   Except
  2708.    Exit;
  2709.   End;
  2710.   RefreshDefinitions;
  2711.   Result:=True;
  2712. End;
  2713.  
  2714. Procedure TKADaoDatabase.RenameIndex(TableName,OldIndexName,NewIndexName:String);
  2715. Begin
  2716.   RefreshDefinitions;
  2717.   CoreDatabase.TableDefs.Item[TableName].Indexes.Item[OldIndexName].Name:=NewIndexName;
  2718.   RefreshDefinitions;
  2719. End;
  2720.  
  2721. Procedure TKADaoDatabase.DeleteIndexByName(TableName,IndexName:String);
  2722. Begin
  2723.  RefreshDefinitions;
  2724.  CoreDatabase.TableDefs.Item[TableName].Indexes.Delete(IndexName);
  2725.  RefreshDefinitions;
  2726. End;
  2727.  
  2728. Procedure TKADaoDatabase.DeleteIndexByFieldName(TableName,FieldName:String);
  2729. Var
  2730.  X         : Integer;
  2731.  TmpName   : String;
  2732.  IndexName : String;
  2733.  NotFound  : Boolean;
  2734. Begin
  2735.  RefreshDefinitions;
  2736.  Try
  2737.   Repeat
  2738.    NotFound:=True;
  2739.    CoreDatabase.TableDefs.Refresh;
  2740.    For X:=0 To CoreDatabase.TableDefs.Item[TableName].Indexes.Count-1 do
  2741.        Begin
  2742.          TmpName:=CoreDatabase.TableDefs.Item[TableName].Indexes.Item[X].Fields.Item[0].Name;
  2743.          if TmpName=FieldName Then
  2744.             Begin
  2745.               IndexName:=CoreDatabase.TableDefs.Item[TableName].Indexes.Item[X].Name;
  2746.               DeleteIndexByName(TableName,IndexName);
  2747.               NotFound:=False;
  2748.               Break;
  2749.             End;
  2750.        End;
  2751.   Until NotFound;
  2752.  Except
  2753.  End;
  2754.  RefreshDefinitions;
  2755. End;
  2756.  
  2757. Procedure TKADaoDatabase.DeleteField(TableName,FieldName:String);
  2758. Var
  2759.  X,Y       : Integer;
  2760.  TmpName   : String;
  2761.  IndexName : String;
  2762.  Found     : Boolean;
  2763. Begin
  2764.  RefreshDefinitions;
  2765.  Try
  2766.   Repeat
  2767.    Found:=False;
  2768.    CoreDatabase.TableDefs.Refresh;
  2769.    For X:=0 To CoreDatabase.TableDefs.Item[TableName].Indexes.Count-1 do
  2770.        Begin
  2771.          For Y := 0 To CoreDatabase.TableDefs.Item[TableName].Indexes.Item[X].Fields.Count-1 do
  2772.              Begin
  2773.                TmpName:=CoreDatabase.TableDefs.Item[TableName].Indexes.Item[X].Fields.Item[Y].Name;
  2774.                if AnsiCompareText(TmpName,FieldName)=0 Then
  2775.                   Begin
  2776.                     IndexName:=CoreDatabase.TableDefs.Item[TableName].Indexes.Item[X].Name;
  2777.                     DeleteIndexByName(TableName,IndexName);
  2778.                     Found:=True;
  2779.                     Break;
  2780.                   End;
  2781.              End;
  2782.          if Found Then Break;
  2783.        End;
  2784.   Until NOT Found;
  2785.  Except
  2786.  End;
  2787.  CoreDatabase.TableDefs.Item[TableName].Fields.Delete(FieldName);
  2788.  RefreshDefinitions;
  2789. End;
  2790.  
  2791. Procedure TKADaoDatabase.RenameField(TableName,OldFieldName,NewFieldName:String);
  2792. Begin
  2793.   RefreshDefinitions;
  2794.   CoreDatabase.TableDefs.Item[TableName].Fields.Item[OldFieldName].Name:=NewFieldName;
  2795.   RefreshDefinitions;
  2796. End;
  2797.  
  2798. Function TKADaoDatabase.EmptyTable(TableName:String):Boolean;
  2799. Begin
  2800.   Result:=False;
  2801.   Try
  2802.     CoreDatabase.Execute('DELETE * FROM ['+TableName+'];',0);
  2803.   Except
  2804.     Exit;
  2805.   End;
  2806.   Result:=True;
  2807. End;
  2808.  
  2809. Function TKADaoDatabase.CreateEmptyTable(TableName:String):Boolean;
  2810. Var
  2811.   NewTable : OleVariant;
  2812.   NewField : OleVariant;
  2813. Begin
  2814.  Result:=False;
  2815.  Try
  2816.    NewTable  := OleVariant(CoreDatabase).CreateTableDef(TableName);
  2817.    NewField  := NewTable.CreateField('Temp',DAOApi.dbLong,0);
  2818.    NewTable.Fields.AppEnd(NewField);
  2819.  Except
  2820.    Exit;
  2821.  End;
  2822.  CoreDatabase.TableDefs.AppEnd(IDispatch(TVarData(NewTable).vDispatch));
  2823.  RefreshDefinitions;
  2824.  DeleteField(TableName,'Temp');
  2825.  Result:=True;
  2826. End;
  2827.  
  2828. //******************************************************************************
  2829. //  1 = Primary index
  2830. //  2 = Unique
  2831. //  4 = NormalIndex
  2832. //******************************************************************************
  2833. Function TKADaoDatabase.CreateTable(TableName:String; FieldNames : Variant; FieldTypes : Variant; FieldSizes : Variant; FieldIndexes:Variant; FieldsRequired:Variant):Boolean;
  2834. Var
  2835.   NewTable       : OleVariant;
  2836.   NewField       : OleVariant;
  2837.   NewIndex       : OleVariant;
  2838.   PrimIndex      : OleVariant;
  2839.   Primary        : Boolean;
  2840.   X              : Integer;
  2841.   Count          : Integer;
  2842.   AutoInc        : Boolean;
  2843.   IdxName        : String;
  2844.   PrimaryKeyName : String;
  2845. Begin
  2846.  if (NOT F_Active) Then
  2847.      Begin
  2848.        DatabaseError(E1027);
  2849.        CreateTable:=False;
  2850.        Exit;
  2851.      End;
  2852.  if TableName='' Then
  2853.     Begin
  2854.        DatabaseError(E1028);
  2855.        CreateTable:=False;
  2856.        Exit;
  2857.      End;
  2858.  Primary := False;
  2859.  NewTable:=OleVariant(CoreDatabase).CreateTableDef(TableName);
  2860.  Count:=VarArrayHighBound(FieldTypes,VarArrayDimCount(FieldTypes));
  2861.  if Pos('paradox',AnsiLowerCase(F_DatabaseType)) > 0 Then PrimaryKeyName := TableName Else PrimaryKeyName:='PrimaryKey';
  2862.  For X:=0 to Count do
  2863.      Begin
  2864.       AutoInc:=False;
  2865.       if FieldTypes[X]=dbAutoIncInteger Then
  2866.          Begin
  2867.            FieldTypes[X]:=dbLong;
  2868.            AutoInc:=True;
  2869.          End;
  2870.       NewField  := NewTable.CreateField(FieldNames[X],FieldTypes[X],FieldSizes[X]);
  2871.       NewTable.Fields.AppEnd(NewField);
  2872.       if AutoInc Then NewTable.Fields[FieldNames[X]].Attributes:=dbAutoIncrField;
  2873.       //************************************************************************
  2874.       // First Create Primary Key Indexes
  2875.       //************************************************************************
  2876.       if FieldIndexes[X] > 0 Then
  2877.          Begin
  2878.            if ((FieldIndexes[X] And 1) > 0) Then
  2879.                Begin
  2880.                  if Not Primary Then
  2881.                     Begin
  2882.                        PrimIndex          := NewTable.CreateIndex(PrimaryKeyName);
  2883.                        PrimIndex.Primary  := True;
  2884.                        PrimIndex.Unique   := True;
  2885.                        Primary:=True;
  2886.                     End;
  2887.                  NewField         := NewTable.CreateField(FieldNames[X],FieldTypes[X],FieldSizes[X]);
  2888.                  PrimIndex.Fields.AppEnd(NewField);
  2889.                End
  2890.          End;
  2891.      End;
  2892.  if Primary Then NewTable.Indexes.AppEnd(PrimIndex);
  2893.  //*****************************************************************************
  2894.  // Then create Unique and NonUnique indexes
  2895.  //*****************************************************************************
  2896.  For X:=0 to Count do
  2897.      Begin
  2898.         if (FieldIndexes[X] And 2 > 0) Or (FieldIndexes[X] And 4 > 0) Then
  2899.          Begin
  2900.            IdxName:=FieldNames[X];
  2901.            NewIndex:=NewTable.CreateIndex(IdxName);
  2902.            if ((FieldIndexes[X] And 2) > 0) Then NewIndex.Unique  := True;
  2903.            NewField  := NewTable.CreateField(FieldNames[X],FieldTypes[X],FieldSizes[X]);
  2904.            NewIndex.Fields.AppEnd(NewField);
  2905.            NewTable.Indexes.AppEnd(NewIndex);
  2906.          End;
  2907.      End;
  2908.  CoreDatabase.TableDefs.AppEnd(IDispatch(TVarData(NewTable).vDispatch));
  2909.  //*****************************************************************************
  2910.  // Then mark required fields
  2911.  //*****************************************************************************
  2912.  RefreshDefinitions;
  2913.  For X:=0 to Count do
  2914.      Begin
  2915.        if FieldsRequired[X]=1 Then
  2916.           CoreDatabase.TableDefs.Item[TableName].Fields.Item[FieldNames[X]].Required := True;
  2917.      End;
  2918.  RefreshDefinitions;
  2919.  CreateTable:=True;
  2920. End;
  2921.  
  2922. //******************************************************************************
  2923. //  1 = Primary index
  2924. //  2 = Unique
  2925. //  4 = NormalIndex
  2926. //******************************************************************************
  2927. Function TKADaoDatabase.AddFieldsToTable(TableName:String; FieldNames : Variant; FieldTypes : Variant; FieldSizes : Variant; FieldIndexes:Variant;  FieldsRequired:Variant):Boolean;
  2928. Var
  2929.   NewTable          : OleVariant;
  2930.   NewField          : OleVariant;
  2931.   PrimIndex         : OleVariant;
  2932.   NewIndex          : OleVariant;
  2933.   X                 : Integer;
  2934.   Count             : Integer;
  2935.   Primary           : Boolean;
  2936.   PrimaryKeyName    : String;
  2937.   IdxName           : String;
  2938. Begin
  2939. if (NOT F_Active) Then
  2940.      Begin
  2941.        DatabaseError(E1029);
  2942.        AddFieldsToTable:=False;
  2943.        Exit;
  2944.      End;
  2945.  if TableName='' Then
  2946.     Begin
  2947.        DatabaseError(E1030);
  2948.        AddFieldsToTable:=False;
  2949.        Exit;
  2950.      End;
  2951.  NewTable:=CoreDatabase.TableDefs.Item[TableName];
  2952.  //*****************************************************************************
  2953.  // Delete PrimaryKey if new Primary key is required
  2954.  //*****************************************************************************
  2955.  Primary := False;
  2956.  Count:=VarArrayHighBound(FieldTypes,VarArrayDimCount(FieldTypes));
  2957.  For X:=0 to Count do
  2958.      Begin
  2959.        if ((FieldIndexes[X] And 1) = 1) Then
  2960.           Begin
  2961.            Primary:=True;
  2962.           End;
  2963.      End;
  2964.  if Pos('paradox',AnsiLowerCase(F_DatabaseType)) > 0 Then PrimaryKeyName := TableName Else PrimaryKeyName:='PrimaryKey';
  2965.  if Primary then DeletePrimaryKey(NewTable);
  2966.  //*****************************************************************************
  2967.  Primary := False;
  2968.  For X:=0 to Count do
  2969.      Begin
  2970.       NewField  := NewTable.CreateField(FieldNames[X],FieldTypes[X],FieldSizes[X]);
  2971.       NewTable.Fields.AppEnd(NewField);
  2972.       //************************************************************************
  2973.       // First Create Primary Key Indexes
  2974.       //************************************************************************
  2975.       if FieldIndexes[X] > 0 Then
  2976.          Begin
  2977.            if ((FieldIndexes[X] And 1) = 1) Then
  2978.                Begin
  2979.                  if Not Primary Then
  2980.                     Begin
  2981.                        PrimIndex          := NewTable.CreateIndex(PrimaryKeyName);
  2982.                        PrimIndex.Primary  := True;
  2983.                        PrimIndex.Unique   := True;
  2984.                        Primary:=True;
  2985.                     End;
  2986.                  NewField         := NewTable.CreateField(FieldNames[X],FieldTypes[X],FieldSizes[X]);
  2987.                  PrimIndex.Fields.AppEnd(NewField);
  2988.                End
  2989.          End;
  2990.      End;
  2991.  if Primary Then NewTable.Indexes.AppEnd(PrimIndex);
  2992.  //*****************************************************************************
  2993.  // Then create Unique and NonUnique indexes
  2994.  //*****************************************************************************
  2995.  For X:=0 to Count do
  2996.      Begin
  2997.         if (FieldIndexes[X] And 2 > 0) Or (FieldIndexes[X] And 4 > 0) Then
  2998.          Begin
  2999.            IdxName:=FieldNames[X];
  3000.            NewIndex:=NewTable.CreateIndex(IdxName);
  3001.            if ((FieldIndexes[X] And 2) > 0) Then NewIndex.Unique  := True;
  3002.            NewField  := NewTable.CreateField(FieldNames[X],FieldTypes[X],FieldSizes[X]);
  3003.            NewIndex.Fields.AppEnd(NewField);
  3004.            NewTable.Indexes.AppEnd(NewIndex);
  3005.          End;
  3006.      End;
  3007.  RefreshDefinitions;
  3008.  //*****************************************************************************
  3009.  // Then mark required fields
  3010.  //*****************************************************************************
  3011.  For X:=0 to Count do
  3012.      Begin
  3013.        if FieldsRequired[X]=1 Then
  3014.           CoreDatabase.TableDefs.Item[TableName].Fields.Item[FieldNames[X]].Required := True;
  3015.      End;
  3016.  RefreshDefinitions;
  3017.  AddFieldsToTable:=True;
  3018. End;
  3019.  
  3020. //******************************************************************************
  3021. // See _PredefinedTableTypes in DaoApi for information about TableType
  3022. //******************************************************************************
  3023. Procedure TKADaoDatabase.LinkExternalTable(Database,TableName,TableType:String;TableAttributes:Integer);
  3024. Var
  3025.  NewTable : OleVariant;
  3026.  TDEFName : String;
  3027.  X, L     : Integer;
  3028. Begin
  3029.  TDEFName:=TableName;
  3030.  L := Length(TDEFName);
  3031.  For X := 1 to L do If TDEFName[X]='.' Then TDEFName[X]:='#';
  3032.  NewTable:=OleVariant(CoreDatabase).CreateTableDef(TDEFName);
  3033.  if Pos('%s',TableType) > 0 Then
  3034.     NewTable.Connect         := Format(TableType,[Database])
  3035.  Else
  3036.     NewTable.Connect         := TableType;
  3037.  if TableAttributes <> 0 Then NewTable.Attributes := TableAttributes;
  3038.  NewTable.SourceTableName := TableName;
  3039.  CoreDatabase.TableDefs.AppEnd(IDispatch(TVarData(NewTable).vDispatch));
  3040. End;
  3041.  
  3042. Procedure TKADaoDatabase.LinkExternalTableEx(Database,TableName,TableFileName,TableType:String;TableAttributes:Integer);
  3043. Var
  3044.  NewTable : OleVariant;
  3045. Begin
  3046.  NewTable:=OleVariant(CoreDatabase).CreateTableDef(TableName);
  3047.  if Pos('%s',TableType) > 0 Then
  3048.     NewTable.Connect         := Format(TableType,[Database])
  3049.  Else
  3050.     NewTable.Connect         := TableType;
  3051.  if TableAttributes <> 0 Then NewTable.Attributes := TableAttributes;
  3052.  NewTable.SourceTableName := TableFileName;
  3053.  CoreDatabase.TableDefs.AppEnd(IDispatch(TVarData(NewTable).vDispatch));
  3054. End;
  3055.  
  3056. Procedure TKADaoDatabase.RefreshLink(Database,TableName,TableType:String);
  3057. Var
  3058.  LinkedTable : OleVariant;
  3059. Begin
  3060.  LinkedTable:=OleVariant(CoreDatabase).TableDefs.Item[TableName];
  3061.  if Pos('%s',TableType) > 0 Then
  3062.     LinkedTable.Connect         := Format(TableType,[Database])
  3063.  Else
  3064.     LinkedTable.Connect         := TableType;
  3065.  LinkedTable.RefreshLink;
  3066. End;
  3067.  
  3068. Function TKADaoDatabase.CreateQueryDef(Name:String;SQL:String):Boolean;
  3069. Var
  3070.  {$IFDEF DYNADAO}
  3071.  Query : OleVariant;
  3072.  {$ELSE}                                                      
  3073.  Query : QueryDef;
  3074.  {$ENDIF}
  3075. Begin
  3076.  Query:=CoreDatabase.CreateQueryDef(Name,SQL);
  3077.  RefreshDefinitions;
  3078.  CreateQueryDef:=True;
  3079. End;
  3080.  
  3081. Procedure TKADaoDatabase.ModifyQueryDef(Name:String;SQL:String);
  3082. Begin
  3083.  RefreshDefinitions;
  3084.  CoreDatabase.QueryDefs.Item[Name].SQL:=SQL;
  3085.  RefreshDefinitions;
  3086. End;
  3087.  
  3088. Function TKADaoDatabase.GetQueryDefSQLText(Name:String):String;
  3089. Begin
  3090.  Try
  3091.    Result:=CoreDatabase.QueryDefs.Item[Name].SQL;
  3092.  Except
  3093.    Result:='';
  3094.  End;
  3095. End;
  3096.  
  3097. Procedure TKADaoDatabase.RenameQueryDef(OldQueryName,NewQueryName:String);
  3098. Begin
  3099.  RefreshDefinitions;
  3100.  CoreDatabase.QueryDefs.Item[OldQueryName].Name:=NewQueryName;
  3101.  RefreshDefinitions;
  3102. End;
  3103.  
  3104. Procedure TKADaoDatabase.DeleteQueryDef(QueryName:String);
  3105. Begin
  3106.  RefreshDefinitions;
  3107.  CoreDatabase.QueryDefs.Delete(QueryName);
  3108.  RefreshDefinitions;
  3109. End;
  3110.  
  3111. Function  TKADaoDatabase.F_ChooseDatabase: String;
  3112. var
  3113.    FileName              : String;
  3114.    Filter                : String;
  3115.    Temp                  : String;
  3116.    P                     : Integer;
  3117.    TableType             : String;
  3118.    DSN                   : String;
  3119.    DlgChooseOdbcDatabase : TODBCDialog;
  3120.    DlgChooseDatabase     : TOpenDialog;
  3121. Begin
  3122.   Result := '';
  3123.   If F_DatabaseType='' Then DatabaseError(E1031);
  3124.   If F_DatabaseType='ODBC' Then
  3125.     Begin
  3126.       DSN:=F_Database;
  3127.       F_Get_SystemDSNs(F_SystemDSNs);
  3128.       F_Get_UserDSNs(F_UserDSNs);
  3129.       Application.CreateForm(TODBCDialog,DlgChooseOdbcDatabase);
  3130.       if DlgChooseOdbcDatabase.Execute(F_SystemDSNs,F_UserDSNs,Dsn,F_UseODBCDialog) Then Result := DSN;
  3131.       DlgChooseOdbcDatabase.Free;
  3132.     End
  3133.   Else
  3134.     Begin
  3135.      DlgChooseDatabase := TOpenDialog.Create(Nil);
  3136.      FileName := Database;
  3137.      if FileName = '' then
  3138.         Begin
  3139.            DlgChooseDatabase.FileName   := '';
  3140.            if csDesigning in ComponentState Then
  3141.               DlgChooseDatabase.InitialDir := GetExeDir
  3142.            Else
  3143.               DlgChooseDatabase.InitialDir := GetExeDir;
  3144.         End
  3145.      Else
  3146.         Begin
  3147.            DlgChooseDatabase.FileName   := ExtractFileName(FileName);
  3148.            DlgChooseDatabase.InitialDir := ExtractFileDir(FileName);
  3149.         End;
  3150.      if F_DatabaseType='Access' Then
  3151.         Begin
  3152.          Filter:='Microsoft Access (*.mdb)|*.mdb';
  3153.          Filter:=Filter+'|All files (*.*)|*.*';
  3154.          DlgChooseDatabase.Title:='Choose '+F_DatabaseType+' Database:';
  3155.          DlgChooseDatabase.Options:=[ofPathMustExist,ofFileMustExist,ofHideReadOnly];
  3156.          DlgChooseDatabase.Filter :=Filter;
  3157.          DlgChooseDatabase.DefaultExt:='mdb';
  3158.          if DlgChooseDatabase.Execute then Result := DlgChooseDatabase.FileName;
  3159.         End
  3160.      Else
  3161.         Begin
  3162.          Filter:=F_Get_DBTypeFileExtension(F_DatabaseType);
  3163.          TableType:=F_Get_DBTypeTableType(F_DatabaseType);
  3164.          if TableType='1' Then
  3165.             Begin
  3166.               if SelectDirectory(FileName,[],0) Then Result := FileName;
  3167.             End
  3168.          Else
  3169.             Begin
  3170.              Temp:=Filter;
  3171.              P:=Pos('(',Temp);
  3172.              if P > 0 Then
  3173.                 Begin
  3174.                   Delete(Temp,1,P);
  3175.                   P:=Pos(')',Temp);
  3176.                   if P > 0 Then Temp:=Copy(Temp,1,P-1);
  3177.                   Filter:=Filter+'|'+Temp;
  3178.                 End;
  3179.              Filter:=Filter+'|All files (*.*)|*.*';
  3180.              DlgChooseDatabase.Title:='Choose '+F_DatabaseType+' Database:';
  3181.              DlgChooseDatabase.Options:=[ofFileMustExist,ofPathMustExist,ofHideReadOnly];
  3182.              DlgChooseDatabase.Filter :=Filter;
  3183.              if DlgChooseDatabase.Execute then Result :=DlgChooseDatabase.FileName;
  3184.             End;
  3185.         End;
  3186.       DlgChooseDatabase.Free;
  3187.     End;
  3188. end;
  3189.  
  3190. //******************************************************************************
  3191. // EASY WRAPPER TO CREATE TABLES USING METHODS SIMILAR TO BORLAND'S TTABLE
  3192. //******************************************************************************
  3193.  
  3194. {$IFDEF USEDB}
  3195. Constructor TKADaoTableManager.Create(Database : TKADaoDatabase);
  3196. Begin
  3197.   F_Database       := Database;
  3198.   F_DummyDataset   := TDummyDataset.Create(Nil);
  3199.   IndexDefs        := TIndexDefs.Create(F_DummyDataset);
  3200.   FieldDefs        := TFieldDefs.Create(F_DummyDataset);
  3201.   TableName        := '';
  3202. End;
  3203.  
  3204. Destructor  TKADaoTableManager.Destroy;
  3205. Begin
  3206.   FieldDefs.Free;
  3207.   IndexDefs.Free;
  3208.   F_DummyDataset.Free;
  3209.   Inherited Destroy;
  3210. End;
  3211.  
  3212. Function TKADaoTableManager.CheckStatus:Boolean;
  3213. Begin
  3214.  Result := False;
  3215.  if Not Assigned(F_Database) Then DatabaseError(E1032);
  3216.  if Not (F_Database.Connected) Then DatabaseError(E1025);
  3217.  if TableName='' Then
  3218.     Begin
  3219.       DatabaseError('Missing TableName!');
  3220.       Exit;
  3221.     End;
  3222.  Result := True;
  3223. End;
  3224.  
  3225. Procedure TKADaoTableManager.StringToList(Items: String; List: TStringList);
  3226. var
  3227.   X: Integer;
  3228. begin
  3229.   For X:= 1 To Length(Items) Do If Items[X] = ';' Then Items[X]:= #13;
  3230.   List.Clear;
  3231.   List.Text:=Items;
  3232.   For X:= 0 To List.Count - 1 Do List[X]:= Trim(List[X]);
  3233. end;
  3234.  
  3235. Procedure   TKADaoTableManager.AppendTable;
  3236. Var
  3237.   FN,FT,FS,FI,FR  : Variant;
  3238.   Count           : Integer;
  3239.   X               : Integer;
  3240.   Idx             : Integer;
  3241. Begin
  3242.   if Not CheckStatus Then Exit;
  3243.   Count:=FieldDefs.Count-1;
  3244.   FN:=VarArrayCreate([0, Count], varOleStr);
  3245.   FT:=VarArrayCreate([0, Count], varInteger);
  3246.   FS:=VarArrayCreate([0, Count], varInteger);
  3247.   FI:=VarArrayCreate([0, Count], varInteger);
  3248.   FR:=VarArrayCreate([0, Count], varInteger);
  3249.   For X :=0 To Count Do
  3250.       Begin
  3251.         FN[X]:=FieldDefs.Items[X].Name;
  3252.         FT[X]:=BDEToDao(FieldDefs.Items[X].DataType);
  3253.         FS[X]:=DaoSizeToBDESize(FT[X],FieldDefs.Items[X].Size);
  3254.         if FieldDefs.Items[X].Required Then FR[X]:=1 Else FR[X]:=0;
  3255.         Idx:=0;
  3256.         FI[X]:=Idx;
  3257.       End;
  3258.   F_Database.AddFieldsToTable(TableName,FN,FT,FS,FI,FR);
  3259.   VarClear(FN); FN:=NULL;
  3260.   VarClear(FT); FT:=NULL;
  3261.   VarClear(FS); FS:=NULL;
  3262.   VarClear(FI); FI:=NULL;
  3263.   VarClear(FR); FR:=NULL;
  3264.   CreateIndex(False);
  3265. End;
  3266.  
  3267.  
  3268. Procedure  TKADaoTableManager.CreateIndex(PreservePrimaryKeys:Boolean);
  3269. Var
  3270.   Count           : Integer;
  3271.   NT,NF,FI        : OleVariant;
  3272.   X,Y             : Integer;
  3273.   PrimaryKeyName  : String;
  3274.   Primary         : Boolean;
  3275.   FieldNames      : TStringList;
  3276.   INam            : String;
  3277. Begin
  3278.   Count:=IndexDefs.Count;
  3279.   if Count=0 Then Exit;
  3280.   if Not CheckStatus Then Exit;
  3281.   FieldNames:=TStringList.Create;
  3282.   Try
  3283.    NT := F_Database.CoreDatabase.TableDefs.Item[TableName];
  3284.    Primary:=False;
  3285.    For X :=0 To Count-1 Do
  3286.       Begin
  3287.        if ixPrimary in IndexDefs[X].Options Then
  3288.           Begin
  3289.             Primary := True;
  3290.             PrimaryKeyName:=IndexDefs[X].Name;
  3291.           End;
  3292.       End;
  3293.    if Pos('paradox',AnsiLowerCase(F_Database.F_DatabaseType)) > 0 Then PrimaryKeyName := TableName;
  3294.    if Primary Then
  3295.      Begin
  3296.        if F_Database.HasPrimaryKey(NT) Then F_Database.DeletePrimaryKey(NT);
  3297.        FI:=NT.CreateIndex(PrimaryKeyName);
  3298.        FI.Primary := True;
  3299.        For X :=0 To Count-1 Do
  3300.           Begin
  3301.            if ixPrimary in IndexDefs[X].Options Then
  3302.               Begin
  3303.                  StringToList(IndexDefs[X].Fields,FieldNames);
  3304.                  For Y := 0 To FieldNames.Count-1 do
  3305.                      Begin
  3306.                        NF:=FI.CreateField(FieldNames.Strings[Y]);
  3307.                        FI.Fields.AppEnd(NF);
  3308.                      End;
  3309.               End;
  3310.           End;
  3311.        NT.Indexes.AppEnd(FI);
  3312.      End;
  3313.    For X :=0 To Count-1 Do
  3314.       Begin
  3315.        if (IndexDefs[X].Options=[])
  3316.        or (IndexDefs[X].Options=[ixPrimary,ixUnique])
  3317.        or (IndexDefs[X].Options=[ixUnique])Then
  3318.           Begin
  3319.            StringToList(IndexDefs[X].Fields,FieldNames);
  3320.            if IndexDefs[X].Name='' Then
  3321.               INam:= FieldNames.Strings[0]
  3322.            Else
  3323.               INam:=IndexDefs[X].Name;
  3324.            if (AnsiCompareText(INam,PrimaryKeyName)=0) And (Primary) Then
  3325.                Begin
  3326.                  //******************* Don't Create again PRIMARY KEY
  3327.                End
  3328.            Else
  3329.                Begin
  3330.                 FI:=NT.CreateIndex(INam);
  3331.                 if ixUnique in IndexDefs[X].Options Then FI.Unique := True;
  3332.                 For Y := 0 To FieldNames.Count-1 do
  3333.                     Begin
  3334.                       NF:=FI.CreateField(FieldNames.Strings[Y]);
  3335.                       FI.Fields.AppEnd(NF);
  3336.                     End;
  3337.                 NT.Indexes.AppEnd(FI);
  3338.                End;
  3339.           End;
  3340.       End;
  3341.    F_Database.RefreshDefinitions;
  3342.   Finally
  3343.     FieldNames.Free;
  3344.   End;
  3345. End;
  3346.  
  3347. Procedure   TKADaoTableManager.CreateTable;
  3348. Var
  3349.   FN,FT,FS,FI,FR  : Variant;
  3350.   Count           : Integer;
  3351.   X               : Integer;
  3352.   Idx             : Integer;
  3353. Begin
  3354.   if Not CheckStatus Then Exit;
  3355.   Count:=FieldDefs.Count-1;
  3356.   FN:=VarArrayCreate([0, Count], varOleStr);
  3357.   FT:=VarArrayCreate([0, Count], varInteger);
  3358.   FS:=VarArrayCreate([0, Count], varInteger);
  3359.   FI:=VarArrayCreate([0, Count], varInteger);
  3360.   FR:=VarArrayCreate([0, Count], varInteger);
  3361.   For X :=0 To Count Do
  3362.       Begin
  3363.         FN[X]:=FieldDefs.Items[X].Name;
  3364.         FT[X]:=BDEToDao(FieldDefs.Items[X].DataType);
  3365.         FS[X]:=DaoSizeToBDESize(FT[X],FieldDefs.Items[X].Size);
  3366.         if FieldDefs.Items[X].Required Then FR[X]:=1 Else FR[X]:=0;
  3367.         Idx:=0;
  3368.         FI[X]:=Idx;
  3369.       End;
  3370.   F_Database.CreateTable(TableName,FN,FT,FS,FI,FR);
  3371.   VarClear(FN); FN:=NULL;
  3372.   VarClear(FT); FT:=NULL;
  3373.   VarClear(FS); FS:=NULL;
  3374.   VarClear(FI); FI:=NULL;
  3375.   VarClear(FR); FR:=NULL;
  3376.   CreateIndex(False);
  3377. End;
  3378. {$ENDIF}
  3379. //******************************************************************************
  3380. procedure Register;
  3381. Begin
  3382.   RegisterComponents('KA Dao', [TKADaoDatabase]);
  3383. End;
  3384.  
  3385. Initialization
  3386.  {$IFNDEF D5UP}
  3387.   TVarData(Unassigned).VType := varEmpty;
  3388.   TVarData(EmptyParam).VType := varError;
  3389.   TVarData(EmptyParam).VError := $80020004;
  3390.  {$ENDIF}
  3391. End.
  3392.  
  3393.  
  3394.