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