home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kompon / d3456 / KADAO72.ZIP / KDaoTable.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-03-18  |  317.7 KB  |  9,189 lines
  1. unit KDaoTable;
  2. {$B-}
  3. //******************************************************************************
  4. //                         Delphi Dao Project
  5. //                 Copyright (c) 2000-2001 by Kiril Antonov
  6. //******************************************************************************
  7. {$DEFINE USEPARAMS}           //  Active only in Delphi 5
  8. {$I KADaoCommonDirectives.pas}
  9. //******************************* CHANGES ************************************** 
  10. // 28.05.2000 - Fixed a minor bug which raises exception when
  11. //              getting GetQueryDefSQLText
  12. // 28.05.2000 - Added FieldChanged TList - each item corresponds to a field                        
  13. //              in the record
  14. //              If  Boolean(FieldChanged[X]) is true then when posting data this
  15. //              field is updated
  16. //              This prevents from writing bak entire record to the database -
  17. //              only changed fields are posted.
  18. // 28.05.2000 - Added new property editor for SortedBy property which allows an                         
  19. //              easy method to define sort order of a Table/Query
  20. //              A new property SortedByText gives low level access to the
  21. //              SortedBy property
  22. // 28.05.2000 - Added new property editor for QueryDefParameters property which                        
  23. //              allows an easy method to enter parameters to QUERYDEF dao object
  24. //              A new property QueryDefParametersText gives low level access to
  25. //              the QueryDefParameters property
  26. // 30.05.2000 - Fixed a bug in GetRecNo which gives some troubles with DBGrids
  27. //
  28. // 31.05.2000 - Changed InternalSetToRecord method to speedup positioning inside
  29. //              a table
  30. //
  31. // 01.06.2000 - Created Master/Detail Relationship support with property editor
  32. //              similar to Delphi
  33. //              A few new properties are anounced:
  34. //                - MasterSource : TDataSource; - DataSource of the Master Table
  35. //                - MasterFields : TStrings;    - A StringList with
  36. //                  relationships in the form: "DetailField -> MasterField"
  37. // 04.06.2000 - Handled default values for fields
  38. //
  39. // 07.06.2000 - Handled empty fields (WITH NOT REQUITRED VALUE)
  40. //              when posting new records to database
  41. //
  42. // 08.06.2000 - Added support for Dynamycally setting DAO Version
  43. //
  44. // 11.06.2000 - Filter is working properly now
  45. //
  46. // 11.06.2000 - Added FULL support for Master/Detail (Table and Query)
  47. //
  48. // 11.06.2000 - Changed many options for Bookmarks
  49. //              to support Dynamic DAO (OleVariant)
  50. //
  51. // 11.06.2000 - Added support for Locate
  52. //
  53. // 11.06.2000 - Added support for Lookup
  54. //
  55. // 12.06.2000 - InternalGotoBookmark rewrited completely
  56. //
  57. // 12.06.2000 - Locate supports TLocateOptions now
  58. //
  59. // 12.06.2000 - Added four new methods:
  60. //              CreateField
  61. //              CreateIndex
  62. //              DeleteField
  63. //              DeleteIndex
  64. //
  65. // 14.06.2000 - Property Editors for Tables, QueryDefs and Indexes use
  66. //              RefreshDefinitions to reflect changes made outside Delphi
  67. //
  68. // 18.06.2000 - Added another method of Locate whish is very fast but works only
  69. //              if Table supports bookmarks
  70. //
  71. // 18.06.2000 - Added GetIndexNames method for Compatibility with TTable
  72. //
  73. // 18.06.2000 - Added FOUR New methods for fast search in a table:
  74. //                Find_First
  75. //                Find_Last
  76. //                Find_Next
  77. //                Find_Prior
  78. //              These new methods are similar to TTable but can search on
  79. //              NON-INDEXED fields
  80. //              Call them as calling Locate method
  81. // 19.06.2000 - Two new method where added  Find_Nearest and Find_NearestEx
  82. //              Call Find_NearestEx as calling a Locate method
  83. //              For Find_Nearest you must first call SetKeyFields method with a
  84. //              semicolon separated Field names and then Call Find_Nearest
  85. //              See the new demos on KADao site for full explanation
  86. // 19.06.2000 - Added new method Seek_Nearest
  87. //              Seek_Nearest works as Dao Seek method so you must set the index
  88. //              in which you want to search
  89. //              See the new demos on KADao site for full explanation
  90. //
  91. // 19.06.2000 - Fixed a minor bug with empty tables
  92. //
  93. // 19.06.2000 - Added support for OnFilterRecord event
  94. //              GetRecordCount And GetRecNo now works as standard specifications
  95. //              require
  96. //
  97. // 27.06.2000 - Added CompareBookmarks method - now multiselect in DBGrid
  98. //              works fine
  99. //
  100. // 28.06.2000 - Added GetFieldNames - it receives as a parameter TStringList
  101. //              and fills them with Names of the fields
  102. //              Each Name has a corresponding TObject wich is an integer
  103. //              describing a Field original DAO type (Not BDE type)
  104. //
  105. // 28.06.2000 - Added QueryDefODBCMaxRecords (works only on ODBC data sources)
  106. //              to limit number of returned records
  107. //              Setting to 0 means NO LIMIT
  108. //
  109. // 28.06.2000 - Added QueryDefType property - it returns a QueryDef Type
  110. //              as a string. Original DAO value is stored in QueryDefTypeInt
  111. //
  112. // 28.06.2000 - Added RecordsAffected variable
  113. //              When using  ExecSQL it teturns then number of affected records
  114. //              and also sets RecordsAffected to the same value.
  115. //
  116. // 28.06.2000 - Added Requery method which is useful for refreshing dynaset
  117. //              tables
  118. //
  119. // 28.06.2000 - Added Seek_NearestEx method
  120. //              An additional parameter is SeekType (String) which can be one of
  121. //              the following: '<', '<=', '=', '>=', '>'
  122. //
  123. // 28.06.2000 - Added SetRecNo internal dataset method (still in beta testing)
  124. //
  125. // 28.06.2000 - Added two new variables BlobOffset and BlobNumBytes
  126. //              Whend one of this variables is different then zero
  127. //              reading from a blob field starts from BlobOffset position
  128. //              and the return information is BlobNumBytes in size
  129. //              When BlobNumBytes is > of entire blob size a smaller amount
  130. //              of bytes is returned (realized using DAO GetChunk method)
  131. //              Warninng! This is blob wide i.e. all blobs are affected
  132. //              So you must set them to Zero each time when the another blob
  133. //              which must be read at all is readed from the record
  134. //
  135. // 28.06.2000 - Added two new read only properties TableDateCreated and
  136. //              TableLastUpdated - works only on standart tables and QueryDefs
  137. //
  138. // 28.06.2000 - Added a new meton AppendToBlob - uses DAO AppendChunk method
  139. //
  140. // 29.06.2000 - Added a new variable QueryDefReturnParams of type OleVariant
  141. //              It contains a results from a QueryDefRecordset
  142. //              If result is only one QueryDefReturnParams is a single variant
  143. //              otherwise QueryDefReturnParams is VarArray
  144. //
  145. // 29.06.2000 - AT LAST FIXED PROBLEM WITH EMPTY RECORDESTS - GREAT VICTORY!!!!
  146. //
  147. // 29.06.2000 - Removed SetRecNo internal dataset method (not yet understand)
  148. //
  149. //
  150. // 03.07.2000 - Added new property UseRecordCount
  151. //              Since DBGrid uses RecordCount Very extensivelly which can
  152. //              slowdown database performance you can turn it off by setting
  153. //              UseRecordCount
  154. //
  155. // 04.07.2000 - AT LAST FIXED PROBLEM WITH RETRIEVING ACTUAL TYPE OF
  156. //              dbDate FIELD TYPE - NOW YOU CAN USE dbTime AND dbTimeStamp !!!
  157. //
  158. // 05.07.2000 - Fixed a very rediculous bug with RETRIEVING ACTUAL TYPE OF
  159. //              dbDate FIELD. Now a ftDateTime is the default type
  160. //              But if you set Format property in MS Acess a dbDate and dbTime
  161. //              also is used!
  162. // 05.07.2000 - Added additional code to DateTimeToBuffer and TimeToBuffer
  163. //              routines to support both method of retrieving Date/Time info
  164. //
  165. // 05.07.2000 - Added support for Forward Only Tables - Works Good but
  166. //              DBGrid violates forward only restrictions so use with care
  167. //              A more complicated changes will be made in future to avoid these
  168. //
  169. // 17.07.2000 - Fixed a bug which does not free allocated resources in Append
  170. //              With many thanks to Andrew Baylis for reporting the problem
  171. //
  172. // 19.07.2000 - Added new property UseBrackets - True by default
  173. //              It places Field names in squire brackets "[ ]" when using
  174. //              Locate, Lookup, and Master/Detail
  175. //              Since squire brackets are MS Access specific turn this property
  176. //              to FALSE when using other databases than MDB
  177. //
  178. // 19.07.2000 - Added support for working with part of all fields
  179. //              I.E Field Designer is supported now
  180. //              Not copletely tested but working
  181. //
  182. // 21.07.2000 - Added few new Exec Functions
  183. //                - ExecuteSQL - Executes SQL stored in SQL Property
  184. //                - ExecuteQueryDefSQL - Executes SQL stored selected
  185. //                  by QueryDefName QueryDef
  186. //
  187. // 21.07.2000 - Added Property LockEdits for Locking Recods at runtime
  188. //              Immediatly after you call Edit metod locking is activa
  189. //
  190. // 24.07.2000 - Added new method for Locating data
  191. //              If table type is dbOpenTable and IndexName <> ''
  192. //              then locate tryes to use selected index when searching
  193. //              otherwise a standard search is executed
  194. //
  195. // 30.07.2000 - Added new property SQLExecutionType for use when executing SQL
  196. //              by default it is DaoApi.dbFailOnError but you may use andother
  197. //              constants like DaoApi.dbSQLPassThrough
  198. //              (With many thanks to to Baldemaier Florian for this)
  199. //
  200. // 31.07.2000 - Fixed ALL problems with ACCESS Date and Time conversion
  201. //              All Borland types i.e ftDate, ftDateTime and ftTime can be used
  202. //              now. The magic number is 693594. Do you know why? I know!
  203. //
  204. // 31.07.2000 - Added new method for Find_First, Find_Next Etc..
  205. //              if somebody encounter problems please report ...
  206. //
  207. // 04.08.20000 - A specific change made to Locate
  208. //               her must be written a some special notes to use locate with
  209. //               an index
  210. //               Microsoft has made strange things with its Seek method
  211. //               So to work with indexes you must create index containing ALL
  212. //               fields you willlocate on and no EXTRA fields in this index
  213. //               Otherwise Locate will use non index based method
  214. //               And Microsoft's limitation is 13 fileds maximum (0..12)
  215. //               Have a nice locating! :-)
  216. //               P.S If somebody encounter problems please report ...
  217. //
  218. // 14.08.2000  - The TKBlobStream.Truncate Procedure was rewritten becouse
  219. //               it does not clear Blob fields proprly - lets say it was doing
  220. //               NOTHING. Now it works fine
  221. //               With many thanks to Andrew Baylis for reporting the problem
  222. //
  223. //
  224. // 14.08.2000  - Changed SetFieldData so Field.Clear to work
  225. //               With many thanks to Andrew Baylis for reporting the problem
  226. //
  227. // 15.08.2000  - Added some features to speedup adding new records
  228. //               Now a new system var F_UpdatableFields of type tlist
  229. //               presents all records that can be updated
  230. //               if Boolean(F_UpdatableFields.Items[xxx]) then field can
  231. //               be changed
  232. //               Also a Resync[] in Internal Post is blocked
  233. //               P.S If somebody encounter problems please report ...
  234. // 18.02.2000  - Added a fix to SortedbyDialogEditor to use brackets
  235. //               With many thanks to Baldemaier Florian for reporting problem
  236. //
  237. // 22.08.2000  - Fixed a bug with setting LockEdits property on tables which
  238. //               does not support Locking
  239. //               With many thanks to Dave Zangger for reporting problem
  240. //
  241. // 28.08.2000  - Fixed a bug with generating SQL for Lookup, Locate etc
  242. //               a ftSmallInt and ftWord was missing. Now included
  243. //               Thanls to Analisis y Estudios Financieros for reporting problem
  244. //
  245. // 29.08.2000  - Added some code for QueryDefTimeOut and ODBCTimeOut
  246. //
  247. // 31.08.2000  - Added IsEmpy Checking for Locate, Lookup and Find methods
  248. //               With many thanks to Jiri Kanda for reporting problem
  249. //
  250. // 07.09.2000 - GetRecNo now retuns a 1 based value not a zero bazed
  251. //              Most of TDatasets do so - also this helps on dbGrids
  252. //              Thanls to Jiri Kanda again
  253. //
  254. // 08.09.2000 - Fixed a bug in F_Set_Filtered method thanks to Oliver HΣger
  255. //
  256. // 21.09.2000 - Fixed a strange DAO bug in QueryDefs when concatenating
  257. //              dbText fields. Dao returns ZERO for the result field length.
  258. //              Now this situation is handled - result size is 255!
  259. //              Thanls to Tom Peiffer for reporting problem
  260. //
  261. // 21.09.2000 - Added GotoCurrent Method - same as TTable.GotoCurrent
  262. //
  263. // 01.10.2000 - Fixed a VERY BIG bug with RecordLocking.
  264. //              My apologese to everybody that report problems with
  265. //              record locking. But Borland nas NO Documentation about
  266. //              internal TDataset routines. Now all is OK
  267. //
  268. // 01.10.2000 - Fixed a bug with ExecuteQueryDefSQL - it does not handle
  269. //              QueryDefParameters but now they are supported
  270. //              Thanls to Jiri Kanda for reporting the problem
  271. //
  272. // 01.10.2000 - Fixed a bug with Requery - it does not handle
  273. //              QueryDefParameters but now they are supported
  274. //
  275. // 01.10.2000 - Added support for ftAutoInc
  276. //
  277. // 01.10.2000 - Added two new Functions
  278. //                  - GetSourceTableName
  279. //                  - GetSourceFieldName
  280. //              They are very usual to find source TableName and FieldName when
  281. //              using a result from join query and want to find which is the
  282. //              origin of the field in join table
  283. //
  284. // 01.10.2000 - Added support for BookmarkValid Function
  285. //              Note that after calling BookmarkValid current record is cahnged
  286. //              to those pointed by passed TBookmark to BookmarkValid
  287. //
  288. // 01.10.2000 - Added New Function PercentPosition to get info from DAO method
  289. //              PercentPosition. See DAO help for details
  290. //
  291. // 01.10.2000 - Added New Function GetRows(NumRows:Integer):OleVariant
  292. //              This Function returns Two dimaensional variant array
  293. //              with NumRows number of records and all fields.
  294. //              This is a interface to DAO Method GetRows - see DAO help
  295. //              Function positions current record at the next unread record.
  296. //
  297. // 02.10.2000  - Added Support for Parametrized queryes (stored in SQL property)
  298. //               Unfortenatelly this does not work with Delphi 3.0
  299. //               Also it is not tested with Delphi 4.0
  300. //               If you encounter problems during compilation please UNDEFINE
  301. //               USEPARAMS at the begining of this file.
  302. //               Thanks to Andrew Baylis for all this.
  303. //               Any help how to implement this on Delphi 3.0 will be
  304. //               greatly appreciated.
  305. //
  306. // 02.10.2000  - Dramatically Increased speed of the following methods
  307. //                Find_First
  308. //                Find_Last
  309. //                Find_Next
  310. //                Find_Prior
  311. //
  312. // 02.10.2000  - Added changes for Bookmark (previously TSafeArray, now
  313. //               OleVariant (it is Interesting that in fact bookmarks are
  314. //               OleStrings;
  315. //
  316. // 02.10.2000  - Speed of Bookmark operations is Dramatically Increased
  317. //
  318. // 10.10.2000  - Fixed a bug in ExecSQL,ExecutSQL,ExecuteQueryDefSQL
  319. //               Thanls to D. Gene Bland for reporting the problem
  320. //
  321. // 11.10.2000  - Fixed a bug in BuildXXXSQL routines
  322. //               They now support ftAutoInc Field
  323. //               Thanls to Paul Weaver for reporting the problem
  324. //
  325. // 13.10.2000  - Fixed another bug in BuildXXXSQL routines
  326. //               Thanls to Manfred Zieglmeier for reporting the problem
  327. //
  328. // 13.10.2000  - Fixed a bug with OnPostError Event
  329. //               Now OnPostError is supported
  330. //               Thanls to Henry Martin for reporting the problem
  331. //
  332. // 17.10.2000  - Added eight new routines for some compatibility with TTable
  333. //               See explanation in KADao Help docs.
  334. //
  335. //               Procedure FindNearest
  336. //               Function  FindKey
  337. //               Property  IndexFieldCount
  338. //               Property  IndexFields
  339. //               Procedure SetFindData
  340. //               Procedure SetKey
  341. //               Function  GotoKey
  342. //               Procedure LockTable
  343. //               Procedure UnlockTable
  344. //               Property  IndexFieldNames
  345. //
  346. //******************************************************************************
  347. //
  348. // 25.10.2000  - Found a bug in Rollback method-table rasies 'No current record'
  349. //               after rollback - now fixed thanks to Sergey
  350. //
  351. // 26.10.2000  - Twice increased the speed of reading and writing records
  352. //               Before reconstruction KADao adds 1000 records for about 7 sec
  353. //               Now for 3.3 seconds
  354. //
  355. // 30.10.2000   - Found a bug in default values processing - now fixed thanks to
  356. //                Eric BACHMANN
  357. //
  358. // 31.10.2000   - Removed FieldChanged TList - now information about changed
  359. //                fields is stored in RecordData TStringList as objects
  360. //
  361. // 01.11.2000   - Dramaticaly is increased speed of Master/Detail relations
  362. //                /EXPERIMENTAL/
  363. //
  364. // 02.11.2000   - Added Function PromptQueryDefParameters - it brings
  365. //                same dialog as QueryDefParameters editor in design time.
  366. //                Thanks to Jorge Dantas
  367. //
  368. //******************************************************************************
  369. //
  370. // 06.11.2000 - Removed BlobOffset and BlobNumBytes variables for safety reasons
  371. //              Removed method AppendToBlob for safety reasons
  372. //
  373. // 06.11.2000 - Found a VERY BIG bug in KADaoBlob handling
  374. //              Bug affects only BINARY BLOBS and NOT Memos
  375. //              It is reccomended before upgrade to this version of KADao
  376. //              to save all your binary blobs (created with KADAO) to files
  377. //              The proble is that Delphi coverts String to WideChar before
  378. //              sending data to DAO so in MDB files blobs have size twice
  379. //              bigger then normal. Thanks to Albert Molina for reporting.
  380. //
  381. // 12.11.2000 - Fixed a bug in DataEvent Procedure
  382. //              Now fixed - thanks to Gianluca D'Angelo
  383. //
  384. // 12.11.2000 - Fixed a bug in InternalGotoBookmark and SetBookmarkString
  385. //              Bug is present when trying to delete multiple records
  386. //
  387. // 14.11.2000 - Added some code to speedup opening readonly tables and queryes
  388. //              Thanks to Simone.
  389. //
  390. // 14.11.2000 - Added handling of Required in InternalInitFieldDefs
  391. //
  392. // 14.11.2000 - Added AGAIN SetRecNo internal dataset method
  393. //              Now works as expected - you can use KADaoTable1.RecNo:=10 and
  394. //              cursor will position at RecordNO 10 (counting is NOT ZERO based)
  395. //
  396. // 15.11.2000 - Preprocessor defintion USESLOWRECORDCOUNT is removed
  397. //              Now KADao ALWAYS handle possible RecordCount bugs in DAO
  398. //
  399. //******************************************************************************
  400. //
  401. // 22.11.2000 - Removed a Bug wich does not allow using Databases in other Forms
  402. //              or DataModules - Thanks to Josimar Serhid.
  403. //
  404. // 22.11.2000 - Added some code to speedup opening readonly tables and queryes
  405. //              in InternalInitFieldDefs. Thanks to Simone.
  406. //s
  407. // 27.11.2000 - Added some code to enhance ftBoolean fields
  408. //
  409. // 27.11.2000 - Added new property WarnOnBadDatabase - True by default
  410. //              When KADaoTable finds a corrupted database (bad RecordCount)
  411. //              and WarnOnBadDatabase is True then an exeption is raised to
  412. //              inform that database needs COMPACT and REPAIR
  413. //******************************************************************************
  414. //
  415. // 04.12.2000 - Restored positioning method in Find_XXX methods
  416. //              This is the slow method but is not based on Bookmark calculation
  417. //
  418. // 05.12.2000 - Removed rediculous bug in BooleanToBuffer -
  419. //              thanks to Sergey Polevikov
  420. //
  421. // 05.12.2000 - Fixed a bug in Master/Detail fast opening recordset system
  422. //              Now works fine. Thanks to Ingmar Bode for reporting the problem
  423. //
  424. // 05.12.2000 - Fixed a bug in Locate/Find_XXX/Seek_XXX routines which occurs on
  425. //              special conditions. Also removed handling of DataEvent internal.
  426. //              Thanks to Sergey Polevikov for reporting the problem
  427. //
  428. // 05.12.2000  - All Error messages are moved to resourcestring so you can
  429. //               localize your KADAO.
  430. //               Errors between 1000 and 1999 are rezerved for KADaoDatabase
  431. //               Errors between 2000 and 2999 are rezerved for KADaoTable
  432. //                                                                                                
  433. // 07.12.2000  - Master/Detail Routines are COMPLETELY rewritten
  434. //               Also if Detail is a parametrized Query all query parameters
  435. //               that have Names equal with Detail fields will get data from
  436. //               Master. Thanks to Dusko Vuksanovic - he was right!  
  437. //
  438. // 07.12.2000  - InternalGotoBookmark and BookmarkValid are changed reflecting
  439. //               new information about this internal dataset routines.
  440. //               Why Borland does not publisg tech info about this!?
  441. //
  442. // 07.12.2000  - Change made to CompareBookmarks method
  443. //               Some custom DataGrids like InfoPower TwwDBGrid sends
  444. //               PIntegers instead of BookmarkStrings
  445. //
  446. // 08.12.2000  - Fixed a bug in GetRecordCount - it retunts 1 instead of 0
  447. //               whel last record is deleted - thanks to Mark Hamilton.
  448. //
  449. // 08.12.2000  - Added new property MasterAutoActivate - True by default
  450. //               When this property is True if a Detail dataset is set to active
  451. //               and the corresponding Master dataset is not active then
  452. //               Detail dataset activates the Master. 
  453. //******************************************************************************
  454. //
  455. // 11.12.2000  - Added minor change to BufferToDate routine
  456. //
  457. // 17.12.2000  - Requery now supports Master/Detail Relations
  458. //
  459. // 18.12.2000  - Added SaveToStream, SaveToFile,
  460. //               LoadFromStream and LoadFromFile methods.
  461. //               The Stream and File formats are compatible with kbmMemTable
  462. //               created by Kim Bo Madsen - Scandinavia - kbm@optical.dk,
  463. //               which is the best MemoryTable i have seen.
  464. //               Only Data fields are stored. Blobs are stored too.
  465. //               Use LoadFromBinaryFile and LoadFromBinaryStream methodts
  466. //               of kbmMemTable to Load Datasets saved from KADaoTable.
  467. //               Using this two methods you can move your data to other
  468. //               Database platforms away from your office.
  469. //
  470. // 18.12.2000  - Added support for TField.DisplayText wich is equivalent
  471. //               to Caption Property in Access
  472. //
  473. // 20.12.2000  - Added support for TField.OldValue.
  474. //               TField.CurValue and TField.NewValue always return the
  475. //               NEW value of the field.
  476. //
  477. // 20.12.2000  - Added FULL SUPPORT  for the following Methods:
  478. //                 - SetKey
  479. //                 - EditKey
  480. //                 - CancelKey
  481. //                 - GotoKey
  482. //                 - GotoNearest
  483. //               They work now as TTable methods.
  484. //               The old SetKey Method is renamed to SetKeyParam.
  485. //               See explanation of the methods in  the help file.
  486. //
  487. // 22.12.2000 - Fixed a bug in Seek_NearestEx - many thanks to Mark Hamilton
  488. //
  489. // 26.12.2000 - Added support for TField.OnValidate Event
  490. //
  491.  
  492. // 26.12.2000 - Added FULL SUPPORT  for the following Methods:
  493. //                - SetRange
  494. //                - SetRangeStart
  495. //                - SetRangeEnd
  496. //                - EditRangeStart
  497. //                - EditRangeEnd
  498. //                - ApplyRange
  499. //                - CancelRange
  500. //               They work exactly as TTable methods.
  501. //               See explanation of the methods in  the help file.
  502. //
  503. // 26.12.2000 - Added new propery UseGetRecNo - True by Default
  504. //              Set to False on BIG Datasets wit Applyed Ranges
  505. //              or Filtered Datasets based on OnFilterRecord event
  506. //              This will speedup Table IO at 300%
  507. //
  508. // 26.12.2000 - Fixed a bug in Filtering (when Filtered is false but
  509. //              OnFilterRecord is Assigned the Filtering is done which is not OK
  510. //              Now works as expected
  511. //
  512. // 02.01.2001 - Added SUPERSPEED record positioning for recordsets that support
  513. //              Bookmarks
  514. //
  515. // 02.01.2001 - Fixed a bug in InternalSetDisplayLabels - conflict with Table
  516. //              Editor;
  517. //
  518. // 03.01.2001 - Added new property ProcessMessages - True by default
  519. //              It is used to control processing of windows messages wnen
  520. //              Saving And Loading data to/from File/Stream
  521. //
  522. // 03.01.2001 - Implemented COM cashing which speeds DRAMATICALY KADao I/O
  523. //              Now KADao Adds 1000 records to empty table for 2 Seconds!
  524. //
  525. // 03.01.2001 - Changed the way on which Rollback works
  526. //              Now after Rollback Table's Current record is the first record.
  527. //
  528. // 03.01.2001 - Added new Event OnExportProgress(Current,Total:Integer);
  529. //              The event is triggered each time a new records is SAVED to
  530. //              File or Stream. Current is zero based position
  531. //              Total is nuber of records in the table -1
  532. //
  533. // 03.01.2001 - Added Support for Default values for String, Memos, Date/Time
  534. //              fields. Note that function based defaults are NOT Supported
  535. //              since they are not DAO based!
  536. //
  537. // 03.01.2001 - Added Handling of situation when user edits a record
  538. //              already deleted by another user.
  539. //
  540. //******************************************************************************
  541. //
  542. // 03.01.2001 - Added support for Default values on Master/Detail relationship
  543. //              Thanks to Jiri Kanda for reporting the problem
  544. //
  545. //
  546. // 07.01.2001 - Removed ULTRAFAST positioning based on Bookmarks
  547. //              it gives ERRORS in too many cases (WHY Microsoft WHY?)
  548. //              Added WORKAROUND CODE to support viewing of BLOB fields
  549. //              in enchanced DBGrids like InfoPower's wwDBGrid
  550. //              This code is workaround becouse viewing of blobs
  551. //              moves DAO cursor on records other than editing record and
  552. //              this cancells editing internally. This results
  553. //              "Update or CancelUpdate without AddNew or Edit" ERROR
  554. //              to be raised when Post/Cancel is called
  555. //              Thanks to Andrew Baylis and Jiri Kanda for reporting the problem
  556. //
  557. //
  558. // 07.01.2001 - Added changes for speedup InternalSetDisplayLabels
  559. //              This is the most then can be do for this routine
  560. //              Sorry but DAO is really too slow on Queryes when
  561. //              retrieving such properties
  562. //
  563. //******************************************************************************
  564. //
  565. // 08.01.2001 - Added propertiy UseCaptions - False by Default
  566. //              Quering some field properties is extremely slow with MS Dao
  567. //              This property controls DisplayLabels of Fileds which is equal
  568. //              to MS Access Caption property
  569. //              When set to True DisplayLabels are retrieved from the
  570. //              Caption property orhervise DisplayLabels are set to Field names
  571. //
  572. // 08.01.2001 - Added property UseDaoProperties -True by Default
  573. //              Quering some field properties is extremely slow with MS Dao
  574. //              This property controls some Fileds properties
  575. //              which can make easy adding new records
  576. //              When set to False, Default Values are not shown when adding new records
  577. //              Also Required property is not set on the fields that are required
  578. //              Also you can modify fields that cannot be modified
  579. //              (this will raise exception on Post)
  580. //              Setting this property to False will increase speed
  581. //              of opening Queries about 10000% but You must do coding carefully
  582. //
  583. // 10.01.2000 - Found A bug in SetBookmarkStr - it appears when deleting couple
  584. //              of records trough multiselection in DBGrid
  585. //              Thanls to Alfredo Milani-Comparetti for bugreport
  586. //
  587. // 12.01.2000 - All KADao Routines for positioning are REWRITED due to
  588. //              special considerations with Indexes.
  589. //
  590. // 13.01.2000 - Fixed a small bug in InternalSetDisplayLabels.
  591. //              Thanks to Jiri Kanda for bugfix.
  592. //
  593. // 14.01.2000 - Added Enchancemet which FANTASTICALLY SPEEDSUP adding records to
  594. //              table. Now Append and Insert work at 500% faster.
  595. //              The only need is to set the NEW property BatchMode to True
  596. //              before adding recodrs and to False after that.
  597. //
  598. // 14.01.2000 - Now Default values are suported in Filtered and Sorted Tables
  599. //
  600. // 15.01.2000 - EmptyTable now is 500% faster.
  601. //
  602. // 15.01.2000 - GotoKey now Support StandardTable too
  603. //
  604. // 16.01.2000 - Fixed a bug in Bookmark Handling - with many thanks to
  605. //              Mark Hamilton.
  606. //
  607. // 16.01.2000 - A little much more code added for handling
  608. //              default fields in blobs
  609. //
  610. // 22.01.2000 - Added minor changes in LoadFromSream for compatibility with
  611. //              KBMMemTable - new Event OnImportProgress(Current:Integer);
  612. //              The event is triggered each time a new records is Loaded from
  613. //              File or Stream - by Mark Hamilton.
  614. //
  615. // 23.01.2000 - Fixed a bug assosiated with Lookup and Calc fields
  616. //              Now everything works properly
  617. //
  618. // 23.01.2000 - WarnOnBadDatabase is now False by default
  619. //
  620. // 23.01.2000 - Added new property CacheMemos - True by default
  621. //              Set to False if you dont need displaying memos in dbGrids
  622. //
  623. // 24.01.2000 - KADAO Search Engine modifyed
  624. //              Now Locate, Find and SeekNearestEx methods are much more faster
  625. //
  626. // 24.01.2000 - Removed IndexChacking in Locate! Now programmers are reposible
  627. //              for setting correct Index when callinc Locate on StandardTables
  628. //              CheckFieldsInIndex is NOT called which speeds up operations.
  629. //
  630. // 24.01.2000 - Added a special workaraound for MS Acces Formulas
  631. //              IN DATE FIELDS ONLY - With Many Thanks to Richard Blanchard
  632. //******************************************************************************
  633. //
  634. // 28.01.2001 - Fixed a small bug in OnPostError event handling - thanks to
  635. //              Jiri Kanda
  636. //
  637. // 30.01.2001 - Added new property CacheBlobs - False by default
  638. //              Set to False if you dont need displaying blobs in dbGrids
  639. //
  640. // 30.01.2001 - Default value for F_CacheMemos is now FALSE!
  641. //
  642. // 30.01.2001 - Changed Blob Stream Handling routine to support
  643. //              BlobViewing dbGrids! Someday i will write why this violates
  644. //              everything created by Borland to speedup tables!
  645. //
  646. // 31.01.2001 - Fixed a small bug in SetBookmarkData
  647. //              Borland passes BookmarkString instead of Bookmark;
  648. //
  649. // 31.01.2001 - Added some code in GetRecNo to support new positioning engine
  650. //
  651. // 01.02.2001 - Bookmarks Revisited. Now all bookmark functions use
  652. //              Integer/PInteger values. This also fixes some bugs which
  653. //              appear on custom dbGrids.
  654. //
  655. // 05.02.2001 - ProcessMessages is now set to FALSE by default.
  656. //              The reason is when using multithread functions based on atoms
  657. //              it will add some asynchronous troubles.
  658. //              Of course you can use them without any throuble ia all other
  659. //              projects.
  660. //
  661. // 05.02.2001 - Fixed a small bug in GetRows function. Thanks to Milan Cyprich!
  662. //
  663. // 08.02.2001 - Added minor changes to PercentPosition and RollbackRefresh
  664. //              Now empty tables are also supported.
  665. //
  666. // 08.02.2001 - Fixed a bug in KADao Search Engine
  667. //              Bug is based on bad approximating calculation
  668. //              Now all is OK. Thanks to Jacques Verleijen
  669. //
  670. // 19.02.2001 - Fixed a very interesting bug in KADaoTable.
  671. //              When state is dsEdit and a grid attached to table is resized
  672. //              a haos records are displayed. Now fixed.
  673. //              Thanks to Jiri Kanda for bug report.
  674. //
  675. // 19.02.2001 - Fixed a bug in processing parametrized queryes
  676. //              Thanks to Shmuel Rosen for bug report.
  677. //
  678. // 19.02.2001 - Added a new routine FindKeyExact according to
  679. //              sujjestions of Joseph Glosz.
  680. //              FindKey now uses Seek('=') and FindKeyEx uses Seek('>=')
  681. //
  682. // 23.02.2001 - Fixed a bug in sorting - a new method called Sort is created
  683. //              see help for details. Thanks to Johannes Hardmeier
  684. //
  685. // 23.02.2001 - Fixed a bug in Master/Detail relations. Bug appears in very
  686. //              specilal conditions. Thanks to Paul Weaver.
  687. //
  688. //******************************************************************************
  689. //
  690. // 28.02.2001 - Fixed a bug in the IndexName property. When table is not active
  691. //              IndexFieldCount contans invalid value. Now OK.
  692. //
  693. // 01.03.2001 - Added support for DefaultExpression field property
  694. //              Note that if you set DefaultExpression it has big priority
  695. //              then the DefaultValue property of the MS Access Field.
  696. //              Thanks to Marcelo Ceschin for reporting the problem.
  697. //
  698. // 01.03.2001 - Fixed a bug which generates live poiners after execution
  699. //
  700. // 09.03.2001 - Speed of detail table which is NOT based on SQL queery is
  701. //              increased dramaticlly.
  702. //
  703. // 20.03.2001 - Now setting IndexFieldNames to empty string clears current
  704. //              Index i.e IndexName is also empty string
  705. //
  706. // 20.03.2001 - Fixed a bug with reading blob data when CacheBlobs is true.
  707. //              Now works properly.
  708. //
  709. // 22.03.2001 - Fixed a bug in GetQueryDefReturnParams routine
  710. //              Bug appears when return parameter is only one.
  711. //              Now works properly.
  712. //              Also return format is not Name=Value but just Value
  713. //              This change is needed becouse result data will be in
  714. //              native format. In previous code return data is always in
  715. //              String format which may cause problems when getting Date and
  716. //              Time data.
  717. //
  718. // 25.03.2001 - Added support for ReadOnly fields;
  719. //
  720. // 27.03.2001 - Added two new Functions which vcan retrive QueryDef from
  721. //              which recordset is open.
  722. //              - Function  CopyQueryDef : OleVariant;
  723. //                returns QueryDef Object as OleVariant;
  724. //              - Function  CopyQueryDefText : String;
  725. //                returns QueryDef SQL text as String;
  726. //
  727. // 27.03.2001 - Added support for OnDeleteError - thanks to Flemming Brandt
  728. //              Clausen for reporting the problem;
  729. //
  730. // 27.03.2001 - Added support for OnEditError
  731. //
  732. // 29.03.2001 - Fixed a bug in GetRecNo with Non-Bookmarkable tables
  733. //              No more comments...
  734. //
  735. // 03.04.2001 - Added tree new methods
  736. //                - AccessExportToTXT(FileName:String; IncludeBlobs, DeleteOld:Boolean);
  737. //                - AccessExportToHTML(FileName:String; IncludeBlobs, DeleteOld:Boolean);
  738. //                - AccessExportToExcel(FileName, SheetName :String; ExcelVersion:Integer; IncludeBlobs, DeleteOld:Boolean);
  739. //                - AccessExportToParadox(FileName :String; ParadoxVersion:Integer; IncludeBlobs, DeleteOld:Boolean);
  740. //                - AccessExportToDbase(FileName :String; DBaseVersion:Integer; IncludeBlobs, DeleteOld:Boolean);
  741. //                See help for more details
  742. //
  743. // 09.04.2001 - Now exceptions generated with default field value functions
  744. //              are supressed. Thanks to Mark Elissen.
  745. //
  746. // 18.04.2001 - Added support for external Encrypting of Strings and Blobs
  747. //              See help for more details
  748. //
  749. // 18.04.2001 - Added support for more flexibility using FieldsEditor
  750. //
  751. // 04.05.2001 - Fixed a bug in Internalrefresh method. Thanks to Andy Chan for
  752. //              reporting the problem.
  753. //
  754. // 16.05.2001 - Fixed a bug in SetFieldData method. Thanks to
  755. //              Serg Gribanov for reporting the problem.
  756. //
  757. // 17.05.2001 - Added support for IndexDefs like TTable
  758. //
  759. // 21.05.2001 - Fixed a bug with Parameters that contain part of the name of
  760. //              another parameter - thanks to Stephane Poudret for reporting.
  761. //
  762. //******************************************************************************
  763. // 29.05.2001 - Added new method CreateTable for compatibility with TTable.
  764. //              See help for details.
  765. //
  766. // 29.05.2001 - Added new method AppendTable adding Fields and indexes to
  767. //              existing table. See help for details.
  768. //
  769. // 04.06.2001 - Added support for BlockReadSize/dsBlockRead
  770. //              by request from Jorg Schaefer.
  771. //
  772. // 04.06.2001 - Added enchancement for work with ForwardOnly Tables
  773. //
  774. // 04.06.2001 - Fixed a bug with Detail dataset which uses QueryDef as source.
  775. //              (Close twice)
  776. //
  777. // 04.06.2001 - Fixed a bug with Detail dataset which uses SQL with Parameters
  778. //              as source (wrong field count).
  779. //
  780. // 05.06.2001 - Fixed a bug with Mater/Detail relations (Bad Deactivation)
  781. //              Thanks to Jorg Schaefer for reporting.
  782. //
  783. // 12.06.2001 - Fixed a bug in Notification routine of TKADaoTable
  784. //              Thanks to Ingmar Bode for reporting the problem.
  785. //
  786. // 17.06.2001 - Changed the way on which BookmarkValid works
  787. //              Now after calling BookmarkValid recordset stays at
  788. //              previous position - i.e as Borland reccomends.
  789. //              Also if table is ForwardOnly - i.e. bookmarks are not supported
  790. //              returned BookmarkSize is 0
  791. //
  792. // 04.06.2001 - Added anodher enchancement for work with ForwardOnly Tables
  793. //
  794. // 25.06.2001 - Found another bug in Master/Detail Relations - Thanks to
  795. //              Martin Rohleder for reporting the problem.
  796. //
  797. // 25.07.2001 - Added enchanced support for Lookup and Lookup/Calc Fields
  798. //
  799. //******************************************************************************
  800. //
  801. // 29.08.2001 - Fixed a bug in GotoNearest and GotoKey with a Date/Time values
  802. //              Thanks to Martin Hart for reporting the problem.
  803. //
  804. //******************************************************************************
  805. //
  806. // 08.09.2001 - Found a bug in Bookmark manegement system
  807. //              Bug appears only on Non-Microsoft databases as Paradox
  808. //
  809. // 17.09.2001 - Fixed a small bug in FieldDef system
  810. //              Now when change TableName the correct fields are displayed
  811. //              in the editor.
  812. //
  813. // 17.09.2001 - Fixed a small bug in DefaultExpression field property
  814. //              Thanks to Marcelo Ceschin for reporting the problem.
  815. //
  816. // 20.9.2001 -  Fixed a bug in SetFieldData routine
  817. //              Thanks to Herman Klijnsma for reporting the problem.
  818. //
  819. // 22.09.2001 - Fixed a bug in internal BlobToString routine
  820. //              Bug appears on empty blob fields
  821. //              Thanks to Len Richter for reporting the problem.
  822. //
  823. // 25.09.2001 - Added a minor change to GetCurrentRecord routine
  824. //
  825. // 04.10.2001 - Removed a locale dependance of F_ComposeSQL routine
  826. //              Now Date, Time and DateTime parameters will be interpreted
  827. //              correctly. Tanks to Walter AJ van Rensburg
  828. //              for reporting the problem.
  829. //
  830. // 09.10.2001 - Added a specilal code in Locate and Lookup for handling
  831. //              batch append/insert of records. This significantly speeds
  832. //              processing of tables with lookup fields
  833. //              Thanks to Vlado Neychev for reporting the problem.
  834. //
  835. // 13.10.2001 - Added a new property CacheLookups - False by default
  836. //              When set to True all Lookup fields data will be cached
  837. //              i.e. each Field.LookupCache property will be set to True.
  838. //
  839. // 13.10.2001 - Added new method RefreshLookups
  840. //              When called all Lookup fields with property LookupCache = True
  841. //              will be updateted.
  842. //
  843. // 27.10.2001 - Found a bug in IndexName property. When IndexName is set to an
  844. //              empty string the Index is not Removed - now fixed;
  845. //
  846. // 27.10.2001 - Added new property ExportMethod which can be one of
  847. //              the following: VisibleFields, AllFields
  848. //              If ExportMethod is VisibleFields then only fields selected
  849. //              in the table editor and visibe will be exported
  850. //              Otherwise all fields from the table will be exported
  851. //              Default value is: VisibleFields
  852. //
  853. //******************************************************************************
  854. //
  855. // 28.11.2001 - Another bug with bookmarks was found and removed!
  856. //
  857. // 02.01.2002 - Fixed two bugs - thansk to brian_asap for reporting them!
  858. //              1. UseGetRecNo now can be turned to false for the following
  859. //                 seek based functions:
  860. //                   Locate
  861. //                   Find
  862. //                   Seek_NearestEx
  863. //              2. LockEdits property now work as expected
  864. //
  865. // 02.01.2002 - A much more enchanced method of getting RecNo is developed
  866. //              You will see the improvement.
  867. //
  868. // 02.01.2002 - Added new property RefreshSorted - false by default
  869. //              If RefreshSorted is set to true then each time when new record
  870. //              is posted to a sorted table entire table is refreshed.
  871. //              This can slowdown operations on big tables.
  872. //
  873. // 17.01.2002 - Added support for AM and PM in date default values
  874. //              Thanks to Niall R Scott for code submission
  875. //
  876. // 26.01.2002 - Added support for AutoIcrement Fields with Random Values
  877. //
  878. // 26.01.2002 - An addition to BookmarValid rountine
  879. //              Thanks to Fabian Becker for code submission
  880. //
  881. // 29.01.2002 - LockEdit property is now ReadOnly
  882. //              There is a conflict between two properties
  883. //              LockEdits an LockType
  884. //              If LockType is set to Pessimistic and  LockEdits is set to False
  885. //                   then Locking is Optimistic
  886. //              If LockType is set to Optimistic and  LockEdits is set to True
  887. //                   then Locking is Pessimistic
  888. //              A new method - SetLockEdits is added.
  889. //              which can be called in runtime only for Lock switching
  890. //              WITH MANY THANKS TO Brian O'Hara FOR THE TITANIC CODE
  891. //              HE WROTE TO TEST THE LOCKING!!!!!!!!!!!!!
  892. //
  893. // 31.01.2002   Added two new  utility routines
  894. //              Function IsFieldUniqueIndex(Table : TKaDaoTable; FieldName : String ) : Boolean;
  895. //              Function GetUniqueIndexFields(Table : TKaDaoTable) : String;
  896. //              Thanks to J÷rg SchΣfer for providing the code
  897. //
  898. // 31.01.2002   Fixed a BUG in all BUILDXXX routines
  899. //              Bug appears when a passed value is an empty string
  900. //              Thanks to Johan Korten for reporting the problem.
  901. //
  902. // 01.02.2002   Fixed a bug on IsNull - it does not work correctly on BLOB/MEMO
  903. //              fields - now is OK.
  904. //
  905. // 04.02.2002   Many changes on Edit/Post for better support of
  906. //              multyuser Environment
  907. //
  908. // 12.02.2002   Fixed a bug in Locate method - Thanks to Brian O'Hara
  909. //              for reporting the problem.
  910. //              Also a new enchanced FindGoodIndex is added so
  911. //              the optimal index is used when using Locate
  912. //              To leave KADAO to search for the optimal index set
  913. //              IndexName property to an empty string.
  914. //
  915. // 22.02.2002   Fixed another bug in Locate method - it raises an error when
  916. //              Locate is used with a NON StandardTable
  917. //
  918. // 22.02.2002   Filtered and Filter properties now use standart dataset methods
  919. //              SetFiltered and SetFilterText
  920. //
  921. // 25.02.2002   Added new export method
  922. //              AccessExportToFoxPro(FileName:String; FoxProVersion:Integer; IncludeBlobs, DeleteOld:Boolean);
  923. //              WARNING - works only with Dao 3.5 and NOT with Dao 3.6
  924. //
  925. // 27.02.2002   Added support for GUID fields - thanks to Slavik for
  926. //              reporting the problem
  927. //
  928. // 01.03.2002   Fixed a Memory leak in Find method
  929. //              Thanks to Flemming Brandt Clausen for finding the bug.
  930. //
  931. // 04.03.2002   Fixed a Memory leak in BookmarkValid method
  932. //              Thanks to Flemming Brandt Clausen for finding the bug.
  933. //
  934. // 08.03.2002   Fixed a bug in F_ComposeSQL routine
  935. //              Bug appears in string parameters containing double quotes
  936. //              or currency and float parameters containing commas
  937. //              Thanks to Formentz for reporting the bug
  938. //
  939. // 12.03.2002   RollbackRefresh routine is modifyed for better
  940. //              Transaction support
  941. //******************************************************************************
  942.  
  943. interface
  944. uses
  945. DAOApi,
  946. {$IFDEF DAO35}
  947. DAO35Api,
  948. {$ENDIF}
  949. {$IFDEF DAO36}
  950. DAO36Api,
  951. {$ENDIF}
  952. Windows, SysUtils, Classes, Db, DBCommon, KDaoDataBase, ActiveX, Forms
  953. {$IFDEF D6UP}, Variants{$ENDIF};
  954.  
  955. //******************************************************* DatabaseError Messages
  956. {$I ErrLangTB.pas}
  957. //******************************************************************************
  958.  
  959.  
  960. const
  961.         MYBOOKMARKSIZE   = 4;
  962.         GUID_ID          = 47554944;
  963.         GUID_VALID_CHARS = ['{','}','-','0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','a','b','c','d','e','f'];
  964.  
  965.  
  966. Type
  967. TKADaoTable = class;
  968.  
  969. TBlobData = String;
  970.  
  971. TDaoInfo=record
  972.         RecordNo        : Integer;
  973.         RecordData      : TStringList;
  974.         BookmarkFlag    : TBookmarkFlag;
  975.         BookmarkData    : Integer;
  976. End;
  977. PDaoInfo=^TDaoInfo;
  978.  
  979. TLockType = (ltReadLock, ltWriteLock);
  980. TKeyType  = (KeyValue,RangeStart,RangeEnd);
  981.  
  982. TLoadMode = (lmAppend, lmEmptyAppend);
  983.  
  984. TOO    = (
  985.           dbDenyWrite,
  986.           dbDenyRead,
  987.           dbReadOnly,
  988.           dbAppendOnly,
  989.           dbInconsistent,
  990.           dbConsistent,
  991.           dbSQLPassThrough,
  992.           dbFailOnError,
  993.           dbForwardOnly,
  994.           dbSeeChanges,
  995.           dbRunAsync,
  996.           dbExecDirect
  997.           );
  998. TOOSet = Set of TOO;
  999.  
  1000. TExportMethod        = (VisibleFields,AllFields);
  1001. TExportProgressEvent = procedure(Current,Total:Integer) of object;
  1002. TImportProgressEvent = procedure(Current:Integer) of object;
  1003.  
  1004. TKADaoIndexDefs = Class(TIndexDefs)
  1005.   Private
  1006.     F_Dataset : TKADaoTable;
  1007.   Public
  1008.     Constructor Create(DataSet: TDataSet);
  1009.     Procedure Add(const Name, Fields: string;  Options: TIndexOptions);
  1010.     Function DeleteIndex(const Name : string):Boolean;
  1011. End;
  1012.  
  1013.  
  1014.  
  1015. TKADaoTable = class(TDataSet)
  1016. private
  1017.         F_RecNo           : Integer;
  1018.         F_RecPos          : Integer;
  1019.         F_LastRecord      : Integer;
  1020.         F_RefreshRC       : Boolean;
  1021.         F_OldRC           : Integer;
  1022.         F_PostMade        : Boolean;
  1023.         F_InPost          : Boolean;
  1024.         F_BatchMode       : Boolean;
  1025.  
  1026.  
  1027.         F_OldValue        : PChar;
  1028.         F_ActiveKeyBuffer : PChar;
  1029.         F_KeyBuffer       : PChar;
  1030.         F_RangeStartBuffer: PChar;
  1031.         F_RangeEndBuffer  : PChar;
  1032.  
  1033.         F_BookmarkRN      : TList;
  1034.         F_BookmarkID      : TList;
  1035.         F_Bookmarkable    : Boolean;
  1036.  
  1037.         F_FilterBuffer    : PChar;
  1038.         F_BufferSize      : Integer;
  1039.         F_StartMyInfo     : Integer;
  1040.         F_StartCalc       : Integer;
  1041.         F_MDisabled       : Boolean;
  1042.         F_KeyFields       : TStringList;
  1043.         F_UpdatableFields : TList;
  1044.  
  1045.         {$IFDEF USEPARAMS}
  1046.           {$IFNDEF VER100}
  1047.             {$IFNDEF VER110}
  1048.         F_ParamCheck      : Boolean;
  1049.         F_Params          : TParams;
  1050.             {$ENDIF}
  1051.           {$ENDIF}
  1052.         {$ENDIF}
  1053.  
  1054.         Procedure       F_OnGetMemoText(Sender: TField; var Text: String; DisplayText: Boolean);
  1055.         Procedure       F_OnGetGUIDText(Sender: TField; var Text: String; DisplayText: Boolean);
  1056.         Procedure       F_OnSetGUIDText(Sender: TField; const Text: string);
  1057.         Function        GetActiveRecordBuffer:  PChar;
  1058.         Function        FilterRecord(Buffer: PChar): Boolean;
  1059. protected
  1060.         F_Database               : TKADaoDatabase;
  1061.         F_Active                 : Boolean;
  1062.         F_ReadOnly               : Boolean;
  1063.         F_ProcessMessages        : Boolean;
  1064.  
  1065.         {$IFDEF DYNADAO} //****************************************************
  1066.         F_DaoTable               : OleVariant;
  1067.         F_DetailRecordset        : OleVariant;
  1068.         {$ELSE}
  1069.         F_DaoTable               : Recordset;
  1070.         F_DetailRecordset        : Recordset;
  1071.         {$ENDIF}
  1072.  
  1073.  
  1074.         F_SQL                    : TStrings;
  1075.         F_SortedBy               : TStrings;
  1076.         F_RefreshSorted          : Boolean;
  1077.         F_FieldNames             : TStrings;
  1078.         F_SortFieldNames         : TStrings;
  1079.         F_FieldTypeNames         : TStrings;
  1080.         F_DefaultValues          : TStrings;
  1081.         F_DisplayLabels          : TStrings;
  1082.  
  1083.         F_QD_ParamNames          : TStringList;
  1084.         F_QD_ParamDaoTypes       : TStringList;
  1085.         F_QD_ParamBDETypes       : TStringList;
  1086.         F_QueryDefMaxRecords     : Integer;
  1087.         F_QueryDefType           : String;
  1088.  
  1089.         F_MasterLink             : TMasterDataLink;
  1090.         F_MasterFields           : TStrings;
  1091.         F_UseBrackets            : Boolean;
  1092.         F_MasterAutoActivate     : Boolean;
  1093.         F_DatabaseAutoActivate   : Boolean;
  1094.         F_UseRecordCountCache    : Boolean;
  1095.         F_UseGetRecNo            : Boolean;
  1096.         F_UseDisplayLabels       : Boolean;
  1097.         F_UseDaoProperties       : Boolean;
  1098.         F_AutoFindIndex          : Boolean;
  1099.  
  1100.         F_IndexDefs              : TKADaoIndexDefs;
  1101.  
  1102.         F_RangeFiltered          : Boolean;
  1103.         F_Filtered               : Boolean;
  1104.         F_Filter                 : String;
  1105.         F_OnFilterRecord         : TFilterRecordEvent;
  1106.         F_OnExportProgress       : TExportProgressEvent;
  1107.         F_OnImportProgress       : TImportProgressEvent;
  1108.  
  1109.         F_TableName              : String;
  1110.         F_QueryDefName           : String;
  1111.         F_QueryDefParameters     : TStrings;
  1112.         F_QueryDefSQLText        : TStrings;
  1113.         F_IndexName              : String;
  1114.         F_IndexFieldCount        : Integer;
  1115.         F_TableType              : Integer;
  1116.         F_LockType               : Integer;
  1117.         F_OpenOptions            : TOOSet;
  1118.         F_RecordSize             : Integer;
  1119.  
  1120.         F_FindKeyFields          : String;
  1121.         F_FindKeyValues          : Variant;
  1122.         F_FindOptions            : TLocateOptions;
  1123.  
  1124.         F_ExportMethod           : TExportMethod;
  1125.  
  1126.         F_KeyKeyFields           : String;
  1127.         F_KeyKeyValues           : Variant;
  1128.  
  1129.         F_DateCreated            : String;
  1130.         F_LastUpdated            : String;
  1131.         F_OLE_ON                 : Boolean;
  1132.         F_ComponentVersion       : String;
  1133.         F_WarnOnBadDatabase      : Boolean;
  1134.         F_CacheMemos             : Boolean;
  1135.         F_CacheBlobs             : Boolean;
  1136.         F_CacheLookups           : Boolean;
  1137.         F_ShowGUID               : Boolean;
  1138.  
  1139.         F_Encrypter              : TComponent;
  1140.         F_EncodedString          : Pointer;
  1141.         F_DecodedString          : Pointer;
  1142.         F_HasEncoder             : Boolean;
  1143.  
  1144.         Letters                  : String;
  1145.         DaoFields                : OleVariant;
  1146.         DaoOpenOptions           : Integer;
  1147.         DaoSortString            : String;
  1148.         InInternalOpen           : Boolean;
  1149.  
  1150.         Procedure                Loaded; override;
  1151.         Procedure                Notification(AComponent: TComponent; Operation: TOperation);Override;
  1152.         
  1153.         Procedure       F_Set_ComponentVersion(Value: String);
  1154.         Function        F_Get_Database:TKADaoDatabase;
  1155.         Procedure       F_Set_Database(Value:TKADaoDatabase);
  1156.         Function        F_Get_TableName:String;
  1157.         Procedure       F_Set_TableName(Value:String);
  1158.         Function        F_Get_DateCreated:String;
  1159.         Function        F_Get_LastUpdated:String;
  1160.  
  1161.         Function        F_Get_IndexName:String;
  1162.         Procedure       F_Set_IndexName(Value:String);
  1163.         Function        F_Get_IndexFieldNames:String;
  1164.         Procedure       F_Set_IndexFieldNames(Value:String);
  1165.         Function        F_Get_IndexFieldCount:Integer;
  1166.         Procedure       F_Set_IndexFieldCount(Value:Integer);
  1167.  
  1168.         Procedure       F_Set_TableType(Value:Integer);
  1169.         Procedure       F_Set_LockType(Value:Integer);
  1170.         Procedure       F_Set_OpenOptions(Value:TOOSet);
  1171.         Procedure       F_Set_ReadOnly(Value:Boolean);
  1172.         Function        F_Get_LockEdits:Boolean;
  1173.         Procedure       F_Set_LockEdits(Value:Boolean);
  1174.         Procedure       F_Set_Sort(Value:TStrings);
  1175.  
  1176.         Procedure       F_Set_SQL(Value:TStrings);
  1177.         Procedure       F_Set_QueryDefName(Value:String);
  1178.         Procedure       F_Set_QueryDefParameters(Value:TStrings);
  1179.         Procedure       F_Set_QueryDefSQLText(Value:TStrings);
  1180.         Function        F_Get_QueryDefType:String;
  1181.  
  1182.         Function        F_Get_MasterSource: TDataSource;
  1183.         Procedure       F_Set_MasterSource(Value: TDataSource);
  1184.         Procedure       F_ProcessMasterFields(Value:TStrings);
  1185.         Procedure       F_Set_MasterFields(Value:TStrings);
  1186.  
  1187.         Procedure       F_Set_Master(Value:TStrings);
  1188.         Procedure       F_Set_Detail(Value:TStrings);
  1189.         Function        WWStringReplace(Src,Pattern,Repl:String):String;
  1190.         Function        ChangeQuotes(S:String):String;
  1191.         Function        ChangeCommas(S:String):String;
  1192.         Function        F_ComposeSQL(SQL:TStrings):String;
  1193.         Function        F_RecalculateRecNo(TempRS:OleVariant;BK:Integer):Integer;
  1194.  
  1195.         //*********************************************************** 22.02.2002
  1196.         Procedure       SetFiltered(Value:Boolean);Override;
  1197.         Procedure       SetFilterText(Const Value:String);Override;
  1198.         //*********************************************************** 22.02.2002
  1199.  
  1200.         Procedure       F_Set_OnFilterRecord(Value: TFilterRecordEvent);
  1201.  
  1202.         Function        F_Get_IndexField(Index: Integer): TField;
  1203.         Procedure       F_Set_IndexField(Index: Integer; Value: TField);
  1204.  
  1205.         Procedure       F_SetBatchMode(Value:Boolean);
  1206.         Procedure       F_Set_CacheMemos(Value:Boolean);
  1207.         Procedure       F_Set_CacheBlobs(Value:Boolean);
  1208.         Procedure       F_Set_CacheLookups(Value:Boolean);
  1209.         Procedure       F_Set_ShowGUID(Value:Boolean);
  1210.  
  1211.         Procedure       F_Set_Encrypter(Value:TComponent);
  1212.  
  1213.         //**********************************************************************
  1214.         {$IFDEF USEPARAMS}
  1215.           {$IFNDEF VER100}
  1216.             {$IFNDEF VER110}
  1217.         Procedure SetParamsList(Value: TParams);
  1218.         Procedure UpdateParamsList(Sender: TObject);
  1219.         Procedure WriteParamData(Writer: TWriter);
  1220.         Function  GetParamsCount: Word;
  1221.         Procedure DefineProperties(Filer: TFiler); override;
  1222.         Procedure ReadParamData(Reader: TReader);
  1223.             {$ENDIF}
  1224.           {$ENDIF}
  1225.         {$ENDIF}
  1226.         //**********************************************************************
  1227.         Procedure       MasterDatasetChanged;
  1228.         Procedure       UpdateFromMaster;
  1229.         Procedure       RefreshQueryParams;
  1230.         Procedure       MasterChanged(Sender: TObject);
  1231.         Procedure       MasterDisabled(Sender: TObject);
  1232.         Procedure       DoOnNewRecord; override;
  1233.         //**********************************************************************
  1234.         Procedure       ClearKey;
  1235.         Procedure       ClearRange(Var Buffer:PChar);
  1236.         Function        FilterRange(Buffer:PChar): Boolean;
  1237.         Function        CompareRecordsRange(B1,B2: PChar; CT : Integer) : Integer;
  1238.         Function        CompareFieldsRange(B1,B2 : String; FieldType: TFieldType):Integer;
  1239.         //**********************************************************************
  1240.         Function        InternalCalcRecordSize:Integer;
  1241.         Function        IntegerToBuffer(Buffer: Pointer; S: String): Boolean;
  1242.         Function        FloatToBuffer(Buffer: Pointer; S: String): Boolean;
  1243.         Function        BooleanToBuffer(Buffer: Pointer; S: String): Boolean;
  1244.  
  1245.         Function        DateToBuffer(Buffer: Pointer; S: String): Boolean;
  1246.         Function        TimeToBuffer(Buffer: Pointer; S: String): Boolean;
  1247.         Function        DateTimeToBuffer(Buffer: Pointer; S: String): Boolean;
  1248.  
  1249.         Function        BufferToDate(Buffer: Pointer): String;
  1250.         Function        BufferToTime(Buffer: Pointer): String;
  1251.         Function        BufferToDateTime(Buffer: Pointer): String;
  1252.  
  1253.         Function        GUIDToBuffer(Buffer: Pointer; S: String): Boolean;
  1254.         Function        BufferToGUID(Buffer:Pointer):String;
  1255.  
  1256.         Function        StringToBlob(Field:TBlobField; Data:String):OleVariant;
  1257.         Function        BlobToString(Field:TBlobField; Data:OleVariant; DataSize:Integer):String;
  1258.  
  1259.         Function        ProcessDTDefault(S:String):String;
  1260.         Procedure       OpenDaoRecordset;
  1261.         Procedure       ReOpenDaoRecordset;
  1262.         Procedure       GetQueryDefReturnParams(QueryDefName:String);
  1263.         Procedure       CloseDaoRecordset;
  1264.  
  1265.         Procedure       InternalOpen; override;
  1266.         Procedure       InternalClose; override;
  1267.         Function        IsCursorOpen: Boolean; override;
  1268.         Function        GetCanModify: Boolean; override;
  1269.         Function        GetRecordSize: Word;override;
  1270.         Function        AllocRecordBuffer: PChar; override;
  1271.         Procedure       FreeRecordBuffer(var Buffer: PChar); override;
  1272.         Function        InternalFillRecordData(RS: OleVariant; MainTable : Boolean; Buffer:PChar):Boolean;
  1273.         Function        GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
  1274.         Procedure       InternalInitIndexDefs;
  1275.         Procedure       UpdateIndexDefs; override;
  1276.         Procedure       InternalInitFieldDefs; override;
  1277.         Procedure       InternalSetDisplayLabels;
  1278.         Procedure       InternalInitRecord(Buffer: PChar); override;
  1279.         Procedure       SetFieldData(Field: TField; Buffer: Pointer);override;
  1280.         Procedure       ClearCalcFields(Buffer: PChar);override;
  1281.                                                                                          
  1282.  
  1283.         //*********************************************** Navigation and Editing
  1284.         Procedure       InternalFirst;override;
  1285.         Procedure       InternalLast;override;
  1286.         Procedure       InternalMoveToBookmark(Bookmark: Pointer);
  1287.         Procedure       InternalSetToRecord(Buffer: PChar); override;
  1288.         Procedure       InternalEdit; override;
  1289.         Procedure       InternalCancel; override;
  1290.         Procedure       InternalPost; override;
  1291.         Procedure       InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
  1292.         Procedure       InternalDelete; override;
  1293.         Procedure       InternalRefresh; override;
  1294.         Procedure       DaoInternalRefresh;
  1295.         //***********************************************
  1296.         Function        GetDaoBookMark(RS:Variant):Integer;
  1297.         Function        GetDaoLastModifiedBookMark(RS:Variant):Integer;
  1298.  
  1299.         Procedure       InternalClearBookmarks;
  1300.         Procedure       InternalGotoBookmark(Bookmark: Pointer); override;
  1301.  
  1302.         Function        GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
  1303.         Procedure       SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
  1304.  
  1305.         Function        GetBookmarkStr: TBookmarkStr; override;
  1306.         Procedure       SetBookmarkStr(const Value: TBookmarkStr); override;
  1307.  
  1308.         Procedure       GetBookmarkData(Buffer: PChar; Data: Pointer); override;
  1309.         Procedure       SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  1310.  
  1311.         Procedure       InternalHandleException; override;
  1312.  
  1313.         Function        GetRecordCount  : Integer; override;
  1314.         Function        GetRecNo        : Integer; override;
  1315.         Procedure       SetRecNo        (Value: Integer); override;
  1316.  
  1317.         //************************************************* TTable Compatibility
  1318.         Function        FindRecord(Restart, GoForward: Boolean): Boolean; override;
  1319.         //************************************************* TTable Compatibility
  1320.  
  1321.         Procedure       StringToList(Items: String; List: TStringList);
  1322.         Procedure       VariantToList(Items: Variant; List: TStringList);
  1323.         Procedure       AssignVarValue(Var V :Variant;const Value: TVarRec);
  1324.  
  1325.         Function        BuildKeySQL(KN,KV:TStringList):String;
  1326.         Function        BuildLocateSQL(KN,KV:TStringList;Options: TLocateOptions):String;
  1327.         Function        BuildDetailSQL  : String;
  1328.  
  1329.         Function        Find(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions;FindType:Integer): Boolean;
  1330.         Function        InsertSQLString(MDString: String): String;
  1331.         Function        UnquoteString(S:String):String;
  1332.  
  1333.  
  1334.   public
  1335.         //*********************************** Public By Property Editors request
  1336.         F_Detail                         : TStrings;
  1337.         F_Master                         : TStrings;
  1338.         F_MDFieldNames                   : TStrings;
  1339.         //**********************************************************************
  1340.         MainDatabaseShutdown             : Boolean;
  1341.         QueryDefTypeInt                  : Integer;
  1342.         QueryDefReturnParams             : OleVariant;
  1343.         RecordsAffected                  : Integer;
  1344.  
  1345.         {$IFDEF DYNADAO}
  1346.         CoreRecordset                    : OleVariant;
  1347.         {$ELSE}
  1348.         CoreRecordset                    : Recordset;
  1349.         {$ENDIF}
  1350.         SQLExecutionType                 : Integer;
  1351.         Constructor                        Create(AOwner: TComponent); override;
  1352.         Destructor                         Destroy; override;
  1353.  
  1354.         Property                           BatchMode : Boolean Read F_BatchMode Write F_SetBatchMode;
  1355.  
  1356.         Procedure                          Post; override;
  1357.         Procedure                          RefreshData;
  1358.         Procedure                          RollbackRefresh;
  1359.  
  1360.         Function                           FindGoodIndex(KeyFields:String):String;
  1361.         Function                           GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
  1362.         Function                           CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
  1363.  
  1364.         Procedure                          SetKeyFields(const KeyFields: string);
  1365.         Function                           GetFieldIndexName(FiledName:String):String;
  1366.         Function                           CheckFieldsInIndex(KF:TStringList):Boolean;
  1367.         Function                           Find_First(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions):Boolean;
  1368.         Function                           Find_Last(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions):Boolean;
  1369.         Function                           Find_Next(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions):Boolean;
  1370.         Function                           Find_Prior(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions):Boolean;
  1371.         Function                           Find_Nearest(const KeyValues: array of const):Boolean;
  1372.         Function                           Find_NearestEx(const KeyFields: string; const KeyValues: Variant):Boolean;
  1373.         Function                           Seek_Nearest(const KeyValues: array of const):Boolean;
  1374.         Function                           Seek_NearestEx(const KeyValues: array of const; SeekType:String):Boolean;
  1375.  
  1376.         //*******************************  For TTable Compatibility
  1377.         Procedure                          FindNearest(const KeyValues: array of const);
  1378.         Property                           IndexFieldNames : String Read F_Get_IndexFieldNames Write F_Set_IndexFieldNames;
  1379.         Property                           IndexFields[Index: Integer]: TField read F_Get_IndexField write F_Set_IndexField;
  1380.         Procedure                          SetFindData(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions);
  1381.         Procedure                          LockTable(LockType: TLockType);
  1382.         Procedure                          UnlockTable(LockType: TLockType);
  1383.         Procedure                          SetLockEdits(LockEdits : Boolean);
  1384.         Function                           GetCurrentRecord(Buffer: PChar): Boolean; override;
  1385.  
  1386.         //*******************************  Key Routines
  1387.         Procedure                          SetKey;
  1388.         Procedure                          EditKey;
  1389.         Procedure                          CancelKey;
  1390.         Procedure                          SetKeyParam(const KeyFields: Array of String;const KeyValues: array of const);
  1391.         Function                           GotoKey: Boolean;
  1392.         Procedure                          GotoNearest;
  1393.         Function                           FindKey(const KeyValues: array of const):Boolean;
  1394.         Function                           FindKeyEx(const KeyValues: array of const):Boolean;
  1395.         //*******************************  Key Routines
  1396.  
  1397.         //*******************************  Range Routines
  1398.         Procedure                          SetRange(const StartValues, EndValues:array of const);
  1399.         Procedure                          SetRangeStart;
  1400.         Procedure                          SetRangeEnd;
  1401.         Procedure                          EditRangeStart;
  1402.         Procedure                          EditRangeEnd;
  1403.         Procedure                          ApplyRange;
  1404.         Procedure                          CancelRange;
  1405.         //*******************************  Range Routines
  1406.  
  1407.         //*******************************  For TTable Compatibility
  1408.         Function                           Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; override;
  1409.         Function                           Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override;
  1410.         Procedure                          RefreshLookups;
  1411.  
  1412.         Function                           CreateField(FieldName:String;FieldType:Integer;FiledSize:Integer):Boolean;
  1413.         Function                           CreateIndex(FieldName:String;IndexType:Integer):Boolean;
  1414.         Function                           DeleteField(FieldName:String):Boolean;
  1415.         Function                           DeleteIndex(FieldName:String):Boolean;
  1416.         Function                           EmptyTable:Boolean;
  1417.         Procedure                          CreateTable;
  1418.         Procedure                          AppendTable;
  1419.  
  1420.         Function                           CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
  1421.         Function                           BookmarkValid(Bookmark: TBookmark): Boolean; override;
  1422.         Function                           GetRows(NumRows:Integer):OleVariant;
  1423.         Function                           GetRawFieldData(FieldName : String):OleVariant;
  1424.         Function                           SetRawFieldData(FieldName : String; Value : OleVariant):Boolean;
  1425.         Function                           CopyQueryDef : OleVariant;
  1426.         Function                           CopyQueryDefText : String;
  1427.         Procedure                          AccessExportToTXT(FileName:String; IncludeBlobs, DeleteOld:Boolean);
  1428.         Procedure                          AccessExportToHTML(FileName:String; IncludeBlobs,DeleteOld:Boolean);
  1429.         Procedure                          AccessExportToExcel(FileName, SheetName :String; ExcelVersion:Integer; IncludeBlobs, DeleteOld:Boolean);
  1430.         Procedure                          AccessExportToParadox(FileName:String; ParadoxVersion:Integer; IncludeBlobs, DeleteOld:Boolean);
  1431.         Procedure                          AccessExportToDBase(FileName:String; DBaseVersion:Integer; IncludeBlobs, DeleteOld:Boolean);
  1432.         Procedure                          AccessExportToFoxPro(FileName:String; FoxProVersion:Integer; IncludeBlobs, DeleteOld:Boolean);
  1433.         Procedure                          AccessExportToMDB(FileName, NewTableName:String; IncludeBlobs, DeleteOld:Boolean);
  1434.  
  1435.         Function                           IsFieldUniqueIndex(Table : TKaDaoTable; FieldName : String ) : Boolean;
  1436.         Function                           GetUniqueIndexFields(Table : TKaDaoTable) : String;
  1437.  
  1438.         Function                           GetGUIDAsString(GUID : String):String;
  1439.         Function                           GetStringAsGUID(GUID : String):TGUID;
  1440.         Function                           PutGUIDInString(GUID : String):String;
  1441.  
  1442.         Property  Bookmarkable           : Boolean         Read F_Bookmarkable;
  1443.         Property  MasterLink             : TMasterDataLink Read F_MasterLink;
  1444.         Property  FieldNames             : TStrings        Read F_FieldNames;
  1445.         Property  SortFieldNames         : TStrings        Read F_SortFieldNames;
  1446.         Property  LinkableFields         : TStrings        Read F_MDFieldNames;
  1447.  
  1448.         {$IFNDEF D4UP}
  1449.         Property  IndexDefs              : TKADaoIndexDefs Read F_IndexDefs Write F_IndexDefs;
  1450.         {$ENDIF}
  1451.  
  1452.         {$IFDEF USEPARAMS}
  1453.           {$IFNDEF VER100}
  1454.             {$IFNDEF VER110}
  1455.         Property ParamCount              : Word read GetParamsCount;
  1456.             {$ENDIF}
  1457.           {$ENDIF}
  1458.         {$ENDIF}
  1459.         Function                           ExecSQL(SQL:TStrings):Integer;
  1460.         Function                           ExecSQLString(SQL:String):Integer;
  1461.         Function                           ExecuteSQL:Integer;
  1462.         Function                           ExecuteQueryDefSQL:Integer;
  1463.  
  1464.         Function                           Requery : Boolean;
  1465.         Procedure                          GotoCurrent(Table: TKADaoTable);
  1466.  
  1467.         Procedure                          GetIndexNames(List: TStrings);
  1468.         Procedure                          GetFieldNames(List: TStrings);
  1469.         Function                           PercentPosition:Single;
  1470.         Function                           GetSourceFieldName(FieldName:String):String;
  1471.         Function                           GetSourceTableName(FieldName:String):String;
  1472.         Function                           GetLastDaoError:TDaoErrRec;
  1473.         Function                           PropertyExists(PropObject:OleVariant;PropertyName:String):Boolean;
  1474.  
  1475.         Procedure                          GetQueryDefParameters(F_QD_ParamNames,F_QD_ParamDaoTypes, F_QD_ParamBDETypes:TStringList);
  1476.         Function                           PromptQueryDefParameters:Boolean;
  1477.  
  1478.         Procedure                          Sort;
  1479.  
  1480.         //**************************************************** Storage Functions
  1481.         Function  StoreField(X:Integer): Boolean;
  1482.         Procedure SaveToStream(Stream: TStream);
  1483.         Procedure SaveToFile(const FileName: String);
  1484.  
  1485.         Procedure LoadFromStream(Stream: TStream; Mode : TLoadMode);
  1486.         Procedure LoadFromFile(const FileName: String; Mode : TLoadMode);
  1487.         //**********************************************************************
  1488.   published
  1489.         Property AutoFindIndex           : Boolean Read F_AutoFindIndex Write F_AutoFindIndex;
  1490.         Property ComponentVersion        : String  Read F_ComponentVersion Write F_Set_ComponentVersion;
  1491.         Property CacheBlobs              : Boolean Read F_CacheBlobs Write F_Set_CacheBlobs;
  1492.         Property CacheMemos              : Boolean Read F_CacheMemos Write F_Set_CacheMemos;
  1493.         Property CacheLookups            : Boolean Read F_CacheLookups Write F_Set_CacheLookups;
  1494.         Property Database                : TKADaoDatabase Read F_Get_Database Write F_Set_Database;
  1495.         Property Encrypter               : TComponent Read F_Encrypter Write F_Set_Encrypter;
  1496.         Property ExportMethod            : TExportMethod Read F_ExportMethod Write F_ExportMethod;
  1497.         Property RefreshSorted           : Boolean Read F_RefreshSorted Write F_RefreshSorted;
  1498.         Property TableName               : String Read F_Get_TableName Write F_Set_TableName;
  1499.         Property SortedBy                : TStrings Read F_SortedBy Write F_Set_Sort;
  1500.         Property SortedByText            : TStrings Read F_SortedBy Write F_Set_Sort;
  1501.         Property QueryDefName            : String Read F_QueryDefName Write F_Set_QueryDefName;
  1502.         Property QueryDefParameters      : TStrings Read F_QueryDefParameters Write F_Set_QueryDefParameters;
  1503.         Property QueryDefParametersText  : TStrings Read F_QueryDefParameters Write F_Set_QueryDefParameters;
  1504.         Property QueryDefSQLText         : TStrings Read F_QueryDefSQLText Write F_Set_QueryDefSQLText;
  1505.         Property QueryDefODBCMaxRecords  : Integer Read F_QueryDefMaxRecords Write F_QueryDefMaxRecords;
  1506.         Property QueryDefType            : String Read F_Get_QueryDefType Write F_QueryDefType;
  1507.         Property SQL                     : TStrings Read F_SQL Write F_Set_SQL;
  1508.         Property ShowGUID                : Boolean Read F_ShowGUID Write F_Set_ShowGUID;
  1509.         {$IFDEF USEPARAMS}
  1510.           {$IFNDEF VER100}
  1511.            {$IFNDEF VER110}
  1512.         Property Params                  : TParams read F_Params Write SetParamsList Stored False;
  1513.            {$ENDIF}
  1514.          {$ENDIF}
  1515.         {$ENDIF}
  1516.         Property TableType               : Integer Read F_TableType Write F_Set_TableType;
  1517.         Property TableDateCreated        : String Read F_Get_DateCreated Write F_DateCreated;
  1518.         Property TableLastUpdated        : String Read F_Get_LastUpdated Write F_LastUpdated;
  1519.         Property LockType                : Integer Read F_LockType Write F_Set_LockType;
  1520.         Property OpenOptions             : TOOSet Read F_OpenOptions Write F_Set_OpenOptions;
  1521.         {$IFDEF D4UP}
  1522.         Property FieldDefs;
  1523.         Property IndexDefs               : TKADaoIndexDefs  Read F_IndexDefs Write F_IndexDefs;
  1524.         {$ENDIF}
  1525.         Property IndexFieldCount         : Integer Read F_Get_IndexFieldCount Write F_Set_IndexFieldCount;
  1526.         Property IndexName               : String Read F_Get_IndexName Write F_Set_IndexName;
  1527.         Property ReadOnly                : Boolean Read F_ReadOnly Write F_Set_ReadOnly;
  1528.         Property LockEdits               : Boolean Read F_Get_LockEdits Write F_Set_LockEdits;
  1529.         Property MasterSource            : TDataSource Read F_Get_MasterSource Write F_Set_MasterSource;
  1530.         Property MasterFields            : TStrings Read F_MasterFields Write F_Set_MasterFields;
  1531.         Property MasterAutoActivate      : Boolean Read F_MasterAutoActivate Write F_MasterAutoActivate;
  1532.         Property DatabaseAutoActivate    : Boolean Read F_DatabaseAutoActivate  Write F_DatabaseAutoActivate;
  1533.         Property UseBrackets             : Boolean Read F_UseBrackets Write F_UseBrackets;
  1534.         Property UseCaptions             : Boolean Read F_UseDisplayLabels Write F_UseDisplayLabels;
  1535.         Property UseDaoProperties        : Boolean Read F_UseDaoProperties Write F_UseDaoProperties;
  1536.         Property UseGetRecNo             : Boolean Read F_UseGetRecNo Write F_UseGetRecNo;
  1537.         Property UseRecordCount          : Boolean Read F_UseRecordCountCache Write F_UseRecordCountCache;
  1538.         Property WarnOnBadDatabase       : Boolean Read F_WarnOnBadDatabase Write F_WarnOnBadDatabase;
  1539.         Property Filtered                : Boolean Read F_Filtered Write SetFiltered;
  1540.         Property Filter                  : String  Read F_Filter Write SetFilterText;
  1541.         Property OnExportProgress        : TExportProgressEvent Read F_OnExportProgress Write F_OnExportProgress;
  1542.         Property OnImportProgress        : TImportProgressEvent Read F_OnImportProgress Write F_OnImportProgress;
  1543.         Property OnFilterRecord          : TFilterRecordEvent read F_OnFilterRecord write F_Set_OnFilterRecord;
  1544.         {$IFDEF USEPARAMS}
  1545.           {$IFNDEF VER100}
  1546.             {$IFNDEF VER110}
  1547.         Property ParamCheck              : Boolean Read F_ParamCheck Write F_ParamCheck;
  1548.             {$ENDIF}
  1549.           {$ENDIF}
  1550.         {$ENDIF}
  1551.         Property ProcessMessages         : Boolean Read F_ProcessMessages Write F_ProcessMessages;
  1552.         Property BeforeOpen;
  1553.         Property AfterOpen;
  1554.         Property BeforeClose;
  1555.         Property AfterClose;
  1556.         Property BeforeInsert;
  1557.         Property AfterInsert;
  1558.         Property BeforeEdit;
  1559.         Property AfterEdit;
  1560.         Property BeforePost;
  1561.         Property AfterPost;
  1562.         Property BeforeCancel;
  1563.         Property AfterCancel;
  1564.         Property BeforeDelete;
  1565.         Property AfterDelete;
  1566.         Property BeforeScroll;
  1567.         Property AfterScroll;
  1568.         Property OnCalcFields;
  1569.         Property OnDeleteError;
  1570.         Property OnEditError;
  1571.         Property OnNewRecord;
  1572.         Property OnPostError;
  1573.         Property AutoCalcFields;
  1574.         Property Active;
  1575. End;
  1576.  
  1577.  
  1578. // Handle Memo fields
  1579.   TKBlobStream = class(TStream)
  1580.   private
  1581.     F_Field      : TBlobField;
  1582.     F_DataSet    : TKADaoTable;
  1583.     F_Buffer     : PChar;
  1584.     F_Mode       : TBlobStreamMode;
  1585.     F_Opened     : Boolean;
  1586.     F_Modified   : Boolean;
  1587.     F_Position   : Longint;
  1588.     F_BlobData   : TBlobData;
  1589.     F_BlobSize   : Integer;
  1590.   public
  1591.     constructor Create(Field: TBlobField; Mode: TBlobStreamMode);
  1592.     destructor Destroy; override;
  1593.     Function Read(var Buffer; Count: Longint): Longint; override;
  1594.     Function Write(const Buffer; Count: Longint): Longint; override;
  1595.     Function Seek(Offset: Longint; Origin: Word): Longint; override;
  1596.     Procedure Truncate;
  1597.   End;
  1598.  
  1599.  
  1600.  
  1601. Procedure Register;
  1602.  
  1603. implementation
  1604. Uses ComObj, DaoUtils, Dialogs, TypInfo, QueryDefDialogUnit;
  1605.  
  1606. Const
  1607.   CRLF=#13+#10;
  1608.   {$IFNDEF D4UP}
  1609.   FieldTypeNames: Array[TFieldType] of String = (
  1610.     'Unknown', 'String', 'SmallInt', 'Integer', 'Word', 'Boolean', 'Float',
  1611.     'Currency', 'BCD', 'Date', 'Time', 'DateTime', 'Bytes', 'VarBytes',
  1612.     'AutoInc', 'Blob', 'Memo', 'Graphic', 'FmtMemo', 'ParadoxOle',
  1613.     'dBaseOle', 'TypedBinary', 'Cursor');
  1614.   {$ENDIF}
  1615.  
  1616.  
  1617. //******************************************************************************
  1618. Constructor TKADaoIndexDefs.Create(DataSet: TDataSet);
  1619. Begin
  1620.   Inherited Create(Dataset);
  1621.   F_DataSet := Dataset As TKADaoTable;
  1622. End;
  1623.  
  1624. //******************************************************************************
  1625. // Warning!  This Routine temporary closes the KAdaoTable
  1626. //******************************************************************************
  1627. Procedure TKADaoIndexDefs.Add(const Name, Fields: string;  Options: TIndexOptions);
  1628. Var
  1629.   FieldsList : TStringList;
  1630.   NewTable   : OleVariant;
  1631.   NewField   : OleVariant;
  1632.   NewIndex   : OleVariant;
  1633.   X          : Integer;
  1634.   Reopen     : Boolean;
  1635. Begin
  1636.   if F_DataSet.F_TableName='' Then Exit;
  1637.   Inherited Add(Name, Fields, Options);
  1638.   if NOT F_DataSet.PropertyExists(OleVariant(F_DataSet.F_Database.CoreDatabase.TableDefs),F_DataSet.F_TableName) Then Exit;
  1639.   If F_DataSet.PropertyExists(OleVariant(F_DataSet.F_Database.CoreDatabase.TableDefs.Item[F_DataSet.F_TableName].Indexes),Name) Then
  1640.      Begin
  1641.       //*************************************************** Index already exists
  1642.      End
  1643.   Else
  1644.      Begin
  1645.        //**************************************** Here DAO Index must be created
  1646.        FieldsList:=TStringList.Create;
  1647.        Reopen := False;
  1648.        Try
  1649.          F_DataSet.StringToList(Fields,FieldsList);
  1650.          For X := 0 To FieldsList.Count-1 do
  1651.              Begin
  1652.                if NOT F_DataSet.PropertyExists(OleVariant(F_DataSet.F_Database.CoreDatabase.TableDefs.Item[F_DataSet.F_TableName].Fields),FieldsList.Strings[X]) Then
  1653.                   Begin
  1654.                    FieldsList.Clear;
  1655.                    System.Break;
  1656.                   End;
  1657.              End;
  1658.          if FieldsList.Count > 0 Then
  1659.             Begin
  1660.               if F_DataSet.Active Then
  1661.                  Begin
  1662.                   Reopen := True;
  1663.                   F_DataSet.Close;
  1664.                  End;
  1665.               F_DataSet.F_Database.RefreshDefinitions;
  1666.               NewTable  := F_DataSet.F_Database.CoreDatabase.TableDefs.Item[F_DataSet.F_TableName];
  1667.               NewIndex  := NewTable.CreateIndex(Name);
  1668.               if (ixPrimary in Options) Then NewIndex.Primary  := True;
  1669.               if (ixUnique  in Options) Then NewIndex.Unique  := True;
  1670.               For X := 0 To FieldsList.Count-1 do
  1671.                   Begin
  1672.                     NewField := NewTable.CreateField(FieldsList.Strings[X]);
  1673.                     if (ixDescending in Options) Then NewField.Attributes := NewField.Attributes OR dbDescending;
  1674.                     NewIndex.Fields.AppEnd(NewField);
  1675.                   End;
  1676.               NewTable.Indexes.AppEnd(NewIndex);
  1677.               F_DataSet.F_Database.RefreshDefinitions;
  1678.             End;
  1679.        Finally
  1680.          if Reopen Then F_DataSet.Open;
  1681.          FieldsList.Free;
  1682.        End;
  1683.      End;
  1684. End;
  1685.  
  1686. //******************************************************************************
  1687. // Warning!  This Routine temporary closes the KAdaoTable
  1688. //******************************************************************************
  1689. Function TKADaoIndexDefs.DeleteIndex(const Name : string):Boolean;
  1690. Var
  1691.   Index  : Integer;
  1692.   Reopen : Boolean;
  1693. Begin
  1694.   Result := False;
  1695.   if F_DataSet.F_TableName='' Then Exit;
  1696.   Index := inherited IndexOf(Name);
  1697.   if Index = -1 Then Exit;
  1698.   Inherited Items[Index].Free;
  1699.   Reopen := False;
  1700.   If F_DataSet.PropertyExists(OleVariant(F_DataSet.F_Database.CoreDatabase.TableDefs.Item[F_DataSet.F_TableName].Indexes),Name) Then
  1701.      Begin
  1702.       //*********************************************** Here we delete the index
  1703.       Try
  1704.         if F_DataSet.Active Then
  1705.             Begin
  1706.               Reopen := True;
  1707.               F_DataSet.Close;
  1708.             End;
  1709.         F_DataSet.F_Database.DeleteIndexByName(F_DataSet.F_TableName,Name);
  1710.       Except
  1711.         if Reopen Then F_DataSet.Open;
  1712.         Exit;
  1713.       End;
  1714.      End;
  1715.    if Reopen Then F_DataSet.Open;
  1716.    Result := True;
  1717. End;
  1718. //******************************************************************************
  1719.  
  1720. constructor TKADaoTable.Create(AOwner: TComponent);
  1721. Var
  1722.   OLE_INIT : Integer;
  1723.   X        : Integer;
  1724. Begin
  1725.   inherited Create(AOwner);
  1726.   MainDatabaseShutdown   := False;
  1727.   F_ComponentVersion     := '7.20';
  1728.   F_TableName            := '';
  1729.   F_TableType            := dbOpenDynaset;
  1730.   F_LockType             := dbOptimistic;
  1731.   F_Encrypter            := Nil;
  1732.   F_HasEncoder           := False;
  1733.   F_OpenOptions          := [];
  1734.   F_ReadOnly             := False;
  1735.   F_ProcessMessages      := False;
  1736.   F_RefreshSorted        := False;
  1737.   F_QueryDefName         := '';
  1738.   F_QueryDefSQLText      := TStringList.Create;
  1739.   F_QueryDefSQLText.Clear;
  1740.   F_QueryDefMaxRecords   := 0;
  1741.   F_QueryDefType         := '';
  1742.   QueryDefTypeInt        := 0;
  1743.   RecordsAffected        := 0;
  1744.   F_SQL                  := TStringList.Create;
  1745.   F_SQL.Clear;
  1746.   F_SortedBy             := TStringList.Create;
  1747.   F_SortedBy.Clear;
  1748.   F_FieldNames           := TStringList.Create;
  1749.   F_FieldNames.Clear;
  1750.   F_SortFieldNames       := TStringList.Create;
  1751.   F_SortFieldNames.Clear;
  1752.   F_FieldTypeNames       := TStringList.Create;
  1753.   F_FieldTypeNames.Clear;
  1754.   F_DefaultValues        := TStringList.Create;
  1755.   F_DefaultValues.Clear;
  1756.   F_MDFieldNames         := TStringList.Create;
  1757.   F_DisplayLabels        := TStringList.Create;
  1758.   F_MDFieldNames.Clear;
  1759.   F_DateCreated          := '';
  1760.   F_LastUpdated          := '';
  1761.   //****************************************************************************
  1762.   F_QD_ParamNames        := TStringList.Create;
  1763.   F_QD_ParamNames.Clear;
  1764.   F_QD_ParamDaoTypes     := TStringList.Create;
  1765.   F_QD_ParamDaoTypes.Clear;
  1766.   F_QD_ParamBDETypes     := TStringList.Create;
  1767.   F_QD_ParamBDETypes.Clear;
  1768.  
  1769.   F_QueryDefParameters   := TStringList.Create;
  1770.   F_QueryDefParameters.Clear;
  1771.   SQLExecutionType       :=DaoApi.dbFailOnError;
  1772.   //****************************************************************************
  1773.   F_FindKeyFields        := '';
  1774.   F_FindKeyValues        := Null;
  1775.   F_FindOptions          := [];
  1776.   F_ExportMethod         := VisibleFields;
  1777.  
  1778.   F_KeyKeyFields         := '';
  1779.   F_KeyKeyValues         := Null;
  1780.   //****************************************************************************
  1781.   F_MDisabled                   := False;
  1782.   F_MasterFields                := TStringList.Create;
  1783.   F_MasterFields.Clear;
  1784.   F_MasterLink                  := TMasterDataLink.Create(Self);
  1785.   F_MasterLink.OnMasterChange   := MasterChanged;
  1786.   F_MasterLink.OnMasterDisable  := MasterDisabled;
  1787.   F_Detail               := TStringList.Create;
  1788.   F_Detail.Clear;
  1789.   F_Master               := TStringList.Create;
  1790.   F_Master.Clear;
  1791.   //****************************************************************************
  1792.  
  1793.   F_KeyFields            := TStringList.Create;
  1794.   F_KeyFields.Clear;
  1795.   F_UpdatableFields      := TList.Create;
  1796.   F_UpdatableFields.Clear;
  1797.  
  1798.   F_BookmarkRN           := TList.Create;
  1799.   F_BookmarkRN.Clear;
  1800.   F_BookmarkID           := TList.Create;
  1801.   F_BookmarkID.Clear;
  1802.   F_Bookmarkable         := False;
  1803.   F_PostMade             := False;
  1804.   F_InPost               := False;
  1805.   F_BatchMode            := False;
  1806.  
  1807.   F_UseBrackets          := True;
  1808.   F_MasterAutoActivate   := True;
  1809.   F_DatabaseAutoActivate := False;
  1810.   F_UseRecordCountCache  := True;
  1811.   F_UseGetRecNo          := True;
  1812.   F_UseDisplayLabels     := False;
  1813.   F_UseDaoProperties     := True;
  1814.   F_AutoFindIndex        := True;
  1815.  
  1816.   F_Filtered             := False;
  1817.   F_RangeFiltered        := False;
  1818.   //************************************************************
  1819.   F_Database             := Nil;
  1820.   F_OldValue             := Nil;
  1821.   F_WarnOnBadDatabase    := False;
  1822.   F_CacheMemos           := False;
  1823.   F_CacheBlobs           := False;
  1824.   F_CacheLookups         := False;
  1825.   F_ShowGUID             := False; 
  1826.   //************************************************************
  1827.   {$IFDEF USEPARAMS}
  1828.    {$IFNDEF VER100}
  1829.     {$IFNDEF VER110}
  1830.   TStringList(F_SQL).OnChange := UpdateParamsList;
  1831.   F_ParamCheck                := True;
  1832.   F_Params                    := TParams.Create(Self);
  1833.     {$ENDIF}
  1834.    {$ENDIF}
  1835.   {$ENDIF}
  1836.   //************************************************************
  1837.   {$IFDEF DYNADAO}
  1838.    F_DetailRecordset   := NULL;
  1839.   {$ELSE}
  1840.    F_DetailRecordset   := NIL;
  1841.   {$ENDIF}
  1842.  
  1843.   F_OnFilterRecord   := Nil;
  1844.   F_OnExportProgress := Nil;
  1845.   F_OnImportProgress := Nil;
  1846.  
  1847.   F_OLE_ON:=False;
  1848.   OLE_INIT:= CoInitialize(NIL);
  1849.   if (OLE_INIT = S_OK) or (OLE_INIT = S_FALSE) then F_OLE_ON:= True
  1850.   else DatabaseError(E2001);
  1851.   //**************************************************************** Com Cashing
  1852.   DaoFields:=VarArrayCreate([0,1],VarVariant);
  1853.   //****************************************************************************
  1854.   F_IndexDefs := TKADaoIndexDefs.Create(Self);
  1855.   //****************************************************************************
  1856.   DaoOpenOptions := 0;
  1857.   DaoSortString  := '';
  1858.   Letters        := '_';
  1859.   For X := 32 to 255 do
  1860.       Begin
  1861.         if IsCharAlphaNumeric(CHR(X)) Then Letters:=Letters+CHR(X);
  1862.       End;
  1863.   InInternalOpen := False;
  1864. End;
  1865.  
  1866. destructor TKADaoTable.Destroy;
  1867. Begin
  1868.   if F_Active Then
  1869.       Begin
  1870.         Close;
  1871.         F_Active:=False;
  1872.       End;
  1873.   //**************************************************************** Com Cashing
  1874.   VarArrayRedim(DaoFields,0);
  1875.   DaoFields := NULL;
  1876.   //****************************************************************************
  1877.   F_SQL.Free;
  1878.   F_SortedBy.Free;
  1879.   F_FieldNames.Free;
  1880.   F_SortFieldNames.Free;
  1881.   F_FieldTypeNames.Free;
  1882.   F_DefaultValues.Free;
  1883.   F_MDFieldNames.Free;
  1884.   F_DisplayLabels.Free;
  1885.   F_QueryDefParameters.Free;
  1886.   F_QueryDefSQLText.Free;
  1887.   F_QD_ParamNames.Free;
  1888.   F_QD_ParamDaoTypes.Free;
  1889.   F_QD_ParamBDETypes.Free;
  1890.   F_MasterLink.Free;
  1891.   F_MasterFields.Free;
  1892.   F_Detail.Free;
  1893.   F_Master.Free;
  1894.   F_KeyFields.Free;
  1895.   F_UpdatableFields.Free;
  1896.  
  1897.   F_BookmarkRN.Free;
  1898.   F_BookmarkID.Free;
  1899.  
  1900.   //****************************************************************************
  1901.   F_IndexDefs.Free;
  1902.   //****************************************************************************
  1903.  
  1904.   {$IFDEF USEPARAMS}
  1905.    {$IFNDEF VER100}
  1906.     {$IFNDEF VER110}
  1907.   F_Params.Free;
  1908.     {$ENDIF}
  1909.    {$ENDIF}
  1910.   {$ENDIF}
  1911.   {$IFDEF DYNADAO}
  1912.   F_DaoTable  := NULL;
  1913.   {$ELSE}
  1914.   F_DaoTable  := Nil;
  1915.   {$ENDIF}
  1916.   if F_OLE_ON then CoUninitialize;
  1917.   inherited Destroy; 
  1918. End;
  1919.  
  1920. Procedure TKADaoTable.F_Set_ComponentVersion(Value: String);
  1921. Begin
  1922.  //*************************** ReadOnly
  1923. End;
  1924.  
  1925. Function TKADaoTable.ExecSQL(SQL:TStrings):Integer;
  1926. Begin
  1927.  Result:=0;
  1928.  RecordsAffected:=Result;
  1929.  if Assigned(F_Database) And (F_Database.Connected) Then
  1930.     Begin
  1931.       F_Database.CoreDatabase.Execute(F_ComposeSQL(SQL),SQLExecutionType);
  1932.       Result:=F_Database.CoreDatabase.RecordsAffected;
  1933.       RecordsAffected:=Result;
  1934.     End
  1935.  Else
  1936.     DatabaseError(E2002);
  1937. End;
  1938.  
  1939. Function TKADaoTable.ExecSQLString(SQL:String):Integer;
  1940. Var
  1941.  SQ : TStringList;
  1942. Begin
  1943.  Result:=0;
  1944.  SQ := TStringList.Create;
  1945.  Try
  1946.   RecordsAffected:=Result;
  1947.   SQ.Text:=SQL;
  1948.   if Assigned(F_Database) And (F_Database.Connected) Then
  1949.     Begin
  1950.       F_Database.CoreDatabase.Execute(F_ComposeSQL(SQ),SQLExecutionType);
  1951.       Result:=F_Database.CoreDatabase.RecordsAffected;
  1952.       RecordsAffected:=Result;
  1953.     End
  1954.   Else
  1955.     DatabaseError(E2002);
  1956.  Finally
  1957.   SQ.Free;
  1958.  End;
  1959. End;
  1960.  
  1961. Function TKADaoTable.F_RecalculateRecNo(TempRS:OleVariant;BK:Integer):Integer;
  1962. Var
  1963.   FPP : Single;
  1964.   CR  : Integer;
  1965.   RC  : Integer;
  1966. Begin
  1967.   //******************************************************************* 2.1.2001
  1968.   Result := -1;
  1969.   if Not F_UseGetRecNo Then Exit;
  1970.   //****************************************************************************
  1971.   FPP := TempRS.PercentPosition;
  1972.   //*************************************************** Decrease for calc errors
  1973.   FPP := FPP-2;
  1974.   if FPP < 0 Then FPP:=0;
  1975.   //****************************************************************************
  1976.   RC  := RecordCount;
  1977.   CR  := Round((FPP*(RC))/100);
  1978.   TempRS.MoveFirst;
  1979.   TempRS.Move(CR);
  1980.   //****************************************************************************
  1981.   While (NOT TempRS.EOF) And (GetDaoBookmark(TempRS) <> BK) do
  1982.     Begin
  1983.       TempRS.MoveNext;
  1984.       Inc(CR);
  1985.     End;
  1986.   //*************************************************************** Safety check
  1987.   if TempRS.EOF Then
  1988.      Begin
  1989.        CR  := 0;
  1990.        TempRS.MoveFirst;
  1991.        While GetDaoBookmark(TempRS) <> BK do
  1992.          Begin
  1993.           TempRS.MoveNext;
  1994.           Inc(CR);
  1995.          End;
  1996.      End;
  1997.   if TempRS.BOF Then
  1998.      Begin
  1999.        CR := RC;
  2000.        TempRS.MoveLast;
  2001.        While GetDaoBookmark(TempRS) <> BK do
  2002.          Begin
  2003.           TempRS.MovePrevious;
  2004.           Dec(CR);
  2005.          End;
  2006.      End;
  2007.   //****************************************************************************
  2008.   Result := CR;
  2009. End;
  2010.  
  2011. Function TKADaoTable.ExecuteSQL:Integer;
  2012. Begin
  2013.  Result:=0;
  2014.  RecordsAffected:=Result;
  2015.  if Assigned(F_Database) And (F_Database.Connected) Then
  2016.     Begin
  2017.       F_Database.CoreDatabase.Execute(F_ComposeSQL(SQL),SQLExecutionType);
  2018.       Result:=F_Database.CoreDatabase.RecordsAffected;
  2019.       RecordsAffected:=Result;
  2020.     End
  2021.  Else
  2022.     DatabaseError(E2003);
  2023. End;
  2024.  
  2025. Function TKADaoTable.ExecuteQueryDefSQL:Integer;
  2026. Var
  2027.  X         : Integer;
  2028.  TabN      : String;
  2029.  NRP       : Integer;
  2030.  Dir       : Integer;
  2031. Begin
  2032.  Result:=0;
  2033.  RecordsAffected:=Result;
  2034.  if Assigned(F_Database) And (F_Database.Connected) And (F_QueryDefName <> '') Then
  2035.     Begin
  2036.       TabN:=F_QueryDefName;
  2037.       NRP:=0;
  2038.       For X:=0 To Database.CoreDatabase.QueryDefs.Item[TabN].Parameters.Count-1 do
  2039.           Begin
  2040.             Dir := F_Database.CoreDatabase.QueryDefs.Item[QueryDefName].Parameters[X].Direction;
  2041.             if (Dir=dbParamInput) Or (Dir=dbParamInputOutput) Then
  2042.                 Begin
  2043.                  Try
  2044.                   if F_QueryDefParameters.Strings[NRP]='NULL' Then
  2045.                      Database.CoreDatabase.QueryDefs.Item[TabN].Parameters.Item[X].Value:=NULL
  2046.                   Else
  2047.                       Database.CoreDatabase.QueryDefs.Item[TabN].Parameters.Item[X].Value:=F_QueryDefParameters.Strings[NRP];
  2048.                   Inc(NRP);
  2049.                  Except
  2050.                   DatabaseError(E2004);
  2051.                  End;
  2052.                 End;
  2053.           End;
  2054.       if F_Database.QueryTimeout <> 60 Then
  2055.       F_Database.CoreDatabase.QueryDefs.Item[F_QueryDefName].ODBCTimeout:=F_Database.QueryTimeout;
  2056.       F_Database.CoreDatabase.QueryDefs.Item[F_QueryDefName].Execute(SQLExecutionType);
  2057.       Result:=F_Database.CoreDatabase.RecordsAffected;
  2058.       RecordsAffected:=Result;
  2059.       GetQueryDefReturnParams(F_QueryDefName);
  2060.     End
  2061.  Else
  2062.     DatabaseError(E2005);
  2063. End;
  2064.  
  2065. Function  TKADaoTable.Requery : Boolean;
  2066. Var
  2067.  X         : Integer;
  2068.  TabN      : String;
  2069.  NRP       : Integer;
  2070.  Dir       : Integer;
  2071. Begin
  2072.   Result:=False;
  2073.   If Not F_Active Then Exit;
  2074.   if Not F_DaoTable.Restartable Then Exit;
  2075.   if (F_QueryDefName <> '') Then
  2076.       Begin
  2077.         TabN:=F_QueryDefName;
  2078.         NRP:=0;
  2079.         For X:=0 To Database.CoreDatabase.QueryDefs.Item[TabN].Parameters.Count-1 do
  2080.           Begin
  2081.             Dir := F_Database.CoreDatabase.QueryDefs.Item[QueryDefName].Parameters[X].Direction;
  2082.             if (Dir=dbParamInput) Or (Dir=dbParamInputOutput) Then
  2083.                 Begin
  2084.                  Try
  2085.                   if F_QueryDefParameters.Strings[NRP]='NULL' Then
  2086.                      Database.CoreDatabase.QueryDefs.Item[TabN].Parameters.Item[X].Value:=NULL
  2087.                   Else
  2088.                      Database.CoreDatabase.QueryDefs.Item[TabN].Parameters.Item[X].Value:=F_QueryDefParameters.Strings[NRP];
  2089.                   Inc(NRP);
  2090.                  Except
  2091.                   DatabaseError(E2006);
  2092.                  End;
  2093.                 End;
  2094.           End;
  2095.       End;
  2096.   if (MasterSource <> NIL) And (Not F_MDisabled) then
  2097.      Begin
  2098.        MasterDatasetChanged;
  2099.      End
  2100.   Else
  2101.      Begin
  2102.       CheckBrowseMode;
  2103.       InternalClearBookmarks;
  2104.       ClearBuffers;
  2105.       OleVariant(F_DaoTable).Requery;
  2106.       F_RefreshRC := True;
  2107.       ActivateBuffers;
  2108.       First;
  2109.      End;
  2110.   Result:=True;
  2111. End;
  2112.  
  2113. Procedure TKADaoTable.GotoCurrent(Table: TKADaoTable);
  2114. Begin
  2115.   CheckBrowseMode;
  2116.   Table.CheckBrowseMode;
  2117.   if (AnsiCompareText(F_Database.Database, Table.Database.Database) <> 0) or
  2118.      (AnsiCompareText(TableName, Table.TableName) <> 0) then
  2119.      DatabaseError(E2007);
  2120.   Table.UpdateCursorPos;
  2121.   First;
  2122.   MoveBy(Table.RecNo-1);
  2123.   Resync([rmExact, rmCenter]);
  2124. End;
  2125.  
  2126. Procedure TKADaoTable.GetIndexNames(List: TStrings);
  2127. Var
  2128.  Count,X : Integer;
  2129. Begin
  2130.   List.Clear;
  2131.   Try
  2132.     if Assigned(F_Database) And (F_Database.Connected) Then
  2133.      Begin
  2134.       F_Database.RefreshDefinitions;
  2135.       Count :=F_Database.CoreDatabase.TableDefs.Item[F_TableName].Indexes.Count;
  2136.       For X := 0 to  Count-1 do
  2137.           Begin
  2138.             List.Add(F_Database.CoreDatabase.TableDefs.Item[F_TableName].Indexes.Item[X].Name);
  2139.           End;
  2140.      End;
  2141.   Except
  2142.   End;
  2143. End;
  2144.  
  2145. Procedure TKADaoTable.GetFieldNames(List: TStrings);
  2146. Var
  2147.  Count, X, FT  : Integer;
  2148. Begin
  2149.   List.Clear;
  2150.   Try
  2151.      if Assigned(F_Database) And (F_Database.Connected) Then
  2152.      Begin
  2153.       F_Database.RefreshDefinitions;
  2154.       Count :=F_Database.CoreDatabase.TableDefs.Item[F_TableName].Fields.Count;
  2155.       For X := 0 to  Count-1 do
  2156.           Begin
  2157.             {$IFDEF DYNADAO}
  2158.             FT :=F_Database.CoreDatabase.TableDefs.Item[F_TableName].Fields.Item[X].Type;
  2159.             {$ELSE}
  2160.             FT :=F_Database.CoreDatabase.TableDefs.Item[F_TableName].Fields.Item[X].Type_;
  2161.             {$ENDIF}
  2162.             List.AddObject(F_Database.CoreDatabase.TableDefs.Item[F_TableName].Fields.Item[X].Name,TObject(FT));
  2163.           End;
  2164.      End;
  2165.   Except
  2166.   End;
  2167. End;
  2168.  
  2169. Function TKADaoTable.PercentPosition:Single;
  2170. Begin
  2171.  Result := -1;
  2172.  if NOT F_Active  Then Exit;
  2173.  if F_DaoTable.BOF Then Exit;
  2174.  if F_DaoTable.EOF Then Exit;
  2175.  Try
  2176.     Result := F_DaoTable.PercentPosition;
  2177.  Except
  2178.  End; 
  2179. End;
  2180.  
  2181. Function  TKADaoTable.GetSourceFieldName(FieldName:String):String;
  2182. Begin
  2183.  Result :='';
  2184.  if Not F_Active Then Exit;
  2185.  Try
  2186.    Result := F_DaoTable.Fields.Item[FieldName].SourceField;
  2187.  Except
  2188.  End;
  2189. End;
  2190.  
  2191. Function  TKADaoTable.GetSourceTableName(FieldName:String):String;
  2192. Begin
  2193.  Result :='';
  2194.  if Not F_Active Then Exit;
  2195.  Try
  2196.    Result := F_DaoTable.Fields.Item[FieldName].SourceTable;
  2197.  Except
  2198.  End;
  2199. End;
  2200.  
  2201. Function  TKADaoTable.GetLastDaoError:TDaoErrRec;
  2202. Begin
  2203.   if Assigned(F_Database) And (F_Database.Connected) Then
  2204.      Result := F_Database.GetLastDaoError;
  2205. End;
  2206.  
  2207. Function TKADaoTable.PropertyExists(PropObject:OleVariant;PropertyName:String):Boolean;
  2208. Var
  2209.   X : Integer;
  2210. Begin
  2211.   Result := False;
  2212.   For X := 0 to PropObject.Count-1 do
  2213.       Begin
  2214.         if AnsiCompareText(PropObject.Item[X].Name,PropertyName)=0 Then
  2215.            Begin
  2216.              Result := True;
  2217.              Exit;
  2218.            End;
  2219.       End;
  2220. End;
  2221.  
  2222. Procedure TKADaoTable.GetQueryDefParameters(F_QD_ParamNames,F_QD_ParamDaoTypes, F_QD_ParamBDETypes:TStringList);
  2223. Var
  2224.   X       : Integer;
  2225.   Dir     : Integer;
  2226.   NP      : Integer;
  2227.   Typ     : Integer;
  2228. Begin
  2229.   if NOT Assigned(F_Database) Then Exit;
  2230.   if NOT (F_Database.Connected) Then Exit;
  2231.   if F_QueryDefName='' Then Exit;
  2232.   if Database.CoreDatabase.QueryDefs.Item[QueryDefName].Parameters.Count=0 Then
  2233.      Begin
  2234.       DatabaseError(E2008);
  2235.       Exit;
  2236.      End;
  2237.   F_QD_ParamNames.Clear;
  2238.   F_QD_ParamDaoTypes.Clear;
  2239.   F_QD_ParamBDETypes.Clear;
  2240.   Try
  2241.      NP:=0;
  2242.      For X := 0 To Database.CoreDatabase.QueryDefs.Item[QueryDefName].Parameters.Count-1 do
  2243.         Begin
  2244.           Dir:= Database.CoreDatabase.QueryDefs.Item[QueryDefName].Parameters[X].Direction;
  2245.           if (Dir=dbParamInput) Or (Dir=dbParamInputOutput) Then
  2246.              Begin
  2247.               Inc(NP);
  2248.               {$IFDEF DYNADAO}
  2249.               Typ :=Database.CoreDatabase.QueryDefs.Item[QueryDefName].Parameters[X].Type;
  2250.               {$ELSE}
  2251.               Typ :=Database.CoreDatabase.QueryDefs.Item[QueryDefName].Parameters[X].Type_;
  2252.               {$ENDIF}
  2253.               if (Typ=dbDate) Then Typ:=dbTimeStamp;
  2254.               F_QD_ParamNames.AddObject(Database.CoreDatabase.QueryDefs.Item[QueryDefName].Parameters[X].Name,TObject(Typ));
  2255.               F_QD_ParamDaoTypes.AddObject(GetDaoFieldTypeNames(Typ),TObject(Typ));
  2256.               F_QD_ParamBDETypes.AddObject(GetBDEFieldTypeNames(DaoToBDE(Typ)),TObject(DaoToBDE(Typ)));
  2257.              End;
  2258.         End;
  2259.      if NP=0 Then
  2260.         Begin
  2261.            DatabaseError(E2009);
  2262.            Exit;
  2263.         End;
  2264.   Except
  2265.       DatabaseError(E2010);
  2266.       Exit;
  2267.   End;
  2268. End;
  2269.  
  2270. Function TKADaoTable.PromptQueryDefParameters:Boolean;
  2271. Begin
  2272.   GetQueryDefParameters(F_QD_ParamNames ,F_QD_ParamDaoTypes, F_QD_ParamBDETypes);
  2273.   Application.CreateForm(TQueryDefDialog,QueryDefDialog);
  2274.   Result := QueryDefDialog.Execute(F_QD_ParamNames,F_QD_ParamDaoTypes,F_QD_ParamBDETypes,F_QueryDefParameters);
  2275.   QueryDefDialog.Free;
  2276. End;
  2277.  
  2278. Function TKADaoTable.StoreField(X:Integer): Boolean;
  2279. Begin
  2280.    Case Fields[X].FieldKind of
  2281.         fkData       : Result := True;
  2282.         fkCalculated : Result := False;
  2283.         fkLookup     : Result := False;
  2284.    Else                Result := False;
  2285.    End;
  2286.    if NOT Fields[X].Visible Then Result := False;
  2287. End;
  2288.  
  2289.  
  2290. Procedure TKADaoTable.SaveToStream(Stream: TStream);
  2291. Var
  2292.    X          : Integer;
  2293.    Book       : TBookmark;
  2294.    Writer     : TWriter;
  2295.    Current    : Integer;
  2296.    Total      : Integer;
  2297. Begin
  2298.   if IsEmpty Then Exit;
  2299.   Book         := GetBookmark;
  2300.   Try
  2301.    DisableControls;
  2302.    Writer := TWriter.Create(Stream, 16384);
  2303.    Writer.WriteSignature;
  2304.    Try
  2305.    //*************************************************** Write Structure
  2306.    Writer.WriteListBegin;
  2307.    For X:=0 to FieldCount-1 do
  2308.        Begin
  2309.         If F_ProcessMessages Then Application.ProcessMessages;
  2310.         if StoreField(X) then
  2311.            Begin
  2312.             Writer.WriteString(Fields[X].FieldName);
  2313.             Writer.WriteString(FieldTypeNames[Fields[X].DataType]);
  2314.             Writer.WriteInteger(Fields[X].Size);
  2315.             Writer.WriteString(Fields[X].DisplayName);
  2316.             Writer.WriteString(Fields[X].EditMask);
  2317.             Writer.WriteInteger(Fields[X].DisplayWidth);
  2318.             Writer.WriteBoolean(Fields[X].Required);
  2319.             Writer.WriteBoolean(Fields[X].ReadOnly);
  2320.            End;
  2321.        end;
  2322.    Writer.WriteListEnd;
  2323.  
  2324.    //******************************************************** Write Data
  2325.    Total  := RecordCount-1;
  2326.    Current:=0;
  2327.    Writer.WriteListBegin;
  2328.    First;
  2329.    While Not EOF do
  2330.      Begin
  2331.       if Assigned(F_OnExportProgress) Then F_OnExportProgress(Current,Total);
  2332.       For X:=0 to FieldCount-1 do
  2333.         Begin
  2334.           If F_ProcessMessages Then Application.ProcessMessages;
  2335.           if StoreField(X) Then
  2336.              Begin
  2337.                Case Fields[X].DataType of
  2338.                     ftBoolean   : Writer.WriteBoolean(Fields[X].AsBoolean);
  2339.                     ftSmallInt  ,
  2340.                     ftInteger   ,
  2341.                     ftWord      ,
  2342.                     ftAutoInc   : Writer.WriteInteger(Fields[X].AsInteger);
  2343.                     ftFloat     : Writer.WriteFloat(Fields[X].AsFloat);
  2344.                     ftBCD       ,
  2345.                     ftCurrency  : Writer.WriteFloat(Fields[X].AsCurrency);
  2346.                     ftDate      ,
  2347.                     ftTime      ,
  2348.                     ftDateTime  : Writer.WriteFloat(Fields[X].AsFloat);
  2349.                Else
  2350.                     Writer.WriteString(Fields[X].AsString);
  2351.                End;
  2352.              End;
  2353.         End;
  2354.       Inc(Current);
  2355.       Next;
  2356.       F_Database.Idle;
  2357.      End;
  2358.    Writer.WriteListEnd;
  2359.    Finally
  2360.      Writer.FlushBuffer;
  2361.      Writer.Free;
  2362.    End;
  2363.   Finally
  2364.     GotoBookmark(Book);
  2365.     EnableControls;
  2366.     FreeBookmark(Book);
  2367.   End;
  2368. End;
  2369.  
  2370. Procedure TKADaoTable.SaveToFile(const FileName: String);
  2371. Var
  2372.  Stream: TStream;
  2373. Begin
  2374.  Stream := TFileStream.Create(FileName, fmCreate);
  2375.  Try
  2376.   SaveToStream(Stream);
  2377.  Finally
  2378.   if Stream.Size=0 Then
  2379.      Begin
  2380.        Stream.Free;
  2381.        DeleteFile(FileName);
  2382.      End
  2383.   Else
  2384.      Begin
  2385.        Stream.Free;
  2386.      End;
  2387.  End;
  2388. End;
  2389.  
  2390. Procedure TKADaoTable.LoadFromStream(Stream: TStream; Mode : TLoadMode);
  2391. Var
  2392.   Reader       : TReader;
  2393.   FieldName    : String;
  2394.   DataTypeName : String;
  2395.   DisplayName  : String;
  2396.   EditMask     : String;
  2397.   DisplayWidth : Integer;
  2398.   Required     : Boolean;
  2399.   ReadOnly     : Boolean;
  2400.   I            : Integer;
  2401.   X            : Integer;
  2402.   Field        : TField;
  2403.   FNames       : TStringList;
  2404.   Book         : TBookmark;
  2405.   OK           : Boolean;
  2406.   Current      : LongInt;
  2407.   KbmFileVers  : Integer;
  2408. Begin
  2409.   if Not Active Then DatabaseError(E2058);
  2410.   if Mode = lmEmptyAppend Then EmptyTable;
  2411.   Book   := GetBookmark;
  2412.   Reader := TReader.Create(Stream, 16384);
  2413.   FNames := TStringList.Create;
  2414.   Try
  2415.    DisableControls;
  2416.    Reader.ReadSignature;
  2417.    if (Reader.NextValue = vaList) Then
  2418.        KbmFileVers := 100 Else
  2419.        KbmFileVers := Reader.ReadInteger;
  2420.    //************************************************************ Read Structure
  2421.    Reader.ReadListBegin;
  2422.      While (Not Reader.EndOfList) Do
  2423.       Begin
  2424.        If F_ProcessMessages Then Application.ProcessMessages;
  2425.        FieldName    := Reader.ReadString;
  2426.        DataTypeName := Reader.ReadString;
  2427.                        Reader.ReadInteger;
  2428.        DisplayName  := Reader.ReadString;
  2429.        EditMask     := Reader.ReadString;
  2430.        DisplayWidth := Reader.ReadInteger;
  2431.        Required     := Reader.ReadBoolean;
  2432.        ReadOnly     := Reader.ReadBoolean;
  2433.        if (KbmFileVers >= 250) Then Reader.ReadString;
  2434.        FNames.Add(FieldName);
  2435.        I := FieldDefs.IndexOf(FieldName);
  2436.        if I > -1 Then
  2437.           Begin
  2438.             Field:=FindField(FieldName);
  2439.             if Field <> Nil Then
  2440.                Begin
  2441.                 Field.DisplayLabel := DisplayName;
  2442.                 Field.EditMask     := EditMask;
  2443.                 Field.DisplayWidth := DisplayWidth;
  2444.                 Field.Required     := Required;
  2445.                 Field.ReadOnly     := ReadOnly;
  2446.               End
  2447.             Else
  2448.               DatabaseError(E2059);
  2449.           End
  2450.        Else
  2451.          DatabaseError(E2059);
  2452.      End;
  2453.    Reader.ReadListEnd;
  2454.    //***************************************************************** Read Data
  2455.    Last;
  2456.    Reader.ReadListBegin;
  2457.    Try
  2458.      F_Database.StartTransaction;
  2459.    Except
  2460.    End;
  2461.    Current := 0;
  2462.    While (NOT Reader.EndOfList) do
  2463.     Begin
  2464.      if Assigned(F_OnImportProgress) Then F_OnImportProgress(Current);
  2465.      OK := False;
  2466.      For X :=0 to FNames.Count-1 do
  2467.          Begin
  2468.           If F_ProcessMessages Then Application.ProcessMessages;
  2469.           Field := FindField(FNames.Strings[X]);
  2470.           if (Field <> Nil) Then
  2471.              Begin
  2472.                if NOT OK Then
  2473.                   Begin
  2474.                     OK := True;
  2475.                     Insert;
  2476.                   End;
  2477.                Case Field.DataType of
  2478.                     ftBoolean  : if Not Field.ReadOnly Then Field.AsBoolean  := Reader.ReadBoolean Else Reader.ReadBoolean;
  2479.                     ftSmallInt ,
  2480.                     ftInteger  ,
  2481.                     ftWord     ,
  2482.                     ftAutoInc  : if Not Field.ReadOnly Then Field.AsInteger  := Reader.ReadInteger Else Reader.ReadInteger;
  2483.                     ftFloat    : if Not Field.ReadOnly Then Field.AsFloat    := Reader.ReadFloat   Else Reader.ReadFloat;
  2484.                     ftBCD,
  2485.                     ftCurrency : if Not Field.ReadOnly Then Field.AsCurrency := Reader.ReadFloat   Else Reader.ReadFloat;
  2486.                     ftDate     ,
  2487.                     ftTime     ,
  2488.                     ftDateTime : if Not Field.ReadOnly Then Field.AsFloat    := Reader.ReadFloat   Else Reader.ReadFloat;
  2489.                Else
  2490.                     Begin
  2491.                       if Not Field.ReadOnly Then            Field.AsString   := Reader.ReadString  Else Reader.ReadString;
  2492.                     End;
  2493.                End;
  2494.              End;
  2495.          End;
  2496.      if OK Then Post;
  2497.      F_Database.Idle;
  2498.      Inc(Current);
  2499.     End;
  2500.    Try
  2501.      F_Database.Commit;
  2502.    Except
  2503.    End;
  2504.    Reader.ReadListEnd;
  2505.   Finally
  2506.    Reader.Free;
  2507.    FNames.Free;
  2508.    if Mode = lmAppend Then GotoBookmark(Book);
  2509.    EnableControls;
  2510.    FreeBookmark(Book);
  2511.   End;
  2512. End;
  2513.  
  2514.  
  2515. Procedure TKADaoTable.LoadFromFile(const FileName: String; Mode : TLoadMode);
  2516. Var
  2517.  Stream: TStream;
  2518. Begin
  2519.  if Not Active Then DatabaseError(E2058);
  2520.  Stream := TFileStream.Create(FileName, fmOpenRead);
  2521.  Try
  2522.   LoadFromStream(Stream, Mode);
  2523.  Finally
  2524.   Stream.Free;
  2525.  End;
  2526. End;
  2527.  
  2528. Function TKADaoTable.F_Get_Database:TKADaoDatabase;
  2529. Begin
  2530.  Result:=F_Database;
  2531. End;
  2532.  
  2533. Procedure TKADaoTable.F_Set_Database(Value:TKADaoDatabase);
  2534. Begin
  2535.  if Active Then DatabaseError(E2011);
  2536.  {$IFDEF VER130}
  2537.  if Assigned(F_Database) Then F_Database.RemoveFreeNotification(Self);
  2538.  {$ENDIF}
  2539.  F_Database := Value;
  2540.  if Assigned(F_Database) Then F_Database.FreeNotification(Self);
  2541. End;
  2542.  
  2543. Function TKADaoTable.F_Get_DateCreated:String;
  2544. Begin
  2545.  Result := '';
  2546.  if F_Active Then
  2547.     Begin
  2548.      Try
  2549.       if TableType=dbOpenTable Then Result:=F_DaoTable.DateCreated
  2550.       Else
  2551.       if F_QueryDefName <> '' then Result:=Database.CoreDatabase.QueryDefs.Item[F_QueryDefName].DateCreated;
  2552.      Except
  2553.      End;
  2554.     End;
  2555. End;
  2556.  
  2557. Function TKADaoTable.F_Get_LastUpdated:String;
  2558. Begin
  2559.  Result := '';
  2560.  if F_Active Then
  2561.     Begin
  2562.      Try
  2563.       if TableType=dbOpenTable Then Result:=F_DaoTable.LastUpdated
  2564.       Else
  2565.       if F_QueryDefName <> '' then Result:=Database.CoreDatabase.QueryDefs.Item[F_QueryDefName].LastUpdated;
  2566.      Except
  2567.      End;
  2568.     End;
  2569. End;
  2570.  
  2571. Function TKADaoTable.F_Get_TableName:String;
  2572. Begin
  2573.  Result:= F_TableName;
  2574. End;
  2575.  
  2576. Procedure TKADaoTable.F_Set_TableName(Value:String);
  2577. Begin
  2578.   if Active Then DatabaseError(E2012);
  2579.   F_TableName:=Value;
  2580.   if Value <> '' Then
  2581.      Begin
  2582.       F_IndexName:='';
  2583.       F_SQL.Clear;
  2584.       F_QueryDefName:='';
  2585.       F_QueryDefSQLText.Clear;
  2586.       F_QueryDefParameters.Clear;
  2587.       F_SortedBy.Clear;
  2588.       F_DisplayLabels.Clear;
  2589.       FieldDefs.Clear;
  2590.       IndexDefs.Clear;
  2591.      End;
  2592. End;
  2593.  
  2594. Procedure TKADaoTable.F_Set_SQL(Value:TStrings);
  2595. Begin
  2596.  F_SQL.SetText(Value.GetText);
  2597.  if Length(Value.GetText) > 0 Then
  2598.     Begin
  2599.      F_QueryDefParameters.Clear;
  2600.      F_QueryDefSQLText.Clear;
  2601.      F_QueryDefName:='';
  2602.      F_IndexName:='';;
  2603.      F_TableName:='';
  2604.      F_DisplayLabels.Clear;
  2605.      FieldDefs.Clear;
  2606.      IndexDefs.Clear;
  2607.     End;
  2608. End;
  2609.  
  2610. Procedure TKADaoTable.F_Set_QueryDefName(Value:String);
  2611. Begin
  2612.   if F_Active Then DatabaseError(E2065);
  2613.   Try
  2614.     if Assigned(F_Database) And (F_Database.Connected) Then
  2615.        Begin
  2616.          F_QueryDefSQLText.Clear;
  2617.          if Value <> '' Then F_QueryDefSQLText.SetText(PChar(F_Database.GetQueryDefSQLText(Value)));
  2618.        End;
  2619.   Except
  2620.   End;
  2621.   F_QueryDefName:=Value;
  2622.   F_QueryDefType:=F_Get_QueryDefType;
  2623.   if Value <> '' Then
  2624.      Begin
  2625.       F_IndexName:='';
  2626.       F_TableName:='';
  2627.       F_SQL.Clear;
  2628.       F_QueryDefParameters.Clear;
  2629.       F_Master.Clear;
  2630.       F_Detail.Clear;
  2631.       F_MasterFields.Clear;
  2632.       F_DisplayLabels.Clear;
  2633.       FieldDefs.Clear;
  2634.       IndexDefs.Clear;
  2635.       if (F_TableType=dbOpenTable)
  2636.       Or (F_TableType=dbOpenDynamic) Then F_TableType:=dbOpenDynaset;
  2637.      End;
  2638. End;
  2639.  
  2640.  
  2641.  
  2642. Function TKADaoTable.F_Get_IndexName:String;
  2643. Begin
  2644.  Result:= F_IndexName;
  2645. End;
  2646.  
  2647. Procedure TKADaoTable.F_Set_IndexName(Value:String);
  2648. Begin
  2649.   if Active Then
  2650.      Begin
  2651.        if (TableType=dbOpenTable) Then
  2652.           Begin
  2653.              F_SortedBy.Clear;
  2654.              F_DaoTable.Index  := Value;
  2655.              CheckBrowseMode;
  2656.              ClearBuffers;
  2657.              F_RefreshRC := True;
  2658.              ActivateBuffers;
  2659.              First;
  2660.           End
  2661.        Else if Value <> '' Then DatabaseError(E2013);
  2662.      End
  2663.    Else
  2664.      Begin
  2665.        if (TableType=dbOpenTable) And (Value <> '') Then
  2666.           Begin
  2667.             F_SortedBy.Clear;
  2668.           End
  2669.        Else
  2670.           Begin
  2671.             if Value <> '' Then DatabaseError(E2013);
  2672.           End;
  2673.      End;
  2674.   F_IndexName:=Value;
  2675. End;
  2676.  
  2677. Function  TKADaoTable.F_Get_IndexFieldNames:String;
  2678. Var
  2679.   X     : Integer;
  2680.   Count : Integer;
  2681. Begin
  2682.   Result := '';
  2683.   if F_IndexName='' Then Exit;
  2684.   Try
  2685.     Count := F_Database.CoreDatabase.TableDefs.Item[F_TableName].Indexes.Item[F_IndexName].Fields.Count-1;
  2686.     For X := 0 To Count do
  2687.       Begin
  2688.         if X = Count Then
  2689.            Result := Result + F_Database.CoreDatabase.TableDefs.Item[F_TableName].Indexes.Item[F_IndexName].Fields.Item[X].Name
  2690.         Else
  2691.            Result := Result + F_Database.CoreDatabase.TableDefs.Item[F_TableName].Indexes.Item[F_IndexName].Fields.Item[X].Name+';';
  2692.       End;
  2693.   Except
  2694.   End;
  2695. End;
  2696.  
  2697. Function  TKADaoTable.F_Get_IndexFieldCount:Integer;
  2698. Begin
  2699.  F_IndexFieldCount := 0;
  2700.  if  (TableType=dbOpenTable)
  2701.  And (Assigned(F_Database))
  2702.  And (F_Database.Connected)
  2703.  And (F_TableName <> '')
  2704.  And (F_IndexName <> '') Then
  2705.      Begin
  2706.       Try
  2707.        F_IndexFieldCount := F_Database.CoreDatabase.TableDefs.Item[F_TableName].Indexes.Item[F_IndexName].Fields.Count;
  2708.       Except
  2709.        F_IndexFieldCount := 0;
  2710.       End;
  2711.      End;
  2712.  Result := F_IndexFieldCount;
  2713. End;
  2714.  
  2715. Procedure TKADaoTable.F_Set_IndexFieldCount(Value:Integer);
  2716. Begin
  2717.  //******************************************************************* Read Only
  2718. End;
  2719.  
  2720. Function  TKADaoTable.FindGoodIndex(KeyFields:String):String;
  2721. Var
  2722.   KFL    :  TStringList;
  2723.   IFL    :  TStringList;
  2724.   X,Y    :  Integer;
  2725.   BR     :  Integer;
  2726.   Exact  :  Boolean;
  2727.   Value  :  String;
  2728. Begin
  2729.   Result := '';
  2730.   //****************************************************************************
  2731.   if IndexDefs.Count=0 Then Exit;
  2732.   if TableType <> dbOpenTable then Exit;
  2733.   if KeyFields='' Then Exit;
  2734.   Value := KeyFields;
  2735.   if Value[1]='!' Then
  2736.      Begin
  2737.       Exact:=True;
  2738.       System.Delete(Value,1,1);
  2739.      End
  2740.   Else
  2741.      Begin
  2742.        Exact:=False;
  2743.      End;
  2744.   if Value = '' Then Exit;
  2745.   //****************************************************************************
  2746.  
  2747.   KFL := TStringList.Create;
  2748.   IFL := TStringList.Create;
  2749.   Try
  2750.     StringToList(Value,KFL);
  2751.     For X := 0 To IndexDefs.Count-1 Do
  2752.       Begin
  2753.         StringToList(IndexDefs.Items[X].Fields,IFL);
  2754.         if Exact Then
  2755.            Begin
  2756.              if IFL.Count = KFL.Count Then
  2757.                 Begin
  2758.                   BR:=0;
  2759.                   For Y := 0 to KFL.Count-1 do
  2760.                     Begin
  2761.                       if NOT (IFL.IndexOf(KFL.Strings[Y]) < 0) Then Inc(BR);
  2762.                     End;
  2763.                   if BR=KFL.Count Then
  2764.                      Begin
  2765.                       Result := IndexDefs.Items[X].Name;
  2766.                       Exit;
  2767.                      End;
  2768.                 End;
  2769.            End
  2770.         Else
  2771.            Begin
  2772.              if IFL.Count >= KFL.Count Then
  2773.                 Begin
  2774.                    BR:=0;
  2775.                    For Y := 0 to KFL.Count-1 do
  2776.                     Begin
  2777.                       if NOT (IFL.IndexOf(KFL.Strings[Y]) < 0) Then Inc(BR);
  2778.                     End;
  2779.                    if BR=KFL.Count Then
  2780.                       Begin
  2781.                        Result:=IndexDefs.Items[X].Name;
  2782.                        if KFL.IndexOf(IFL.Strings[0]) <> -1 Then Exit;
  2783.                       End;
  2784.                  End;
  2785.            End;
  2786.       End;
  2787.   Finally
  2788.     KFL.Free;
  2789.     IFL.Free;
  2790.   End;
  2791. End;
  2792.  
  2793. Procedure TKADaoTable.F_Set_IndexFieldNames(Value:String);
  2794. Var
  2795.   S : String;
  2796. Begin
  2797.   if TableType <> dbOpenTable then Exit;
  2798.   if Value='' Then
  2799.      Begin
  2800.        F_Set_IndexName(Value);
  2801.        Exit;
  2802.      End;
  2803.   S:=FindGoodIndex(Value);
  2804.   if S <> '' Then F_Set_IndexName(S);
  2805. End;
  2806.  
  2807. Function TKADaoTable.F_Get_IndexField(Index: Integer): TField;
  2808. Var
  2809.  FieldName:String;
  2810. Begin
  2811.  Result := Nil;
  2812.  if NOT Active Then DatabaseError(E2014);
  2813.  if F_IndexName='' Then Exit;
  2814.  Try
  2815.   FieldName:=F_Database.CoreDatabase.TableDefs.Item[F_TableName].Indexes.Item[F_IndexName].Fields.Item[Index].Name;
  2816.  Except
  2817.   Exit;
  2818.  End;
  2819.  Result := FindField(FieldName);
  2820. End;
  2821.  
  2822. Procedure TKADaoTable.F_Set_IndexField(Index: Integer; Value: TField);
  2823. Begin
  2824.  //******************************************************************* Read Only
  2825. End;
  2826.  
  2827. Procedure TKADaoTable.F_SetBatchMode(Value:Boolean);
  2828. Begin
  2829.  F_BatchMode := Value;
  2830.  if Value Then DisableControls Else EnableControls; 
  2831.  if Not Value Then
  2832.     Begin
  2833.       Resync([]); //************************************** 3.1.2002
  2834.       if F_UseGetRecNo Then GetRecNo;  
  2835.     End;
  2836. End;
  2837.  
  2838. Procedure TKADaoTable.F_Set_TableType(Value:Integer);
  2839. Begin
  2840.   if Active Then DatabaseError(E2015);
  2841.   F_TableType:=Value;
  2842.   if F_TableType=dbOpenTable Then
  2843.      Begin
  2844.        F_SortedBy.Clear;
  2845.      End
  2846.   Else
  2847.      Begin
  2848.        F_IndexName:='';
  2849.        IndexDefs.Clear;
  2850.      End;
  2851.   if F_TableType=dbOpenForwardOnly Then F_SortedBy.Clear;
  2852. End;
  2853.  
  2854. Procedure TKADaoTable.F_Set_LockType(Value:Integer);
  2855. Begin
  2856.   if Active Then DatabaseError(E2016);
  2857.   F_LockType:=Value;
  2858. End;
  2859.  
  2860. Procedure TKADaoTable.F_Set_OpenOptions(Value:TOOSet);
  2861. Begin
  2862.   F_OpenOptions:=Value;
  2863.   if F_Active Then
  2864.      Begin
  2865.        CheckBrowseMode;
  2866.        ClearBuffers;
  2867.        CloseDaoRecordset;
  2868.        OpenDaoRecordset;
  2869.        ActivateBuffers;
  2870.        First;
  2871.      End;
  2872. End;
  2873.  
  2874. Procedure TKADaoTable.LockTable(LockType: TLockType);
  2875. Var
  2876.   OO:TOOSet;
  2877. Begin
  2878.   if LockType = ltReadLock  Then OO := F_OpenOptions+[dbDenyRead];
  2879.   if LockType = ltWriteLock Then OO := F_OpenOptions+[dbDenyWrite];
  2880.   if Active Then F_Set_OpenOptions(OO);
  2881. End;
  2882.  
  2883. Procedure TKADaoTable.UnlockTable(LockType: TLockType);
  2884. Var
  2885.   OO:TOOSet;
  2886. Begin
  2887.   if LockType = ltReadLock  Then OO := F_OpenOptions-[dbDenyRead];
  2888.   if LockType = ltWriteLock Then OO := F_OpenOptions-[dbDenyWrite];
  2889.   if Active Then F_Set_OpenOptions(OO);
  2890. End;
  2891.  
  2892. Procedure TKADaoTable.F_Set_ReadOnly(Value:Boolean);
  2893. Begin
  2894.   if Active Then DatabaseError(E2017);
  2895.   if Assigned(F_Database) And (F_Database.Connected) and (F_Database.ReadOnly) And (NOT Value) Then
  2896.      Begin
  2897.        Value := True;
  2898.      End;
  2899.   F_ReadOnly:=Value;
  2900. End;
  2901.  
  2902. Procedure TKADaoTable.SetLockEdits(LockEdits : Boolean);
  2903. Begin
  2904.   if  (Active)
  2905.   And (F_Database.DatabaseType <> 'ODBC')
  2906.   And (NOT F_Database.ReadOnly)                                 
  2907.   And (NOT F_ReadOnly)
  2908.   And ((F_TableType = dbOpenTable) Or (F_TableType = dbOpenDynaset)) Then
  2909.       Begin
  2910.         F_DaoTable.LockEdits := LockEdits;
  2911.       End;
  2912. End;
  2913.  
  2914. Procedure TKADaoTable.F_Set_LockEdits(Value:Boolean);
  2915. Begin
  2916.   //****************************************************************** Read Only
  2917. End;
  2918.  
  2919. Function TKADaoTable.F_Get_LockEdits:Boolean;
  2920. Begin
  2921.   Result := False;
  2922.   if  (Active)
  2923.   And (F_Database.DatabaseType <> 'ODBC')
  2924.   And (NOT F_Database.ReadOnly)
  2925.   And (NOT F_ReadOnly)
  2926.   And ((F_TableType = dbOpenTable) Or (F_TableType = dbOpenDynaset)) Then
  2927.       Begin
  2928.         Result := F_DaoTable.LockEdits;
  2929.       End;
  2930. End;
  2931.  
  2932. Procedure TKADaoTable.F_Set_Sort(Value:TStrings);
  2933. Begin
  2934.  F_SortedBy.SetText(Value.GetText);
  2935.  F_IndexName:='';
  2936.  if F_Active Then
  2937.     Begin
  2938.      CheckBrowseMode;
  2939.      ClearBuffers;
  2940.      CloseDaoRecordset;
  2941.      OpenDaoRecordset;
  2942.      ActivateBuffers;
  2943.      First;
  2944.     End;
  2945. End;
  2946.  
  2947. Procedure TKADaoTable.Sort;
  2948. Begin
  2949.  if F_Active Then
  2950.     Begin
  2951.      CheckBrowseMode;
  2952.      ClearBuffers;
  2953.      CloseDaoRecordset;
  2954.      OpenDaoRecordset;
  2955.      ActivateBuffers;
  2956.      First;
  2957.     End;
  2958. End;
  2959.  
  2960. Procedure TKADaoTable.F_Set_QueryDefParameters(Value:TStrings);
  2961. Begin
  2962.  F_QueryDefParameters.SetText(Value.GetText);
  2963. End;
  2964.  
  2965. Procedure TKADaoTable.F_Set_QueryDefSQLText(Value:TStrings);
  2966. Begin
  2967. //*************************** READ ONLY
  2968. End;
  2969.  
  2970. Function TKADaoTable.F_Get_QueryDefType:String;
  2971. Var
  2972.  QDType : Integer;
  2973. Begin
  2974.  Result:='';
  2975.  QueryDefTypeInt:=0;
  2976.  Try
  2977.   if Assigned(F_Database) And (F_Database.Connected) And (F_QueryDefName <> '') Then
  2978.     Begin
  2979.       {$IFDEF DYNADAO}
  2980.       QDType:=Database.CoreDatabase.QueryDefs.Item[F_QueryDefName].Type;
  2981.       {$ELSE}
  2982.       QDType:=Database.CoreDatabase.QueryDefs.Item[F_QueryDefName].Type_;
  2983.       {$ENDIF}
  2984.       if QDType=dbQSelect         Then Begin Result := 'dbQSelect'        ; QueryDefTypeInt := dbQSelect         ; End;
  2985.       if QDType=dbQProcedure      Then Begin Result := 'dbQProcedure'     ; QueryDefTypeInt := dbQProcedure      ; End;
  2986.       if QDType=dbQAction         Then Begin Result := 'dbQAction'        ; QueryDefTypeInt := dbQAction         ; End;
  2987.       if QDType=dbQCrosstab       Then Begin Result := 'dbQCrosstab'      ; QueryDefTypeInt := dbQCrosstab       ; End;
  2988.       if QDType=dbQDelete         Then Begin Result := 'dbQDelete'        ; QueryDefTypeInt := dbQDelete         ; End;
  2989.       if QDType=dbQUpdate         Then Begin Result := 'dbQUpdate'        ; QueryDefTypeInt := dbQUpdate         ; End;
  2990.       if QDType=dbQAppend         Then Begin Result := 'dbQAppend'        ; QueryDefTypeInt := dbQAppend         ; End;
  2991.       if QDType=dbQMakeTable      Then Begin Result := 'dbQMakeTable'     ; QueryDefTypeInt := dbQMakeTable      ; End;
  2992.       if QDType=dbQDDL            Then Begin Result := 'dbQDDL'           ; QueryDefTypeInt := dbQDDL            ; End;
  2993.       if QDType=dbQSQLPassThrough Then Begin Result := 'dbQSQLPassThrough'; QueryDefTypeInt := dbQSQLPassThrough ; End;
  2994.       if QDType=dbQSetOperation   Then Begin Result := 'dbQSetOperation'  ; QueryDefTypeInt := dbQSetOperation   ; End;
  2995.       if QDType=dbQSPTBulk        Then Begin Result := 'dbQSPTBulk'       ; QueryDefTypeInt := dbQSPTBulk        ; End;
  2996.       if QDType=dbQCompound       Then Begin Result := 'dbQCompound'      ; QueryDefTypeInt := dbQCompound       ; End;
  2997.     End;
  2998.  Except
  2999.  End;
  3000. End;
  3001.  
  3002. Function TKADaoTable.WWStringReplace(Src,Pattern,Repl:String):String;
  3003. Var
  3004.   S  : String;
  3005.   Pat: String;
  3006.   L  : Integer;
  3007.   P  : Integer;
  3008.   PR : Integer;
  3009. Begin
  3010.   Result := Src;
  3011.   L := Length(Result);
  3012.   if L=0 Then Exit;
  3013.   Result := '';
  3014.   S   := ' '+AnsiLowerCase(Src)+' ';
  3015.   Pat := AnsiLowerCase(Pattern);
  3016.   L   := Length(Pat);
  3017.   Repeat
  3018.     P := AnsiPos(Pat,S);
  3019.     if P > 0 Then
  3020.        Begin
  3021.         PR := P-1;
  3022.         if  (Pos(S[P-1],Letters) = 0)
  3023.         And (Pos(S[P+L],Letters) = 0) Then
  3024.           Begin
  3025.             Result := Result+System.Copy(Src,1,PR-1);
  3026.             Result := Result+Repl;
  3027.           End
  3028.         Else
  3029.           Begin
  3030.            Result := Result+System.Copy(Src,1,PR+L-1);
  3031.           End;
  3032.         System.Delete(S,1,P+L-1);
  3033.         System.Delete(Src,1,PR+L-1);
  3034.         S:=' '+S;
  3035.        End;
  3036.   Until P =0;
  3037.   Result := Result+Src;
  3038. End;
  3039.  
  3040. Function TKADaoTable.ChangeQuotes(S:String):String;
  3041. Var
  3042.  X, L : Integer;
  3043. Begin
  3044.  Result := '';
  3045.  L      := Length(S);
  3046.  if L   =  0 Then Exit;
  3047.  For X := 1 To L do
  3048.      Begin
  3049.        Result := Result+S[X];
  3050.        if S[X]='"' Then Result := Result+'"';
  3051.      End;
  3052. End;
  3053.  
  3054. Function TKADaoTable.ChangeCommas(S:String):String;
  3055. Var
  3056.  X, L : Integer;
  3057. Begin
  3058.  Result := '';
  3059.  L      := Length(S);
  3060.  if L   =  0 Then Exit;
  3061.  For X := 1 To L do
  3062.      Begin
  3063.        if S[X]=DecimalSeparator Then
  3064.           Result := Result+'.'
  3065.        Else
  3066.        if S[X]<> ThousandSeparator Then Result := Result+S[X];
  3067.      End;
  3068. End;
  3069.  
  3070. Function TKADaoTable.F_ComposeSQL(SQL:TStrings):String;
  3071. Var
  3072.  X       : Integer;
  3073. {$IFDEF USEPARAMS}
  3074.  {$IFNDEF VER100}
  3075.   {$IFNDEF VER110}
  3076.  S, Sep  : String;
  3077.   {$ENDIF}
  3078.  {$ENDIF}
  3079. {$ENDIF}
  3080.  
  3081. Begin
  3082.  Result:='';
  3083.  For X:=0 To SQL.Count-1 do
  3084.      Begin
  3085.        Result := Result+SQL.Strings[X];
  3086.        if X <  SQL.Count-1 Then Result := Result+' ';
  3087.      End;
  3088.  {$IFDEF USEPARAMS}
  3089.   {$IFNDEF VER100}
  3090.    {$IFNDEF VER110}
  3091.  if F_ParamCheck then
  3092.     Begin
  3093.       For X := 0 to F_Params.Count - 1 do
  3094.         Begin
  3095.             if F_Params[X].IsNull Then
  3096.                Begin
  3097.                  S := ' IS NULL';
  3098.                End
  3099.             Else
  3100.                Begin
  3101.                  Case F_Params[X].DataType of
  3102.                       ftDateTime   ,
  3103.                       ftDate       ,
  3104.                       ftTime       : Sep := '#';
  3105.                       ftUnknown    : Sep := '';
  3106.                       ftString     : Sep := '"';
  3107.                  Else
  3108.                       Sep := '';
  3109.                  end;
  3110.                  //******************************************************* 04.10.2001
  3111.                  Case F_Params[X].DataType of
  3112.                       ftBytes   : Begin
  3113.                                     S:= Sep + '{guid '+GetGUIDAsString(F_Params[X].AsString)+'}'   + Sep;
  3114.                                   End;
  3115.                       ftDate    : Begin
  3116.                                     S:= Sep + FormatDateTime('mm"/"dd"/"yyyy', F_Params[X].AsDate) + Sep;
  3117.                                   End;
  3118.                       ftTime    : Begin
  3119.                                     S:= Sep + FormatDateTime('hh":"nn":"ss', F_Params[X].AsTime)   + Sep;
  3120.                                   End;
  3121.                       ftDateTime: Begin
  3122.                                     S:= Sep + FormatDateTime('mm"/"dd"/"yyyy hh":"nn":"ss', F_Params[X].AsDateTime) + Sep;
  3123.                                   End;
  3124.                       ftString  : Begin
  3125.                                     S:= Sep + ChangeQuotes(F_Params[X].AsString) + Sep;
  3126.                                   End;
  3127.                       ftCurrency,
  3128.                  ftFloat   :  Begin
  3129.                                     S:= Sep + ChangeCommas(F_Params[X].AsString) + Sep;
  3130.                                   End;
  3131.                       Else
  3132.                          S := Sep + F_Params[X].AsString + Sep;
  3133.                  End;
  3134.                 //******************************************************************
  3135.                End;
  3136.             Result := WWStringReplace(Result, ':' + F_Params[X].Name, S);
  3137.         end;
  3138.     End;
  3139.    {$ENDIF}
  3140.   {$ENDIF}
  3141.  {$ENDIF}
  3142. End;
  3143.  
  3144. Procedure TKADaoTable.SetFiltered(Value:Boolean);
  3145. var
  3146.   Old_Filtered : Boolean;
  3147. Begin
  3148.   Old_Filtered := F_Filtered;
  3149.   Try
  3150.     F_Filtered:=Value;
  3151.     if F_Filtered=Old_Filtered Then Exit;
  3152.     if F_Active Then
  3153.        Begin
  3154.          CheckBrowseMode;
  3155.          ClearBuffers;
  3156.          CloseDaoRecordset;
  3157.          OpenDaoRecordset;
  3158.          ActivateBuffers;
  3159.          First;
  3160.        End;
  3161.   Except
  3162.     F_Filtered := Old_Filtered;
  3163.     Raise;
  3164.   End;
  3165.   Inherited SetFiltered(F_Filtered);
  3166. End;
  3167.  
  3168. Procedure TKADaoTable.SetFilterText(Const Value:String);
  3169. Begin
  3170.   F_Filter:=Value;
  3171.   if (F_Active) And (F_Filtered) Then
  3172.      Begin
  3173.        CheckBrowseMode;
  3174.        ClearBuffers;
  3175.        CloseDaoRecordset;
  3176.        OpenDaoRecordset;
  3177.        ActivateBuffers;
  3178.        First;
  3179.      End;
  3180.   Inherited SetFilterText(F_Filter);
  3181. End;
  3182.  
  3183. Procedure TKADaoTable.F_Set_CacheMemos(Value:Boolean);
  3184. Begin
  3185.   F_CacheMemos:=Value;
  3186.   if (csLoading in ComponentState) Then Exit;
  3187.   if (F_Active) Then
  3188.      Begin
  3189.        Close;
  3190.        Open;
  3191.        First;
  3192.      End;
  3193. End;
  3194.  
  3195. Procedure TKADaoTable.F_Set_CacheBlobs(Value:Boolean);
  3196. Begin
  3197.   F_CacheBlobs:=Value;
  3198.   if (csLoading in ComponentState) Then Exit;
  3199.   if (F_Active) Then
  3200.      Begin
  3201.        Close;
  3202.        Open;
  3203.        First;
  3204.      End;
  3205. End;
  3206.  
  3207. Procedure TKADaoTable.F_Set_ShowGUID(Value:Boolean);
  3208. Begin
  3209.   F_ShowGUID:=Value;
  3210.   if (csLoading in ComponentState) Then Exit;
  3211.   if (F_Active) Then
  3212.      Begin
  3213.        Close;
  3214.        Open;
  3215.        First;
  3216.      End;
  3217. End;
  3218.  
  3219. Procedure TKADaoTable.F_Set_CacheLookups(Value:Boolean);
  3220. Begin
  3221.   F_CacheLookups:=Value;
  3222.   if (csLoading in ComponentState) Then Exit;
  3223.   if (F_Active) Then
  3224.      Begin
  3225.        Close;
  3226.        Open;
  3227.        First;
  3228.      End;
  3229. End;
  3230.  
  3231. Procedure TKADaoTable.F_Set_Encrypter(Value:TComponent);
  3232. Begin
  3233.   F_Encrypter := Value;
  3234.   if (csLoading in ComponentState) Then Exit;
  3235.   if (F_Active) Then
  3236.      Begin
  3237.        Close;
  3238.        Open;
  3239.        First;
  3240.      End;
  3241. End;
  3242.  
  3243.  
  3244. Procedure TKADaoTable.F_Set_OnFilterRecord(Value: TFilterRecordEvent);
  3245. Begin
  3246.   F_OnFilterRecord:=Value;
  3247.   if (F_Active) And (F_Filtered) Then
  3248.      Begin
  3249.        CheckBrowseMode;
  3250.        ClearBuffers;
  3251.        CloseDaoRecordset;
  3252.        OpenDaoRecordset;
  3253.        ActivateBuffers;
  3254.        First;
  3255.      End;
  3256.   Inherited OnFilterRecord:=Value;
  3257. End;
  3258.  
  3259. //******************************************************************************
  3260. Function TKADaoTable.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
  3261. Begin
  3262.   Result:=TKBlobStream.Create(TBlobField(Field),Mode);
  3263. End;
  3264.  
  3265. Function TKADaoTable.InternalCalcRecordSize:Integer;
  3266. Begin
  3267.  F_RecordSize:=0;
  3268.  Result:=F_RecordSize;
  3269. End;
  3270.  
  3271.  
  3272. Procedure TKADaoTable.GetQueryDefReturnParams(QueryDefName:String);
  3273. Var
  3274.   X, Dir, NRP : Integer;
  3275. Begin
  3276.   if (NOT Assigned(F_Database)) OR (NOT F_Database.Connected) Then Exit;
  3277.   if NOT VarIsNull(QueryDefReturnParams) Then QueryDefReturnParams:=NULL;
  3278.   NRP:=0;
  3279.  Try
  3280.   For X:=0 To F_Database.CoreDatabase.QueryDefs.Item[QueryDefName].Parameters.Count-1 do
  3281.       Begin
  3282.         Dir := F_Database.CoreDatabase.QueryDefs.Item[QueryDefName].Parameters[X].Direction;
  3283.         if (Dir=dbParamOutput) Or (Dir=dbParamInputOutput) Or (Dir=dbParamReturnValue) Then Inc(NRP);
  3284.       End;
  3285.   if NRP=0 Then Exit;
  3286.   if NRP=1 Then
  3287.       Begin
  3288.        For X:=0 To F_Database.CoreDatabase.QueryDefs.Item[QueryDefName].Parameters.Count-1 do
  3289.            Begin
  3290.             Dir := F_Database.CoreDatabase.QueryDefs.Item[QueryDefName].Parameters[X].Direction;
  3291.             if (Dir=dbParamOutput) Or (Dir=dbParamInputOutput) Or (Dir=dbParamReturnValue) Then
  3292.                Begin
  3293.                  QueryDefReturnParams:=F_Database.CoreDatabase.QueryDefs.Item[QueryDefName].Parameters[X].Value;
  3294.                  Exit;
  3295.                End;
  3296.            End;
  3297.       End
  3298.   Else
  3299.       Begin
  3300.         QueryDefReturnParams:=VarArrayCreate([0, NRP],varVariant);
  3301.         For X:=0 To F_Database.CoreDatabase.QueryDefs.Item[QueryDefName].Parameters.Count-1 do
  3302.            Begin
  3303.              Dir := F_Database.CoreDatabase.QueryDefs.Item[QueryDefName].Parameters[X].Direction;
  3304.              if (Dir=dbParamOutput) Or (Dir=dbParamInputOutput) Or (Dir=dbParamReturnValue) Then
  3305.                 QueryDefReturnParams[X]:=F_Database.CoreDatabase.QueryDefs.Item[QueryDefName].Parameters[X].Value;
  3306.            End;
  3307.      End;
  3308.  Except
  3309.  End;
  3310. End;
  3311.  
  3312. Function TKADaoTable.ProcessDTDefault(S:String):String;
  3313. Var
  3314.  P         : Integer;
  3315.  M,D,Y     : Integer;
  3316.  Ho,Mi,
  3317.  Se,Ms     : Integer;
  3318.  DT        : TDateTime;
  3319.  DTS       : TTimeStamp;
  3320. Begin
  3321.  Result := '';
  3322.  if S = '' Then Exit;
  3323.  Try
  3324.  Ho := 0;
  3325.  Mi := 0;
  3326.  Se := 0;
  3327.  Ms := 0;
  3328.  P := Pos('/',S);
  3329.  //********************************** Mesec
  3330.  M :=0;
  3331.  if P > 0 Then
  3332.     Begin
  3333.      M := StrToInt(Copy(S,1,P-1));
  3334.      System.Delete(S,1,P);
  3335.     End;
  3336.   //********************************** Den
  3337.   D := 0;
  3338.   P := Pos('/',S);
  3339.   if P > 0 Then
  3340.      Begin
  3341.       D := StrToInt(Copy(S,1,P-1));
  3342.       System.Delete(S,1,P);
  3343.      End;
  3344.   //********************************** Godina
  3345.   P := Pos(' ',S);
  3346.   if P=0 Then
  3347.      Begin
  3348.        Y := StrToInt(S);
  3349.        DT:=EncodeDate(Y,M,D);
  3350.        DTS:=DateTimeToTimeStamp(DT);
  3351.        S:=IntToStr(DTS.Date)+' '+IntToStr(DTS.Time);
  3352.      End
  3353.   Else
  3354.      Begin
  3355.        Y := StrToInt(Copy(S,1,P-1));
  3356.        System.Delete(S,1,P);
  3357.  
  3358.        //********************************** Chasove
  3359.        Ho :=0;
  3360.        P := Pos(':',S);
  3361.        if P > 0 Then
  3362.           Begin
  3363.            Ho := StrToInt(Copy(S,1,P-1));
  3364.            System.Delete(S,1,P);
  3365.            //************************************ 17.01.2002
  3366.            P := Pos(' AM', S);
  3367.            if P > 0 Then System.Delete(S, P, 3);
  3368.            P := Pos(' PM', S);
  3369.            if P > 0 Then
  3370.               Begin
  3371.                Ho := Ho + 12;
  3372.                System.Delete(S, P, 3);
  3373.               End;
  3374.            //************************************ 17.01.2002   
  3375.           End;
  3376.        //********************************** Minuti
  3377.        Mi := 0;
  3378.        P := Pos(':',S);
  3379.        if P > 0 Then
  3380.           Begin
  3381.            Mi := StrToInt(Copy(S,1,P-1));
  3382.            System.Delete(S,1,P);
  3383.           End;
  3384.        //********************************** Secundi
  3385.        Se :=0;
  3386.        if S <> '' Then Se := StrToInt(S);
  3387.        //********************************** MiliSecundi
  3388.        Ms := 0;
  3389.      End;
  3390.  
  3391.   //********************************** Encode All
  3392.   DT:=EncodeTime(Ho,Mi,Se,Ms);
  3393.   DTS:=DateTimeToTimeStamp(DT);
  3394.   S:=IntToStr(DTS.Time);
  3395.   DT:=EncodeDate(Y,M,D);
  3396.   DTS:=DateTimeToTimeStamp(DT);
  3397.   //********************************** Compose Result
  3398.   S:=IntToStr(DTS.Date)+' '+S;
  3399.   Except
  3400.    S:='';
  3401.   End;
  3402.   Result := S;
  3403. End;
  3404.  
  3405. Procedure TKADaoTable.OpenDaoRecordset;
  3406. Var
  3407.  X         : Integer;
  3408.  L         : Integer;
  3409.  S         : String;
  3410.  FldType   : Integer;
  3411.  FldAttr   : Integer;
  3412.  FldCount  : Integer;
  3413.  TabType   : Integer;
  3414.  LoType    : Integer;
  3415.  Options   : Integer;
  3416.  {$IFDEF DYNADAO}
  3417.  TempRS    : OleVariant;
  3418.  {$ELSE}
  3419.  TempRS    : Recordset;
  3420.  {$ENDIF}
  3421.  TabN      : String;
  3422.  TempSort  : String;
  3423.  NRP, Dir  : Integer;
  3424. Begin
  3425.         if Not Assigned(F_Database) Then
  3426.            Begin
  3427.              DatabaseError(E2018);
  3428.            End;
  3429.         if (TableName='') And
  3430.            (SQL.Count=0)  And
  3431.            (QueryDefName='')
  3432.         Then DatabaseError(E2019);
  3433.  
  3434.         if Not F_DatabaseAutoActivate Then
  3435.            Begin
  3436.              if F_Database.Connected=False Then DatabaseError(E2020);
  3437.            End
  3438.         Else
  3439.            Begin
  3440.              if F_Database.Connected=False Then F_Database.Connected:=True;
  3441.            End;
  3442.  
  3443.         if (F_TableType=dbOpenDynamic) And (F_Database.DatabaseType <> 'ODBC') Then DatabaseError(E2021);
  3444.         TabType:=F_TableType;
  3445.         LoType:=F_LockType;
  3446.  
  3447.         if (F_Database.ReadOnly) And (NOT F_ReadOnly) Then F_ReadOnly:=True;
  3448.         if F_TableType=dbOpenForwardOnly Then F_ReadOnly:=True;
  3449.         if F_TableType=dbOpenSnapshot Then F_ReadOnly:=True;
  3450.  
  3451.         Options:=0;
  3452.         if dbDenyWrite      in F_OpenOptions Then Options:=Options + DAOApi.dbDenyWrite;
  3453.         if dbDenyRead       in F_OpenOptions Then Options:=Options + DAOApi.dbDenyRead;
  3454.         if dbReadOnly       in F_OpenOptions Then Options:=Options + DAOApi.dbReadOnly;
  3455.         if dbAppendOnly     in F_OpenOptions Then Options:=Options + DAOApi.dbAppendOnly;
  3456.         if dbInconsistent   in F_OpenOptions Then Options:=Options + DAOApi.dbInconsistent;
  3457.         if dbConsistent     in F_OpenOptions Then Options:=Options + DAOApi.dbConsistent;
  3458.         if dbSQLPassThrough in F_OpenOptions Then Options:=Options + DAOApi.dbSQLPassThrough;
  3459.         if dbFailOnError    in F_OpenOptions Then Options:=Options + DAOApi.dbFailOnError;
  3460.         if dbForwardOnly    in F_OpenOptions Then Options:=Options + DAOApi.dbOpenForwardOnly;
  3461.         if dbSeeChanges     in F_OpenOptions Then Options:=Options + DAOApi.dbSeeChanges;
  3462.         if dbRunAsync       in F_OpenOptions Then Options:=Options + DAOApi.dbRunAsync;
  3463.         if dbExecDirect     in F_OpenOptions Then Options:=Options + DAOApi.dbExecDirect;
  3464.  
  3465.         DaoOpenOptions := Options;
  3466.  
  3467.         {$IFDEF DYNADAO}
  3468.            if NOT VarIsNull(F_DetailRecordset) Then F_DetailRecordset.Close;
  3469.            F_DetailRecordset:=NULL;
  3470.         {$ELSE}
  3471.            if F_DetailRecordset <> NIL Then F_DetailRecordset.Close;
  3472.            F_DetailRecordset:=NIL;
  3473.         {$ENDIF}
  3474.  
  3475.         RecordsAffected:=0;
  3476.         TabN:=TableName;
  3477.         if F_SQL.Count > 0 Then
  3478.            Begin
  3479.              if (MasterSource <> NIL) Then RefreshQueryParams;
  3480.              TabN:=F_ComposeSQL(F_SQL);
  3481.            End;
  3482.         if F_QueryDefName <> '' Then                                                           
  3483.            Begin
  3484.              TabN:=F_QueryDefName;
  3485.              NRP:=0;
  3486.                For X:=0 To Database.CoreDatabase.QueryDefs.Item[TabN].Parameters.Count-1 do
  3487.                  Begin
  3488.                    Dir := F_Database.CoreDatabase.QueryDefs.Item[QueryDefName].Parameters[X].Direction;
  3489.                    if (Dir=dbParamInput) Or (Dir=dbParamInputOutput) Then
  3490.                        Begin
  3491.                         Try
  3492.                          if F_QueryDefParameters.Strings[NRP]='NULL' Then
  3493.                             Database.CoreDatabase.QueryDefs.Item[TabN].Parameters.Item[X].Value:=NULL
  3494.                          Else
  3495.                             Database.CoreDatabase.QueryDefs.Item[TabN].Parameters.Item[X].Value:=F_QueryDefParameters.Strings[NRP];
  3496.                          Inc(NRP);
  3497.                         Except
  3498.                          DatabaseError(E2022);
  3499.                         End;
  3500.                        End;
  3501.                  End;
  3502.            End;
  3503.         if (F_QueryDefName <> '') And (Database.CoreDatabase.QueryDefs.Item[TabN].Parameters.Count > 0) Then
  3504.             Begin
  3505.                 F_QueryDefSQLText.Clear;
  3506.                 if Assigned(F_Database) And (F_Database.Connected) Then
  3507.                    F_QueryDefSQLText.SetText(PChar(F_Database.GetQueryDefSQLText(TabN)));
  3508.                 Database.CoreDatabase.QueryDefs.Item[TabN].MaxRecords:=F_QueryDefMaxRecords;
  3509.                 if F_Database.QueryTimeout <> 60 Then
  3510.                 F_Database.CoreDatabase.QueryDefs.Item[TabN].ODBCTimeout:=F_Database.QueryTimeout;
  3511.                 F_DaoTable:=Database.CoreDatabase.QueryDefs.Item[TabN].OpenRecordset(TabType,Options,LoType);
  3512.                 GetQueryDefReturnParams(TabN);
  3513.             End
  3514.         Else
  3515.             Begin
  3516.                F_QueryDefSQLText.Clear;
  3517.                if (F_QueryDefName <> '') Then
  3518.                    Begin
  3519.                      F_QueryDefSQLText.SetText(PChar(F_Database.GetQueryDefSQLText(TabN)));
  3520.                      Database.CoreDatabase.QueryDefs.Item[TabN].MaxRecords:=F_QueryDefMaxRecords;
  3521.                      if F_Database.QueryTimeout <> 60 Then
  3522.                      F_Database.CoreDatabase.QueryDefs.Item[TabN].ODBCTimeout:=F_Database.QueryTimeout;
  3523.                      F_DaoTable:=Database.CoreDatabase.QueryDefs.Item[TabN].OpenRecordset(TabType,Options,LoType);
  3524.                    End
  3525.                Else
  3526.                    Begin
  3527.                      F_DaoTable:=Database.CoreDatabase.OpenRecordset(TabN,TabType,Options,LoType);
  3528.                    End;
  3529.             End;
  3530.             
  3531.         F_Database.Idle;
  3532.         if NOT F_DaoTable.Updatable Then F_ReadOnly:=True;
  3533.         F_Bookmarkable := F_DaoTable.Bookmarkable;
  3534.         InternalClearBookmarks;
  3535.         F_Database.RefreshDefinitions;
  3536.         RecordsAffected:=F_Database.CoreDatabase.RecordsAffected;
  3537.  
  3538.         //******************************************************** Setting Index
  3539.         if F_IndexName <> '' Then
  3540.            Begin
  3541.              Try
  3542.                F_DaoTable.Index:=F_IndexName;
  3543.              Except
  3544.                //******** May raise exception when table is empty
  3545.              End;
  3546.            End;
  3547.         //**********************************************************************
  3548.         FldCount := F_DaoTable.Fields.Count;
  3549.         //******************************************* Default Values
  3550.         F_UpdatableFields.Clear;
  3551.         F_DefaultValues.Clear;
  3552.         //********************************* Fast Open without quering properties
  3553.         For X :=0 To FldCount-1 do
  3554.          Begin
  3555.            F_DefaultValues.Add('');
  3556.            F_UpdatableFields.Add(Pointer(True));
  3557.          End;
  3558.         //**********************************************************************
  3559.         if (NOT F_ReadOnly) And (F_UseDaoProperties) Then
  3560.          Begin
  3561.           F_UpdatableFields.Clear;
  3562.           F_DefaultValues.Clear;
  3563.           For X :=0 To FldCount-1 do
  3564.             Begin
  3565.              {$IFDEF DYNADAO}
  3566.              FldType := F_DaoTable.Fields.Item[X].Type;
  3567.              {$ELSE}
  3568.              FldType := F_DaoTable.Fields.Item[X].Type_;
  3569.              {$ENDIF}
  3570.              FldAttr := F_DaoTable.Fields.Item[X].Attributes;
  3571.              F_UpdatableFields.Add(Pointer(False));
  3572.              if (FldAttr And dbUpdatableField) > 0 Then
  3573.                 Begin
  3574.                  if (FldAttr And dbAutoIncrField) = 0 Then
  3575.                     Begin
  3576.                       if (FldAttr And dbSystemField) = 0 Then
  3577.                           Begin
  3578.                            F_UpdatableFields.Items[X]:=Pointer(True);
  3579.                           End;
  3580.                     End;
  3581.                 End;
  3582.              Try
  3583.                 //**************************************************************
  3584.                 S:='';
  3585.                 if F_Database.EngineType=dbUseJet Then
  3586.                    S:=F_DaoTable.Fields.Item[X].DefaultValue;
  3587.                 //**************************************************************
  3588.                 if (FldType=dbText) or (FldType=dbMemo) Then
  3589.                    Begin
  3590.                      L := Length(S);
  3591.                      if (L > 1) And (S[1]='"') And (S[L]='"') Then
  3592.                         Begin
  3593.                           System.Delete(S,L,1);
  3594.                           System.Delete(S,1,1);
  3595.                         End;
  3596.                    End;
  3597.                 if (FldType=dbDate) Then
  3598.                    Begin
  3599.                      L := Length(S);
  3600.                      if (L > 1) And (S[1]='#') And (S[L]='#') Then
  3601.                         Begin
  3602.                           System.Delete(S,L,1);
  3603.                           System.Delete(S,1,1);
  3604.                           S:=ProcessDTDefault(S);
  3605.                         End
  3606.                       Else
  3607.                         S := '';
  3608.                    End;
  3609.                 F_DefaultValues.Add(S);
  3610.                 if AnsiCompareText(F_DefaultValues.Strings[X],'Null')=0 Then F_DefaultValues.Strings[X] := '';
  3611.               Except
  3612.                 F_DefaultValues.Add('');
  3613.               End;
  3614.             End;
  3615.          End;
  3616.         if F_SortedBy.Count > 0 Then
  3617.            Begin
  3618.              TempSort:='';
  3619.              For X:=0 To F_SortedBy.Count-1 Do
  3620.                 Begin
  3621.                   TempSort:=TempSort+F_SortedBy.Strings[X];
  3622.                   if X < F_SortedBy.Count-1 Then TempSort:=TempSort+',';
  3623.                   TempSort:=TempSort+' ';
  3624.                 End;
  3625.              DaoSortString:=TempSort;
  3626.              F_DaoTable.Sort:=TempSort;
  3627.              TempRS:=F_DaoTable;
  3628.              F_DaoTable:=TempRS.OpenRecordset(TabType,Options);
  3629.              TempRS.Close;
  3630.              {$IFDEF DYNADAO}
  3631.              TempRS:=NULL;
  3632.              {$ELSE}
  3633.              TempRS:=Nil;
  3634.              {$ENDIF}
  3635.            End;
  3636.         if F_Filtered Then
  3637.            Begin
  3638.              if Filter<>'' Then
  3639.                 Begin
  3640.                  F_DaoTable.Filter:=Filter;
  3641.                  TempRS:=F_DaoTable;
  3642.                  F_DaoTable:=TempRS.OpenRecordset(TabType,Options);
  3643.                  TempRS.Close;
  3644.                  {$IFDEF DYNADAO}
  3645.                  TempRS:=NULL;
  3646.                  {$ELSE}
  3647.                  TempRS:=Nil;
  3648.                  {$ENDIF}
  3649.                 End;
  3650.            End;
  3651.         if (MasterSource <> NIL) And (Assigned(F_MasterLink.DataSet)) Then
  3652.            Begin
  3653.              F_MDisabled := Not (F_MasterLink.Active);
  3654.              if (NOT F_MasterLink.DataSet.Active) And (F_MasterAutoActivate) Then
  3655.                 Begin
  3656.                   Try
  3657.                     F_MasterLink.DataSet.Active := True;
  3658.                   Finally
  3659.                     F_MDisabled := Not (F_MasterLink.Active);
  3660.                   End;
  3661.                 End;                                                            
  3662.            End
  3663.         Else
  3664.            Begin
  3665.              F_MDisabled := True;
  3666.            End;
  3667.         if (MasterSource <> NIL) And (Not(F_MDisabled)) And (MasterSource.Enabled) then
  3668.             Begin
  3669.               F_ProcessMasterFields(F_MasterFields);
  3670.               if (F_Master.Count > 0) Then
  3671.                   Begin
  3672.                    TabN:=BuildDetailSQL;
  3673.                    TabN:=InsertSQLString(TabN);
  3674.                    F_DaoTable.Filter:=TabN;
  3675.                    if (F_TableName <> '') Then
  3676.                       Begin
  3677.                         F_DaoTable.Close;
  3678.                         if DaoSortString <> '' Then
  3679.                            F_DaoTable:=F_Database.CoreDatabase.OpenRecordset('Select * From ['+F_TableName+'] Where '+TabN+' Order By '+DaoSortString+';',TabType,Options,F_LockType)
  3680.                         Else
  3681.                            F_DaoTable:=F_Database.CoreDatabase.OpenRecordset('Select * From ['+F_TableName+'] Where '+TabN+';',TabType,Options,F_LockType);
  3682.                       End
  3683.                    Else
  3684.                       Begin
  3685.                         F_DetailRecordset:=F_DaoTable;
  3686.                         F_DaoTable:=F_DetailRecordset.OpenRecordset(TabType,Options);
  3687.                       End;
  3688.                   End;
  3689.             End;
  3690.         //********************************************************** COM Cashing
  3691.         VarArrayRedim(DaoFields,Integer(FldCount-1));
  3692.         For X := 0 To FldCount-1 do
  3693.             Begin
  3694.               DaoFields[X] := OleVariant(F_DaoTable.Fields[X]);
  3695.             End;
  3696.         //********************************************************** COM Cashing
  3697.         CoreRecordset := F_DaoTable;
  3698.         F_RefreshRC := True;
  3699.         F_OldRC:=-1;
  3700.         F_RecNo:=-1;
  3701.         F_LastRecord:=-1;
  3702.         F_Database.Idle; //****************************************** 12.03.2002
  3703. End;
  3704.  
  3705. Procedure TKADaoTable.ReOpenDaoRecordset;
  3706. Var
  3707.   TabN     : String;
  3708.   X        : Integer;
  3709. Begin
  3710.   InternalClearBookmarks;
  3711.   TabN:=BuildDetailSQL;
  3712.   if (F_TableName <> '')  Then
  3713.      Begin
  3714.        TabN:=InsertSQLString(TabN);
  3715.        if DaoSortString <> '' Then
  3716.           F_DaoTable:=F_Database.CoreDatabase.OpenRecordset('Select * From ['+F_TableName+'] Where '+TabN+' Order By '+DaoSortString+';',F_TableType,DaoOpenOptions,F_LockType)
  3717.        Else
  3718.           F_DaoTable:=F_Database.CoreDatabase.OpenRecordset('Select * From ['+F_TableName+'] Where '+TabN+';',F_TableType,DaoOpenOptions,F_LockType);
  3719.      End
  3720.   Else
  3721.      Begin
  3722.        OleVariant(F_DetailRecordset).Requery;
  3723.        F_DetailRecordset.Filter:=TabN;
  3724.        F_DaoTable:=F_DetailRecordset.OpenRecordset(EmptyParam,dbSeeChanges)
  3725.      End;
  3726.   CoreRecordset := F_DaoTable;
  3727.   //**************************************************************** COM Cashing
  3728.   VarArrayRedim(DaoFields,Integer(F_DaoTable.Fields.Count-1));
  3729.   For X := 0 To F_DaoTable.Fields.Count-1 do
  3730.       Begin
  3731.         DaoFields[X] := OleVariant(F_DaoTable.Fields[X]);
  3732.       End;
  3733.   //****************************************************************************
  3734.   F_RefreshRC := True;
  3735.   F_OldRC:=-1;
  3736.   F_RecNo:=-1;
  3737.   F_LastRecord:=-1;
  3738.   GetRecordCount;
  3739.   F_Database.Idle; //************************************************ 12.03.2002
  3740. End;
  3741.  
  3742. Procedure TKADaoTable.Loaded;
  3743. begin
  3744.   try
  3745.     inherited Loaded;
  3746.   except
  3747.     Application.HandleException(Self)
  3748.   end;
  3749. end;
  3750.  
  3751. Procedure TKADaoTable.Notification(AComponent: TComponent; Operation: TOperation);
  3752. Begin
  3753.  If (Operation = opRemove) And (AComponent = F_Database) Then F_Database := Nil;
  3754.  If (Operation = opRemove) And (AComponent = F_Encrypter) Then
  3755.      Begin
  3756.       if F_Active Then Close;
  3757.       F_HasEncoder := False;
  3758.       F_Encrypter  := Nil;
  3759.      End;
  3760.  Inherited Notification(AComponent, Operation);
  3761. End;
  3762.  
  3763. Function TKADaoTable.UnquoteString(S:String):String;
  3764. Var
  3765.  L: Integer;
  3766. Begin
  3767.  Result := S;
  3768.  L:=Length(Result);
  3769.  if L=0 Then Exit;
  3770.  if Result[1]='''' Then System.Delete(Result,1,1);
  3771.  L:=Length(Result);
  3772.  if L=0 Then Exit;
  3773.  if Result[L]='''' Then System.Delete(Result,L,1);
  3774. End;
  3775.  
  3776. Procedure TKADaoTable.InternalOpen;
  3777. Var
  3778.    X       : Integer;
  3779.    TempMD  : Boolean;
  3780.    FF      : TField;
  3781.    Prop    : Pointer;
  3782. Begin
  3783.         OpenDaoRecordset;
  3784.         if Self.Name='' Then Self.Name:='KADaoTable_'+IntToStr(GetTickCount);
  3785.  
  3786.         InInternalOpen:=True;
  3787.         InternalInitFieldDefs;
  3788.         InInternalOpen:=False;
  3789.         if DefaultFields then CreateFields;
  3790.         if F_CacheLookups Then
  3791.            Begin
  3792.             For X := 0 To FieldCount-1 do
  3793.                 Begin
  3794.                   if Fields[X].FieldKind=fkLookup Then Fields[X].LookupCache:=True;
  3795.                 End;
  3796.            End;
  3797.         BindFields(True);
  3798.         if F_UseDisplayLabels Then InternalSetDisplayLabels;
  3799.         if F_Bookmarkable Then BookmarkSize := MYBOOKMARKSIZE Else BookmarkSize := 0;
  3800.         F_StartMyInfo:=InternalCalcRecordSize;
  3801.         F_StartCalc:=F_StartMyInfo+SizeOf(TDaoInfo);
  3802.         F_BufferSize:=F_RecordSize+Sizeof(TDaoInfo)+CalcFieldsSize;
  3803.         //****************************************************************
  3804.         TempMD:=F_MDisabled;
  3805.         F_MDisabled:= True;
  3806.         F_FieldNames.Clear;
  3807.         F_SortFieldNames.Clear;
  3808.         F_MDFieldNames.Clear;
  3809.         For X:=0 to FieldDefs.Count-1 do
  3810.             Begin
  3811.              FF  :=FindField(FieldDefs.Items[X].Name);
  3812.              if (FF <> Nil) Then
  3813.                 Begin
  3814.                   if Boolean(F_UpdatableFields.Items[X])=False Then
  3815.                      Begin
  3816.                        FF.ReadOnly:=True;
  3817.                      End;
  3818.                   if FF.DefaultExpression <> '' Then
  3819.                      Begin
  3820.                        F_DefaultValues.Strings[X]:=UnQuoteString(FF.DefaultExpression);
  3821.                      End;
  3822.                  If (NOT FF.IsBlob) Then
  3823.                     Begin
  3824.                       F_SortFieldNames.Add(FieldDefs.Items[X].Name);
  3825.                     End;
  3826.                  F_FieldNames.Add(FieldDefs.Items[X].Name);
  3827.                  F_FieldTypeNames.Add(GetBDEFieldTypeNames(FieldDefs.Items[X].DataType));
  3828.                  if (NOT (FF.DataType=ftBlob)) Then
  3829.                     Begin
  3830.                      F_MDFieldNames.Add(FieldDefs.Items[X].Name);
  3831.                     End;
  3832.                  if (FF.DataType=ftDateTime) Then FF.DisplayWidth:=20;
  3833.                  if (FF.DataType=ftMemo) Then
  3834.                     Begin
  3835.                       if F_CacheMemos Then
  3836.                          Begin
  3837.                            FF.DisplayWidth:=30;
  3838.                            FF.OnGetText:=F_OnGetMemoText;
  3839.                          End;
  3840.                     End;
  3841.                   if (FF.DataType=ftBytes) And (FieldDefs.Items[X].Precision=GUID_ID) Then
  3842.                      Begin
  3843.                       FF.ValidChars := GUID_VALID_CHARS;
  3844.                       if F_ShowGUID Then
  3845.                          Begin
  3846.                           FF.DisplayWidth := 38;
  3847.                           FF.OnGetText    := F_OnGetGUIDText;
  3848.                           FF.OnSetText    := F_OnSetGUIDText;
  3849.                          End;
  3850.                      End;
  3851.                 End;
  3852.             End;
  3853.         F_MDisabled:=TempMD;
  3854.  
  3855.         F_OldValue          := Nil;
  3856.         F_KeyBuffer         := AllocRecordBuffer;
  3857.         F_RangeStartBuffer  := AllocRecordBuffer;
  3858.         F_RangeEndBuffer    := AllocRecordBuffer;
  3859.  
  3860.         F_HasEncoder        := False;
  3861.         if Assigned(F_Encrypter) Then
  3862.            Begin
  3863.              Prop := GetPropInfo(F_Encrypter.ClassInfo, 'EncodedString');
  3864.              if Prop <> Nil Then
  3865.                 Begin
  3866.                   F_EncodedString:=Prop;
  3867.                   Prop := GetPropInfo(F_Encrypter.ClassInfo, 'DecodedString');
  3868.                   If Prop <> Nil Then
  3869.                      Begin
  3870.                       F_DecodedString := Prop;
  3871.                       F_HasEncoder := True;
  3872.                      End;
  3873.                 End;
  3874.            End;
  3875.         F_Active:=True;
  3876.         Try
  3877.           if F_TableType=dbOpenTable Then GetRecordCount; //*********** 5.1.2002
  3878.         Except
  3879.         End;
  3880.         InternalFirst;
  3881.         //****************************************************************
  3882.         F_Database.ActiveTableNames.AddObject(Self.Name,Self);
  3883.         if (F_Database.TrackTransactions) And (F_Database.GetTransactionCount > 0) Then
  3884.            Begin
  3885.              F_Database.AddRNToTransaction(Self.Name,1)
  3886.            End;
  3887.         F_Database.Idle; //****************************************** 12.03.2002
  3888. End;
  3889.  
  3890. Procedure TKADaoTable.CloseDaoRecordset;
  3891. Var
  3892.  X : Integer;
  3893. Begin
  3894.  //****************************************** Com Cashing
  3895.  For X :=0 To F_DaoTable.Fields.Count-1 do
  3896.      Begin
  3897.        DaoFields[X]:=NULL;
  3898.      End;
  3899.  //******************************************
  3900.  Try
  3901.    F_DaoTable.Close;
  3902.  Except
  3903.  End;  
  3904. End;
  3905.  
  3906. Procedure TKADaoTable.InternalClose;
  3907. Var
  3908.   I : Integer;
  3909. Begin
  3910.         if Not F_Active Then Exit;
  3911.         Try
  3912.          if State=dsEdit Then OleVariant(F_DaoTable).CancelUpdate;
  3913.         Except
  3914.         End;
  3915.         //************************************************** Changed 16.11.2000
  3916.         F_Active:=False;
  3917.         //************************************************** Changed 16.11.2000
  3918.         DaoOpenOptions := 0;
  3919.         DaoSortString  := '';
  3920.         BindFields(False);
  3921.         if DefaultFields then DestroyFields;
  3922.         CloseDaoRecordset;
  3923.         {$IFDEF DYNADAO}
  3924.         if NOT VarIsNull(F_DetailRecordset) Then F_DetailRecordset.Close;
  3925.         F_DetailRecordset := NULL;
  3926.         {$ELSE}
  3927.         if F_DetailRecordset <> Nil Then F_DetailRecordset.Close;
  3928.         F_DetailRecordset := NIL;
  3929.         {$ENDIF}
  3930.         if Assigned(F_Database) And (Not MainDatabaseShutdown) Then
  3931.            Begin
  3932.               I := F_Database.ActiveTableNames.IndexOf(Self.Name);
  3933.               if I <> -1 Then  F_Database.ActiveTableNames.Delete(I);
  3934.            End
  3935.         Else
  3936.            MainDatabaseShutdown  := False;
  3937.         if F_OldValue <> Nil then FreeRecordBuffer(F_OldValue);
  3938.         FreeRecordBuffer(F_KeyBuffer);
  3939.         FreeRecordBuffer(F_RangeStartBuffer);
  3940.         FreeRecordBuffer(F_RangeEndBuffer);
  3941. End;
  3942.  
  3943. //*********************************************************** BOOKMARK Functions
  3944. Procedure TKADaoTable.InternalClearBookmarks;
  3945. Begin
  3946.   F_BookmarkRN.Clear;
  3947.   F_BookmarkID.Clear;
  3948. End;
  3949.  
  3950. Procedure TKADaoTable.InternalGotoBookmark(Bookmark: Pointer);
  3951. Var
  3952.   I       : Integer;
  3953.   X       : Integer;
  3954.   BK      : OleVariant;
  3955.   P       : PChar;
  3956.   PB      : PChar;
  3957.   Invalid : Boolean;
  3958. Begin
  3959.   Invalid := False;
  3960.   if NOT F_Active Then DatabaseError(E2023);
  3961.   if Bookmark=Nil Then DatabaseError(E2024);
  3962.   //***************************************************** 30.04.2001
  3963.   if IsEmpty Then Exit;
  3964.   //***************************************************** 30.04.2001
  3965.   X:=PInteger(Bookmark)^;
  3966.   if (F_Bookmarkable) And (X <> 0) Then
  3967.      Begin
  3968.       Try
  3969.         I:= F_BookmarkID.IndexOf(Pointer(X));
  3970.         if I = -1 Then
  3971.            Begin
  3972.              Invalid := True;
  3973.              DatabaseError(E2024);
  3974.            End
  3975.         Else
  3976.            Begin
  3977.              BK  := VarArrayCreate([0, 3],varByte);
  3978.              P   := PChar(Bookmark);
  3979.              PB  := VarArrayLock(BK);
  3980.              For X := 0 to 3 do PB[X] := P[X];
  3981.              VarArrayUnLock(BK);
  3982.              OleVariant(F_DaoTable).Bookmark:=VarAsType(BK, varArray or VarByte);
  3983.              F_RecNo:=Integer(F_BookmarkRN.Items[I]);
  3984.              VarClear(BK);
  3985.            End;
  3986.       Except
  3987.         if Invalid Then Raise;
  3988.         if GetLastDaoError.ErrNo=3167 Then
  3989.            Begin
  3990.              DaoInternalRefresh;
  3991.              InternalFirst;
  3992.              Raise;
  3993.            End;
  3994.       End;
  3995.      End
  3996.   Else
  3997.      Begin
  3998.        DatabaseError(E2025);
  3999.      End;
  4000. End;
  4001.  
  4002. Function TKADaoTable.BookmarkValid(Bookmark: TBookmark): Boolean;
  4003. Var
  4004.   TmpBookmark : TBookmark;
  4005.   BK          : Integer;
  4006. Begin
  4007.   Result := False;
  4008.   //***************************************************** 30.04.2001
  4009.   if IsEmpty Then Exit;
  4010.   //***************************************************** 30.04.2001
  4011.   If (F_Active) And (F_Bookmarkable) And (Assigned(Bookmark)) then
  4012.   Begin
  4013.    //**************************************************** 26.01.2002
  4014.    BK := PInteger(Bookmark)^;
  4015.    if (BK <> 0) Then
  4016.    Begin
  4017.       if F_BookmarkID.IndexOf(Pointer(BK)) = -1 Then Exit;
  4018.    End;
  4019.    //**************************************************** 26.01.2002
  4020.    TmpBookmark:=GetBookmark;
  4021.    Try
  4022.     InternalGotoBookmark(Bookmark);
  4023.     CursorPosChanged;
  4024.     Result := True;
  4025.    Except
  4026.     if Assigned(TmpBookmark) Then
  4027.        Begin
  4028.         InternalGotoBookmark(TmpBookmark);
  4029.         CursorPosChanged;
  4030.        End;
  4031.    End;
  4032.    FreeBookmark(TmpBookMark);
  4033.   End;
  4034. End;
  4035.  
  4036.  
  4037.  
  4038. Function TKADaoTable.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
  4039. Begin
  4040.   Result:=PDaoInfo(Buffer+F_StartMyInfo)^.BookmarkFlag;
  4041. End;
  4042.  
  4043. Procedure TKADaoTable.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
  4044. Begin
  4045.   PDaoInfo(Buffer + F_StartMyInfo)^.BookmarkFlag := Value;
  4046.   if (F_BatchMode) And (ControlsDisabled) Then
  4047.      Begin
  4048.        if (Value=bfEOF) or (Value=bfInserted) Then F_InPost := True;
  4049.      End;
  4050. End;
  4051.  
  4052. Function TKADaoTable.GetBookmarkStr: TBookmarkStr;
  4053. Var
  4054.  Buffer : PChar;
  4055.  RN     : Integer;
  4056.  I      : Integer;
  4057.  BKS    : Integer;
  4058.  PIN    : PInteger;
  4059. Begin
  4060.   BKS :=  0;
  4061.   PIN := @BKS;
  4062.   SetString(Result,PChar(PIN),BookmarkSize);
  4063.   Try
  4064.     if F_Bookmarkable Then
  4065.        Begin
  4066.          Buffer:=GetActiveRecordBuffer;
  4067.          if (Buffer <> Nil) Then
  4068.              Begin
  4069.                PIN:=@PDaoInfo(Buffer + F_StartMyInfo)^.BookmarkData;
  4070.                SetString(Result,PChar(PIN),BookmarkSize);
  4071.                RN     := PDaoInfo(Buffer + F_StartMyInfo)^.RecordNo;
  4072.                I      := F_BookmarkRN.IndexOf(Pointer(RN));
  4073.                if I=-1 Then
  4074.                   Begin
  4075.                    F_BookmarkRN.Add(Pointer(RN));
  4076.                    F_BookmarkID.Add(Pointer(PDaoInfo(Buffer + F_StartMyInfo)^.BookmarkData));
  4077.                   End
  4078.                Else
  4079.                   Begin
  4080.                    F_BookmarkID.Items[I]:=Pointer(PDaoInfo(Buffer + F_StartMyInfo)^.BookmarkData);
  4081.                   End;
  4082.              End;
  4083.        End;
  4084.   Except
  4085.     BKS :=  0;
  4086.     PIN := @BKS;
  4087.     SetString(Result,PChar(PIN),BookmarkSize);
  4088.   End;
  4089. End;
  4090.  
  4091. Procedure TKADaoTable.SetBookmarkStr(const Value: TBookmarkStr);
  4092. Var
  4093.  PBI : PInteger;
  4094. Begin
  4095.  //***************************************************** 30.04.2001
  4096.  if IsEmpty Then Exit;
  4097.  //***************************************************** 30.04.2001
  4098.  if (F_Bookmarkable) And (Value <> '') Then
  4099.      Begin
  4100.       PBI:=PInteger(PChar(Value));
  4101.       InternalGotoBookmark(PBI);
  4102.       Resync([]);
  4103.      End;
  4104. End;
  4105.  
  4106. Procedure TKADaoTable.GetBookmarkData(Buffer: PChar; Data: Pointer);
  4107. Var
  4108.   I  : Integer;
  4109.   RN : Integer;
  4110. Begin
  4111.   if (F_Bookmarkable) And (Buffer <> Nil) And (Data <> Nil) Then
  4112.     Begin
  4113.      PInteger(Data)^ := PDaoInfo(Buffer + F_StartMyInfo)^.BookmarkData;
  4114.      RN              := PDaoInfo(Buffer + F_StartMyInfo)^.RecordNo;
  4115.      I               := F_BookmarkRN.IndexOf(Pointer(RN));
  4116.      if I=-1 Then
  4117.         Begin
  4118.           F_BookmarkRN.Add(Pointer(RN));
  4119.           F_BookmarkID.Add(Pointer(PDaoInfo(Buffer + F_StartMyInfo)^.BookmarkData));
  4120.         End
  4121.       Else
  4122.         Begin
  4123.           F_BookmarkID.Items[I]:=Pointer(PDaoInfo(Buffer + F_StartMyInfo)^.BookmarkData);
  4124.         End;
  4125.     End
  4126.   Else
  4127.     Begin
  4128.      if Data <> Nil Then PInteger(Data)^ := 0;
  4129.     End;
  4130. End;
  4131.  
  4132. Procedure TKADaoTable.SetBookmarkData(Buffer: PChar; Data: Pointer);
  4133. Begin
  4134.   if (Buffer <> Nil) And (Data <> Nil) Then
  4135.       Begin
  4136.         PDaoInfo(Buffer + F_StartMyInfo)^.BookmarkData := PInteger(Data)^;
  4137.       End;
  4138. End;
  4139.  
  4140. Function TKADaoTable.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
  4141. Const
  4142.   ResultCodes     : array[Boolean, Boolean] of ShortInt = ((2,-1),(1,0));
  4143. Begin
  4144.   Result := ResultCodes[Bookmark1 = nil, Bookmark2 = nil];
  4145.   If Result = 2 then
  4146.      Begin
  4147.        Result := 0;
  4148.        if PInteger(Bookmark1)^ < PInteger(Bookmark2)^ Then Result := -1;
  4149.        if PInteger(Bookmark1)^ > PInteger(Bookmark2)^ Then Result :=  1;
  4150.      End;
  4151. End;
  4152. //*********************************************************** BOOKMARK Functions
  4153.  
  4154. Function TKADaoTable.GetRawFieldData(FieldName : String):OleVariant;
  4155. Var
  4156.   Buffer : PChar;
  4157.   FF     : TField;
  4158. Begin
  4159.   Result := NULL;
  4160.   if (F_Active) And (F_Bookmarkable) Then
  4161.      Begin
  4162.       FF := FindField(FieldName);
  4163.       if FF=Nil Then Exit;
  4164.       Buffer:=GetActiveRecordBuffer;
  4165.       if (Buffer = Nil) Then Exit;
  4166.       InternalSetToRecord(Buffer);
  4167.       Result := F_DaoTable.Fields.Item[FieldName].Value;
  4168.      End;
  4169. End;
  4170.  
  4171. Function TKADaoTable.SetRawFieldData(FieldName : String; Value : OleVariant):Boolean;
  4172. Var
  4173.   Buffer : PChar;
  4174.   FF     : TField;
  4175. Begin
  4176.   Result := False;
  4177.   if (F_Active) And (F_Bookmarkable) Then
  4178.      Begin
  4179.       FF := FindField(FieldName);
  4180.       if FF=Nil Then Exit;
  4181.       Buffer:=GetActiveRecordBuffer;
  4182.       if (Buffer = Nil) Then Exit;
  4183.       InternalSetToRecord(Buffer);
  4184.       Try
  4185.         F_DaoTable.Edit;
  4186.       Except
  4187.         if F_DaoTable.EditMode <> DaoApi.dbEditInProgress Then OleVariant(F_DaoTable).Move(0);
  4188.         DaoInternalRefresh;
  4189.       End;
  4190.       F_DaoTable.Fields.Item[FieldName].Value:=Value;
  4191.       OleVariant(F_DaoTable).Update;
  4192.       Result := True;
  4193.      End;
  4194. End;
  4195.  
  4196.  
  4197. Function TKADaoTable.GetRows(NumRows:Integer):OleVariant;
  4198. Var
  4199.   Buffer : PChar;
  4200. Begin
  4201.   Result:=NULL;
  4202.   if (F_Active) And (F_Bookmarkable) Then
  4203.      Begin
  4204.       if (F_Filtered) And (Assigned(F_OnFilterRecord)) Then DatabaseError(E2063);
  4205.       Buffer:=GetActiveRecordBuffer;
  4206.       if (Buffer = Nil) Then Exit;
  4207.       InternalSetToRecord(Buffer);
  4208.       Result:=F_DaoTable.GetRows(NumRows);
  4209.       if F_RecNo < RecordCount Then Inc(F_RecNo,NumRows);
  4210.       Try
  4211.         Resync([]);
  4212.       Except
  4213.         InternalFirst;
  4214.         Resync([]);
  4215.         Raise;
  4216.       End;
  4217.      End;
  4218. End;
  4219.  
  4220. Function  TKADaoTable.CopyQueryDef : OleVariant;
  4221. Begin
  4222.   Result := OleVariant(F_DaoTable).CopyQueryDef;
  4223. End;
  4224.  
  4225. Function  TKADaoTable.CopyQueryDefText : String;
  4226. Var
  4227.   QD : OleVariant;
  4228. Begin
  4229.   QD := OleVariant(F_DaoTable).CopyQueryDef;
  4230.   Result := QD.SQL;
  4231. End;
  4232.  
  4233. Procedure TKADaoTable.AccessExportToTXT(FileName:String; IncludeBlobs, DeleteOld:Boolean);
  4234. Var
  4235.  SQL : TStringList;
  4236.  FN  : String;
  4237.  FP  : String;
  4238.  L   : Integer;
  4239.  SS  : String;
  4240.  X   : Integer;
  4241.  FC  : Integer;
  4242.  TN  : String;
  4243. Begin
  4244.  If Not F_Active Then DatabaseError('Table must be open in order to export data!');
  4245.  TN := '';
  4246.  //*****************************************************************************
  4247.  Try
  4248.  if (DeleteOld) And FileExists(FileName) Then DeleteFile(FileName);
  4249.  if F_TableName='' Then
  4250.     Begin
  4251.       if F_QueryDefName='' Then
  4252.          Begin
  4253.            TN := 'Query'+IntToStr(Integer(GetTickcount));
  4254.            Try
  4255.              F_Database.CoreDatabase.BeginTrans;
  4256.            Except
  4257.            End;
  4258.            F_Database.CreateQueryDef(TN,F_ComposeSQL(F_SQL));
  4259.          End
  4260.       Else
  4261.          Begin
  4262.           TN := F_QueryDefName;
  4263.          End;
  4264.     End
  4265.  Else
  4266.     Begin
  4267.       TN := F_TableName;
  4268.     End;
  4269.  FN := ExtractFileName(FileName);
  4270.  FP := ExtractFilePath(FileName);
  4271.  if FP='' Then FP:='.';
  4272.  L  := Length(FN);
  4273.  If L=0 Then DatabaseError('FileName is empty!');
  4274.  For X :=1 To L do If FN[X]='.' Then FN[X]:='#';
  4275.  SS:='';
  4276.  FC := FieldCount-1;
  4277.  For X := 0 To FC do
  4278.      Begin
  4279.       if StoreField(X) Then
  4280.        Begin
  4281.         if IncludeBlobs Then
  4282.           Begin
  4283.             if F_UseBrackets Then
  4284.                Begin
  4285.                  SS := SS+' '+BracketField(Fields[X].FieldName);
  4286.                  if X < FC Then SS := SS+',';
  4287.                End
  4288.             Else
  4289.                Begin
  4290.                  if X < FC Then SS := SS+' '+Fields[X].FieldName+',' Else SS := SS+' '+Fields[X].FieldName;
  4291.                End;
  4292.           End
  4293.         Else
  4294.           Begin
  4295.            if Fields[X].DataType<>ftBlob Then
  4296.               Begin
  4297.                if F_UseBrackets Then
  4298.                   Begin
  4299.                     SS := SS+' '+BracketField(Fields[X].FieldName);
  4300.                     if X < FC Then SS := SS+',';
  4301.                   End
  4302.                Else
  4303.                   Begin
  4304.                     if X < FC Then SS := SS+' '+Fields[X].FieldName+',' Else SS := SS+' '+Fields[X].FieldName;
  4305.                   End;
  4306.               End;
  4307.           End;
  4308.        End;
  4309.      End;
  4310.  if SS[Length(SS)]=',' Then System.Delete(SS,Length(SS),1);
  4311.  if F_ExportMethod = AllFields Then SS :='*';
  4312.  SQL := TStringList.Create;
  4313.  Try
  4314.    SQL.Add(Format('Select %s INTO [%s] IN "%s"[Text;] FROM [%s]',[SS,FN,FP,TN]));
  4315.    if (F_Filtered) And (F_Filter <> '') Then SQL.Add(' WHERE '+F_Filter);
  4316.    SQL.Add(';');
  4317.    ExecSQL(SQL);
  4318.  Finally
  4319.    SQL.Free;
  4320.  End;
  4321.  Finally
  4322.    if (F_TableName='') And (F_QueryDefName='') And (TN <> '') Then
  4323.        Begin
  4324.          F_Database.DeleteQueryDef(TN);
  4325.          Try
  4326.            F_Database.CoreDatabase.Rollback;
  4327.          Except
  4328.          End;
  4329.        End;
  4330.  End;
  4331.  //*****************************************************************************
  4332. End;
  4333.  
  4334. Procedure TKADaoTable.AccessExportToHTML(FileName:String; IncludeBlobs, DeleteOld:Boolean);
  4335. Var
  4336.  SQL : TStringList;
  4337.  FN  : String;
  4338.  FP  : String;
  4339.  SS  : String;
  4340.  X   : Integer;
  4341.  FC  : Integer;
  4342.  TN  : String;
  4343. Begin
  4344.  If Not F_Active Then DatabaseError('Table must be open in order to export data!');
  4345.  TN := '';
  4346.  //*****************************************************************************
  4347.  Try
  4348.  if (DeleteOld) And FileExists(FileName) Then DeleteFile(FileName);
  4349.  if F_TableName='' Then
  4350.     Begin
  4351.       if F_QueryDefName='' Then
  4352.          Begin
  4353.            TN := 'Query'+IntToStr(Integer(GetTickcount));
  4354.            Try
  4355.              F_Database.CoreDatabase.BeginTrans;
  4356.            Except
  4357.            End;
  4358.            F_Database.CreateQueryDef(TN,F_ComposeSQL(F_SQL));
  4359.          End
  4360.       Else
  4361.          Begin
  4362.           TN := F_QueryDefName;
  4363.          End;
  4364.     End
  4365.  Else
  4366.     Begin
  4367.       TN := F_TableName;
  4368.     End;
  4369.  FN := ExtractFileName(FileName);
  4370.  FP := ExtractFilePath(FileName);
  4371.  if FP='' Then FP:='.';
  4372.  SS:='';
  4373.  FC := FieldCount-1;
  4374.  For X := 0 To FC do
  4375.      Begin
  4376.       if StoreField(X) Then
  4377.        Begin
  4378.         if IncludeBlobs Then
  4379.           Begin
  4380.             if F_UseBrackets Then
  4381.                Begin
  4382.                  SS := SS+' '+BracketField(Fields[X].FieldName);
  4383.                  if X < FC Then SS := SS+',';
  4384.                End
  4385.             Else
  4386.                Begin
  4387.                  if X < FC Then SS := SS+' '+Fields[X].FieldName+',' Else SS := SS+' '+Fields[X].FieldName;
  4388.                End;
  4389.           End
  4390.         Else
  4391.           Begin
  4392.            if Fields[X].DataType<>ftBlob Then
  4393.               Begin
  4394.                if F_UseBrackets Then
  4395.                   Begin
  4396.                     SS := SS+' '+BracketField(Fields[X].FieldName);
  4397.                     if X < FC Then SS := SS+',';
  4398.                   End
  4399.                Else
  4400.                   Begin
  4401.                     if X < FC Then SS := SS+' '+Fields[X].FieldName+',' Else SS := SS+' '+Fields[X].FieldName;
  4402.                   End;
  4403.               End;
  4404.           End;
  4405.        End;
  4406.      End;
  4407.  if SS[Length(SS)]=',' Then System.Delete(SS,Length(SS),1);
  4408.  if F_ExportMethod = AllFields Then SS :='*';
  4409.  SQL := TStringList.Create;
  4410.  Try
  4411.    SQL.Add(Format('Select %s INTO [%s] IN "%s"[HTML Export;] FROM [%s]',[SS,FN,FP,TN]));
  4412.    if (F_Filtered) And (F_Filter <> '') Then SQL.Add(' WHERE '+F_Filter);
  4413.    SQL.Add(';');
  4414.    ExecSQL(SQL);
  4415.  Finally
  4416.    SQL.Free;
  4417.  End;
  4418.  Finally
  4419.    if (F_TableName='') And (F_QueryDefName='') And (TN <> '') Then
  4420.        Begin
  4421.          F_Database.DeleteQueryDef(TN);
  4422.          Try
  4423.            F_Database.CoreDatabase.Rollback;
  4424.          Except
  4425.          End;
  4426.        End;
  4427.  End;
  4428.  //*****************************************************************************
  4429. End;
  4430.  
  4431. Procedure TKADaoTable.AccessExportToExcel(FileName, SheetName :String; ExcelVersion:Integer; IncludeBlobs, DeleteOld:Boolean);
  4432. Var
  4433.  SQL : TStringList;
  4434.  EV  : String;
  4435.  SS  : String;
  4436.  X   : Integer;
  4437.  FC  : Integer;
  4438.  TN  : String;
  4439. Begin
  4440.  If Not F_Active Then DatabaseError('Table must be open in order to export data!');
  4441.  TN :='';
  4442.  //*****************************************************************************
  4443.  Try
  4444.  if (DeleteOld) And FileExists(FileName) Then DeleteFile(FileName);
  4445.  if F_TableName='' Then
  4446.     Begin
  4447.       if F_QueryDefName='' Then
  4448.          Begin
  4449.            TN := 'Query'+IntToStr(Integer(GetTickcount));
  4450.            Try
  4451.              F_Database.CoreDatabase.BeginTrans;
  4452.            Except
  4453.            End;
  4454.            F_Database.CreateQueryDef(TN,F_ComposeSQL(F_SQL));
  4455.          End
  4456.       Else
  4457.          Begin
  4458.           TN := F_QueryDefName;
  4459.          End;
  4460.     End
  4461.  Else
  4462.     Begin
  4463.       TN := F_TableName;
  4464.     End;
  4465.  EV := 'Excel 8.0;';
  4466.  Case ExcelVersion of
  4467.       3 : EV := 'Excel 3.0;';
  4468.       4 : EV := 'Excel 4.0;';
  4469.       5 : EV := 'Excel 5.0;';
  4470.       8 : EV := 'Excel 8.0;';
  4471.  End;
  4472.  SS:='';
  4473.  FC := FieldCount-1;
  4474.  For X := 0 To FC do
  4475.      Begin
  4476.       if StoreField(X) Then
  4477.        Begin
  4478.         if IncludeBlobs Then
  4479.           Begin
  4480.             if F_UseBrackets Then
  4481.                Begin
  4482.                  SS := SS+' '+BracketField(Fields[X].FieldName);
  4483.                  if X < FC Then SS := SS+',';
  4484.                End
  4485.             Else
  4486.                Begin
  4487.                  if X < FC Then SS := SS+' '+Fields[X].FieldName+',' Else SS := SS+' '+Fields[X].FieldName;
  4488.                End;
  4489.           End
  4490.         Else
  4491.           Begin
  4492.            if Fields[X].DataType<>ftBlob Then
  4493.               Begin
  4494.                if F_UseBrackets Then
  4495.                   Begin
  4496.                     SS := SS+' '+BracketField(Fields[X].FieldName);
  4497.                     if X < FC Then SS := SS+',';
  4498.                   End
  4499.                Else
  4500.                   Begin
  4501.                     if X < FC Then SS := SS+' '+Fields[X].FieldName+',' Else SS := SS+' '+Fields[X].FieldName;
  4502.                   End;
  4503.               End;
  4504.           End;
  4505.        End;
  4506.      End;
  4507.  if SS[Length(SS)]=',' Then System.Delete(SS,Length(SS),1);
  4508.  if F_ExportMethod = AllFields Then SS :='*';
  4509.  SQL := TStringList.Create;
  4510.  Try
  4511.    SQL.Add(Format('Select %s INTO [%s] IN "%s"[%s] FROM [%s]',[SS,SheetName,FileName,EV,TN]));
  4512.    if (F_Filtered) And (F_Filter <> '') Then SQL.Add(' WHERE '+F_Filter);
  4513.    SQL.Add(';');
  4514.    ExecSQL(SQL);
  4515.  Finally
  4516.    SQL.Free;
  4517.  End;
  4518.  Finally
  4519.    if (F_TableName='') And (F_QueryDefName='') And (TN <> '') Then
  4520.        Begin
  4521.          F_Database.DeleteQueryDef(TN);
  4522.          Try
  4523.            F_Database.CoreDatabase.Rollback;
  4524.          Except
  4525.          End;
  4526.        End;
  4527.  End;
  4528.  //*****************************************************************************
  4529. End;
  4530.  
  4531. Procedure TKADaoTable.AccessExportToParadox(FileName:String; ParadoxVersion:Integer; IncludeBlobs, DeleteOld:Boolean);
  4532. Var
  4533.  SQL : TStringList;
  4534.  FN  : String;
  4535.  FP  : String;
  4536.  SS  : String;
  4537.  X   : Integer;
  4538.  FC  : Integer;
  4539.  PV  : String;
  4540.  P   : PChar;
  4541.  TN  : String;
  4542. Begin
  4543.  If Not F_Active Then DatabaseError('Table must be open in order to export data!');
  4544.  TN := '';
  4545.  //*****************************************************************************
  4546.  Try
  4547.  if F_TableName='' Then
  4548.     Begin
  4549.       if F_QueryDefName='' Then
  4550.          Begin
  4551.            TN := 'Query'+IntToStr(Integer(GetTickcount));
  4552.            Try
  4553.              F_Database.CoreDatabase.BeginTrans;
  4554.            Except
  4555.            End;
  4556.            F_Database.CreateQueryDef(TN,F_ComposeSQL(F_SQL));
  4557.          End
  4558.       Else
  4559.          Begin
  4560.           TN := F_QueryDefName;
  4561.          End;
  4562.     End
  4563.  Else
  4564.     Begin
  4565.       TN := F_TableName;
  4566.     End;
  4567.  FN := ExtractFileName(FileName);
  4568.  FP := ExtractFilePath(FileName);
  4569.  if (DeleteOld) Then
  4570.     Begin
  4571.      P:=StrRScan(PChar(FN),'.');
  4572.      if P <> Nil Then P[0] := #0;
  4573.      FN := StrPas(PChar(FN));
  4574.      DeleteFile(FP+FN+'.db');
  4575.      DeleteFile(FP+FN+'.mb');
  4576.      DeleteFile(FP+FN+'.px');
  4577.      DeleteFile(FP+FN+'.val');
  4578.     End;
  4579.  FN := ExtractFileName(FileName);
  4580.  if FP='' Then FP:='.';
  4581.  SS:='';
  4582.  FC := FieldCount-1;
  4583.  For X := 0 To FC do
  4584.      Begin
  4585.       if StoreField(X) Then
  4586.        Begin
  4587.         if IncludeBlobs Then
  4588.           Begin
  4589.             if F_UseBrackets Then
  4590.                Begin
  4591.                  SS := SS+' '+BracketField(Fields[X].FieldName);
  4592.                  if X < FC Then SS := SS+',';
  4593.                End
  4594.             Else
  4595.                Begin
  4596.                  if X < FC Then SS := SS+' '+Fields[X].FieldName+',' Else SS := SS+' '+Fields[X].FieldName;
  4597.                End;
  4598.           End
  4599.         Else
  4600.           Begin
  4601.            if Fields[X].DataType<>ftBlob Then
  4602.               Begin
  4603.                if F_UseBrackets Then
  4604.                   Begin
  4605.                     SS := SS+' '+BracketField(Fields[X].FieldName);
  4606.                     if X < FC Then SS := SS+',';
  4607.                   End
  4608.                Else
  4609.                   Begin
  4610.                     if X < FC Then SS := SS+' '+Fields[X].FieldName+',' Else SS := SS+' '+Fields[X].FieldName;
  4611.                   End;
  4612.               End;
  4613.           End;
  4614.        End;
  4615.      End;
  4616.  Case ParadoxVersion of
  4617.       3 : PV := 'Paradox 3.X;';
  4618.       4 : PV := 'Paradox 4.X;';
  4619.       5 : PV := 'Paradox 5.X;';
  4620.       7 : PV := 'Paradox 7.X;';
  4621.  End;
  4622.  if SS[Length(SS)]=',' Then System.Delete(SS,Length(SS),1);
  4623.  if F_ExportMethod = AllFields Then SS :='*';
  4624.  SQL := TStringList.Create;
  4625.  Try
  4626.    SQL.Add(Format('Select %s INTO [%s] IN "%s"[%s] FROM [%s]',[SS,FN,FP,PV,TN]));
  4627.    if (F_Filtered) And (F_Filter <> '') Then SQL.Add(' WHERE '+F_Filter);
  4628.    SQL.Add(';');
  4629.    ExecSQL(SQL);
  4630.  Finally
  4631.    SQL.Free;
  4632.  End;
  4633.  Finally
  4634.    if (F_TableName='') And (F_QueryDefName='') And (TN <> '') Then
  4635.        Begin
  4636.          F_Database.DeleteQueryDef(TN);
  4637.          Try
  4638.            F_Database.CoreDatabase.Rollback;
  4639.          Except
  4640.          End;
  4641.        End;
  4642.  End;
  4643.  //*****************************************************************************
  4644. End;
  4645.  
  4646. Procedure TKADaoTable.AccessExportToDBase(FileName:String; DBaseVersion:Integer; IncludeBlobs, DeleteOld:Boolean);
  4647. Var
  4648.  SQL : TStringList;
  4649.  FN  : String;
  4650.  FP  : String;
  4651.  SS  : String;
  4652.  X   : Integer;
  4653.  FC  : Integer;
  4654.  DV  : String;
  4655.  P   : PChar;
  4656.  TN  : String;
  4657. Begin
  4658.  If Not F_Active Then DatabaseError('Table must be open in order to export data!');
  4659.  TN := '';
  4660.  //*****************************************************************************
  4661.  Try
  4662.  if F_TableName='' Then
  4663.     Begin
  4664.       if F_QueryDefName='' Then
  4665.          Begin
  4666.            TN := 'Query'+IntToStr(Integer(GetTickcount));
  4667.            Try
  4668.              F_Database.CoreDatabase.BeginTrans;
  4669.            Except
  4670.            End;
  4671.            F_Database.CreateQueryDef(TN,F_ComposeSQL(F_SQL));
  4672.          End
  4673.       Else
  4674.          Begin
  4675.           TN := F_QueryDefName;
  4676.          End;
  4677.     End
  4678.  Else
  4679.     Begin
  4680.       TN := F_TableName;
  4681.     End;
  4682.  FN := ExtractFileName(FileName);
  4683.  FP := ExtractFilePath(FileName);
  4684.  if (DeleteOld) Then
  4685.     Begin
  4686.      P:=StrRScan(PChar(FN),'.');
  4687.      if P <> Nil Then P[0] := #0;
  4688.      FN := StrPas(PChar(FN));
  4689.      DeleteFile(FP+FN+'.dbf');
  4690.      DeleteFile(FP+FN+'.dbt');
  4691.      DeleteFile(FP+FN+'.ndx');
  4692.      DeleteFile(FP+FN+'.ntx');
  4693.      DeleteFile(FP+FN+'.mdx');
  4694.     End;
  4695.  FN := ExtractFileName(FileName);
  4696.  if FP='' Then FP:='.';
  4697.  SS:='';
  4698.  FC := FieldCount-1;
  4699.  For X := 0 To FC do
  4700.      Begin
  4701.       if StoreField(X) Then
  4702.        Begin
  4703.         if IncludeBlobs Then
  4704.           Begin
  4705.             if F_UseBrackets Then
  4706.                Begin
  4707.                  SS := SS+' '+BracketField(Fields[X].FieldName);
  4708.                  if X < FC Then SS := SS+',';
  4709.                End
  4710.             Else
  4711.                Begin
  4712.                  if X < FC Then SS := SS+' '+Fields[X].FieldName+',' Else SS := SS+' '+Fields[X].FieldName;
  4713.                End;
  4714.           End
  4715.         Else
  4716.           Begin
  4717.            if Fields[X].DataType<>ftBlob Then
  4718.               Begin
  4719.                if F_UseBrackets Then
  4720.                   Begin
  4721.                     SS := SS+' '+BracketField(Fields[X].FieldName);
  4722.                     if X < FC Then SS := SS+',';
  4723.                   End
  4724.                Else
  4725.                   Begin
  4726.                     if X < FC Then SS := SS+' '+Fields[X].FieldName+',' Else SS := SS+' '+Fields[X].FieldName;
  4727.                   End;
  4728.               End;
  4729.           End;
  4730.        End;
  4731.      End;
  4732.  Case DBaseVersion of
  4733.       3 : DV := 'dBase III;';
  4734.       4 : DV := 'dBase IV;';
  4735.       5 : DV := 'dBase 5.0;';
  4736.  End;
  4737.  if SS[Length(SS)]=',' Then System.Delete(SS,Length(SS),1);
  4738.  if F_ExportMethod = AllFields Then SS :='*';
  4739.  SQL := TStringList.Create;
  4740.  Try
  4741.    SQL.Add(Format('Select %s INTO [%s] IN "%s"[%s] FROM [%s]',[SS,FN,FP,DV,TN]));
  4742.    if (F_Filtered) And (F_Filter <> '') Then SQL.Add(' WHERE '+F_Filter);
  4743.    SQL.Add(';');
  4744.    ExecSQL(SQL);
  4745.  Finally
  4746.    SQL.Free;
  4747.  End;
  4748.  Finally
  4749.    if (F_TableName='') And (F_QueryDefName='') And (TN <> '') Then
  4750.        Begin
  4751.          F_Database.DeleteQueryDef(TN);
  4752.          Try
  4753.            F_Database.CoreDatabase.Rollback;
  4754.          Except
  4755.          End;
  4756.        End;
  4757.  End;
  4758.  //*****************************************************************************
  4759. End;
  4760.  
  4761.  
  4762. Procedure TKADaoTable.AccessExportToFoxPro(FileName:String; FoxProVersion:Integer; IncludeBlobs, DeleteOld:Boolean);
  4763. Var
  4764.  SQL : TStringList;
  4765.  FN  : String;
  4766.  FP  : String;
  4767.  SS  : String;
  4768.  X   : Integer;
  4769.  FC  : Integer;
  4770.  DV  : String;
  4771.  P   : PChar;
  4772.  TN  : String;
  4773. Begin
  4774.  If Not F_Active Then DatabaseError('Table must be open in order to export data!');
  4775.  TN := '';
  4776.  //*****************************************************************************
  4777.  Try
  4778.  if F_TableName='' Then
  4779.     Begin
  4780.       if F_QueryDefName='' Then
  4781.          Begin
  4782.            TN := 'Query'+IntToStr(Integer(GetTickcount));
  4783.            Try
  4784.              F_Database.CoreDatabase.BeginTrans;
  4785.            Except
  4786.            End;
  4787.            F_Database.CreateQueryDef(TN,F_ComposeSQL(F_SQL));
  4788.          End
  4789.       Else
  4790.          Begin
  4791.           TN := F_QueryDefName;
  4792.          End;
  4793.     End
  4794.  Else
  4795.     Begin
  4796.       TN := F_TableName;
  4797.     End;
  4798.  FN := ExtractFileName(FileName);
  4799.  FP := ExtractFilePath(FileName);
  4800.  if (DeleteOld) Then
  4801.     Begin
  4802.      P:=StrRScan(PChar(FN),'.');
  4803.      if P <> Nil Then P[0] := #0;
  4804.      FN := StrPas(PChar(FN));
  4805.      DeleteFile(FP+FN+'.dbf');
  4806.      DeleteFile(FP+FN+'.fpt');
  4807.      DeleteFile(FP+FN+'.cdx');
  4808.     End;
  4809.  FN := ExtractFileName(FileName);
  4810.  if FP='' Then FP:='.';
  4811.  SS:='';
  4812.  FC := FieldCount-1;
  4813.  For X := 0 To FC do
  4814.      Begin
  4815.       if StoreField(X) Then
  4816.        Begin
  4817.         if IncludeBlobs Then
  4818.           Begin
  4819.             if F_UseBrackets Then
  4820.                Begin
  4821.                  SS := SS+' '+BracketField(Fields[X].FieldName);
  4822.                  if X < FC Then SS := SS+',';
  4823.                End
  4824.             Else
  4825.                Begin
  4826.                  if X < FC Then SS := SS+' '+Fields[X].FieldName+',' Else SS := SS+' '+Fields[X].FieldName;
  4827.                End;
  4828.           End
  4829.         Else
  4830.           Begin
  4831.            if Fields[X].DataType<>ftBlob Then
  4832.               Begin
  4833.                if F_UseBrackets Then
  4834.                   Begin
  4835.                     SS := SS+' '+BracketField(Fields[X].FieldName);
  4836.                     if X < FC Then SS := SS+',';
  4837.                   End
  4838.                Else
  4839.                   Begin
  4840.                     if X < FC Then SS := SS+' '+Fields[X].FieldName+',' Else SS := SS+' '+Fields[X].FieldName;
  4841.                   End;
  4842.               End;
  4843.           End;
  4844.        End;
  4845.      End;
  4846.  Case FoxProVersion of
  4847.       20 : DV := 'FoxPro 2.0;';
  4848.       25 : DV := 'FoxPro 2.5;';
  4849.       26 : DV := 'FoxPro 2.6;';
  4850.       30 : DV := 'FoxPro 3.0;';
  4851.  End;
  4852.  if SS[Length(SS)]=',' Then System.Delete(SS,Length(SS),1);
  4853.  if F_ExportMethod = AllFields Then SS :='*';
  4854.  SQL := TStringList.Create;
  4855.  Try
  4856.    SQL.Add(Format('Select %s INTO [%s] IN "%s"[%s] FROM [%s]',[SS,FN,FP,DV,TN]));
  4857.    if (F_Filtered) And (F_Filter <> '') Then SQL.Add(' WHERE '+F_Filter);
  4858.    SQL.Add(';');
  4859.    ExecSQL(SQL);
  4860.  Finally
  4861.    SQL.Free;
  4862.  End;
  4863.  Finally
  4864.    if (F_TableName='') And (F_QueryDefName='') And (TN <> '') Then
  4865.        Begin
  4866.          F_Database.DeleteQueryDef(TN);
  4867.          Try
  4868.            F_Database.CoreDatabase.Rollback;
  4869.          Except
  4870.          End;
  4871.        End;
  4872.  End;
  4873.  //*****************************************************************************
  4874. End;
  4875.  
  4876. Procedure TKADaoTable.AccessExportToMDB(FileName,NewTableName:String; IncludeBlobs, DeleteOld:Boolean);
  4877. Var
  4878.  SQL : TStringList;
  4879.  SS  : String;
  4880.  X   : Integer;
  4881.  FC  : Integer;
  4882.  TN  : String;
  4883. Begin
  4884.  If Not F_Active Then DatabaseError('Table must be open in order to export data!');
  4885.  TN := '';
  4886.  //*****************************************************************************
  4887.  Try
  4888.  if (DeleteOld) Then
  4889.      Begin
  4890.        SQL := TStringList.Create;
  4891.        Try
  4892.         SQL.Add('DROP TABLE ['+FileName+'].['+NewTableName+'];');
  4893.         ExecSQL(SQL);
  4894.        Except
  4895.        End;
  4896.        SQL.Free;
  4897.      End;
  4898.  if F_TableName='' Then
  4899.     Begin
  4900.       if F_QueryDefName='' Then
  4901.          Begin
  4902.            TN := 'Query'+IntToStr(Integer(GetTickcount));
  4903.            F_Database.CreateQueryDef(TN,F_ComposeSQL(F_SQL));
  4904.          End
  4905.       Else
  4906.          Begin
  4907.           TN := F_QueryDefName;
  4908.          End;
  4909.     End
  4910.  Else
  4911.     Begin
  4912.       TN := F_TableName;
  4913.     End;
  4914.  SS:='';
  4915.  FC := FieldCount-1;
  4916.  For X := 0 To FC do
  4917.      Begin
  4918.       if StoreField(X) Then
  4919.        Begin
  4920.         if IncludeBlobs Then
  4921.           Begin
  4922.             if F_UseBrackets Then
  4923.                Begin
  4924.                  SS := SS+' '+BracketField(Fields[X].FieldName);
  4925.                  if X < FC Then SS := SS+',';
  4926.                End
  4927.             Else
  4928.                Begin
  4929.                  if X < FC Then SS := SS+' '+Fields[X].FieldName+',' Else SS := SS+' '+Fields[X].FieldName;
  4930.                End;
  4931.           End
  4932.         Else
  4933.           Begin
  4934.            if Fields[X].DataType<>ftBlob Then
  4935.               Begin
  4936.                if F_UseBrackets Then
  4937.                   Begin
  4938.                     SS := SS+' '+BracketField(Fields[X].FieldName);
  4939.                     if X < FC Then SS := SS+',';
  4940.                   End
  4941.                Else
  4942.                   Begin
  4943.                     if X < FC Then SS := SS+' '+Fields[X].FieldName+',' Else SS := SS+' '+Fields[X].FieldName;
  4944.                   End;
  4945.               End;
  4946.           End;
  4947.        End;
  4948.      End;
  4949.  if SS[Length(SS)]=',' Then System.Delete(SS,Length(SS),1);
  4950.  if F_ExportMethod = AllFields Then SS :='*';
  4951.  SQL := TStringList.Create;
  4952.  Try
  4953.    SQL.Add(Format('Select %s INTO [%s].[%s] FROM [%s]',[SS,FileName,NewTableName,TN]));
  4954.    if (F_Filtered) And (F_Filter <> '') Then SQL.Add(' WHERE '+F_Filter);
  4955.    SQL.Add(';');
  4956.    ExecSQL(SQL);
  4957.  Finally
  4958.    SQL.Free;
  4959.  End;
  4960.  Finally
  4961.    if (F_TableName='') And (F_QueryDefName='') And (TN <> '') Then F_Database.DeleteQueryDef(TN);
  4962.  End;
  4963.  //*****************************************************************************
  4964. End;
  4965.  
  4966.  
  4967. Procedure TKADaoTable.InternalInitIndexDefs;
  4968. Var
  4969.   {$IFDEF DYNADAO}
  4970.   ID         : OleVariant;
  4971.   {$ELSE}
  4972.   ID         : Indexes;
  4973.   {$ENDIF}
  4974.   IndexCount : Integer;
  4975.   FieldCount : Integer;
  4976.   X          : Integer;
  4977.   Y          : Integer;
  4978.   IName      : String;
  4979.   IFields    : String;
  4980.   IPrimary   : Boolean;
  4981.   IUnique    : Boolean;
  4982.   IDesc      : Boolean;
  4983.   IDescFields: String;
  4984.   Options    : TIndexOptions;
  4985. Begin
  4986.  F_IndexDefs.Clear;                                                                 
  4987.  if F_TableName='' Then Exit;
  4988.  if F_TableType <> DaoApi.dbOpenTable Then Exit;
  4989.  if F_Database.EngineType=dbUseODBC Then Exit;
  4990.  ID := F_Database.CoreDatabase.TableDefs.Item[F_TableName].Indexes;
  4991.  //****************************************************************** 13.02.2002
  4992.  Try
  4993.    ID.Refresh;
  4994.  Except
  4995.  End;
  4996.  //****************************************************************** 13.02.2002
  4997.  IndexCount := ID.Count;
  4998.  For X := 0 To IndexCount-1 do
  4999.      Begin
  5000.        IName       := '';
  5001.        IPrimary    := False;
  5002.        IUnique     := False;
  5003.        Try
  5004.         IName       := ID.Item[X].Name;
  5005.         IPrimary    := ID.Item[X].Primary;
  5006.         IUnique     := ID.Item[X].Unique;
  5007.        Except
  5008.        End;
  5009.        IDesc       := True;
  5010.        IFields     := '';
  5011.        IDescFields := '';
  5012.        FieldCount := ID.Item[X].Fields.Count;
  5013.        For Y := 0 To FieldCount-1 Do
  5014.            Begin
  5015.              if Y < FieldCount-1 Then
  5016.                 IFields:=IFields+ID.Item[X].Fields.Item[Y].Name+';'
  5017.              Else
  5018.                 IFields:=IFields+ID.Item[X].Fields.Item[Y].Name;
  5019.              if (ID.Item[X].Fields.Item[Y].Attributes and dbDescending) = 0 Then
  5020.                 Begin
  5021.                  IDesc := False;
  5022.                 End
  5023.              Else
  5024.                 Begin
  5025.                   IDescFields := IDescFields+ID.Item[X].Fields.Item[Y].Name+';';
  5026.                 End;
  5027.            End;
  5028.        Options  := [];
  5029.        if IPrimary Then Options:=Options+[ixPrimary];
  5030.        if IUnique  Then Options:=Options+[ixUnique];
  5031.        if IDesc    Then Options:=Options+[ixDescending];
  5032.        F_IndexDefs.Add(IName,IFields,Options);
  5033.        if Length(IDescFields) > 0 Then System.Delete(IDescFields,Length(IDescFields),1);
  5034.        {$IFDEF D4UP}
  5035.        F_IndexDefs.Items[F_IndexDefs.Count-1].DescFields:=IDescFields;
  5036.        {$ENDIF}
  5037.      End;
  5038. End;
  5039.  
  5040. Procedure TKADaoTable.UpdateIndexDefs;
  5041. Begin
  5042.  InternalInitIndexDefs;
  5043. End;
  5044.  
  5045. Procedure TKADaoTable.InternalInitFieldDefs;
  5046. Var
  5047.   X        : Integer;
  5048.   Sz       : Integer;
  5049.   Typ      : Integer;
  5050.   ResTyp   : TFieldType;
  5051.   Nam      : String;
  5052.   F_Format : String;
  5053. Begin
  5054.         FieldDefs.Clear;
  5055.         F_DisplayLabels.Clear;
  5056.         if Not InInternalOpen Then
  5057.            Begin
  5058.             if Not F_Active Then OpenDaoRecordset;
  5059.            End;
  5060.         with FieldDefs do
  5061.         Begin
  5062.           For X:=0 To F_DaoTable.Fields.Count-1 do
  5063.               Begin
  5064.                 Typ  := DaoFields[X].Type;
  5065.                 Nam := DaoFields[X].Name;
  5066.                 Sz:=DaoSizeToBDESize(Typ,DaoFields[X].Size);
  5067.                 if (Typ=dbDate) And (PropertyExists(OleVariant(DaoFields[X].Properties),'Format')) Then
  5068.                    Begin
  5069.                      F_Format:=DaoFields[X].Properties.Item['Format'].Value;
  5070.                      if AnsiCompareText(F_Format,'Long Time')=0    Then Typ:=dbTime
  5071.                         Else
  5072.                         if AnsiCompareText(F_Format,'Medium Time')=0  Then Typ:=dbTime
  5073.                            Else
  5074.                            if AnsiCompareText(F_Format,'Short Time')=0   Then Typ:=dbTime                 
  5075.                               Else
  5076.                                 if AnsiCompareText(F_Format,'General Date')=0   Then Typ:=dbTimeStamp;
  5077.                    End
  5078.                 Else
  5079.                    if (Typ=dbDate) Then Typ:=dbTimeStamp;                             
  5080.                    if (Typ=dbText) And (Sz=0) Then Sz:=255;
  5081.                    if (Typ=dbLong) And ((DaoFields[X].Attributes And dbAutoIncrField) > 0) Then Typ := dbAutoIncInteger;
  5082.                    //************************************************ 26.01.2002
  5083.                    if F_Database.EngineType=dbUseJet Then
  5084.                       Begin
  5085.                         if (Typ=dbAutoIncInteger) Then
  5086.                            Begin
  5087.                              F_DefaultValues.Strings[X] := '';
  5088.                            End;
  5089.                         if (Typ=dbLong) And (Pos('genuniqueid',AnsiLowercase(DaoFields[X].DefaultValue))>0) Then
  5090.                             Begin
  5091.                               F_DefaultValues.Strings[X] := '';
  5092.                             End;        
  5093.                         if (Typ=dbGUID) And (Pos('genguid',AnsiLowercase(DaoFields[X].DefaultValue))>0) Then
  5094.                             Begin
  5095.                               F_DefaultValues.Strings[X] := '';
  5096.                             End;
  5097.                       End;
  5098.                    //************************************************ 26.01.2002   
  5099.                    //***********************************************************
  5100.                    ResTyp := DaoToBDE(Typ);
  5101.                    if F_ReadOnly Then
  5102.                       Add(Nam,ResTyp,Sz,False)
  5103.                    Else
  5104.                       if (F_UseDaoProperties) Then
  5105.                           Add(Nam,ResTyp,Sz,DaoFields[X].Required)
  5106.                       Else
  5107.                           Add(Nam,ResTyp,Sz,False);
  5108.                    //***********************************************************
  5109.                    if ResTyp=ftBlob Then F_DefaultValues.Strings[X] := '';
  5110.                    //***********************************************************
  5111.                 if (F_UseDisplayLabels) And (PropertyExists(OleVariant(DaoFields[X].Properties),'Caption')) Then
  5112.                    F_DisplayLabels.Add(DaoFields[X].Properties['Caption'])
  5113.                 Else
  5114.                    F_DisplayLabels.Add(Nam);
  5115.                 //**************************************************************
  5116.                 // Tricky way to check out GUID
  5117.                 //**************************************************************
  5118.                 if (Typ=dbGUID) Then Items[Count-1].Precision := GUID_ID;
  5119.                 //**************************************************************
  5120.               End;
  5121.         End;
  5122.         InternalInitIndexDefs;
  5123.         if Not InInternalOpen Then
  5124.            Begin
  5125.             if Not F_Active Then CloseDaoRecordset;
  5126.            End;
  5127. End;
  5128.  
  5129. Procedure TKADaoTable.InternalSetDisplayLabels;
  5130. Var
  5131.   X  : Integer;
  5132.   FF : TField;
  5133. Begin
  5134.  For X:=0 To FieldDefs.Count-1 do
  5135.   Begin
  5136.    FF := FindField(FieldDefs.Items[X].Name);
  5137.    if FF <> Nil Then FF.DisplayLabel:=F_DisplayLabels.Strings[X];
  5138.   End;
  5139. End;
  5140.  
  5141. Function TKADaoTable.GetActiveRecordBuffer:  PChar;
  5142. Begin
  5143.         case State of
  5144.              {$IFDEF D4UP}
  5145.              dsBlockRead   ,
  5146.              {$ENDIF}
  5147.              dsBrowse      : if IsEmpty Then
  5148.                                 Result := Nil
  5149.                              Else
  5150.                                 Result := ActiveBuffer;
  5151.              dsCalcFields  : Result    := CalcBuffer;
  5152.              dsFilter      : Result    := F_FilterBuffer;
  5153.              dsEdit        ,
  5154.              dsInsert      ,
  5155.              dsNewValue    ,
  5156.              dsCurValue    : Result    := ActiveBuffer;
  5157.              dsOldValue:     if F_OldValue=Nil then
  5158.                               Result   :=ActiveBuffer
  5159.                            Else
  5160.                               Result   := F_OldValue;
  5161.              dsSetKey      :  Result   := F_ActiveKeyBuffer;
  5162.         Else Result:=Nil;
  5163.         End;
  5164. End;
  5165.  
  5166.  
  5167. Procedure TKADaoTable.InternalHandleException;
  5168. Begin
  5169.      Application.HandleException(Self);
  5170. End;
  5171.  
  5172. Procedure TKADaoTable.ClearCalcFields(Buffer: PChar);
  5173. Begin
  5174.     FillChar(Buffer[F_StartCalc],CalcFieldsSize,0);
  5175. End;
  5176.  
  5177. Procedure TKADaoTable.F_OnGetMemoText(Sender: TField; var Text: String; DisplayText: Boolean);
  5178. Var
  5179.  P      : Integer;
  5180.  Buffer : PChar;
  5181.  DInfo  : TDaoInfo;
  5182. Begin
  5183.    if F_CacheMemos Then
  5184.       Begin
  5185.        Buffer := GetActiveRecordBuffer;
  5186.        if Buffer=Nil Then Exit;
  5187.        DInfo := PDaoInfo(Buffer+F_StartMyInfo)^;
  5188.        P := Pos(#13,DInfo.RecordData.Strings[Sender.FieldNo-1]);
  5189.        if P > 0 Then
  5190.           Text := Copy(DInfo.RecordData.Strings[Sender.FieldNo-1],1,P-1)
  5191.        Else
  5192.           Text := DInfo.RecordData.Strings[Sender.FieldNo-1];
  5193.       End;
  5194. End;
  5195.  
  5196.  
  5197. Procedure TKADaoTable.F_OnGetGUIDText(Sender: TField; var Text: String; DisplayText: Boolean);
  5198. Var
  5199.  P      : Integer;
  5200.  Buffer : PChar;
  5201.  DInfo  : TDaoInfo;
  5202. Begin
  5203.    if F_ShowGUID Then
  5204.       Begin
  5205.        Buffer := GetActiveRecordBuffer;
  5206.        if Buffer=Nil Then Exit;
  5207.        DInfo := PDaoInfo(Buffer+F_StartMyInfo)^;
  5208.        Text  := DInfo.RecordData.Strings[Sender.FieldNo-1];
  5209.        P := Pos('{guid ',Text);
  5210.        if P = 1 Then
  5211.           Begin
  5212.             System.Delete(Text,1,6);
  5213.             P := Pos('}}',Text);
  5214.             if P = Length(Text)-1 Then System.Delete(Text,P,1);
  5215.           End;
  5216.       End;
  5217. End;
  5218.  
  5219. Procedure TKADaoTable.F_OnSetGUIDText(Sender: TField; const Text: string);
  5220. Var
  5221.  SGUID : String;
  5222. Begin
  5223.   if F_ShowGUID Then
  5224.      Begin
  5225.        if Length(Text) = 38 Then
  5226.           Begin
  5227.             SGUID := PutGUIDInString(Text);
  5228.             Sender.AsString := SGUID;
  5229.           End;
  5230.      End;
  5231. End;
  5232.  
  5233. Function TKADaoTable.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
  5234. var
  5235.   SourceBuffer : PChar;
  5236.   Value        : TStringList;
  5237.   FieldNumber  : Integer;
  5238.   TempString   : String;
  5239. Begin
  5240.         Result:=False;
  5241.         SourceBuffer:=GetActiveRecordBuffer;
  5242.         if (not F_Active) or (SourceBuffer=nil) then
  5243.            Begin
  5244.               Exit;
  5245.            End;
  5246.         if (Field.FieldKind=fkCalculated) or (Field.FieldKind=fkLookup) then
  5247.           Begin
  5248.                 Inc(SourceBuffer,F_StartCalc+Field.Offset);
  5249.                 if (SourceBuffer[0]=#0) or (Buffer=nil) then
  5250.                   Begin
  5251.                     Exit;
  5252.                   End
  5253.                 Else
  5254.                   Begin
  5255.                     Move(SourceBuffer[1], Buffer^, Field.DataSize);
  5256.                     Result:=True;
  5257.                   End;
  5258.           end
  5259.         else
  5260.           Begin
  5261.            Try
  5262.              Value :=PDaoInfo(PChar(SourceBuffer)+F_StartMyInfo)^.RecordData;
  5263.            Except
  5264.              Exit;
  5265.            End;
  5266.            FieldNumber:=Field.FieldNo-1;
  5267.            if (Value=Nil) Then Exit;
  5268.            if (Buffer = Nil)  Then
  5269.             Begin
  5270.               Result:=(Value.Strings[FieldNumber] <> '');
  5271.             End
  5272.                Else
  5273.             Begin
  5274.               Case Field.DataType of
  5275.                 ftBytes     : Begin
  5276.                                //***********************************************
  5277.                                If Field.ValidChars = GUID_VALID_CHARS Then
  5278.                                   Begin
  5279.                                     //******************************* GUID
  5280.                                     Result := GUIDToBuffer(Buffer,Value.Strings[FieldNumber])
  5281.                                   End
  5282.                                Else
  5283.                                   Begin
  5284.                                     //******************************* BYTE ARRAY
  5285.                                     TempString:=Value.Strings[FieldNumber];
  5286.                                     TempString:=TempString+#0;
  5287.                                     CopyMemory(PChar(Buffer),PChar(TempString),Length(TempString));
  5288.                                     Result := Value.Strings[FieldNumber] <> '';
  5289.                                   End;
  5290.                                //***********************************************   
  5291.                               End;
  5292.                 ftInteger   : Result:=IntegerToBuffer(Buffer,Value.Strings[FieldNumber]);
  5293.                 ftAutoInc   : Result:=IntegerToBuffer(Buffer,Value.Strings[FieldNumber]);
  5294.                 ftSmallint  : Result:=IntegerToBuffer(Buffer,Value.Strings[FieldNumber]);
  5295.                 ftCurrency  : Result:=FloatToBuffer(Buffer,Value.Strings[FieldNumber]);
  5296.                 ftFloat     : Result:=FloatToBuffer(Buffer,Value.Strings[FieldNumber]);
  5297.                 ftDate      : Result:=DateToBuffer(Buffer,Value.Strings[FieldNumber]);
  5298.                 ftString    : Begin
  5299.                                 TempString:=Value.Strings[FieldNumber];
  5300.                                 TempString:=TempString+#0;
  5301.                                 CopyMemory(PChar(Buffer),PChar(TempString),Length(TempString));
  5302.                                 Result := Value.Strings[FieldNumber] <> '';
  5303.                               End;
  5304.                 ftTime      : Result:=TimeToBuffer(Buffer,Value.Strings[FieldNumber]);
  5305.                 ftDateTime  : Result:=DateTimeToBuffer(Buffer,Value.Strings[FieldNumber]);
  5306.                 ftBoolean   : Result:=BooleanToBuffer(Buffer,Value.Strings[FieldNumber]);
  5307.               End;
  5308.             End;
  5309.           End;
  5310. End;
  5311.  
  5312. Procedure TKADaoTable.SetFieldData(Field: TField; Buffer: Pointer);
  5313. var
  5314.         DestinationBuffer: PChar;
  5315.         Tmp              : String;
  5316.         BTmp             : WordBool;
  5317.         BBTmp            : Boolean;
  5318. Begin
  5319.         DestinationBuffer:=GetActiveRecordBuffer;
  5320.         if DestinationBuffer=Nil Then Exit;
  5321.         if (Field.FieldKind=fkCalculated) or (Field.FieldKind=fkLookup) then
  5322.            Begin
  5323.                 Inc(DestinationBuffer,F_StartCalc+Field.Offset);
  5324.                 Boolean(DestinationBuffer[0]):=(Buffer<>nil);
  5325.                 if Boolean(DestinationBuffer[0]) then CopyMemory(@DestinationBuffer[1],Buffer,Field.DataSize);
  5326.            End
  5327.         Else
  5328.           Begin
  5329.             //************************************** Field Checking And Validation
  5330.             if Field.FieldKind in [fkData, fkInternalCalc] then Field.Validate(Buffer);
  5331.             if Field.ReadOnly Then Exit; //*****************************20.09.2001
  5332.             //********************************************************************
  5333.             Tmp:='';
  5334.             if Buffer <> Nil Then
  5335.                Begin
  5336.                  Case Field.DataType of
  5337.                   ftBytes      : Begin
  5338.                                    //*******************************************
  5339.                                    If Field.ValidChars = GUID_VALID_CHARS Then
  5340.                                       Begin
  5341.                                         //*************************** GUID
  5342.                                         Tmp := BufferToGUID(Buffer);
  5343.                                       End
  5344.                                    Else
  5345.                                       Begin
  5346.                                         //*************************** BYTE ARRAY
  5347.                                         SetString(Tmp,PChar(Buffer),Field.Size);
  5348.                                       End;
  5349.                                    //*******************************************
  5350.                                  End;
  5351.                   ftString     : Tmp := PChar(Buffer);
  5352.                   ftSmallint   : Tmp := IntToStr(Integer(Buffer^));
  5353.                   ftWord       : Tmp := IntToStr(Integer(Buffer^));
  5354.                   ftInteger    : Tmp := IntToStr(Integer(Buffer^));
  5355.                   ftAutoInc    : Tmp := IntToStr(Integer(Buffer^));
  5356.  
  5357.                   ftBCD        : Tmp := FloatToStr(Double(Buffer^));
  5358.                   ftCurrency   : Tmp := FloatToStr(Double(Buffer^));
  5359.                   ftFloat      : Tmp := FloatToStr(Double(Buffer^));
  5360.  
  5361.                   ftDate       : Tmp := BufferToDate(Buffer);
  5362.                   ftTime       : Tmp := BufferToTime(Buffer);
  5363.                   ftDateTime   : Tmp := BufferToDateTime(Buffer);
  5364.                   ftBoolean    : Begin
  5365.                                    BTmp := WordBool(Buffer^);
  5366.                                    BBTmp:=Boolean(BTmp);
  5367.                                    Case BBTmp Of
  5368.                                      True   : Tmp:= 'True';
  5369.                                      False  : Tmp:= 'False';
  5370.                                    End;
  5371.                                  End;
  5372.                  End;
  5373.                End;
  5374.             PDaoInfo(DestinationBuffer+F_StartMyInfo)^.RecordData.Strings[Field.FieldNo-1]:=Tmp;
  5375.             PDaoInfo(DestinationBuffer+F_StartMyInfo)^.RecordData.Objects[Field.FieldNo-1]:=TObject(True);
  5376.          End;
  5377.         if not (State in [{$IFDEF D4UP}dsInternalCalc, {$ENDIF} dsCalcFields, dsFilter, dsNewValue]) then DataEvent(deFieldChange, Longint(Field));
  5378. End;
  5379.  
  5380. Procedure TKADaoTable.InternalFirst;
  5381. Begin
  5382.   F_RecNo:=-1;
  5383.   F_RecPos:=-1;
  5384.   if (F_DaoTable.BOF) And (F_DaoTable.EOF) Then Exit;
  5385.   if F_TableType = dbOpenForwardOnly Then Exit;
  5386.   Try
  5387.    F_DaoTable.MoveFirst;
  5388.    F_DaoTable.MovePrevious;
  5389.   Except
  5390.   End;
  5391. End;
  5392.  
  5393. Procedure TKADaoTable.InternalLast;
  5394. Var
  5395.  TmpRS        : OleVariant;
  5396.  DoRaise      : Boolean;
  5397.  OldR         : Integer;
  5398. Begin
  5399.      if (F_DaoTable.BOF) And (F_DaoTable.EOF) Then Begin F_RecNo:=-1; Exit; End;
  5400.      DoRaise := False;
  5401.      Try
  5402.       if F_TableType = dbOpenForwardOnly Then
  5403.         Begin
  5404.          if NOT F_DaoTable.EOF Then
  5405.            Begin
  5406.             While NOT F_DaoTable.EOF Do
  5407.               Begin
  5408.                 F_DaoTable.MoveNext;
  5409.                 Inc(F_RecPos);
  5410.                 F_RecNo:=F_RecPos;
  5411.               End;
  5412.              Dec(F_RecPos);
  5413.            End;
  5414.           F_RecNo:=F_RecPos;
  5415.         End
  5416.       Else
  5417.         Begin
  5418.          OleVariant(F_DaoTable).MoveLast;
  5419.          F_DaoTable.MoveNext;
  5420.          OldR    := F_RecNo;
  5421.          F_RecNo := F_DaoTable.RecordCount;
  5422.          if F_TableType = dbOpenTable Then
  5423.            Begin
  5424.             if (F_RecNo > F_LastRecord) Or (OldR > F_RecNo) Then
  5425.                 Begin
  5426.                  TmpRS:=OleVariant(F_DaoTable).OpenRecordset(dbOpenSnapShot);
  5427.                  TmpRS.MoveLast;
  5428.                  F_RecNo:=TmpRS.RecordCount;
  5429.                  TmpRS.Close;
  5430.                  F_LastRecord:=F_RecNo;
  5431.                  if (F_RecNo <> F_DaoTable.RecordCount) And (F_WarnOnBadDatabase) Then
  5432.                     Begin
  5433.                       DoRaise := True;
  5434.                       DatabaseError(Format(E2026,[F_Database.Database]));
  5435.                     End;
  5436.                 End;
  5437.            End;
  5438.         End;
  5439.      Except
  5440.        if DoRaise Then Raise;
  5441.      End;
  5442. End;
  5443.  
  5444. Procedure TKADaoTable.InternalMoveToBookmark(Bookmark: Pointer);
  5445. Var
  5446.   X       : Integer;
  5447.   BK      : OleVariant;
  5448.   P       : PChar;
  5449.   PB      : PChar;
  5450. Begin
  5451.    BK  := VarArrayCreate([0, 3],varByte);
  5452.    P   := PChar(Bookmark);
  5453.    PB  := VarArrayLock(BK);
  5454.    For X := 0 to 3 do PB[X] := P[X];
  5455.    VarArrayUnLock(BK);                                                           
  5456.    Try
  5457.      OleVariant(F_DaoTable).Bookmark:=VarAsType(BK, varArray or VarByte);
  5458.    Except
  5459.      if GetLastDaoError.ErrNo=3167 Then First;
  5460.      VarClear(BK);
  5461.      Raise;
  5462.    End;
  5463.    VarClear(BK);
  5464. End;
  5465.  
  5466. Procedure TKADaoTable.InternalSetToRecord(Buffer: PChar);
  5467. Var
  5468.   RN     : Integer;
  5469.   Delta  : Integer;
  5470.   Err    : String;
  5471. Begin
  5472.   if (F_DaoTable.BOF) And (F_DaoTable.EOF) Then Exit;
  5473.   if Buffer=Nil Then Exit;
  5474.   IF PDaoInfo(Buffer+F_StartMyInfo)^.BookmarkFlag in [bfCurrent, bfInserted] Then
  5475.      Begin
  5476.        RN:=F_RecNo;
  5477.        F_RecNo:=PDaoInfo(Buffer+F_StartMyInfo)^.RecordNo;
  5478.        if F_TableType = dbOpenForwardOnly Then Exit;
  5479.        if State = dsSetKey Then Exit;
  5480.        if F_Bookmarkable Then
  5481.           Begin
  5482.             Try
  5483.              if (State <> dsEdit) And (State <> dsInsert) Then
  5484.              InternalMoveToBookmark(@PDaoInfo(Buffer+F_StartMyInfo)^.BookmarkData);
  5485.             Except
  5486.               //****************************************** HANDLE DELETED RECORD
  5487.               Err := GetLastDaoError.Description;
  5488.               Try
  5489.                 InternalFirst;
  5490.                 Resync([rmCenter]);
  5491.                 DatabaseError(Err);
  5492.               Finally
  5493.               End;
  5494.               //****************************************** HANDLE DELETED RECORD
  5495.             End;
  5496.           End
  5497.        Else
  5498.           Begin
  5499.            Delta:=F_RecNo-RN;
  5500.            if Delta=0 Then Exit;
  5501.            Try
  5502.              If ((F_Filtered) And (Assigned(F_OnFilterRecord))) Or (F_RangeFiltered) Then
  5503.                  Begin
  5504.                   F_DaoTable.MoveFirst;
  5505.                   OleVariant(F_DaoTable).Move(F_RecNo);
  5506.                  End
  5507.              Else
  5508.                  Begin
  5509.                    OleVariant(F_DaoTable).Move(Delta);
  5510.                  End;
  5511.            Except
  5512.              F_DaoTable.MoveFirst;
  5513.              OleVariant(F_DaoTable).Move(F_RecNo);
  5514.            End;
  5515.           End;
  5516.     End;
  5517. End;
  5518.  
  5519. Procedure TKADaoTable.InternalEdit;
  5520. Label
  5521.    Again;
  5522. Var
  5523.   PS       : PChar;
  5524.   PT       : PChar;
  5525.   JumpAgain: Boolean;
  5526.   Action   : TDataAction;
  5527.   LDE      : TDaoErrRec;
  5528. Begin
  5529.      if F_OldValue <> Nil then FreeRecordBuffer(F_OldValue);
  5530.      F_OldValue:=AllocRecordBuffer;
  5531.      PT := F_OldValue+F_StartMyInfo;
  5532.      PS := GetActiveRecordBuffer;
  5533.      if PS <> Nil Then
  5534.         Begin
  5535.          PS := PS+F_StartMyInfo;
  5536.          PDaoInfo(PT)^.BookmarkData := PDaoInfo(PS)^.BookmarkData;
  5537.          PDaoInfo(PT)^.BookmarkFlag := PDaoInfo(PS)^.BookmarkFlag;
  5538.          PDaoInfo(PT)^.RecordNo := PDaoInfo(PS)^.RecordNo;
  5539.          PDaoInfo(PT)^.RecordData.Assign(PDaoInfo(PS)^.RecordData);
  5540.         End;
  5541. Again:
  5542.      JumpAgain:= False;
  5543.      Try
  5544.        if F_DaoTable.EditMode <> DaoApi.dbEditInProgress Then F_DaoTable.Edit;
  5545.      Except
  5546.        On E:Exception do
  5547.           Begin
  5548.            LDE:=GetLastDaoError;
  5549.            //******************************************************** 04.02.2002
  5550.            if F_DaoTable.EditMode <> DaoApi.dbEditInProgress Then
  5551.               Begin
  5552.                OleVariant(F_DaoTable).Move(0);
  5553.                Resync([]);
  5554.               End;
  5555.            //******************************************************** 04.02.2002
  5556.            if Assigned(OnEditError) Then
  5557.               Begin
  5558.                 E.HelpContext := LDE.HelpContext;
  5559.                 E.Message     := LDE.Description;
  5560.                 OnEditError(Self,EDatabaseError(E),Action);
  5561.                 if Action=daRetry  Then JumpAgain:=True;
  5562.                 if Action=daAbort  Then Exit;
  5563.                 if Action=daFail   Then Raise;
  5564.               End
  5565.            Else
  5566.               Begin
  5567.                 Raise;
  5568.               End;
  5569.           End;
  5570.      End;
  5571.      if JumpAgain Then Goto Again;
  5572.      inherited InternalEdit;
  5573.      //*************************************************************************
  5574.      if PS <> Nil Then InternalFillRecordData(OleVariant(F_DaoTable), True, PS);
  5575.      //*************************************************************************
  5576. End;
  5577.  
  5578. Procedure TKADaoTable.InternalCancel;
  5579. Begin
  5580.      Try
  5581.        If (F_DaoTable.EditMode = DaoApi.dbEditInProgress) Then
  5582.           OleVariant(F_DaoTable).CancelUpdate;
  5583.      Except
  5584.      End;
  5585.      if F_OldValue <> Nil Then FreeRecordBuffer(F_OldValue);
  5586.      F_Database.Idle;   //******************************************* 27.01.2002
  5587.      inherited InternalCancel;
  5588. End;
  5589.  
  5590. Procedure TKADaoTable.InternalPost;
  5591. Label Again;
  5592. Var
  5593.  Buffer    : PChar;
  5594.  X         : Integer;
  5595.  RData     : TStringList;
  5596.  S         : String;
  5597.  DTSV      : OleVariant;
  5598.  FF        : TField;
  5599.  Action    : TDataAction;
  5600.  JumpAgain : Boolean;
  5601.  LDE       : TDaoErrRec;
  5602. Begin
  5603.  F_PostMade := False;
  5604.  CheckActive;
  5605.  //*************************************************************** Special Check
  5606.  If (State=dsEdit) And (F_DaoTable.EditMode <> DaoApi.DbEditInProgress) Then
  5607.      Begin
  5608.        Try
  5609.         F_DaoTable.Edit;
  5610.        Except
  5611.         if F_DaoTable.EditMode <> DaoApi.dbEditInProgress Then OleVariant(F_DaoTable).Move(0);
  5612.         DaoInternalRefresh;
  5613.         Raise;
  5614.        End;
  5615.      End;
  5616.  //*****************************************************************************
  5617.  Again:
  5618.  JumpAgain := False;
  5619.  if State = dsEdit then //************************************* EDITING A RECORD
  5620.   Begin
  5621.     Buffer:=GetActiveRecordBuffer;
  5622.     RData:=PDaoInfo(Buffer+F_StartMyInfo)^.RecordData;
  5623.     For X:=0 to RData.Count-1 do
  5624.         Begin
  5625.         FF:=FindField(FieldDefs.Items[X].Name);
  5626.         if (Boolean(RData.Objects[X])) And (FF <> Nil) Then
  5627.          Begin
  5628.           S:=RData.Strings[X];
  5629.           if Boolean(F_UpdatableFields.Items[X]) Then
  5630.              Begin
  5631.                if S='' Then
  5632.                   Begin
  5633.                     DaoFields[X].Value:=NULL
  5634.                   End
  5635.                Else
  5636.                   Begin
  5637.                     //*********************************************** Byte Array
  5638.                     if  (FF.DataType=ftBytes)
  5639.                     And (FF.ValidChars <> GUID_VALID_CHARS) Then
  5640.                         Begin
  5641.                           DTSV := StringToBlob(TBlobField(FF), S);
  5642.                           DaoFields[X].Value:=DTSV;
  5643.                           VarClear(DTSV);
  5644.                           DTSV := NULL;
  5645.                         End
  5646.                     Else
  5647.                     //*********************************************** Date/Time
  5648.                     if (FF.DataType=ftDate) or
  5649.                        (FF.DataType=ftTime) or
  5650.                        (FF.DataType=ftDateTime) Then
  5651.                        Begin
  5652.                          DTSV:=ComposeDateTimeVariant(S);
  5653.                          if DTSV <> NULL Then DaoFields[X].Value:=VarAsType(DTSV,VarDate);
  5654.                          VarClear(DTSV);
  5655.                          DTSV:=NULL;
  5656.                        End
  5657.                     Else
  5658.                        Begin
  5659.                          if (FF.IsBlob) Then
  5660.                             Begin
  5661.                               if F_HasEncoder Then
  5662.                                   Begin
  5663.                                    //*******************************************
  5664.                                    // Perform Encoding here
  5665.                                    //*******************************************
  5666.                                    SetStrProp(F_Encrypter, F_DecodedString,S);
  5667.                                    S:=GetStrProp(F_Encrypter, F_EncodedString);
  5668.                                   End;
  5669.                               DTSV := StringToBlob(TBlobField(FF), S);
  5670.                               DaoFields[X].Value:=DTSV;
  5671.                               VarClear(DTSV);
  5672.                               DTSV:=NULL;
  5673.                             End
  5674.                          Else
  5675.                             Begin
  5676.                               if (F_HasEncoder) And (FF.DataType=ftString) Then
  5677.                                  Begin
  5678.                                    //*******************************************
  5679.                                    // Perform Encoding here
  5680.                                    //*******************************************
  5681.                                    SetStrProp(F_Encrypter, F_DecodedString,S);
  5682.                                    S:=GetStrProp(F_Encrypter, F_EncodedString);
  5683.                                  End;
  5684.                               DaoFields[X].Value:=S;
  5685.                             End;
  5686.                        End;
  5687.                   End;
  5688.              End;
  5689.          End;
  5690.         End;
  5691.     Try
  5692.       OleVariant(F_DaoTable).Update;
  5693.     Except
  5694.       On E:Exception do
  5695.            Begin
  5696.             If Assigned(OnPostError) Then
  5697.                Begin
  5698.                    LDE := GetLastDaoError;
  5699.                    E.HelpContext := LDE.HelpContext;
  5700.                    E.Message     := LDE.Description;
  5701.                    OnPostError(Self,EDatabaseError(E),Action);
  5702.                    if Action = daRetry Then
  5703.                       Begin
  5704.                         JumpAgain := True;
  5705.                         If (F_DaoTable.EditMode <> DaoApi.dbEditInProgress) Then OleVariant(F_DaoTable).Move(0);
  5706.                       End
  5707.                    Else
  5708.                    if Action = daAbort Then
  5709.                       Begin
  5710.                         If  (F_DaoTable.LockEdits=False)
  5711.                         And (F_DaoTable.EditMode = DaoApi.dbEditInProgress) Then OleVariant(F_DaoTable).CancelUpdate;
  5712.                         If (F_DaoTable.EditMode <> DaoApi.dbEditInProgress) Then OleVariant(F_DaoTable).Move(0);
  5713.                         Exit;
  5714.                       End
  5715.                    Else
  5716.                    if Action = daFail  Then
  5717.                       Begin
  5718.                         If  (F_DaoTable.LockEdits=False)
  5719.                         And (F_DaoTable.EditMode = DaoApi.dbEditInProgress) Then OleVariant(F_DaoTable).CancelUpdate;
  5720.                         If (F_DaoTable.EditMode <> DaoApi.dbEditInProgress) Then OleVariant(F_DaoTable).Move(0);
  5721.                         Raise;
  5722.                       End;
  5723.                End
  5724.             Else
  5725.                Begin
  5726.                  If  (F_DaoTable.LockEdits=False)
  5727.                  And (F_DaoTable.EditMode = DaoApi.dbEditInProgress) Then OleVariant(F_DaoTable).CancelUpdate;
  5728.                  If (F_DaoTable.EditMode <> DaoApi.dbEditInProgress) Then OleVariant(F_DaoTable).Move(0);
  5729.                  Raise;
  5730.                End;
  5731.            End;
  5732.     End;
  5733.     if JumpAgain Then Goto Again;                         
  5734.   End
  5735.  Else
  5736.   Begin //************************************************** ADDING A NEW RECORD
  5737.     Buffer:=GetActiveRecordBuffer;
  5738.     RData:=PDaoInfo(Buffer+F_StartMyInfo)^.RecordData;
  5739.     F_DaoTable.AddNew;
  5740.     For X:=0 to RData.Count-1 do
  5741.         Begin
  5742.          FF:=FindField(FieldDefs.Items[X].Name);
  5743.          if (Boolean(RData.Objects[X])) And (FF <> Nil) Then
  5744.          Begin
  5745.           S:=RData.Strings[X];
  5746.           if Boolean(F_UpdatableFields.Items[X]) Then
  5747.              Begin
  5748.                if S='' Then
  5749.                   Begin
  5750.                     DaoFields[X].Value:=NULL
  5751.                   End
  5752.                Else
  5753.                   Begin
  5754.                     //*********************************************** Byte Array
  5755.                     if  (FF.DataType=ftBytes)
  5756.                     And (FF.ValidChars <> GUID_VALID_CHARS) Then
  5757.                         Begin
  5758.                           DTSV := StringToBlob(TBlobField(FF), S);
  5759.                           DaoFields[X].Value:=DTSV;
  5760.                           VarClear(DTSV);
  5761.                           DTSV := NULL;
  5762.                         End
  5763.                     Else
  5764.                     //*********************************************** Date/Time
  5765.                     if (FF.DataType=ftDate) or
  5766.                        (FF.DataType=ftTime) or
  5767.                        (FF.DataType=ftDateTime) Then
  5768.                         Begin
  5769.                           DTSV:=ComposeDateTimeVariant(S);
  5770.                           if DTSV <> NULL Then DaoFields[X].Value:=VarAsType(DTSV,VarDate);
  5771.                           VarClear(DTSV);
  5772.                           DTSV:=NULL;
  5773.                         End
  5774.                     Else
  5775.                         Begin
  5776.                           if (FF.IsBlob) Then
  5777.                              Begin
  5778.                                if F_HasEncoder Then
  5779.                                   Begin
  5780.                                    //*******************************************
  5781.                                    // Perform Encoding here
  5782.                                    //*******************************************
  5783.                                    SetStrProp(F_Encrypter, F_DecodedString,S);
  5784.                                    S:=GetStrProp(F_Encrypter, F_EncodedString);
  5785.                                   End;
  5786.                                DTSV := StringToBlob(TBlobField(FF), S);
  5787.                                DaoFields[X].Value:=DTSV;
  5788.                                VarClear(DTSV);
  5789.                                DTSV:=NULL;
  5790.                              End
  5791.                           Else
  5792.                              Begin
  5793.                                if (F_HasEncoder) And (FF.DataType=ftString) Then
  5794.                                   Begin
  5795.                                    //*******************************************
  5796.                                    // Perform Encoding here
  5797.                                    //*******************************************
  5798.                                    SetStrProp(F_Encrypter, F_DecodedString,S);
  5799.                                    S:=GetStrProp(F_Encrypter, F_EncodedString);
  5800.                                   End;
  5801.                                DaoFields[X].Value:=S;
  5802.                              End;
  5803.                          End;
  5804.                   End;
  5805.              End;
  5806.           End;
  5807.         End;
  5808.       Try
  5809.         OleVariant(F_DaoTable).Update;
  5810.       Except
  5811.         On E:Exception do
  5812.            Begin
  5813.             If Assigned(OnPostError) Then
  5814.                Begin
  5815.                    LDE := GetLastDaoError;
  5816.                    E.HelpContext := LDE.HelpContext;
  5817.                    E.Message     := LDE.Description;
  5818.                    OnPostError(Self,EDatabaseError(E),Action);
  5819.                    if Action = daRetry Then
  5820.                       Begin
  5821.                         JumpAgain := True;
  5822.                       End
  5823.                    Else
  5824.                    if Action = daAbort Then
  5825.                       Begin
  5826.                         If F_DaoTable.EditMode = DaoApi.dbEditAdd Then OleVariant(F_DaoTable).CancelUpdate;
  5827.                         Exit;
  5828.                       End
  5829.                    Else
  5830.                    if Action = daFail Then
  5831.                       Begin
  5832.                         Raise;
  5833.                       End;
  5834.                End
  5835.             Else
  5836.                Begin
  5837.                  If F_DaoTable.EditMode = DaoApi.dbEditAdd Then OleVariant(F_DaoTable).CancelUpdate;
  5838.                  Raise;
  5839.                End;                                       
  5840.            End;
  5841.       End;
  5842.       if JumpAgain Then Goto Again;
  5843.       Try
  5844.        //************************************************* CHANGED AT 06.01.2001
  5845.        F_RefreshRC := True;
  5846.        Inc(F_LastRecord);
  5847.        Inc(F_RecNo);
  5848.        If Not F_Bookmarkable Then
  5849.           Begin
  5850.            InternalLast;
  5851.            PDaoInfo(Buffer+F_StartMyInfo)^.RecordNo:=F_RecNo-1;
  5852.           End;
  5853.        //***********************************************************************
  5854.       Except
  5855.       End;
  5856.   End;
  5857.   InternalLast;
  5858.   If F_Bookmarkable Then
  5859.      Begin
  5860.        if F_Database.EngineType=dbUseJet Then
  5861.           Begin
  5862.             PDaoInfo(Buffer+F_StartMyInfo)^.BookmarkData:=GetDaoLastModifiedBookMark(F_DaoTable);
  5863.             InternalMoveToBookmark(@PDaoInfo(Buffer+F_StartMyInfo)^.BookmarkData);
  5864.           End
  5865.        Else
  5866.           Begin
  5867.             If State=dsEdit Then
  5868.                PDaoInfo(Buffer+F_StartMyInfo)^.BookmarkData:=GetDaoLastModifiedBookMark(F_DaoTable)
  5869.             Else
  5870.                PDaoInfo(Buffer+F_StartMyInfo)^.BookmarkData:=GetDaoBookmark(F_DaoTable);
  5871.             InternalMoveToBookmark(@PDaoInfo(Buffer+F_StartMyInfo)^.BookmarkData);
  5872.           End;
  5873.      End;
  5874.   if F_OldValue <> Nil Then FreeRecordBuffer(F_OldValue);
  5875.   F_Database.Idle;   //********************************************** 27.01.2002
  5876.   F_PostMade := True;
  5877. End;
  5878.  
  5879. Procedure TKADaoTable.Post;
  5880. Begin
  5881.   F_InPost   := True;
  5882.   Try
  5883.     Inherited Post;
  5884.   Finally
  5885.     F_InPost := False;
  5886.   End;
  5887.   If (F_SortedBy.Count > 0) And (F_RefreshSorted) Then
  5888.      Begin
  5889.        CheckBrowseMode;
  5890.        InternalClearBookmarks;
  5891.        ClearBuffers;
  5892.        OleVariant(F_DaoTable).Requery;
  5893.        F_RefreshRC := True;
  5894.        ActivateBuffers;
  5895.        First;
  5896.      End;
  5897. End;
  5898.  
  5899. Procedure TKADaoTable.InternalAddRecord(Buffer: Pointer; Append: Boolean);
  5900. Begin
  5901.     if Append Then
  5902.        Begin
  5903.          InternalLast;
  5904.          SetBookmarkFlag(Buffer, bfEOF);
  5905.        End;
  5906.     InternalPost;
  5907. End;
  5908.  
  5909. Procedure TKADaoTable.InternalDelete;
  5910. Label Again;
  5911. Var
  5912.   Buffer   : PChar;
  5913.   X        : Integer;
  5914.   I        : Integer;
  5915.   RN       : Integer;
  5916.   RR       : Integer;
  5917.   Action   : TDataAction;
  5918.   LDE      : TDaoErrRec;
  5919.   JumpAgain: Boolean;
  5920. Begin
  5921.   Buffer := GetActiveRecordBuffer;
  5922.   if Buffer=Nil Then Exit;
  5923.   RN     := PDaoInfo(Buffer + F_StartMyInfo)^.RecordNo;
  5924.   I      := F_BookmarkRN.IndexOf(Pointer(RN));
  5925.   if I > -1 Then
  5926.      Begin
  5927.        F_BookmarkRN.Delete(I);
  5928.        F_BookmarkID.Delete(I);
  5929.      End;
  5930.   For X:=0 to F_BookmarkRN.Count-1 do
  5931.       Begin
  5932.        RR := Integer(F_BookmarkRN.Items[X]);
  5933.        if RR > RN Then
  5934.           Begin
  5935.             Dec(RR);
  5936.             F_BookmarkRN.Items[X]:=Pointer(RR);
  5937.           End;
  5938.       End;
  5939. Again:
  5940.   JumpAgain:=False;
  5941.   Try
  5942.     F_DaoTable.Delete;
  5943.   Except
  5944.     On E:Exception do
  5945.      Begin
  5946.        LDE:=GetLastDaoError;
  5947.        if Assigned(OnDeleteError) Then
  5948.           Begin
  5949.            E.HelpContext := LDE.HelpContext;
  5950.            E.Message     := LDE.Description;
  5951.            OnDeleteError(Self,EDatabaseError(E),Action);
  5952.            if Action = daRetry Then
  5953.               Begin
  5954.                JumpAgain := True;
  5955.               End
  5956.            Else
  5957.            if Action = daAbort Then
  5958.               Begin
  5959.                F_RefreshRC := True;
  5960.                DaoInternalRefresh;
  5961.                F_RefreshRC := True;
  5962.                Exit;
  5963.               End
  5964.            Else
  5965.            if Action = daFail  Then
  5966.               Begin
  5967.                 if LDE.ErrNo=3167 Then
  5968.                    Begin
  5969.                     F_RefreshRC := True;
  5970.                     DaoInternalRefresh;
  5971.                    End;
  5972.                 Raise;
  5973.               End;
  5974.           End
  5975.        Else
  5976.           Begin
  5977.            if LDE.ErrNo=3167 Then
  5978.               Begin
  5979.                F_RefreshRC := True;
  5980.                DaoInternalRefresh;
  5981.                Exit;
  5982.               End;
  5983.           End;
  5984.        if Not JumpAgain Then Raise; //******************************* 15.01.2002
  5985.      End;
  5986.   End;
  5987.   if JumpAgain Then Goto Again;
  5988.   F_Database.Idle;   //********************************************** 27.01.2002
  5989.   F_RefreshRC := True;
  5990.   IF (F_DaoTable.EOF) then OleVariant(F_DaoTable).MoveLast Else F_DaoTable.MoveNext;
  5991. End;
  5992.  
  5993.  
  5994. Procedure TKADaoTable.RollbackRefresh;
  5995. Begin
  5996.  ClearBuffers;
  5997.  ActivateBuffers;
  5998.  if Not IsEmpty Then First;
  5999. End;
  6000.  
  6001. Procedure TKADaoTable.DaoInternalRefresh;
  6002. Var
  6003.   TempRecNo:Integer;
  6004. Begin
  6005.     Try
  6006.      F_RefreshRC := True;
  6007.      Resync([rmExact, rmCenter]);
  6008.     Except
  6009.      TempRecNo:=F_RecNo;
  6010.      CheckBrowseMode;
  6011.      ClearBuffers;
  6012.      CloseDaoRecordset;
  6013.      OpenDaoRecordset;
  6014.      ActivateBuffers;
  6015.      First;
  6016.      if TempRecNo < RecordCount Then MoveBy(TempRecNo) Else Last;
  6017.     End;
  6018. End;
  6019.  
  6020. Procedure TKADaoTable.InternalRefresh;
  6021. Var
  6022.   TempRecNo : Integer;
  6023. Begin
  6024.     Try
  6025.      F_RefreshRC := True;
  6026.      if NOT Self.ControlsDisabled Then Resync([rmExact, rmCenter]);
  6027.     Except
  6028.      TempRecNo:=F_RecNo;
  6029.      CheckBrowseMode;
  6030.      ClearBuffers;
  6031.      CloseDaoRecordset;
  6032.      OpenDaoRecordset;
  6033.      ActivateBuffers;
  6034.      First;
  6035.      if TempRecNo < RecordCount Then MoveBy(TempRecNo) Else Last;
  6036.     End;
  6037. End;
  6038.  
  6039. Procedure TKADaoTable.RefreshData;
  6040. Begin
  6041.   if F_DaoTable.Restartable Then
  6042.      Begin
  6043.       //********************************************************************
  6044.       CheckBrowseMode;
  6045.       InternalClearBookmarks;
  6046.       ClearBuffers;
  6047.       OleVariant(F_DaoTable).Requery;
  6048.       F_RefreshRC := True;
  6049.       ActivateBuffers;
  6050.       First;
  6051.       //********************************************************************
  6052.      End;
  6053. End;
  6054.  
  6055. Function TKADaoTable.IsCursorOpen: Boolean;
  6056. Begin
  6057.   Result:=F_Active;
  6058. End;
  6059.  
  6060. Function TKADaoTable.GetCanModify: Boolean;
  6061. Begin
  6062.  Result := (F_Active) And (NOT F_ReadOnly);
  6063. End;
  6064.  
  6065. Function TKADaoTable.GetRecordSize: Word;
  6066. Begin
  6067.   Result:=F_BufferSize;
  6068. End;                                                       
  6069.  
  6070. Function TKADaoTable.AllocRecordBuffer: PChar;
  6071. Var
  6072.   X:Integer;
  6073. Begin
  6074.         GetMem(Result,F_BufferSize);
  6075.         FillChar(Result^,F_BufferSize,0);
  6076.         PDaoInfo(Result+F_StartMyInfo)^.RecordData:=TStringList.Create;
  6077.         For X:=0 To FieldDefs.Count-1 do
  6078.           Begin
  6079.             PDaoInfo(Result+F_StartMyInfo)^.RecordData.AddObject('',TObject(False));
  6080.           End;
  6081. End;
  6082.  
  6083. Procedure TKADaoTable.FreeRecordBuffer(var Buffer: PChar);
  6084. Begin
  6085.         if Buffer=Nil Then Exit;
  6086.         PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Free;
  6087.         PDaoInfo(Buffer+F_StartMyInfo)^.RecordData:=Nil;
  6088.         FreeMem(Buffer,F_BufferSize);
  6089.         Buffer:=Nil;
  6090. End;
  6091.  
  6092. Procedure TKADaoTable.InternalInitRecord(Buffer: PChar);
  6093. Var
  6094.   X          : Integer;
  6095.   PT         : PChar;
  6096.   PS         : PChar;
  6097.   FF         : TField;
  6098. Begin
  6099.      //*************************************************************************
  6100.      if F_OldValue <> Nil Then FreeRecordBuffer(F_OldValue);
  6101.      F_OldValue:=AllocRecordBuffer;
  6102.      PT := F_OldValue+F_StartMyInfo;
  6103.      PS := GetActiveRecordBuffer;
  6104.      if PS <> Nil Then
  6105.         Begin
  6106.          PS := PS+F_StartMyInfo;
  6107.          PDaoInfo(PT)^.BookmarkData := PDaoInfo(PS)^.BookmarkData;
  6108.          PDaoInfo(PT)^.BookmarkFlag := PDaoInfo(PS)^.BookmarkFlag;
  6109.          PDaoInfo(PT)^.RecordNo := PDaoInfo(PS)^.RecordNo;
  6110.          PDaoInfo(PT)^.RecordData.Assign(PDaoInfo(PS)^.RecordData);                         
  6111.         End;
  6112.      //*************************************************************************
  6113.      For X:=0 To FieldDefs.Count-1 do
  6114.           Begin
  6115.             PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Objects[X]:=TObject(False);
  6116.             FF := FindField(FieldDefs.Items[X].Name);
  6117.             if (FF <> Nil) And  (FF.DefaultExpression <> '') Then
  6118.                Begin
  6119.                  F_DefaultValues.Strings[X]:=UnQuoteString(FF.DefaultExpression);
  6120.                  PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Objects[X]:=TObject(True);
  6121.                End;
  6122.             PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Strings[X]:=F_DefaultValues.Strings[X];
  6123.           End;
  6124.      PDaoInfo(Buffer+F_StartMyInfo)^.BookmarkFlag := bfInserted;
  6125.      PDaoInfo(Buffer+F_StartMyInfo)^.BookmarkData := 0;
  6126.      PDaoInfo(Buffer+F_StartMyInfo)^.RecordNo     := -1;
  6127. End;
  6128.  
  6129. Function TKADaoTable.GetCurrentRecord(Buffer: PChar): Boolean;
  6130. Var
  6131.   AB : PChar;
  6132. begin
  6133.   Result := F_Active;
  6134.   if Result Then Result := Not IsEmpty;
  6135.   AB := GetActiveRecordBuffer;
  6136.   if AB = Nil Then Result := False;
  6137.   if Result then Move(AB^, Buffer^, F_BufferSize);
  6138. end;
  6139.  
  6140. Function TKADaoTable.InternalFillRecordData(RS: OleVariant; MainTable : Boolean; Buffer:PChar):Boolean;
  6141. Var
  6142.  X          : Integer;
  6143.  RD         : Variant;
  6144.  DTS        : TTimeStamp;
  6145.  FF         : TField;
  6146.  SZ         : Integer;
  6147.  ReadData   : Boolean;
  6148. Begin
  6149.  Result := True;
  6150.  F_Database.Idle;   //*********************************************** 27.01.2002
  6151.  With PDaoInfo(Buffer+F_StartMyInfo)^ do
  6152.    Begin
  6153.     if F_Bookmarkable Then BookmarkData:=GetDaoBookmark(RS) Else  BookmarkData:=0;
  6154.     RecordNo     := F_RecNo;
  6155.     BookmarkFlag := bfCurrent;
  6156.     For X:=0 To FieldDefs.Count-1 do
  6157.         Begin
  6158.          FF := FindField(FieldDefs.Items[X].Name);
  6159.          if FF <> Nil Then
  6160.             Begin
  6161.               ReadData := True;
  6162.               //****************************************************************
  6163.               if (FF.IsBlob) Then
  6164.                  Begin
  6165.                    ReadData := False;
  6166.                    if  (FF.DataType = ftMemo) And (F_CacheMemos) Then ReadData := True;
  6167.                    if  (FF.DataType = ftBlob) And (F_CacheBlobs) Then ReadData := True;
  6168.                  End;
  6169.               //****************************************************************
  6170.               if ReadData Then
  6171.                  Begin
  6172.                   Try
  6173.                    if MainTable Then RD:=DaoFields[X].Value Else RD:=RS.Fields.Item[X].Value
  6174.                   Except
  6175.                    RD:=NULL;
  6176.                    //********** Edit Conflict with other user.
  6177.                    if GetLastDaoError.ErrNo=3167 Then
  6178.                       Begin
  6179.                         Result:=False;
  6180.                         Exit;
  6181.                       End;
  6182.                     //****************************************
  6183.                   End;
  6184.                  End
  6185.               Else
  6186.                  Begin
  6187.                    RD:='';
  6188.                  End;
  6189.               //****************************************************************
  6190.               if VarType(RD) = varNull then
  6191.                  Begin
  6192.                   RD := ''
  6193.                  End
  6194.               Else
  6195.                  Begin
  6196.                   //********************************************* Array Handling
  6197.                   if  (NOT (FF.IsBlob))
  6198.                   And (VarISArray(RD)) Then
  6199.                      Begin
  6200.                        RD := BlobToString(TBlobField(FF),RD,(VarArrayHighBound(RD,1)-VarArrayLowBound(RD,1))+1);
  6201.                      End;
  6202.                   //********************************************* Date/Time Handling
  6203.                   if (FF.DataType=ftDateTime)
  6204.                   Or (FF.DataType=ftDate)
  6205.                   Or (FF.DataType=ftTime) Then
  6206.                      Begin
  6207.                        DTS:=DateTimeToTimeStamp(VarAsType(RD,varDate));
  6208.                        RD:=IntToStr(DTS.Date)+' '+IntToStr(DTS.Time);
  6209.                      End;
  6210.                   //********************************************* Boolean Handling
  6211.                   if (FF.DataType=ftBoolean) Then
  6212.                      Begin
  6213.                        if RD Then RD := 'True' Else RD := 'False';
  6214.                      End;
  6215.                  End;
  6216.               //****************************************************************
  6217.               if ReadData Then
  6218.                  Begin
  6219.                    if (FF.DataType = ftBlob) Then
  6220.                       Begin
  6221.                         If MainTable Then SZ := DaoFields[X].FieldSize Else SZ := RS.Fields.Item[X].FieldSize;
  6222.                         RecordData.Strings[X]:=BlobToString((TBlobField(FF)),RD,SZ);
  6223.                       End
  6224.                    Else
  6225.                       Begin
  6226.                         RecordData.Strings[X]:=RD;
  6227.                       End;
  6228.                  End
  6229.               Else               
  6230.                  Begin
  6231.                   //************************************************* 01.02.2002
  6232.                   If MainTable Then SZ := DaoFields[X].FieldSize Else SZ := RS.Fields.Item[X].FieldSize;
  6233.                   if SZ=0 Then
  6234.                      RecordData.Strings[X]:=''
  6235.                   Else
  6236.                      RecordData.Strings[X]:=IntToStr(SZ);
  6237.                   //************************************************* 01.02.2002   
  6238.                  End;
  6239.               //****************************************************************
  6240.               if (F_HasEncoder) And (ReadData) Then
  6241.                  Begin
  6242.                   //*******************************************
  6243.                   // Perform Decoding here
  6244.                   //*******************************************
  6245.                   if  (FF.DataType=ftString)
  6246.                   OR  (FF.IsBlob) Then
  6247.                     Begin
  6248.                      SetStrProp(F_Encrypter, F_EncodedString,RecordData.Strings[X]);
  6249.                      RecordData.Strings[X]:=GetStrProp(F_Encrypter, F_DecodedString);
  6250.                     End;
  6251.                  End;
  6252.               //*************************************************************
  6253.               RecordData.Objects[X]:=TObject(False);
  6254.               VarClear(RD);
  6255.               RD:=NULL;
  6256.             End;
  6257.         End;
  6258.    End; {WITH}
  6259. End;
  6260.  
  6261. Function TKADaoTable.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
  6262. var
  6263.  Acceptable : Boolean;
  6264. Begin
  6265.    Result:=grOK;
  6266.    Acceptable:=False;
  6267.    //********************************************************* SKIP UNUSUAL READ
  6268.    if (ControlsDisabled) And
  6269.       (F_InPost)         And
  6270.       (F_BatchMode)      And
  6271.       (GetMode <> gmCurrent) Then 
  6272.       Begin
  6273.          if NOT (F_Filtered And Assigned(F_OnFilterRecord)) Then
  6274.             Begin
  6275.              Result:=grEOF;
  6276.              Exit;
  6277.             End;
  6278.       End;
  6279.    //***************************************************************************
  6280.    if State=dsInsert Then
  6281.       Begin
  6282.         //*********************************************************** 25.01.2002
  6283.         if NOT ((F_DaoTable.BOF) AND (F_DaoTable.EOF)) Then CheckBrowseMode;
  6284.         Result := grError;
  6285.         Exit;                                          
  6286.         //*********************************************************** 25.01.2002
  6287.       End;
  6288.    if State=dsEdit Then
  6289.       Begin
  6290.         //*********************************************************** 25.01.2002
  6291.         if F_DaoTable.EditMode = DaoApi.dbEditInProgress Then CheckBrowseMode;
  6292.         Result := grError;
  6293.         Exit;
  6294.         //*********************************************************** 25.01.2002
  6295.       End;
  6296.    //***************************************************************************
  6297.    Repeat
  6298.     Case GetMode of
  6299.        gmNext:
  6300.         Begin
  6301.           if (F_TableType = dbOpenForwardOnly) And (F_RecNo=-1) Then
  6302.              Begin
  6303.                //******************* Do not call MoveNext at first record
  6304.              End
  6305.           Else
  6306.              Begin
  6307.                if Not F_DaoTable.EOF Then F_DaoTable.MoveNext;
  6308.              End;
  6309.           if F_DaoTable.EOF Then Result := grEOF;
  6310.           if Result=grOK Then
  6311.              Begin
  6312.                Inc(F_RecNo);
  6313.                Inc(F_RecPos);
  6314.              End;
  6315.         End;
  6316.       gmPrior:
  6317.         Begin
  6318.           if F_TableType = dbOpenForwardOnly Then
  6319.              Begin
  6320.                Result   := grBOF;
  6321.              End
  6322.           Else
  6323.              Begin
  6324.                if Not F_DaoTable.BOF Then F_DaoTable.MovePrevious;
  6325.                if F_DaoTable.BOF Then Result := grBOF;
  6326.              End;
  6327.           if Result=grOK Then
  6328.              Begin
  6329.                Dec(F_RecNo);
  6330.                Dec(F_RecPos);
  6331.              End;
  6332.         End;
  6333.       gmCurrent:
  6334.         Begin
  6335.           if F_DaoTable.BOF Then Result := grBOF;
  6336.           if F_DaoTable.EOF Then Result := grEOF;
  6337.         End;
  6338.     End;{CASE}
  6339.     //**************************************************************************
  6340.     if Result=grEOF Then
  6341.        Begin
  6342.          F_LastRecord := F_RecNo+1; /// +1 **************************** 5.1.2002
  6343.        End
  6344.     Else
  6345.        Begin
  6346.          if F_LastRecord < F_RecNo Then F_LastRecord := F_RecNo;
  6347.        End;
  6348.     //**************************************************************************
  6349.     if Result=grOk then
  6350.        Begin
  6351.         if Not InternalFillRecordData(OleVariant(F_DaoTable), True, Buffer) Then
  6352.            Begin
  6353.              Result:=grError;
  6354.              Exit;
  6355.            End;
  6356.         Acceptable:=FilterRecord(Buffer);
  6357.         if (GetMode=gmCurrent) And (Not Acceptable) Then Result:=grError;
  6358.        End;
  6359.    Until (Result <> grOk) or (Acceptable);
  6360. End;
  6361.  
  6362. Function TKADaoTable.FilterRecord(Buffer: PChar): Boolean;
  6363. var
  6364.   SaveState: TDatasetState;
  6365. Begin
  6366.  Result:=True;
  6367.  SaveState:=SetTempState(dsFilter);
  6368.  ClearCalcFields(Buffer);
  6369.  GetCalcFields(Buffer);
  6370.  if F_RangeFiltered Then Result:=FilterRange(Buffer);
  6371.  if (F_Filtered) And (Result) And (Assigned(F_OnFilterRecord)) Then
  6372.     Begin
  6373.       F_FilterBuffer:=Buffer;
  6374.       OnFilterRecord(Self,Result);
  6375.     End;
  6376.  RestoreState(SaveState);
  6377. End;
  6378.  
  6379. Function TKADaoTable.GetRecordCount: Integer;
  6380. var
  6381.   SaveState    : TDataSetState;
  6382.   SavePosition : Integer;
  6383.   TempBuffer   : PChar;
  6384.   TmpRS        : OleVariant;
  6385.   DoRaise      : Boolean;
  6386. Begin
  6387.  Result:=-1;
  6388.  if F_TableType=dbOpenForwardOnly Then Exit;
  6389.  if F_UseRecordCountCache Then
  6390.     Begin
  6391.      if NOT F_RefreshRC Then
  6392.         Begin
  6393.          Result := F_OldRC;
  6394.          F_LastRecord:=Result;
  6395.          Exit;
  6396.         End;
  6397.     End;
  6398.  
  6399.  DoRaise     := False;
  6400.  F_RefreshRC := False;
  6401.  if (F_DaoTable.BOF) And (F_DaoTable.EOF) Then
  6402.     Begin
  6403.       Result:=0;
  6404.       F_OldRC:=Result;
  6405.       F_LastRecord:=Result;
  6406.       F_RecNo := -1;
  6407.       Exit;
  6408.     End;
  6409.  If ((F_Filtered) And (Assigned(F_OnFilterRecord))) Or (F_RangeFiltered) Then
  6410.      Begin
  6411.        Result:=0;
  6412.        SaveState:=SetTempState(dsBrowse);
  6413.        SavePosition:=F_RecNo;
  6414.        Try
  6415.          TempBuffer:=AllocRecordBuffer;
  6416.          InternalFirst;
  6417.          While GetRecord(TempBuffer,gmNext,True)=grOk do Inc(Result);
  6418.        Finally
  6419.          RestoreState(SaveState);
  6420.          F_RecNo:=SavePosition;
  6421.          FreeRecordBuffer(TempBuffer);
  6422.        End;                                                  
  6423.      End
  6424.  Else
  6425.      Begin
  6426.       if F_TableType=dbOpenTable Then
  6427.          Begin
  6428.            Try
  6429.             Result:=F_DaoTable.RecordCount;
  6430.             if (Result > F_LastRecord) Then 
  6431.                Begin
  6432.                 TmpRS:=OleVariant(F_DaoTable).OpenRecordset(dbOpenSnapShot);
  6433.                 TmpRS.MoveLast;
  6434.                 Result:=TmpRS.RecordCount;
  6435.                 TmpRS.Close;
  6436.                 TmpRS:=NULL;
  6437.                 if (Result <> F_DaoTable.RecordCount) And (F_WarnOnBadDatabase) Then
  6438.                    Begin
  6439.                      DoRaise := True;
  6440.                      DatabaseError(Format(E2026,[F_Database.Database]));
  6441.                    End;
  6442.                End;
  6443.            Except
  6444.              if DoRaise Then Raise;
  6445.            End;
  6446.          End
  6447.       Else
  6448.          Begin
  6449.           Try
  6450.            F_DaoTable.MoveFirst;
  6451.            OleVariant(F_DaoTable).MoveLast;
  6452.            Result:=F_DaoTable.RecordCount;
  6453.            Except
  6454.            End;
  6455.           End; 
  6456.        if F_Bookmarkable Then                                                  
  6457.          Begin
  6458.            TempBuffer := GetActiveRecordBuffer;
  6459.            if TempBuffer <> Nil Then
  6460.               Begin
  6461.                 if PDaoInfo(TempBuffer+F_StartMyInfo)^.BookmarkData <> 0 Then
  6462.                    InternalMoveToBookmark(@PDaoInfo(TempBuffer+F_StartMyInfo)^.BookmarkData);
  6463.               End;                                
  6464.          End
  6465.        Else
  6466.          Begin
  6467.            F_DaoTable.MoveFirst;
  6468.            if F_RecNo=-1 Then
  6469.             Begin
  6470.              F_DaoTable.MovePrevious;
  6471.             End
  6472.            Else
  6473.             Begin
  6474.              if (F_RecNo < Result) Then OleVariant(F_DaoTable).Move(F_RecNo);
  6475.             End;
  6476.          End;
  6477.      End;                                     
  6478.      F_OldRC:=Result;
  6479.      F_LastRecord:=Result;
  6480. End;
  6481.  
  6482. Function  TKADaoTable.GetRecNo: Integer;
  6483. var
  6484.   SaveState     : TDataSetState;
  6485.   SavePosition  : Integer;
  6486.   TempBuffer    : PChar;
  6487.   BK            : Integer;
  6488. Begin
  6489.   UpdateCursorPos;
  6490.   //******************************************************************* 1.1.2002
  6491.   TempBuffer:=GetActiveRecordBuffer;
  6492.   if TempBuffer <> Nil Then InternalSetToRecord(TempBuffer);
  6493.   //****************************************************************************
  6494.  
  6495.   if NOT F_UseGetRecNo Then
  6496.      Begin
  6497.        Result := -1;
  6498.        Exit;
  6499.      End;
  6500.  
  6501.   if F_RecNo<-1 Then F_PostMade:=True;
  6502.  
  6503.   if (F_TableType = dbOpenForwardOnly) Then
  6504.      Begin
  6505.        Result := F_RecNo+1;
  6506.        Exit;
  6507.      End;
  6508.  
  6509.   if F_DaoTable.BOF Then
  6510.      Begin
  6511.        Result := -1;
  6512.        Exit;
  6513.      End;
  6514.  
  6515.   If ((F_Filtered) And (Assigned(F_OnFilterRecord)))  Or (F_RangeFiltered) Then
  6516.     Begin
  6517.      Result := -1;
  6518.      SaveState:=SetTempState(dsBrowse);
  6519.      TempBuffer:=GetActiveRecordBuffer;
  6520.      if TempBuffer <> Nil Then
  6521.         Begin
  6522.           SavePosition:=PDaoInfo(TempBuffer+F_StartMyInfo)^.BookmarkData;
  6523.           Try
  6524.            TempBuffer:=AllocRecordBuffer;
  6525.            InternalFirst;
  6526.            Result := 0;
  6527.            While (GetRecord(TempBuffer,gmNext,True)=grOk) And
  6528.                  (PDaoInfo(TempBuffer+F_StartMyInfo)^.BookmarkData <> SavePosition)
  6529.                  do Inc(Result);
  6530.           Finally
  6531.            if (PDaoInfo(TempBuffer+F_StartMyInfo)^.BookmarkData <> SavePosition) Then
  6532.               Begin
  6533.                InternalSetToRecord(GetActiveRecordBuffer);
  6534.               End;
  6535.            FreeRecordBuffer(TempBuffer);
  6536.           End;
  6537.         End;
  6538.      RestoreState(SaveState);
  6539.      if Result=-1 Then Exit;
  6540.     End
  6541.  Else
  6542.     Begin  
  6543.       if F_PostMade Then
  6544.          Begin
  6545.           TempBuffer:=GetActiveRecordBuffer;
  6546.           if TempBuffer <> Nil Then
  6547.              Begin
  6548.               F_RecNo:=-1;
  6549.               if (F_TableType=dbOpenDynaset)
  6550.               OR (F_TableType=dbOpenSnapshot)
  6551.               OR (F_TableType=dbOpenDynamic) Then
  6552.                  Begin
  6553.                    F_RecNo := F_DaoTable.AbsolutePosition;
  6554.                  End
  6555.               Else
  6556.                  Begin
  6557.                    //***********************************************************
  6558.                    // If we are at the end of the table then we can easy calc
  6559.                    // the RecNo
  6560.                    Try
  6561.                     F_DaoTable.MoveNext;
  6562.                     if F_DaoTable.EOF Then F_RecNo := F_DaoTable.RecordCount-1;
  6563.                    Except
  6564.                    End;
  6565.                    F_DaoTable.MovePrevious;
  6566.                    //***********************************************************
  6567.                    // if Previous test does not work then
  6568.                    if F_RecNo = -1 Then
  6569.                       Begin
  6570.                         if F_Bookmarkable Then
  6571.                            Begin
  6572.                              BK:=GetDaoLastModifiedBookMark(F_DaoTable);
  6573.                              F_RecNo:=F_RecalculateRecNo(OleVariant(F_DaoTable),BK);
  6574.                            End
  6575.                         Else
  6576.                            Begin
  6577.                              //**************************************** TOO Slow
  6578.                              While Not F_DaoTable.BOF Do
  6579.                                Begin
  6580.                                 Inc(F_RecNo);
  6581.                                 F_DaoTable.MovePrevious;
  6582.                                End;
  6583.                            End;
  6584.                       End;
  6585.                    //***********************************************************
  6586.                    PDaoInfo(TempBuffer+F_StartMyInfo)^.RecordNo:=F_RecNo;
  6587.                    if F_Bookmarkable Then
  6588.                       Begin
  6589.                        InternalMoveToBookmark(@PDaoInfo(TempBuffer+F_StartMyInfo)^.BookmarkData);
  6590.                       End
  6591.                    Else
  6592.                       Begin
  6593.                        F_DaoTable.MoveFirst;
  6594.                        OleVariant(F_DaoTable).Move(F_RecNo);
  6595.                       End;
  6596.                  End;
  6597.               F_PostMade:=False;
  6598.              End;
  6599.          End
  6600.       Else
  6601.          Begin
  6602.            //********************************************************** 2.1.2002
  6603.            if (F_TableType=dbOpenDynaset)
  6604.            OR (F_TableType=dbOpenSnapshot)
  6605.            OR (F_TableType=dbOpenDynamic) Then
  6606.               Begin
  6607.                 F_RecNo := F_DaoTable.AbsolutePosition;
  6608.               End;
  6609.            //*******************************************************************   
  6610.          End;
  6611.       Result:=F_RecNo;
  6612.     End;
  6613.  Inc(Result);
  6614. End;
  6615.  
  6616.  
  6617. Procedure TKADaoTable.SetRecNo(Value: Integer);
  6618. Var
  6619.  SaveState      : TDataSetState;
  6620.  SavePosition   : Integer;
  6621.  TempBuffer     : PChar;
  6622. Begin
  6623.   CheckBrowseMode;
  6624.   CursorPosChanged;
  6625.   DoBeforeScroll;
  6626.   If ((F_Filtered) And (Assigned(F_OnFilterRecord))) Or (F_RangeFiltered) Then
  6627.      Begin
  6628.        SaveState:=SetTempState(dsBrowse);
  6629.        SavePosition:=F_RecNo;
  6630.        try
  6631.          TempBuffer:=AllocRecordBuffer;
  6632.          InternalFirst;
  6633.          Repeat
  6634.            Begin
  6635.              if GetRecord(TempBuffer,gmNext,True)=grOk Then
  6636.                Begin
  6637.                 Dec(Value);
  6638.                End
  6639.              Else
  6640.                Begin
  6641.                  F_RecNo  := SavePosition;
  6642.                  Break;
  6643.                End;
  6644.            End;
  6645.          Until Value=0;
  6646.        Finally
  6647.          RestoreState(SaveState);
  6648.          FreeRecordBuffer(TempBuffer);
  6649.        End;
  6650.      End
  6651.   Else
  6652.      Begin
  6653.       F_RecNo := (Value-1);
  6654.       F_DaoTable.MoveFirst;
  6655.       OleVariant(F_DaoTable).Move(F_RecNo);
  6656.      End;
  6657.   Resync([rmExact,rmCenter]);
  6658.   DoAfterScroll;
  6659. end;
  6660.  
  6661. Procedure TKADaoTable.StringToList(Items: String; List: TStringList);
  6662. var
  6663.   X: Integer;
  6664. Begin
  6665.   For X:= 1 To Length(Items) Do If Items[X] = ';' Then Items[X]:= #13;
  6666.   List.Clear;
  6667.   List.Text:=Items;
  6668.   For X:= 0 To List.Count - 1 Do List[X]:= Trim(List[X]);
  6669. End;
  6670.  
  6671. Procedure TKADaoTable.VariantToList(Items: Variant; List: TStringList);
  6672. Var
  6673.    X    : Integer;
  6674.    V    : Variant;
  6675.    Count: Integer;
  6676. Begin
  6677.    List.Clear;
  6678.    if VarIsArray(Items) Then
  6679.       Begin
  6680.         Count:=(VarArrayHighBound(Items, 1) - VarArrayLowBound(Items, 1))+1;
  6681.         For X:=0 to Count-1 do
  6682.             Begin
  6683.              V:=Items[VarArrayLowBound(Items, 1) + X];
  6684.              if VarIsNull(V) Then
  6685.                 List.Add('NULL')                         
  6686.              Else
  6687.                 List.Add(VarAsType(V,VarString));
  6688.             End;
  6689.       End
  6690.    Else
  6691.       Begin
  6692.          V:=Items;
  6693.          if VarIsNull(V) Then
  6694.             List.Add('NULL')
  6695.          Else
  6696.             List.Add(VarAsType(V,VarString));
  6697.       End;
  6698. End;
  6699.  
  6700. Procedure TKADaoTable.AssignVarValue(Var V :Variant; const Value: TVarRec);
  6701. Begin
  6702.   with Value do
  6703.     case VType of
  6704.       vtInteger:
  6705.         V := VInteger;
  6706.       vtBoolean:
  6707.         V := VBoolean;
  6708.       vtChar:
  6709.         V := VChar;
  6710.       vtExtended:
  6711.         V := VExtended^;
  6712.       vtString:
  6713.         V := VString^;
  6714.       vtPointer:
  6715.         if VPointer <> nil then DatabaseError(E2027);
  6716.       vtPChar:
  6717.         if VPChar <> nil then DatabaseError(E2027);
  6718.       vtObject:
  6719.          DatabaseError('Invalid object');
  6720.       vtAnsiString:
  6721.         V := string(VAnsiString);
  6722.       vtCurrency:
  6723.         V := VCurrency^;
  6724.       vtVariant:
  6725.         if not VarIsEmpty(VVariant^) then V := VVariant^;
  6726.     else
  6727.       DatabaseError(E2027);
  6728.     End;
  6729. End;
  6730.  
  6731. Function  TKADaoTable.BuildKeySQL(KN,KV:TStringList):String;
  6732. Var
  6733.  X  : Integer;
  6734.  S  : String;
  6735.  FT : TField;
  6736. Begin
  6737. S:='';
  6738. Result:='';
  6739. if KN.Count > 0 Then
  6740.      Begin
  6741.       For X:=0 To KN.Count-1 do
  6742.          Begin
  6743.           S:=S+'(';
  6744.           if F_UseBrackets Then
  6745.              S:=S+BracketField(KN.Strings[X])
  6746.           Else
  6747.              S:=S+KN.Strings[X];
  6748.           S:=S+' ';
  6749.           FT :=FieldByName(KN.Strings[X]);
  6750.           if KV.Strings[X]='NULL' Then S:= S + 'IS NULL'
  6751.           Else
  6752.           Case FT.DataType of
  6753.              ftBytes    :  Begin
  6754.                              if KV.Strings[X] = '' Then
  6755.                                 Begin
  6756.                                   S := S + ' IS NULL';
  6757.                                 End
  6758.                              Else
  6759.                                 Begin
  6760.                                   if FT.ValidChars = GUID_VALID_CHARS Then
  6761.                                      S := S + ' = {guid '+KV.Strings[X]+'}'
  6762.                                   Else
  6763.                                      S := S + ' = "' + KV.Strings[X] + '"';
  6764.                                 End;
  6765.                            End;
  6766.              ftString,
  6767.              ftMemo     : S := S + ' = "' + ChangeQuotes(KV.Strings[X]) + '"';
  6768.              ftBoolean,
  6769.              ftCurrency,
  6770.              ftFloat,
  6771.              ftSmallint,
  6772.              ftWord,
  6773.              ftAutoInc,
  6774.              ftInteger : Begin
  6775.                           if KV.Strings[X]='' Then
  6776.                              S := S + ' IS NULL'
  6777.                           Else
  6778.                              S := S + ' = ' + ChangeCommas(KV.Strings[X]);
  6779.                          End;
  6780.              ftDate    : Begin
  6781.                            if KV.Strings[X]='' Then
  6782.                              Begin
  6783.                                S := S + ' IS NULL';
  6784.                              End
  6785.                           Else
  6786.                              Begin
  6787.                                KV.Strings[X]:=RemoveNonDigitChars(KV.Strings[X]);
  6788.                                S:= S + ' = #' + FormatDateTime('mm"/"dd"/"yyyy', StrToDateTime(KV.Strings[X])) + '#';
  6789.                              End;
  6790.                          End;
  6791.              ftTime    : Begin
  6792.                            if KV.Strings[X]='' Then
  6793.                              Begin
  6794.                                S := S + ' IS NULL';
  6795.                              End
  6796.                           Else
  6797.                              Begin
  6798.                                KV.Strings[X]:=RemoveNonDigitChars(KV.Strings[X]);
  6799.                                S:= S + ' = #' + FormatDateTime('hh":"nn":"ss', StrToDateTime(KV.Strings[X])) + '#';
  6800.                              End;
  6801.                          End;
  6802.              ftDateTime: Begin
  6803.                            if KV.Strings[X]='' Then
  6804.                              Begin
  6805.                                S := S + ' IS NULL';
  6806.                              End
  6807.                           Else
  6808.                              Begin
  6809.                                KV.Strings[X]:=RemoveNonDigitChars(KV.Strings[X]);
  6810.                                S:= S + ' = #' + FormatDateTime('mm"/"dd"/"yyyy hh":"nn":"ss', StrToDateTime(KV.Strings[X])) + '#';
  6811.                              End;
  6812.                          End;
  6813.  
  6814.              Else
  6815.              DatabaseError(E2028)
  6816.           End;
  6817.           S:=S+')';
  6818.           if (X < KN.Count-1) Then S:=S+' AND ';
  6819.          End;
  6820.      End;
  6821.  Result := S;
  6822. End;
  6823.  
  6824. Function  TKADaoTable.BuildLocateSQL(KN,KV:TStringList;Options: TLocateOptions):String;
  6825. Var
  6826.  X  : Integer;
  6827.  S  : String;
  6828.  FT : TField;
  6829. Begin
  6830. S:='';
  6831. Result:='';
  6832. if KN.Count > 0 Then
  6833.      Begin
  6834.       For X:=0 To KN.Count-1 do
  6835.          Begin
  6836.           S:=S+'(';
  6837.           FT :=FieldByName(KN.Strings[X]);
  6838.           if F_UseBrackets Then
  6839.              S:=S+BracketField(KN.Strings[X])
  6840.           Else
  6841.              S:=S+KN.Strings[X];
  6842.           S:=S+' ';
  6843.           if KV.Strings[X]='NULL' Then S:= S + 'IS NULL'
  6844.           Else
  6845.           Case FT.DataType of
  6846.              ftBytes    :  Begin
  6847.                              if KV.Strings[X] = '' Then
  6848.                                 Begin
  6849.                                   S := S + ' IS NULL';
  6850.                                 End
  6851.                              Else
  6852.                                 Begin
  6853.                                   if FT.ValidChars = GUID_VALID_CHARS Then
  6854.                                      S := S + ' = {guid '+KV.Strings[X]+'}'
  6855.                                   Else
  6856.                                      S := S + ' = "' + KV.Strings[X] + '"';
  6857.                                 End;
  6858.                            End;
  6859.              ftString,
  6860.              ftMemo     :  Begin
  6861.                              if loCaseInsensitive in Options Then KV.Strings[X]:=AnsiLowerCase(KV.Strings[X]);
  6862.                              If loPartialKey in Options Then
  6863.                                 Begin
  6864.                                   if loCaseInsensitive in Options Then
  6865.                                      Begin
  6866.                                        if Pos('*',KV.Strings[X]) > 0 Then
  6867.                                          S:= S + ' LIKE LCASE("' + ChangeQuotes(KV.Strings[X]) + '")'
  6868.                                        Else
  6869.                                          S:= S + ' LIKE LCASE("' + ChangeQuotes(KV.Strings[X]) + '*")';
  6870.                                      End
  6871.                                   Else
  6872.                                      Begin
  6873.                                        if Pos('*',KV.Strings[X]) > 0 Then
  6874.                                          S:= S + ' LIKE "' + ChangeQuotes(KV.Strings[X]) + '"'
  6875.                                        Else
  6876.                                          S:= S + ' LIKE "' + ChangeQuotes(KV.Strings[X]) + '*"';
  6877.                                      End;
  6878.                                 End
  6879.                              Else
  6880.                                 Begin
  6881.                                   if loCaseInsensitive in Options Then
  6882.                                      Begin
  6883.                                        S:= S + ' = LCASE("' + ChangeQuotes(KV.Strings[X]) + '")';
  6884.                                      End
  6885.                                    Else
  6886.                                      Begin
  6887.                                        S:= S + ' = "' + ChangeQuotes(KV.Strings[X]) + '"';
  6888.                                      End;
  6889.                                 End;
  6890.                            End;
  6891.              ftBoolean,
  6892.              ftCurrency,
  6893.              ftFloat,                                               
  6894.              ftSmallint,
  6895.              ftWord,
  6896.              ftAutoInc,
  6897.              ftInteger : Begin
  6898.                           if KV.Strings[X]='' Then
  6899.                              S := S + ' IS NULL'
  6900.                           Else
  6901.                              S := S + ' = ' + ChangeCommas(KV.Strings[X]);
  6902.                          End;
  6903.              ftDate    : Begin
  6904.                            if KV.Strings[X]='' Then
  6905.                               Begin
  6906.                                  S := S + ' IS NULL'
  6907.                               End
  6908.                            Else
  6909.                               Begin
  6910.                                 KV.Strings[X]:=RemoveNonDigitChars(KV.Strings[X]);
  6911.                                 S:= S + ' = #' + FormatDateTime('mm"/"dd"/"yyyy', StrToDateTime(KV.Strings[X])) + '#';
  6912.                               End;
  6913.                          End;
  6914.              ftTime    : Begin
  6915.                             if KV.Strings[X]='' Then
  6916.                               Begin
  6917.                                  S := S + ' IS NULL'
  6918.                               End
  6919.                            Else
  6920.                               Begin
  6921.                                KV.Strings[X]:=RemoveNonDigitChars(KV.Strings[X]);
  6922.                                S:= S + ' = #' + FormatDateTime('hh":"nn":"ss', StrToDateTime(KV.Strings[X])) + '#';
  6923.                               End;
  6924.                          End;
  6925.              ftDateTime: Begin
  6926.                             if KV.Strings[X]='' Then
  6927.                               Begin
  6928.                                  S := S + ' IS NULL'
  6929.                               End
  6930.                            Else
  6931.                               Begin
  6932.                                KV.Strings[X]:=RemoveNonDigitChars(KV.Strings[X]);
  6933.                                S:= S + ' = #' + FormatDateTime('mm"/"dd"/"yyyy hh":"nn":"ss', StrToDateTime(KV.Strings[X])) + '#';
  6934.                               End;
  6935.                          End;
  6936.              Else
  6937.              DatabaseError(E2029)
  6938.           End;
  6939.           S:=S+')';
  6940.           if (X < KN.Count-1) Then S:=S+' AND ';
  6941.          End;
  6942.      End;
  6943.  Result := S;
  6944. End;
  6945.  
  6946. Function  TKADaoTable.BuildDetailSQL:String;
  6947. Var
  6948.  X  : Integer;
  6949.  S  : String;
  6950.  FT : TField;
  6951. Begin
  6952. S:='';
  6953. Result:='';
  6954. if F_Master.Count <> F_Detail.Count Then
  6955.      Begin
  6956.        DatabaseError(E2030);
  6957.      End;
  6958. if F_Master.Count > 0 Then
  6959.      Begin
  6960.       For X:=0 To F_Master.Count-1 do
  6961.          Begin
  6962.           S:=S+'(';
  6963.           if F_UseBrackets Then
  6964.              S:=S+BracketField(F_Detail.Strings[X])
  6965.           Else
  6966.              S:=S+F_Detail.Strings[X];
  6967.           S:=S+' ';
  6968.           FT :=F_MasterLink.Dataset.FieldByName(F_Master.Strings[X]);
  6969.           if FT.IsNull then S:= S + 'IS NULL'
  6970.           Else
  6971.           Case FT.DataType of
  6972.              ftBytes    :  Begin
  6973.                              if FT.AsString = '' Then
  6974.                                 Begin
  6975.                                   S := S + ' IS NULL';
  6976.                                 End
  6977.                              Else
  6978.                                 Begin
  6979.                                   if FT.ValidChars = GUID_VALID_CHARS Then
  6980.                                      S := S + ' = {guid '+GetGUIDAsString(FT.AsString)+'}'
  6981.                                   Else
  6982.                                      S := S + ' = "' + FT.AsString + '"';
  6983.                                 End;
  6984.                            End;
  6985.              ftString,
  6986.              ftMemo     : S := S + ' = "' + ChangeQuotes(FT.AsString) + '"';
  6987.              ftCurrency,
  6988.              ftFloat,
  6989.              ftSmallint,
  6990.              ftWord,
  6991.              ftAutoInc,
  6992.              ftInteger : Begin
  6993.                            if FT.AsString='' Then
  6994.                               S := S + ' IS NULL'
  6995.                            Else
  6996.                               S := S + ' = ' + ChangeCommas(FT.AsString);
  6997.                          End;
  6998.              ftBoolean : Begin
  6999.                            if FT.AsString='' Then
  7000.                               S := S + ' IS NULL'
  7001.                            Else
  7002.                               If FT.AsBoolean then S:= S + ' = True' Else S:= S + ' = False';
  7003.                          End;
  7004.              ftDate    : Begin
  7005.                            if FT.AsString='' Then
  7006.                               S := S + ' IS NULL'
  7007.                            Else
  7008.                               S := S + ' = #' + FormatDateTime('mm"/"dd"/"yyyy', FT.AsDateTime) + '#';
  7009.                          End;
  7010.              ftTime    : Begin
  7011.                            if FT.AsString='' Then
  7012.                               S := S + ' IS NULL'
  7013.                            Else
  7014.                               S := S + ' = #' + FormatDateTime('hh":"nn":"ss', FT.AsDateTime) + '#';
  7015.                          End;
  7016.              ftDateTime: Begin
  7017.                            if FT.AsString='' Then
  7018.                               S := S + ' IS NULL'
  7019.                            Else
  7020.                               S := S + ' = #' + FormatDateTime('mm"/"dd"/"yyyy hh":"nn":"ss', FT.AsDateTime) + '#';
  7021.                          End;
  7022.              Else
  7023.                 DatabaseError(E2031)
  7024.           End;
  7025.           S:=S+')';
  7026.           if (X < F_Master.Count-1) Then S:=S+' AND ';
  7027.          End;
  7028.      End;
  7029.  Result := S;
  7030. End;
  7031.  
  7032. //***************************************************************************************
  7033. Function TKADaoTable.GetDaoLastModifiedBookMark(RS:Variant):Integer;
  7034. Var
  7035.  TempBK : Pointer;
  7036. Begin
  7037.  Result:=0;
  7038.  if (RS.BOF) And (RS.EOF) Then Exit;
  7039.  if F_Bookmarkable Then
  7040.     Begin
  7041.       TempBK:=TVarData(RS.LastModified).VPointer;
  7042.       if Assigned (PSafeArray(TempBK)) Then
  7043.          Begin
  7044.            Result := PInteger(PSafeArray(TempBK)^.pvData)^;
  7045.          End
  7046.       Else
  7047.          Begin
  7048.            Result := GetDaoBookMark(RS);
  7049.          End;
  7050.     End
  7051.  Else
  7052.     Begin
  7053.       Result := 0;
  7054.     End;
  7055. End;
  7056.  
  7057.  
  7058. Function  TKADaoTable.GetDaoBookMark(RS:Variant):Integer;
  7059. Var
  7060.  TempBK : Pointer;
  7061. Begin
  7062.  Result:=0;
  7063.  if (RS.BOF) Or (RS.EOF) Then Exit;
  7064.  Try
  7065.   if F_Bookmarkable Then
  7066.     Begin
  7067.       TempBK:=TVarData(RS.Bookmark).VPointer;
  7068.       Result:=PInteger(PSafeArray(TempBK)^.pvData)^;
  7069.     End
  7070.   Else
  7071.     Begin
  7072.       Result := 0;
  7073.     End;
  7074.   Except
  7075.     InternalFirst;
  7076.   End;
  7077. End;
  7078.  
  7079.  
  7080. Function TKADaoTable.GetFieldIndexName(FiledName:String):String;
  7081. Var
  7082.   X,Y : Integer;
  7083. Begin
  7084.  if Assigned(F_Database) And (F_Database.Connected) Then
  7085.  Begin
  7086.  Try
  7087.   For X :=0 To F_Database.CoreDatabase.TableDefs[F_TableName].Indexes.Count-1 do
  7088.       Begin
  7089.         For Y := 0 To F_Database.CoreDatabase.TableDefs[F_TableName].Indexes.Item[X].Fields.Count-1 do
  7090.             Begin
  7091.               if AnsiCompareText(FiledName,F_Database.CoreDatabase.TableDefs[F_TableName].Indexes.Item[X].Fields.Item[Y].Name)=0 Then
  7092.                  Begin
  7093.                   Result :=F_Database.CoreDatabase.TableDefs[F_TableName].Indexes.Item[X].Name;
  7094.                   Exit;
  7095.                  End;
  7096.             End;
  7097.       End;
  7098.   Except
  7099.   End;
  7100.   End;
  7101.   Result := '';
  7102. End;
  7103.  
  7104. Function TKADaoTable.CheckFieldsInIndex(KF:TStringList):Boolean;
  7105. Var
  7106.   X,Y  : Integer;
  7107.   OK   : Boolean;
  7108. Begin
  7109.   Result := False;
  7110.   if F_IndexName='' Then Exit;
  7111.   if (NOT Assigned(F_Database))  Or (NOT F_Database.Connected) Then Exit;
  7112.   For X :=0 To KF.Count-1 do
  7113.       Begin
  7114.         OK :=False;
  7115.         For Y:=0 To F_Database.CoreDatabase.TableDefs[F_TableName].Indexes.Item[F_IndexName].Fields.Count-1 do
  7116.             Begin
  7117.              if AnsiCompareText(KF.Strings[X],F_Database.CoreDatabase.TableDefs[F_TableName].Indexes.Item[F_IndexName].Fields.Item[Y].Name)=0 Then OK :=True;
  7118.             End;
  7119.         if Not OK Then Exit;
  7120.       End;
  7121.   Result := True;
  7122. End;
  7123.  
  7124. //******************************************************************* 31.01.2002
  7125. Function TKADaoTable.GetUniqueIndexFields(Table : TKaDaoTable) : String;
  7126. Var
  7127.   X : integer;
  7128. Begin
  7129.   Result := '';
  7130.   Table.IndexDefs.Update;
  7131.   For X := 0 to Table.IndexDefs.Count - 1 do
  7132.       Begin
  7133.        if ixUnique in Table.IndexDefs.Items[X].Options then
  7134.           Begin
  7135.            Result := Table.IndexDefs.Items[X].Fields;
  7136.            System.Break;
  7137.           End;
  7138.       End;
  7139. End;
  7140.  
  7141. Function TKADaoTable.IsFieldUniqueIndex(Table : TKaDaoTable; FieldName : String ) : Boolean;
  7142. Var
  7143.   X : Integer;
  7144. Begin
  7145.   Result := False;
  7146.   Table.IndexDefs.Update;
  7147.   for X := 0 to Table.IndexDefs.Count -1 do
  7148.       Begin
  7149.       if  (Table.IndexDefs.Items[X].Fields = FieldName)
  7150.         And (ixUnique in Table.IndexDefs.Items[X].Options ) Then
  7151.             Begin
  7152.              Result := true;
  7153.              System.Break;
  7154.             End;
  7155.       End;
  7156. end;
  7157. //******************************************************************* 31.01.2002
  7158.  
  7159.  
  7160.  
  7161. Function  TKADaoTable.Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean;
  7162. Var
  7163.  KF       : TStringList;
  7164.  KV       : TStringList;
  7165.  X        : Integer;
  7166.  CR       : Integer;
  7167.  RI       : Integer;
  7168.  FN       : Integer;
  7169.  Find     : Boolean;
  7170.  S1,S2    : String;
  7171.  L        : Integer;
  7172.  Filter   : String;
  7173.  KVV      : Array[0..12] of OleVariant;
  7174.  IdxC     : Integer;
  7175.  IdxCT    : Integer;
  7176.  IndexOK  : Boolean;
  7177.  CompText : String;
  7178.  //*************************************
  7179.  BK       : Integer;
  7180.  TempRS   : OleVariant;
  7181.  APOK     : Boolean;
  7182.  IdxName  : String;
  7183.  //*************************************
  7184. Begin
  7185.  Result:=False;
  7186.  if IsEmpty Then Exit;
  7187.  if F_BatchMode  Then Exit;
  7188.  If ((F_Filtered) And (Assigned(F_OnFilterRecord))) Or (F_RangeFiltered) Then Exit;
  7189.  if (NOT Assigned(F_Database))  Or (NOT F_Database.Connected) Then Exit;
  7190.  KF :=  TStringList.Create;
  7191.  KV :=  TStringList.Create;
  7192.  Try
  7193.   StringToList(KeyFields,KF);
  7194.   VariantToList(KeyValues,KV);
  7195.   If (KF.Count <> KV.Count)  Then DatabaseError(E2032);
  7196.   //****************************************************************************
  7197.   APOK := False;
  7198.   if     (F_TableType=dbOpenDynaset)
  7199.       OR (F_TableType=dbOpenSnapshot)
  7200.       OR (F_TableType=dbOpenDynamic) Then APOK:=True;
  7201.   //****************************************************************************
  7202.   InternalSetToRecord(GetActiveRecordBuffer);
  7203.   CR:=F_RecNo;
  7204.   if F_Bookmarkable Then
  7205.      Begin
  7206.        //************************************************************ 13.02.2002
  7207.        if F_AutoFindIndex Then
  7208.           Begin
  7209.             IdxName   := FindGoodIndex('!'+KeyFields);
  7210.             if IdxName = '' Then IdxName := FindGoodIndex(KeyFields);
  7211.             if IdxName = '' Then IdxName := F_IndexName;
  7212.           End
  7213.        Else
  7214.           Begin
  7215.             IdxName := F_IndexName;
  7216.             if IdxName='' Then
  7217.                Begin
  7218.                 IdxName   := FindGoodIndex('!'+KeyFields);
  7219.                 if IdxName = '' Then IdxName := FindGoodIndex(KeyFields);
  7220.                End;
  7221.           End;
  7222.        //************************************************************ 13.02.2002
  7223.        IndexOK := (IdxName<>'');
  7224.        if (TableType=dbOpenTable) And (IndexOK) Then
  7225.           Begin
  7226.             //******************************************************************
  7227.             For X := 0 to 12 do KVV[X]:=Null;
  7228.             IdxC  := F_Database.CoreDatabase.TableDefs[F_TableName].Indexes[IdxName].Fields.Count;
  7229.             IdxCT := 0;
  7230.             For X:=0 to IdxC-1 do
  7231.                 Begin
  7232.                   L:=KF.IndexOf(F_Database.CoreDatabase.TableDefs[F_TableName].Indexes[IdxName].Fields.Item[X].Name);
  7233.                   if L <> -1 Then
  7234.                      Begin
  7235.                        KVV[X]:=KV.Strings[L];
  7236.                        IdxCT:=X+1;
  7237.                      End;
  7238.                 End;
  7239.             //******************************************************************
  7240.             if IdxCT > 0 Then IdxC:=IdxCT;
  7241.             CompText := '=';
  7242.             if KF.Count <> F_Database.CoreDatabase.TableDefs[F_TableName].Indexes.Item[IdxName].Fields.Count Then CompText := '>=';
  7243.             if loPartialKey in Options then CompText := '>=';
  7244.  
  7245.             TempRS:=F_DaoTable.Clone;
  7246.             TempRS.Index:=IdxName;
  7247.             TempRS.MoveFirst;
  7248.             if IdxC=1 Then OleVariant(TempRS).Seek(CompText,KVV[0])
  7249.             Else
  7250.             if IdxC=2 Then OleVariant(TempRS).Seek(CompText,KVV[0],KVV[1])
  7251.             Else
  7252.             if IdxC=3 Then OleVariant(TempRS).Seek(CompText,KVV[0],KVV[1],KVV[2])
  7253.             Else
  7254.             if IdxC=4 Then OleVariant(TempRS).Seek(CompText,KVV[0],KVV[1],KVV[2],KVV[3])
  7255.             Else
  7256.             if IdxC=5 Then OleVariant(TempRS).Seek(CompText,KVV[0],KVV[1],KVV[2],KVV[3],KVV[4])
  7257.             Else
  7258.             if IdxC=6 Then OleVariant(TempRS).Seek(CompText,KVV[0],KVV[1],KVV[2],KVV[3],KVV[4],KVV[5])
  7259.             Else
  7260.             if IdxC=7 Then OleVariant(TempRS).Seek(CompText,KVV[0],KVV[1],KVV[2],KVV[3],KVV[4],KVV[5],KVV[6])
  7261.             Else
  7262.             if IdxC=8 Then OleVariant(TempRS).Seek(CompText,KVV[0],KVV[1],KVV[2],KVV[3],KVV[4],KVV[5],KVV[6],KVV[7])
  7263.             Else
  7264.             if IdxC=9 Then OleVariant(TempRS).Seek(CompText,KVV[0],KVV[1],KVV[2],KVV[3],KVV[4],KVV[5],KVV[6],KVV[7],KVV[8])
  7265.             Else
  7266.             if IdxC=10 Then OleVariant(TempRS).Seek(CompText,KVV[0],KVV[1],KVV[2],KVV[3],KVV[4],KVV[5],KVV[6],KVV[7],KVV[8],KVV[9])
  7267.             Else
  7268.             if IdxC=11 Then OleVariant(TempRS).Seek(CompText,KVV[0],KVV[1],KVV[2],KVV[3],KVV[4],KVV[5],KVV[6],KVV[7],KVV[8],KVV[9],KVV[10])
  7269.             Else
  7270.             if IdxC=12 Then OleVariant(TempRS).Seek(CompText,KVV[0],KVV[1],KVV[2],KVV[3],KVV[4],KVV[5],KVV[6],KVV[7],KVV[8],KVV[9],KVV[10],KVV[11])
  7271.             Else
  7272.             if IdxC=13 Then OleVariant(TempRS).Seek(CompText,KVV[0],KVV[1],KVV[2],KVV[3],KVV[4],KVV[5],KVV[6],KVV[7],KVV[8],KVV[9],KVV[10],KVV[11],KVV[12]);
  7273.             For X:=0 to 12 do Begin VarClear(KVV[X]); KVV[X]:=NULL; End;
  7274.           End
  7275.        Else
  7276.           Begin
  7277.             if (TableType=dbOpenTable) Then DatabaseError(E2062);
  7278.             //******************************************************************
  7279.             Filter:=BuildLocateSQL(KF,KV,Options);
  7280.             TempRS:=F_DaoTable.Clone;
  7281.             TempRS.MoveFirst;
  7282.             OleVariant(TempRS).Move(CR);
  7283.             TempRS.FindFirst(Filter);
  7284.             //******************************************************************
  7285.           End;
  7286.        Find:=NOT TempRS.NoMatch;
  7287.        if (Find) Then
  7288.            Begin
  7289.              Result:= True;
  7290.              BK:=GetDaoBookMark(TempRS);
  7291.              CheckBrowseMode;
  7292.              CursorPosChanged;
  7293.              DoBeforeScroll;
  7294.              if APOK Then
  7295.                 Begin
  7296.                   CR := TempRS.AbsolutePosition;
  7297.                 End
  7298.              Else
  7299.                 Begin
  7300.                    CR:=F_RecalculateRecNo(TempRS,BK);
  7301.                 End;
  7302.              InternalMoveToBookmark(@BK);
  7303.              F_RecNo:=CR;
  7304.              //ClearBuffers;
  7305.              Resync([]);
  7306.              DoAfterScroll;
  7307.            End;
  7308.        TempRS.Close;
  7309.        TempRS:=NULL;
  7310.      End
  7311.   Else
  7312.      Begin
  7313.        CheckBrowseMode;
  7314.        CursorPosChanged;
  7315.        DoBeforeScroll;
  7316.        F_DaoTable.MoveFirst;
  7317.        Find:=False;
  7318.        RI:=0;
  7319.        While Not (F_DaoTable.EOF) Do
  7320.              Begin
  7321.               Find:=True;
  7322.               For X:=0 to KF.Count-1 do
  7323.                   Begin
  7324.                    FN:=Integer(KF.Objects[X])-1;
  7325.                    S1:=KV[X];
  7326.                    S2:=VarAsType(F_DaoTable.Fields.Item[FN].Value,VarString);
  7327.                    if loCaseInsensitive in Options Then
  7328.                        Begin
  7329.                         S1:=AnsiLowerCase(S1);
  7330.                         S2:=AnsiLowerCase(S2);
  7331.                        End;
  7332.                    if loPartialKey in Options Then
  7333.                        Begin
  7334.                         L:=Length(S1);
  7335.                         if S1[L]='*' Then System.Delete(S1,L,1);
  7336.                         if S1[1]='*' Then System.Delete(S1,1,1);
  7337.                         if Pos(S1,S2) = 0 Then Find:=False;
  7338.                        End
  7339.                    Else
  7340.                        Begin
  7341.                         if S1 <> S2 Then Find:=False;
  7342.                        End;
  7343.                    if NOT Find Then Break;
  7344.                   End;
  7345.               If Find Then
  7346.                  Begin
  7347.                   DoBeforeScroll;
  7348.                   F_RecNo:=RI;
  7349.                   Result:= True;
  7350.                   //ClearBuffers;
  7351.                   Resync([]);
  7352.                   DoAfterScroll;
  7353.                   Break;
  7354.                  End
  7355.               Else
  7356.                  Begin
  7357.                   Inc(RI);
  7358.                   F_DaoTable.MoveNext;
  7359.                  End;
  7360.              End;
  7361.        if Not(Find) Then
  7362.           Begin
  7363.             F_DaoTable.MoveFirst;
  7364.             OleVariant(F_DaoTable).Move(CR);
  7365.             //ClearBuffers;
  7366.             Resync([rmExact, rmCenter]);
  7367.           End;
  7368.        DoAfterScroll;
  7369.      End;
  7370.  Finally
  7371.   KV.Free;
  7372.   KF.Free;
  7373.  End; 
  7374. End;
  7375.  
  7376.  
  7377. Function  TKADaoTable.Find(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions;FindType:Integer): Boolean;
  7378. Var
  7379.  KF       : TStringList;
  7380.  KV       : TStringList;
  7381.  X        : Integer;
  7382.  CR       : Integer;
  7383.  Filter   : String;
  7384.  //*************************************
  7385.  BK       : Integer;
  7386.  TempRS   : OleVariant;
  7387.  APOK     : Boolean;
  7388.  //*************************************
  7389. Begin
  7390.  Result:=False;
  7391.  if IsEmpty Then Exit;
  7392.  If ((F_Filtered) And (Assigned(F_OnFilterRecord))) Or (F_RangeFiltered) Then Exit;
  7393.  KF :=  TStringList.Create;
  7394.  KV :=  TStringList.Create;
  7395.  Try
  7396.   StringToList(KeyFields,KF);
  7397.   VariantToList(KeyValues,KV);
  7398.   If (KF.Count <> KV.Count)  Then DatabaseError(E2032);
  7399.   For X:=0 To KF.Count-1 do KF.Objects[X]:=Pointer(FieldByName(KF[X]).FieldNo);
  7400.   //*****************************************************************************
  7401.   APOK := False;
  7402.   if     (F_TableType=dbOpenDynaset)
  7403.      OR (F_TableType=dbOpenSnapshot)
  7404.      OR (F_TableType=dbOpenDynamic) Then APOK:=True;
  7405.   //*****************************************************************************
  7406.   InternalSetToRecord(GetActiveRecordBuffer);
  7407.   CR:=F_RecNo;
  7408.   if F_Bookmarkable Then
  7409.     Begin
  7410.       Filter:=BuildLocateSQL(KF,KV,Options);
  7411.       TempRS:=F_DaoTable.Clone;
  7412.       TempRS.MoveFirst;
  7413.       OleVariant(TempRS).Move(CR);
  7414.       Case FindType of
  7415.            1 : TempRS.FindFirst(Filter);
  7416.            2 : TempRS.FindLast(Filter);
  7417.            3 : TempRS.FindNext(Filter);
  7418.            4 : TempRS.FindPrevious(Filter);
  7419.       End;
  7420.       if (Not TempRS.NoMatch) Then
  7421.           Begin
  7422.             Result:= True;
  7423.             BK:=GetDaoBookMark(TempRS);
  7424.             CheckBrowseMode;
  7425.             CursorPosChanged;
  7426.             DoBeforeScroll;
  7427.             if APOK Then
  7428.                Begin
  7429.                  CR := TempRS.AbsolutePosition;
  7430.                End
  7431.             Else
  7432.                Begin
  7433.                   CR:=F_RecalculateRecNo(TempRS,BK);
  7434.                End;
  7435.             InternalMoveToBookmark(@BK);
  7436.             F_RecNo:=CR;
  7437.             //ClearBuffers;
  7438.             Resync([rmExact, rmCenter]);
  7439.             DoAfterScroll;
  7440.           End;
  7441.       TempRS.Close;
  7442.       TempRS:=NULL;
  7443.     End
  7444.   Else
  7445.     Result:=False;
  7446.  Finally
  7447.   KV.Free;
  7448.   KF.Free;
  7449.  End;
  7450. End;
  7451.  
  7452. Procedure TKADaoTable.SetKeyFields(const KeyFields: string);
  7453. Begin
  7454.  StringToList(KeyFields,F_KeyFields);
  7455. End;
  7456.  
  7457. Function TKADaoTable.Find_First(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions):Boolean;
  7458. Begin
  7459.   Result:=Find(KeyFields,KeyValues,Options,1);
  7460. End;
  7461.  
  7462. Function TKADaoTable.Find_Last(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions):Boolean;
  7463. Begin
  7464.   Result:=Find(KeyFields,KeyValues,Options,2);
  7465. End;
  7466.  
  7467. Function TKADaoTable.Find_Next(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions):Boolean;
  7468. Begin
  7469.   Result:=Find(KeyFields,KeyValues,Options,3);
  7470. End;
  7471.  
  7472. Function TKADaoTable.Find_Prior(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions):Boolean;
  7473. Begin
  7474.   Result:=Find(KeyFields,KeyValues,Options,4);
  7475. End;
  7476.  
  7477. Procedure TKADaoTable.SetFindData(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions);
  7478. Begin
  7479.  F_FindKeyFields:=KeyFields;
  7480.  F_FindKeyValues:=KeyValues;
  7481.  F_FindOptions:=Options;
  7482. End;
  7483.  
  7484. Function TKADaoTable.FindRecord(Restart, GoForward: Boolean): Boolean;
  7485. Begin
  7486.    Result:=False;
  7487.    if F_FindKeyFields='' Then Exit;
  7488.    if VarIsNull(F_FindKeyValues) Then Exit;
  7489.    if (Restart) And (GoForward)         Then Result:=Find_First(F_FindKeyFields,F_FindKeyValues,F_FindOptions);
  7490.    if (Restart) And (NOT GoForward)     Then Result:=Find_Last(F_FindKeyFields,F_FindKeyValues,F_FindOptions);
  7491.    if (NOT Restart) And (GoForward)     Then Result:=Find_Next(F_FindKeyFields,F_FindKeyValues,F_FindOptions);
  7492.    if (NOT Restart) And (NOT GoForward) Then Result:=Find_Prior(F_FindKeyFields,F_FindKeyValues,F_FindOptions);
  7493. End;
  7494.  
  7495. //*************************************************************** Range Routines
  7496. Function TKADaoTable.CompareFieldsRange(B1, B2: String; FieldType: TFieldType):Integer;
  7497. Var
  7498.   BOOL1, BOOL2 : WordBool;
  7499.   DOUB1, DOUB2 : Double;
  7500.   SMAL1, SMAL2 : SmallInt;
  7501.   WORD1, WORD2 : Word;
  7502.   INTE1, INTE2 : Integer;
  7503. Begin
  7504.  Result := 0;
  7505.  Case FieldType of
  7506.       ftString,
  7507.       ftMemo     :       Begin
  7508.                            Result := AnsiCompareText(B1, B2);
  7509.                          End;
  7510.       ftBoolean  :       Begin
  7511.                            if AnsiLowerCase(B1) = 'true' Then BOOL1 := True Else BOOL1 := False;
  7512.                            if AnsiLowerCase(B2) = 'true' Then BOOL2 := True Else BOOL2 := False;
  7513.                            if BOOL1 > BOOL2 Then Result:=1
  7514.                            Else
  7515.                            if BOOL1 < BOOL2 Then Result:=-1;
  7516.                          End;
  7517.       ftCurrency,
  7518.       ftFloat    :       Begin
  7519.                            Try
  7520.                             DOUB1 := StrToFloat(B1);
  7521.                             DOUB2 := StrToFloat(B2);
  7522.                             if DOUB1 > DOUB2 Then Result:=1
  7523.                             Else
  7524.                             if DOUB1 < DOUB2 Then Result:=-1;
  7525.                            Except
  7526.                            End;
  7527.                          End;
  7528.  
  7529.       ftSmallInt :       Begin
  7530.                            Try
  7531.                             SMAL1 := SmallInt(StrToInt(B1));
  7532.                             SMAL2 := SmallInt(StrToInt(B2));
  7533.                             Result:=SMAL1-SMAL2;
  7534.                            Except
  7535.                            End;
  7536.                          End;
  7537.  
  7538.       ftWord     :       Begin
  7539.                            Try
  7540.                             WORD1 := Word(StrToInt(B1));
  7541.                             WORD2 := Word(StrToInt(B2));
  7542.                             Result:=WORD1-WORD2;
  7543.                            Except
  7544.                            End;
  7545.                          End;
  7546.       ftAutoInc,
  7547.       ftInteger  :       Begin
  7548.                            Try
  7549.                             INTE1 := LongInt(StrToInt(B1));
  7550.                             INTE2 := LongInt(StrToInt(B2));
  7551.                             Result:=INTE1-INTE2;
  7552.                            Except
  7553.                            End;
  7554.                          End;
  7555.       ftDate     :       Begin
  7556.                            Result := AnsiCompareText(B1, B2);
  7557.                          End;
  7558.       ftTime     :       Begin
  7559.                            Result := AnsiCompareText(B1, B2);
  7560.                          End;
  7561.       ftDateTime :       Begin
  7562.                            Result := AnsiCompareText(B1, B2);
  7563.                          End;
  7564.  End;
  7565. End;
  7566.  
  7567. Function TKADaoTable.CompareRecordsRange(B1,B2 : PChar; CT : Integer) : Integer;
  7568. Var
  7569.  X       : Integer;
  7570.  F1,F2   : String;
  7571. Begin
  7572.  Result := 0;
  7573.  If (B1=Nil) Or (B2=nil) then Exit;
  7574.  For X := 0  to FieldCount-1 do
  7575.      Begin
  7576.        F1 := PDaoInfo(B1+F_StartMyInfo)^.RecordData.Strings[X];
  7577.        F2 := PDaoInfo(B2+F_StartMyInfo)^.RecordData.Strings[X];
  7578.        if (F1 <> '') And (F2 <> '') Then
  7579.           Begin
  7580.             Result := CompareFieldsRange(F1,F2,Fields[X].DataType);
  7581.           End
  7582.        Else
  7583.           Begin
  7584.             //*************** SET OUTSIDE RANGE IF THERE ARE NO VALUE TO COMPARE
  7585.             if F2 <> '' Then
  7586.                Begin
  7587.                  if (CT=1) Then Result:=-1
  7588.                  Else
  7589.                  if (CT=2) Then Result:=1;
  7590.                End;
  7591.           End;
  7592.        if (Result < 0) And (CT=1) Then Break;
  7593.        if (Result > 0) And (CT=2) Then Break;
  7594.      End;
  7595. End;
  7596.  
  7597. Function TKADaoTable.FilterRange(Buffer:PChar): Boolean;
  7598. Var
  7599.  R1,R2 : Integer;
  7600. Begin
  7601.  R1 := CompareRecordsRange(Buffer,F_RangeStartBuffer,1);
  7602.  R2 := CompareRecordsRange(Buffer,F_RangeEndBuffer,2);
  7603.  Result := (R1 >=0) And (R2 <=0);
  7604. End;
  7605.  
  7606. Procedure TKADaoTable.ClearRange(Var Buffer:PChar);
  7607. Var
  7608.   X : Integer;
  7609. Begin
  7610.   PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Clear;
  7611.   For X := 0 To FieldDefs.Count-1 do
  7612.       Begin
  7613.        PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.AddObject('',TObject(False));
  7614.       End;
  7615.   SetState(dsBrowse);
  7616.   //******************************************* 29.08.2001
  7617.   DataEvent(deDataSetChange, 0);
  7618.   //******************************************* 29.08.2001
  7619. End;
  7620.  
  7621. Procedure TKADaoTable.ApplyRange;
  7622. Var
  7623.  B1 : String;
  7624.  B2 : String;
  7625. Begin
  7626.  B1 := StrPas(PDaoInfo(F_RangeStartBuffer+F_StartMyInfo)^.RecordData.GetText);
  7627.  B2 := StrPas(PDaoInfo(F_RangeEndBuffer+F_StartMyInfo)^.RecordData.GetText);
  7628.  B1 :=Trim(B1);
  7629.  B2 :=Trim(B2);
  7630.  F_RangeFiltered := (B1 <> '') And (B2 <> '');
  7631.  F_RefreshRC     := True;
  7632.  SetState(dsBrowse);
  7633.  //******************************************* 29.08.2001
  7634.  DataEvent(deDataSetChange, 0);
  7635.  //******************************************* 29.08.2001
  7636.  First;
  7637. End;
  7638.  
  7639. Procedure TKADaoTable.CancelRange;
  7640. Begin
  7641.   F_RangeFiltered   := False;
  7642.   F_ActiveKeyBuffer := Nil;
  7643.   F_RefreshRC       := True;
  7644.   First;
  7645.   Resync([rmExact]);
  7646. End;
  7647.  
  7648. Procedure TKADaoTable.SetRange(const StartValues, EndValues : Array of Const);
  7649. var
  7650.    Maks  : Integer;
  7651.    Mini  : Integer;
  7652.    X     : Integer;
  7653. Begin
  7654.      CheckBrowseMode;
  7655.      //***************************************************** Setting Start Range
  7656.      SetRangeStart;
  7657.      Mini := High(StartValues);
  7658.      Maks := PDaoInfo(F_RangeStartBuffer+F_StartMyInfo)^.RecordData.Count;
  7659.      if Maks > Mini Then Maks := Mini;
  7660.      For X := 0 to Maks do Fields[X].AssignValue(StartValues[X]);
  7661.      //******************************************************* Setting End Range
  7662.      SetRangeEnd;
  7663.      Mini := High(StartValues);
  7664.      Maks := PDaoInfo(F_RangeEndBuffer+F_StartMyInfo)^.RecordData.Count;
  7665.      if Maks > Mini Then Maks := Mini;
  7666.      For X := 0 to Maks do Fields[X].AssignValue(EndValues[X]);
  7667.      //****************************************************** Applying the Range
  7668.      ApplyRange;
  7669. End;
  7670.  
  7671. Procedure TKADaoTable.SetRangeStart;
  7672. Begin
  7673.   ClearRange(F_RangeStartBuffer);
  7674.   F_ActiveKeyBuffer := F_RangeStartBuffer;
  7675.   SetState(dsSetKey);
  7676.   DataEvent(deDataSetChange, 0);
  7677. End;
  7678.  
  7679. Procedure TKADaoTable.SetRangeEnd;
  7680. Begin
  7681.   ClearRange(F_RangeEndBuffer);
  7682.   F_ActiveKeyBuffer := F_RangeEndBuffer;
  7683.   SetState(dsSetKey);
  7684.   DataEvent(deDataSetChange, 0);
  7685. End;
  7686.  
  7687. Procedure TKADaoTable.EditRangeStart;
  7688. Begin
  7689.  F_ActiveKeyBuffer := F_RangeStartBuffer;
  7690.  SetState(dsSetKey);
  7691.  DataEvent(deDataSetChange, 0);
  7692. End;
  7693.  
  7694. Procedure TKADaoTable.EditRangeEnd;
  7695. Begin
  7696.   F_ActiveKeyBuffer := F_RangeEndBuffer;
  7697.   SetState(dsSetKey);
  7698.   DataEvent(deDataSetChange, 0);
  7699. End;
  7700. //***************************************************************** Key Routines
  7701.  
  7702. Procedure TKADaoTable.SetKeyParam(const KeyFields: Array of String;const KeyValues: array of const);
  7703. Var
  7704.   X : Integer;
  7705. Begin
  7706.   F_KeyKeyFields:='';
  7707.   F_KeyKeyValues:=Null;
  7708.   For X:=0 to High(KeyFields) do
  7709.       Begin
  7710.         if X < High(KeyValues) Then
  7711.            F_KeyKeyFields := F_KeyKeyFields+KeyFields[X]+';'
  7712.         Else
  7713.            F_KeyKeyFields := F_KeyKeyFields+KeyFields[X];
  7714.        End;
  7715.   if High(KeyValues)=0 then
  7716.     Begin
  7717.       AssignVarValue(F_KeyKeyValues,KeyValues[0]);
  7718.     End
  7719.   Else
  7720.      Begin
  7721.        F_KeyKeyValues:=VarArrayCreate([0,High(KeyValues)],varVariant);
  7722.        For X:=0 to High(KeyFields) do AssignVarValue(F_KeyKeyValues,KeyValues[X]);
  7723.      End;
  7724. End;
  7725.  
  7726. Procedure TKADaoTable.CancelKey;
  7727. Var
  7728.   Buffer : PChar;
  7729.   X      : Integer;
  7730. begin
  7731.      Buffer := F_KeyBuffer;
  7732.      PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Clear;
  7733.      For X := 0 To FieldDefs.Count-1 do
  7734.           Begin
  7735.             PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.AddObject('',TObject(False));
  7736.           End;
  7737.      F_ActiveKeyBuffer := Nil;
  7738.      F_KeyKeyFields    := '';
  7739.      VarClear(F_KeyKeyValues);
  7740.      F_KeyKeyValues    := Null;
  7741.      SetState(dsBrowse);
  7742.      //******************************************* 29.08.2001
  7743.      DataEvent(deDataSetChange, 0);
  7744.      //******************************************* 29.08.2001
  7745.      Resync([rmExact]);
  7746. end;
  7747.  
  7748. Procedure TKADaoTable.ClearKey;
  7749. Var
  7750.   Buffer : PChar;
  7751.   X      : Integer;
  7752. begin
  7753.      Buffer := F_KeyBuffer;
  7754.      PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Clear;
  7755.      For X := 0 To FieldDefs.Count-1 do
  7756.           Begin
  7757.             PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.AddObject('',TObject(False));
  7758.           End;
  7759.      SetState(dsBrowse);
  7760.      //******************************************* 29.08.2001
  7761.      DataEvent(deDataSetChange, 0);
  7762.      //******************************************* 29.08.2001
  7763. end;
  7764.  
  7765. Procedure TKADaoTable.SetKey;
  7766. begin
  7767.      ClearKey;
  7768.      F_ActiveKeyBuffer := F_KeyBuffer;
  7769.      SetState(dsSetKey);
  7770.      DataEvent(deDataSetChange, 0);
  7771. end;
  7772.  
  7773. Procedure TKADaoTable.EditKey;
  7774. begin
  7775.      F_ActiveKeyBuffer := F_KeyBuffer;
  7776.      SetState(dsSetKey);
  7777.      DataEvent(deDataSetChange, 0);
  7778. end;
  7779.  
  7780. Function  TKADaoTable.GotoKey: Boolean;
  7781. Var
  7782.   Buffer    : PChar;
  7783.   X         : Integer;
  7784.   Count     : Integer;
  7785.   NumFields : Integer;
  7786.   NF        : Integer;
  7787.   FF        : TField;
  7788. Begin
  7789.   Result := False;
  7790.   if State=dsSetKey Then
  7791.      Begin
  7792.       Buffer := GetActiveRecordBuffer;
  7793.       if Buffer=Nil Then Exit;
  7794.       F_KeyKeyFields:='';
  7795.       F_KeyKeyValues:=Null;
  7796.       Count := PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Count-1;
  7797.       NumFields := 0;
  7798.       For X := 0 To Count Do
  7799.           Begin
  7800.             if PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Strings[X] <> '' Then
  7801.                Begin
  7802.                  F_KeyKeyFields := F_KeyKeyFields+FieldDefs[X].Name+';';
  7803.                  Inc(NumFields);
  7804.                End;
  7805.           End;
  7806.        if NumFields > 1 Then F_KeyKeyValues:=VarArrayCreate([0,NumFields-1],varVariant);
  7807.        NF:=0;
  7808.        For X := 0 To Count Do
  7809.           Begin
  7810.             if PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Strings[X] <> '' Then
  7811.                Begin
  7812.                  if NumFields > 1 Then F_KeyKeyValues[NF]:=PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Strings[X]
  7813.                  Else F_KeyKeyValues :=PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Strings[X];
  7814.                  //************************************************** 29.08.2001
  7815.                  FF:=FindField(FieldDefs[X].Name);
  7816.                  if (FF <> Nil) And ((FF.DataType=ftDateTime) or (FF.DataType=ftDate) or (FF.DataType=ftTime)) Then
  7817.                     Begin
  7818.                      if NumFields > 1 Then
  7819.                         F_KeyKeyValues[NF]:=ComposeDateTimeVariant(PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Strings[X])
  7820.                      Else
  7821.                         F_KeyKeyValues:=ComposeDateTimeVariant(PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Strings[X]);
  7822.                     End;
  7823.                  //************************************************** 29.08.2001
  7824.                  Inc(NF);
  7825.                End;
  7826.           End;
  7827.       SetState(dsBrowse);
  7828.       DataEvent(deDataSetChange, 0);
  7829.       if (TableType=dbOpenDynaset) or (TableType=dbOpenSnapshot) Then
  7830.          Begin
  7831.             Result := Find(F_KeyKeyFields,F_KeyKeyValues,[],3);
  7832.             if Not Result Then
  7833.                Result := Find(F_KeyKeyFields,F_KeyKeyValues,[],1);
  7834.          End;
  7835.       if (TableType=dbOpenTable) And (F_IndexName <> '') Then
  7836.           Begin
  7837.             Result := Locate(F_KeyKeyFields,F_KeyKeyValues,[]);
  7838.           End;
  7839.       if (Not Result) And (Not ISEmpty) Then Resync([]);
  7840.      End
  7841.   Else
  7842.      Begin
  7843.        if F_KeyKeyFields = '' Then Exit;
  7844.        if (TableType=dbOpenDynaset) or (TableType=dbOpenSnapshot) Then
  7845.          Begin
  7846.           Result := Find(F_KeyKeyFields,F_KeyKeyValues,[],3);
  7847.           if Not Result Then
  7848.              Result := Find(F_KeyKeyFields,F_KeyKeyValues,[],1);
  7849.          End;
  7850.        if (TableType=dbOpenTable) And (F_IndexName <> '') Then
  7851.           Begin
  7852.             Result := Locate(F_KeyKeyFields,F_KeyKeyValues,[]);
  7853.           End;
  7854.      End;
  7855.   VarClear(F_KeyKeyValues);
  7856.   F_KeyKeyValues:=Null;
  7857. End;
  7858.  
  7859. Procedure  TKADaoTable.GotoNearest;
  7860. Var
  7861.   Buffer    : PChar;
  7862.   X         : Integer;
  7863.   Count     : Integer;
  7864.   NumFields : Integer;
  7865.   NF        : Integer;
  7866.   FF        : TField;
  7867. Begin
  7868.   if State=dsSetKey Then
  7869.      Begin
  7870.       Buffer := GetActiveRecordBuffer;
  7871.       if Buffer=Nil Then Exit;
  7872.       F_KeyKeyFields:='';
  7873.       F_KeyKeyValues:=Null;
  7874.       Count := PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Count-1;
  7875.       NumFields := 0;
  7876.       For X := 0 To Count Do
  7877.           Begin
  7878.             if PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Strings[X] <> '' Then
  7879.                Begin
  7880.                  if X < Count Then
  7881.                     F_KeyKeyFields := F_KeyKeyFields+FieldDefs[X].Name+';'
  7882.                  Else
  7883.                     F_KeyKeyFields := F_KeyKeyFields+FieldDefs[X].Name;
  7884.                  Inc(NumFields);
  7885.                End;
  7886.           End;
  7887.        if NumFields > 1 Then F_KeyKeyValues:=VarArrayCreate([0,NumFields-1],varVariant);
  7888.        NF:=0;
  7889.        For X := 0 To Count Do
  7890.           Begin
  7891.             if PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Strings[X] <> '' Then
  7892.                Begin
  7893.                  if NumFields > 1 Then F_KeyKeyValues[NF]:=PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Strings[X]
  7894.                  Else F_KeyKeyValues :=PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Strings[X];
  7895.                  //************************************************** 29.08.2001
  7896.                  FF:=FindField(FieldDefs[X].Name);
  7897.                  if (FF <> Nil) And ((FF.DataType=ftDateTime) or (FF.DataType=ftDate) or (FF.DataType=ftTime)) Then
  7898.                     Begin
  7899.                      if NumFields > 1 Then
  7900.                         F_KeyKeyValues[NF]:=ComposeDateTimeVariant(PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Strings[X])
  7901.                      Else
  7902.                         F_KeyKeyValues:=ComposeDateTimeVariant(PDaoInfo(Buffer+F_StartMyInfo)^.RecordData.Strings[X]);
  7903.                     End;
  7904.                  //************************************************** 29.08.2001
  7905.                  Inc(NF);
  7906.                End;
  7907.           End;
  7908.       SetState(dsBrowse);
  7909.       DataEvent(deDataSetChange, 0);
  7910.       Find_NearestEx(F_KeyKeyFields,F_KeyKeyValues);
  7911.      End
  7912.   Else
  7913.      Begin
  7914.        if F_KeyKeyFields = '' Then Exit;
  7915.        Find_NearestEx(F_KeyKeyFields,F_KeyKeyValues);
  7916.      End;
  7917.   VarClear(F_KeyKeyValues);
  7918.   F_KeyKeyValues:=Null;   
  7919. End;
  7920.  
  7921. Function TKADaoTable.FindKey(const KeyValues: array of const):Boolean;
  7922. Begin
  7923.  Result:=Seek_NearestEx(KeyValues,'=');
  7924. End;
  7925.  
  7926. Function TKADaoTable.FindKeyEx(const KeyValues: array of const):Boolean;
  7927. Begin
  7928.  Result:=Seek_NearestEx(KeyValues,'>=');
  7929. End;
  7930.  
  7931. //******************************************************************************
  7932.  
  7933. Function TKADaoTable.Find_NearestEx(const KeyFields: string; const KeyValues: Variant):Boolean;
  7934. Var
  7935.   Options:TLocateOptions;
  7936. Begin
  7937.   Options:=[loCaseInsensitive,loPartialKey];
  7938.   Result:=Find(KeyFields,KeyValues,Options,1);
  7939.   if Not Result Then Result:=Find(KeyFields,KeyValues,Options,3);
  7940. End;
  7941.  
  7942. Function TKADaoTable.Find_Nearest(const KeyValues: array of const):Boolean;
  7943. Var
  7944.   KF         : String;
  7945.   KV         : Variant;
  7946.   KT         : Variant;
  7947.   X          : Integer;
  7948. Begin
  7949.   KF:='';
  7950.   For X:=0 to High(KeyValues) do
  7951.       Begin
  7952.         if X < High(KeyValues) Then KF := KF+F_KeyFields.Strings[X]+';' Else  KF := KF+F_KeyFields.Strings[X];
  7953.        End;
  7954.   if High(KeyValues)=0 then
  7955.     Begin
  7956.       AssignVarValue(KV,KeyValues[0]);
  7957.     End
  7958.   Else
  7959.      Begin
  7960.        KV:=VarArrayCreate([0,High(KeyValues)],varVariant);
  7961.        For X:=0 to High(KeyValues) do
  7962.            Begin
  7963.             AssignVarValue(KT,KeyValues[X]);
  7964.             KV[X]:=KT;
  7965.            End;
  7966.      End;
  7967.   Result:=Find_NearestEx(KF,KV);
  7968.   VarClear(KV);
  7969.   KV:=NULL;
  7970. End;
  7971.  
  7972.  
  7973. Function TKADaoTable.Seek_NearestEx(const KeyValues: array of const; SeekType:String):Boolean;
  7974. Var
  7975.  KV     : Variant;
  7976.  KT     : Variant;
  7977.  X      : Integer;
  7978.  CR     : Integer;
  7979.  NumVals: Integer;
  7980.  //*************************************
  7981.  BK       : Integer;
  7982.  TempRS   : OleVariant;
  7983.  //*************************************
  7984. Begin
  7985.  Result:=False;
  7986.  if F_IndexName='' Then Exit;
  7987.  if IsEmpty Then Exit;
  7988.  If ((F_Filtered) And (Assigned(F_OnFilterRecord))) Or (F_RangeFiltered) Then Exit;
  7989.  if High(KeyValues)=0 then
  7990.     Begin
  7991.       NumVals:=1;
  7992.       AssignVarValue(KV,KeyValues[0]);
  7993.     End
  7994.   Else
  7995.      Begin
  7996.        KV:=VarArrayCreate([0,High(KeyValues)],varVariant);
  7997.        NumVals:=High(KeyValues)+1;
  7998.        For X:=0 to High(KeyValues) do
  7999.            Begin
  8000.             AssignVarValue(KT,KeyValues[X]);
  8001.             KV[X]:=KT;
  8002.            End;
  8003.      End;
  8004.      InternalSetToRecord(GetActiveRecordBuffer);
  8005.      CR:=F_RecNo;
  8006.      TempRS:=F_DaoTable.Clone;
  8007.      TempRS.Index:=F_IndexName;
  8008.      TempRS.MoveFirst;
  8009.      TempRS.Move(CR);
  8010.      if NumVals=1 Then TempRS.Seek(SeekType,KV)
  8011.      Else
  8012.      if NumVals=2 Then TempRS.Seek(SeekType,KV[0],KV[1])
  8013.      Else
  8014.      if NumVals=3 Then TempRS.Seek(SeekType,KV[0],KV[1],KV[2])
  8015.      Else
  8016.      if NumVals=4 Then TempRS.Seek(SeekType,KV[0],KV[1],KV[2],KV[3])
  8017.      Else
  8018.      if NumVals=5 Then TempRS.Seek(SeekType,KV[0],KV[1],KV[2],KV[3],KV[4])
  8019.      Else
  8020.      if NumVals=6 Then TempRS.Seek(SeekType,KV[0],KV[1],KV[2],KV[3],KV[4],KV[5])
  8021.      Else
  8022.      if NumVals=7 Then TempRS.Seek(SeekType,KV[0],KV[1],KV[2],KV[3],KV[4],KV[5],KV[6])
  8023.      Else
  8024.      if NumVals=8 Then TempRS.Seek(SeekType,KV[0],KV[1],KV[2],KV[3],KV[4],KV[5],KV[6],KV[7])
  8025.      Else
  8026.      if NumVals=9 Then TempRS.Seek(SeekType,KV[0],KV[1],KV[2],KV[3],KV[4],KV[5],KV[6],KV[7],KV[8])
  8027.      Else
  8028.      if NumVals=10 Then TempRS.Seek(SeekType,KV[0],KV[1],KV[2],KV[3],KV[4],KV[5],KV[6],KV[7],KV[8],KV[9])
  8029.      Else
  8030.      if NumVals=11 Then TempRS.Seek(SeekType,KV[0],KV[1],KV[2],KV[3],KV[4],KV[5],KV[6],KV[7],KV[8],KV[9],KV[10])
  8031.      Else
  8032.      if NumVals=12 Then TempRS.Seek(SeekType,KV[0],KV[1],KV[2],KV[3],KV[4],KV[5],KV[6],KV[7],KV[8],KV[9],KV[10],KV[11])
  8033.      Else
  8034.      if NumVals=13 Then TempRS.Seek(SeekType,KV[0],KV[1],KV[2],KV[3],KV[4],KV[5],KV[6],KV[7],KV[8],KV[9],KV[10],KV[11],KV[12])
  8035.      Else
  8036.         DatabaseError(E2033);
  8037.      VarClear(KV);
  8038.      KV := NULL;
  8039.      if (Not TempRS.NoMatch) Then
  8040.           Begin
  8041.             Result:= True;
  8042.             BK:=GetDaoBookMark(TempRS);
  8043.             CheckBrowseMode;
  8044.             CursorPosChanged;
  8045.             DoBeforeScroll;
  8046.             CR:=F_RecalculateRecNo(TempRS,BK);
  8047.             InternalMoveToBookmark(@BK);
  8048.             F_RecNo:=CR;
  8049.             //ClearBuffers;
  8050.             Resync([rmExact, rmCenter]);
  8051.             DoAfterScroll;
  8052.           End;
  8053.      TempRS.Close;
  8054.      TempRS:=NULL;
  8055. End;
  8056.  
  8057. Function TKADaoTable.Seek_Nearest(const KeyValues: array of const):Boolean;
  8058. Begin
  8059.  Result:=Seek_NearestEx(KeyValues,'>=');
  8060. End;
  8061.  
  8062. Procedure TKADaoTable.FindNearest(const KeyValues: array of const);
  8063. Begin
  8064.  if Seek_NearestEx(KeyValues,'>=')=False Then
  8065.     Begin
  8066.     End;
  8067. End;
  8068.  
  8069.  
  8070. Function  TKADaoTable.Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant;
  8071. Var
  8072.  KF     : TStringList;
  8073.  KV     : TStringList;
  8074.  RF     : TStringList;
  8075.  {$IFDEF DYNADAO}
  8076.  RS     : OleVariant;
  8077.  TempRS : OleVariant;
  8078.  {$ELSE}
  8079.  RS     : Recordset;
  8080.  TempRS : Recordset;
  8081.  {$ENDIF}
  8082.  FT      : String;
  8083.  X       : Integer;
  8084.  FN      : Integer;
  8085.  FF      : TField;
  8086.  HasLKF  : Boolean;
  8087. Begin
  8088.  Result:= NULL;
  8089.  if IsEmpty Then Exit;
  8090.  if F_BatchMode  Then Exit;
  8091.  KF := TStringList.Create;
  8092.  KV := TStringList.Create;
  8093.  RF := TStringList.Create;
  8094.  Try
  8095.   StringToList(KeyFields,KF);
  8096.   VariantToList(KeyValues,KV);
  8097.   StringToList(ResultFields,RF);
  8098.   if (KF.Count <> KV.Count)  Then DatabaseError(E2032);
  8099.   if (RF.Count=0) Or (ResultFields='') Then DatabaseError(E2034);
  8100.   HasLKF := False;
  8101.   For X:=0 To RF.Count-1 do
  8102.      Begin
  8103.        FF := FindField(RF.Strings[X]);
  8104.        if FF <> Nil Then
  8105.           Begin
  8106.            FN := FF.FieldNo;
  8107.            RF.Objects[X]:=Pointer(FN);
  8108.            if (FF.FieldKind<>fkData) Then HasLKF := True;
  8109.           End
  8110.        Else
  8111.           Begin
  8112.             DatabaseError(E2070+RF.Strings[X]);
  8113.           End;
  8114.      End;
  8115.   RS:=F_DaoTable;
  8116.   FT:=F_DaoTable.Filter;
  8117.   RS.Filter:=BuildKeySQL(KF,KV);
  8118.   F_Database.Idle;
  8119.   TempRS:=RS.OpenRecordset(dbOpenSnapshot,dbReadOnly);
  8120.   If Not(TempRS.EOF and TempRS.BOF) then
  8121.     Begin
  8122.        TempRS.MoveFirst;
  8123.        if HasLKF Then
  8124.            Begin
  8125.              //*********************************** We have Calc or Lookup fields
  8126.              InternalFillRecordData(TempRS,False, TempBuffer);
  8127.              SetTempState(dsCalcFields);
  8128.              Try
  8129.               CalculateFields(TempBuffer);
  8130.               Result := FieldValues[ResultFields];
  8131.              Finally
  8132.               RestoreState(dsBrowse);
  8133.              End;
  8134.            End
  8135.        Else
  8136.            Begin
  8137.             //************************************* Only DAO Fields so go faster
  8138.             if RF.Count=1 Then
  8139.                Begin
  8140.                  FN:=Integer(RF.Objects[0])-1;
  8141.                  Result:=TempRS.Fields.Item[FN].Value;
  8142.                End
  8143.             Else
  8144.                Begin
  8145.                  Result:= VarArrayCreate([0,RF.Count - 1], varVariant);
  8146.                  For X:=0 To RF.Count-1 do
  8147.                      Begin
  8148.                       FN:=Integer(RF.Objects[X])-1;
  8149.                       Result[X]:=TempRS.Fields.Item[FN].Value
  8150.                     End;
  8151.                End;
  8152.            End;
  8153.     End;
  8154.   TempRS.Close;
  8155.   {$IFDEF DYNADAO}
  8156.   TempRS:=NULL;
  8157.   {$ELSE}
  8158.   TempRS:=Nil;
  8159.   {$ENDIF}
  8160.   RS.Filter:=FT;
  8161.  Finally
  8162.   RF.Free;
  8163.   KV.Free;
  8164.   KF.Free;
  8165.  End; 
  8166. End;
  8167.  
  8168. Procedure TKADaoTable.RefreshLookups;
  8169. Var
  8170.   X : Integer;
  8171. Begin
  8172.   if NOT F_Active then Exit;
  8173.   For X := 0 to FieldCount-1 do
  8174.      Begin
  8175.        if (Fields[X].FieldKind=fkLookup) And (Fields[X].LookupCache) Then
  8176.           Fields[X].RefreshLookupList;
  8177.      End;
  8178. End;
  8179.  
  8180. {*************************************************************** DAO FIELD TYPES
  8181.   dbBoolean = 1;
  8182.   dbByte = 2;
  8183.   dbInteger = 3;
  8184.   dbLong = 4;
  8185.   dbCurrency = 5;
  8186.   dbSingle = 6;
  8187.   dbDouble = 7;
  8188.   dbDate = 8;
  8189.   dbBinary = 9;
  8190.   dbText = 10;
  8191.   dbLongBinary = 11;
  8192.   dbMemo = 12;
  8193.   dbGUID = 15;
  8194.   dbBigInt = 16;
  8195.   dbVarBinary = 17;
  8196.   dbChar = 18;
  8197.   dbNumeric = 19;
  8198.   dbDecimal = 20;
  8199.   dbFloat = 21;
  8200.   dbTime = 22;
  8201.   dbTimeStamp = 23;
  8202. //******************************************************************************
  8203. }
  8204.  
  8205. Function TKADaoTable.CreateField(FieldName:String;FieldType:Integer;FiledSize:Integer):Boolean;
  8206. Var
  8207.   FN,FT,FS,FI,FR:Variant;
  8208. Begin
  8209.   Result:=False;
  8210.   if F_TableName='' Then
  8211.      Begin
  8212.        DatabaseError(E2035);
  8213.        Exit;
  8214.      End;
  8215.   if Not Assigned(F_Database) Then
  8216.          Begin
  8217.            DatabaseError(E2036);
  8218.            Exit;
  8219.          End;
  8220.    if Not (F_Database.Connected) Then
  8221.          Begin
  8222.            DatabaseError(E2037);
  8223.            Exit;
  8224.          End;
  8225.   if F_Active Then
  8226.      Begin
  8227.       DatabaseError(E2038);
  8228.       Exit;
  8229.      End;
  8230.   FN:=VarArrayCreate([0, 0], varOleStr);
  8231.   FT:=VarArrayCreate([0, 0], varInteger);
  8232.   FS:=VarArrayCreate([0, 0], varInteger);
  8233.   FI:=VarArrayCreate([0, 0], varInteger);
  8234.   FR:=VarArrayCreate([0, 0], varInteger);
  8235.   FN[0]:=FieldName;
  8236.   FT[0]:=FieldType;
  8237.   FS[0]:=DaoSizeToBDESize(FieldType,FiledSize);
  8238.   FI[0]:=0;
  8239.   FR[0]:=0;
  8240.   Try
  8241.     Result:=F_Database.AddFieldsToTable(F_TableName,FN,FT,FS,FI,FR);
  8242.   Except
  8243.     Exit;
  8244.   End;
  8245.   VarClear(FN);FN:=NULL;
  8246.   VarClear(FT);FT:=NULL;
  8247.   VarClear(FS);FS:=NULL;
  8248.   VarClear(FI);FI:=NULL;
  8249.   VarClear(FR);FR:=NULL;
  8250. End;
  8251.  
  8252. Function TKADaoTable.CreateIndex(FieldName:String;IndexType:Integer):Boolean;
  8253. Begin
  8254.   Result:=False;
  8255.   if F_TableName='' Then
  8256.      Begin
  8257.        DatabaseError(E2039);
  8258.        Exit;
  8259.      End;
  8260.   if Not Assigned(F_Database) Then
  8261.      Begin
  8262.        DatabaseError(E2040);
  8263.        Exit;
  8264.      End;
  8265.    if Not (F_Database.Connected) Then
  8266.          Begin
  8267.            DatabaseError(E2041);
  8268.            Exit;
  8269.          End;
  8270.   if F_Active Then
  8271.      Begin
  8272.        DatabaseError(E2042);
  8273.        Exit;
  8274.      End;
  8275.   Result:=F_Database.CreateIndex(F_TableName,FieldName,IndexType);
  8276. End;
  8277.  
  8278. Function TKADaoTable.DeleteField(FieldName:String):Boolean;
  8279. Begin
  8280.   Result:=False;
  8281.   if F_TableName='' Then
  8282.      Begin
  8283.        DatabaseError(E2043);
  8284.        Exit;
  8285.      End;
  8286.   if Not Assigned(F_Database) Then
  8287.      Begin
  8288.        DatabaseError(E2044);
  8289.        Exit;
  8290.      End;
  8291.   if Not (F_Database.Connected) Then
  8292.      Begin
  8293.        DatabaseError(E2045);
  8294.        Exit;
  8295.      End;
  8296.   if F_Active Then
  8297.      Begin
  8298.        DatabaseError(E2046);
  8299.        Exit;
  8300.      End;
  8301.   Try
  8302.     F_Database.DeleteField(F_TableName,FieldName);
  8303.   Except
  8304.     Exit;
  8305.   End;
  8306.   Result:=True;
  8307. End;
  8308.  
  8309. Function TKADaoTable.DeleteIndex(FieldName:String):Boolean;
  8310. Begin
  8311.   Result:=False;
  8312.   if F_TableName='' Then
  8313.      Begin
  8314.        DatabaseError(E2047);
  8315.        Exit;
  8316.      End;
  8317.   if Not Assigned(F_Database) Then
  8318.      Begin
  8319.        DatabaseError(E2048);
  8320.        Exit;
  8321.      End;
  8322.   if F_Active Then
  8323.      Begin
  8324.        DatabaseError(E2049);
  8325.        Exit;
  8326.      End;
  8327.   if Not (F_Database.Connected) Then
  8328.      Begin
  8329.        DatabaseError(E2050);
  8330.        Exit;
  8331.      End;
  8332.  
  8333.   Try
  8334.     F_Database.DeleteIndexByFieldName(F_TableName,FieldName);
  8335.   Except
  8336.     Exit;
  8337.   End;
  8338.   Result:=True;
  8339. End;
  8340.  
  8341. Function TKADaoTable.EmptyTable:Boolean;
  8342. Begin
  8343.  Result := True;
  8344.  if IsEmpty Then Exit;
  8345.  if F_ReadOnly Then DatabaseError(E2064);
  8346.  BatchMode := True;
  8347.  Try
  8348.    First;
  8349.    While NOT EOF do
  8350.      Begin
  8351.        F_InPost := True;
  8352.        Delete;
  8353.        F_InPost := False;
  8354.      End;
  8355.   CursorPosChanged;
  8356.   Resync([]);
  8357.  Finally
  8358.    BatchMode:=False;
  8359.    F_InPost := False;
  8360.    Result := Not IsEmpty;
  8361.  End;
  8362. End;
  8363.  
  8364. //******************************************************************************
  8365. Procedure TKADaoTable.CreateTable;
  8366. Var
  8367.  TM : TKadaoTableManager;
  8368. Begin
  8369.  if F_Active Then DatabaseError(E2066);
  8370.  if F_TableName='' Then DatabaseError(E2067);
  8371.  TM := TKADaoTableManager.Create(F_Database);
  8372.  Try
  8373.   TM.TableName:=F_TableName;
  8374.   TM.FieldDefs.Assign(Self.FieldDefs);
  8375.   TM.IndexDefs.Assign(Self.IndexDefs);
  8376.   TM.CreateTable;
  8377.  Finally
  8378.   TM.Free;
  8379.  End;
  8380. End;
  8381.  
  8382. Procedure TKADaoTable.AppendTable;
  8383. Var
  8384.  TM : TKadaoTableManager;
  8385. Begin
  8386.  if F_Active Then DatabaseError(E2068);
  8387.  if F_TableName='' Then DatabaseError(E2069);
  8388.  TM := TKADaoTableManager.Create(F_Database);
  8389.  Try
  8390.   TM.TableName:=F_TableName;
  8391.   TM.FieldDefs.Assign(Self.FieldDefs);
  8392.   TM.IndexDefs.Assign(Self.IndexDefs);
  8393.   TM.AppendTable;
  8394.  Finally
  8395.   TM.Free;
  8396.  End;
  8397. End; 
  8398. //******************************************************************************
  8399.  
  8400. Function TKADaoTable.InsertSQLString(MDString: String): String;
  8401. Begin
  8402.   Result:='';
  8403.   if F_Filtered Then Result:= Filter;
  8404.   if MDString <> '' then
  8405.     Begin
  8406.       if Result <> '' Then
  8407.          Result := '('+MDString+') AND ('+Result+')'
  8408.       Else
  8409.          Result := MDString;
  8410.     End;
  8411. End;
  8412.  
  8413. //******************************************************************************
  8414. //*                  Master/Detail Handling
  8415. //******************************************************************************
  8416. Function  TKADaoTable.F_Get_MasterSource : TDataSource;
  8417. Begin
  8418.  Result:= F_MasterLink.DataSource;
  8419. End;
  8420.  
  8421. Procedure TKADaoTable.F_Set_MasterSource(Value: TDataSource);
  8422. Begin
  8423.  if IsLinkedTo(Value) then DatabaseError(E2057);
  8424.  if (Value=Nil) Then MasterFields.Clear;
  8425.  F_MasterLink.DataSource:= Value;
  8426.  if (Active) Then
  8427.      Begin
  8428.        CheckBrowseMode;
  8429.        ClearBuffers;
  8430.        CloseDaoRecordset;
  8431.        OpenDaoRecordset;
  8432.        ActivateBuffers;
  8433.        First;
  8434.      End;
  8435. End;
  8436.  
  8437. Procedure TKADaoTable.F_ProcessMasterFields(Value:TStrings);
  8438. Var
  8439.   X                       : Integer;
  8440.   I                       : Integer;
  8441.   S                       : String;
  8442.   MasterField,DetailField : String;
  8443.   FieldNames              : String;
  8444. Begin
  8445.   F_Detail.Clear;
  8446.   F_Master.Clear;
  8447.   if (Value.Count=1) And (Pos(';',Value.Strings[0]) > 0) Then
  8448.      Begin
  8449.        S := Value.Strings[0];
  8450.        Repeat
  8451.         I := Pos(';',S);
  8452.         if I > 0 Then
  8453.            Begin
  8454.             DetailField:=Copy(S,1,I-1);
  8455.             System.Delete(S,1,I);
  8456.            End
  8457.         Else
  8458.            Begin
  8459.             DetailField:=S;
  8460.            End;
  8461.         if Length(DetailField) > 0 Then
  8462.            Begin
  8463.             MasterField:=DetailField;
  8464.             F_Detail.Add(DetailField);
  8465.             F_Master.Add(MasterField);
  8466.            End;
  8467.        Until I = 0;
  8468.      End
  8469.   Else
  8470.   For X:=0 to Value.Count-1 do
  8471.       Begin
  8472.         S := Value.Strings[X];
  8473.         I := Pos(' -> ',S);
  8474.         if I > 0 Then
  8475.         Begin
  8476.          DetailField:=Copy(S,1,I-1);
  8477.          System.Delete(S,1,I+Length(' -> ')-1);
  8478.          MasterField:=S;
  8479.          F_Detail.Add(DetailField);
  8480.          F_Master.Add(MasterField);
  8481.         End;
  8482.       End;
  8483.   FieldNames:='';
  8484.   For X := 0 To F_Detail.Count-1 do
  8485.       Begin
  8486.         if X < F_Detail.Count-1 Then
  8487.            FieldNames:=FieldNames+F_Master.Strings[X]+';'
  8488.         Else
  8489.            FieldNames:=FieldNames+F_Master.Strings[X];
  8490.       End;
  8491.   F_MasterLink.FieldNames:=FieldNames;
  8492. End;
  8493.  
  8494. Procedure TKADaoTable.F_Set_MasterFields(Value:TStrings);
  8495. Begin
  8496.  F_MasterFields.SetText(Value.GetText);
  8497.  if (Active) Then
  8498.      Begin
  8499.        CheckBrowseMode;
  8500.        ClearBuffers;
  8501.        CloseDaoRecordset;
  8502.        OpenDaoRecordset;
  8503.        ActivateBuffers;
  8504.        First;
  8505.      End;
  8506. End;
  8507.  
  8508. Procedure TKADaoTable.F_Set_Master(Value:TStrings);
  8509. Begin
  8510.  F_Master.SetText(Value.GetText);
  8511. End;
  8512.  
  8513. Procedure TKADaoTable.F_Set_Detail(Value:TStrings);
  8514. Begin
  8515.  F_Detail.SetText(Value.GetText);
  8516. End;
  8517.  
  8518.  
  8519. Procedure TKADaoTable.MasterDatasetChanged;
  8520. Begin
  8521.   if csDestroying in ComponentState then EXIT;
  8522.   F_MDisabled := Not (F_MasterLink.Active);
  8523.   if (MasterSource <> NIL) And (Not F_MDisabled) then
  8524.   Begin
  8525.   //***************************************************************** 28.01.2002
  8526.   if NOT MasterSource.Enabled    Then Exit;
  8527.   if MasterSource.State = dsEdit Then Exit;  
  8528.   //***************************************************************** 28.01.2002
  8529.   if F_Master.Count > 0 Then
  8530.      Begin
  8531.       //*************************************************
  8532.       CheckBrowseMode;
  8533.       ClearBuffers;
  8534.       CloseDaoRecordset;
  8535.       if F_SQL.Count > 0 Then
  8536.          Begin
  8537.            OpenDaoRecordset
  8538.          End
  8539.       Else
  8540.          Begin
  8541.            Try
  8542.              ReOpenDaoRecordset;
  8543.            Except
  8544.              OpenDaoRecordset;
  8545.            End;
  8546.           End;
  8547.       ActivateBuffers;
  8548.       First;
  8549.       //*************************************************
  8550.      End;
  8551.   End;
  8552. End;
  8553.  
  8554.  
  8555. Procedure TKADaoTable.RefreshQueryParams;
  8556. var
  8557.   DataSet   : TDataSet;
  8558.   {$IFDEF USEPARAMS}{$IFNDEF VER100}{$IFNDEF VER110}
  8559.   X         : Integer;
  8560.   TempParam : TParam;
  8561.   {$ENDIF}{$ENDIF}{$ENDIF}
  8562. Begin
  8563.   Try
  8564.     if F_MasterLink.DataSource <> nil then
  8565.        Begin
  8566.         DataSet := F_MasterLink.DataSource.DataSet;
  8567.         if (DataSet <> Nil)
  8568.             And (DataSet.Active)
  8569.             And (DataSet.State <> dsSetKey) Then
  8570.               Begin
  8571.                 {$IFDEF USEPARAMS}{$IFNDEF VER100}{$IFNDEF VER110}
  8572.                 If ((F_ParamCheck) And (F_Params.Count > 0)) Then
  8573.                     Begin
  8574.                       For X := 0 to F_MasterLink.DataSource.DataSet.Fields.Count - 1 do
  8575.                         Begin
  8576.                           TempParam := F_Params.FindParam(F_MasterLink.DataSource.DataSet.Fields[X].FieldName);
  8577.                           if TempParam <> Nil Then
  8578.                              Begin
  8579.                                if TempParam.DataType=ftUnknown Then TempParam.DataType:=F_MasterLink.DataSource.DataSet.Fields[X].DataType;
  8580.                                TempParam.Assign(F_MasterLink.DataSource.DataSet.Fields[X]);
  8581.                              End;
  8582.                         End;
  8583.                     End;
  8584.                 {$ENDIF}{$ENDIF}{$ENDIF}
  8585.               End;
  8586.        End;
  8587.   Finally
  8588.   End;
  8589. End;
  8590.  
  8591.  
  8592. Procedure TKADaoTable.UpdateFromMaster;
  8593. Var
  8594.   X         : Integer;
  8595.   TempField : TField;
  8596. Begin
  8597.   For X := 0 to F_MasterLink.Fields.Count - 1 do
  8598.       Begin
  8599.        TempField := FieldByName(F_Detail.Strings[X]);
  8600.        TempField.Assign(TField(F_MasterLink.Fields[X]));
  8601.       End;
  8602. End;
  8603.  
  8604. Procedure TKADaoTable.DoOnNewRecord;
  8605. begin
  8606.   If (F_MasterLink.Active) And (F_MasterLink.Fields.Count>0) Then
  8607.      Begin
  8608.       UpdateFromMaster;
  8609.      End;
  8610.   inherited DoOnNewRecord;
  8611. end;
  8612.  
  8613. Procedure TKADaoTable.MasterChanged(Sender: TObject);
  8614. Begin
  8615.  if not Active then Exit;
  8616.  CheckBrowseMode;
  8617.  If (F_MasterLink.Active) And (F_MasterLink.Fields.Count>0)  Then
  8618.      Begin                                                              
  8619.       if (F_SQL.Count > 0) Then RefreshQueryParams;
  8620.       MasterDatasetChanged;                                                     
  8621.      End;
  8622. End;
  8623.  
  8624. Procedure TKADaoTable.MasterDisabled(Sender: TObject);
  8625. Begin
  8626.  CheckBrowseMode;
  8627.  F_MDisabled := Not (F_MasterLink.Active);
  8628. End;
  8629. //******************************************************************************
  8630. //*                         Blob Stream Handling
  8631. //******************************************************************************
  8632. Function TKADaoTable.BlobToString(Field:TBlobField; Data:OleVariant; DataSize:Integer):String;
  8633. Var
  8634.    P      : PChar;
  8635. Begin
  8636.   //***************************************************************** 22.09.2001
  8637.   Result := '';
  8638.   if VarIsNull(Data)  Then Exit;
  8639.   if VarIsEmpty(Data) Then Exit;
  8640.   if DataSize=0       Then Exit;
  8641.   //****************************************************************************
  8642.   if Field.BlobType=ftMemo Then
  8643.      Begin
  8644.        Result:=Data;
  8645.      End
  8646.   Else
  8647.      Begin
  8648.        P:=VarArrayLock(Data);
  8649.        SetString(Result,P,DataSize);
  8650.        VarArrayUnlock(Data);
  8651.      End;
  8652. End;
  8653.  
  8654. Function TKADaoTable.StringToBlob(Field:TBlobField; Data:String):OleVariant;
  8655. Var
  8656.    DataSize : Integer;
  8657.    P        : PChar;
  8658.    pData    : PChar;
  8659. Begin
  8660.    if Field.DataType=ftMemo Then
  8661.       Begin
  8662.         Result := Data;
  8663.       End
  8664.    Else
  8665.       Begin
  8666.         DataSize := Length(Data);
  8667.         Result := VarArrayCreate([0,DataSize-1],VarByte);
  8668.         P := VarArrayLock(Result);
  8669.         pData := PChar(Data);
  8670.         Move(pData[0],P[0],DataSize);
  8671.         VarArrayUnlock(Result);
  8672.      End;
  8673. End;
  8674.  
  8675. Constructor TKBlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode);
  8676. Var
  8677.    RD     : OleVariant;
  8678.    RS     : Integer;
  8679.    DInfo  : TDaoInfo;
  8680.    TempBK : Integer;
  8681. Begin
  8682.      F_BlobData := '';
  8683.      F_BlobSize := 0;
  8684.      Size       := F_BlobSize;
  8685.      F_Position := 0;
  8686.      F_Mode     := Mode;
  8687.      F_Field    := Field;
  8688.      F_Opened   := True;
  8689.      F_DataSet  := F_Field.DataSet as TKADaoTable;
  8690.      F_Buffer   := F_DataSet.GetActiveRecordBuffer;
  8691.      //************************************************** Table is empty so exit
  8692.      if F_Buffer = Nil Then Exit;
  8693.      //*************************************************************************
  8694.      if Mode = bmWrite then
  8695.         Begin
  8696.           if F_DataSet.ReadOnly Then DatabaseError(E2056);
  8697.           Truncate;
  8698.         End
  8699.      Else
  8700.      if Not F_Field.Modified Then
  8701.         Begin
  8702.            DInfo := PDaoInfo(F_Buffer+F_DataSet.F_StartMyInfo)^;
  8703.            //*******************************************************************
  8704.            //              CACHED MEMOS HANDLING
  8705.            //*******************************************************************
  8706.            if  (Field.DataType = ftMemo)
  8707.            And (F_Dataset.F_CacheMemos)  Then
  8708.                Begin
  8709.                  F_BlobData:=DInfo.RecordData.Strings[F_Field.FieldNo-1];
  8710.                  if (DInfo.RecordNo=-1) And (F_BlobData='') Then
  8711.                     F_BlobData := F_DataSet.F_DefaultValues.Strings[F_Field.FieldNo-1];
  8712.                  F_BlobSize:=Length(F_BlobData);
  8713.                  Size := F_BlobSize;
  8714.                  Exit;
  8715.                End;
  8716.            //*******************************************************************
  8717.            //              CACHED BLOBS HANDLING
  8718.            //*******************************************************************
  8719.            if  (Field.DataType = ftBlob)
  8720.            And (F_Dataset.F_CacheBlobs)  Then
  8721.                Begin
  8722.                  F_BlobData:=DInfo.RecordData.Strings[F_Field.FieldNo-1];
  8723.                  if (DInfo.RecordNo=-1) And (F_BlobData='') Then
  8724.                     F_BlobData := F_DataSet.F_DefaultValues.Strings[F_Field.FieldNo-1];
  8725.                  F_BlobSize:=Length(F_BlobData);
  8726.                  Size := F_BlobSize;
  8727.                  Exit;
  8728.                End;
  8729.             //*******************************************************************
  8730.            //            Save Current Position and go to the desired row
  8731.            //*******************************************************************
  8732.             TempBK := F_DataSet.GetDaoBookmark(F_DataSet.F_DaoTable);
  8733.             if DInfo.BookmarkData > 0 Then
  8734.                F_DataSet.InternalMoveToBookmark(@DInfo.BookmarkData);
  8735.            //*******************************************************************
  8736.            //   UNIQUE CODE TO SUPPORT BOTH VIEW OF BLOBS IN GRIDS
  8737.            //   AND DEFAULT VALUES FOR BLOBS
  8738.            //*******************************************************************
  8739.            if (F_DataSet.State = dsInsert) And (DInfo.RecordNo=-1) Then
  8740.               Begin
  8741.                 F_BlobData := '';
  8742.                 F_BlobData := DInfo.RecordData.Strings[F_Field.FieldNo-1];
  8743.                 if (F_BlobData='') And
  8744.                    (F_DataSet.F_DefaultValues.Strings[F_Field.FieldNo-1] <> '') Then
  8745.                     Begin
  8746.                       F_BlobData := F_DataSet.F_DefaultValues.Strings[F_Field.FieldNo-1];
  8747.                     End;
  8748.               End
  8749.            Else
  8750.               Begin
  8751.                 Try
  8752.                   //************************************************* 01.02.2002
  8753.                   RD:=F_DataSet.F_DaoTable.Fields.Item[F_Field.FieldNo-1].Value;
  8754.                   RS:=F_DataSet.F_DaoTable.Fields.Item[F_Field.FieldNo-1].FieldSize;
  8755.                   if VarType(RD) = varNull Then
  8756.                      F_BlobData := ''
  8757.                   Else
  8758.                      F_BlobData:=F_DataSet.BlobToString(F_Field,RD,RS);
  8759.                   if F_DataSet.F_HasEncoder Then
  8760.                      Begin
  8761.                       //*******************************************
  8762.                       // Perform Decoding here
  8763.                       //*******************************************
  8764.                        SetStrProp(F_DataSet.F_Encrypter, F_DataSet.F_EncodedString,F_BlobData);
  8765.                        F_BlobData:=GetStrProp(F_DataSet.F_Encrypter, F_DataSet.F_DecodedString);
  8766.                      End;
  8767.                   //************************************************* 01.02.2002
  8768.                 Except
  8769.                   F_BlobData:='';
  8770.                   if F_DataSet.F_TableType <> dbOpenForwardOnly Then F_DataSet.DaoInternalRefresh;
  8771.                 End;
  8772.               End;
  8773.            F_BlobSize:=Length(F_BlobData);
  8774.            Size := F_BlobSize;
  8775.            //******************************************************** Reposition
  8776.            if TempBK > 0 Then
  8777.               Begin
  8778.                F_DataSet.InternalMoveToBookmark(@TempBK);
  8779.               End;
  8780.            //*******************************************************************
  8781.         End;
  8782. End;                                  
  8783.  
  8784.  
  8785. Destructor TKBlobStream.Destroy;
  8786. Begin
  8787.  if F_Modified then
  8788.    try                                                                                           
  8789.      F_DataSet.DataEvent(deFieldChange, Longint(F_Field));
  8790.      F_BlobData := '';
  8791.      F_Buffer   := Nil;
  8792.      F_Opened   := False;
  8793.    Except
  8794.      Application.HandleException(Self);
  8795.    End;
  8796. End;
  8797.  
  8798.  
  8799. Function TKBlobStream.Read(var Buffer; Count: Longint): Longint;
  8800. Begin
  8801.   Result := 0;
  8802.   if F_Opened then
  8803.   Begin
  8804.     if Count > Size - F_Position then
  8805.        Result := Size - F_Position
  8806.     Else
  8807.        Result := Count;
  8808.     if Result > 0 then
  8809.        Begin
  8810.          Move(PChar(F_BlobData)[F_Position], Buffer, Result);
  8811.          Inc(F_Position, Result);
  8812.        End;
  8813.      End;
  8814. End;
  8815.  
  8816.  
  8817. Function TKBlobStream.Write(const Buffer; Count: Longint): Longint;
  8818. var
  8819.    pTemp  : Pointer;
  8820.    sTemp  : String;
  8821.    RData  : TStringList;
  8822. Begin
  8823.  Result := 0;
  8824.  if F_Opened then
  8825.     Begin
  8826.      try
  8827.        SetLength(sTemp,Count);
  8828.        pTemp:=PChar(sTemp);
  8829.        CopyMemory(pTemp, @Buffer, Count);
  8830.        F_BlobData  := Copy(F_BlobData,1,F_Position)+sTemp;
  8831.        F_BlobSize  := Length(F_BlobData);
  8832.        Size := F_BlobSize;
  8833.        RData:=PDaoInfo(F_Buffer+F_DataSet.F_StartMyInfo)^.RecordData;
  8834.        RData.Strings[F_Field.FieldNo-1]:=F_BlobData;
  8835.        RData.Objects[F_Field.FieldNo-1]:=TObject(True);
  8836.        F_Modified := True;
  8837.      Finally
  8838.      End;
  8839.      Inc(F_Position, Count);
  8840.      Result := Count;
  8841.      F_Modified := True;
  8842.    End;
  8843. End;
  8844.  
  8845.  
  8846. Function TKBlobStream.Seek(Offset: Longint; Origin: Word): Longint;
  8847. Begin
  8848.  Case Origin of
  8849.       0: F_Position := Offset;
  8850.       1: Inc(F_Position, Offset);
  8851.       2: F_Position := F_BlobSize + Offset;
  8852.  End;
  8853.  Result := F_Position;
  8854. End;
  8855.  
  8856.  
  8857. Procedure TKBlobStream.Truncate;
  8858. Var
  8859.    RData  : TStringList;
  8860. Begin
  8861.  if F_Opened then
  8862.     Begin
  8863.      RData:=PDaoInfo(F_Buffer+F_DataSet.F_StartMyInfo)^.RecordData;
  8864.      SetLength(F_BlobData,F_Position);
  8865.      F_BlobSize  := Length(F_BlobData);
  8866.      Size := F_BlobSize;
  8867.      RData.Strings[F_Field.FieldNo-1]:=F_BlobData;
  8868.      RData.Objects[F_Field.FieldNo-1]:=TObject(True);
  8869.      F_Modified := True;
  8870.    End;
  8871. End;
  8872.  
  8873. //***********************************************************************************
  8874. Function TKADaoTable.IntegerToBuffer(Buffer: Pointer; S: String): Boolean;
  8875. Begin
  8876.      Result:=False;
  8877.      if Buffer=Nil Then Exit;
  8878.      Result := (S <> '');
  8879.      if S = '' then S := '0';
  8880.      Try
  8881.        Integer(Buffer^) := StrToInt(S);
  8882.      Except
  8883.        Try
  8884.          Integer(Buffer^) := Round(StrToFloat(S));
  8885.        Except
  8886.        End;  
  8887.      End;
  8888. End;
  8889.  
  8890.  
  8891. Function TKADaoTable.FloatToBuffer(Buffer: Pointer; S: String): Boolean;
  8892. Begin
  8893.      Result:=False;
  8894.      if Buffer=Nil Then Exit;
  8895.      Result := (S <> '');
  8896.      if S = '' then S := '0';
  8897.      Try
  8898.        Double(Buffer^) := StrToFloat(S);
  8899.      Except
  8900.      End;
  8901. End;                                                         
  8902.  
  8903. Function TKADaoTable.BooleanToBuffer(Buffer: Pointer; S: String): Boolean;
  8904. Begin
  8905.      Result:=False;
  8906.      if Buffer=Nil Then Exit;
  8907.      Result := (S <> '');
  8908.      //************************************************************** 25.01.2002
  8909.      if Result Then
  8910.         Begin
  8911.          if S[1]='=' Then System.Delete(S,1,1);
  8912.          if AnsiLowerCase(S)='false' Then S := '0'
  8913.          Else
  8914.          if AnsiLowerCase(S)='true'  Then S := '1'
  8915.          Else
  8916.          if AnsiLowerCase(S)='no'    Then S := '0'
  8917.          Else
  8918.          if AnsiLowerCase(S)='yes'   Then S := '1'
  8919.          Else
  8920.          if AnsiLowerCase(S)='on'    Then S := '1'
  8921.          Else
  8922.          if AnsiLowerCase(S)='off'   Then S := '0'
  8923.          Else
  8924.          if S = ''    Then S := '0'
  8925.          Else
  8926.          if S = '-1'  Then S := '1';
  8927.          Try
  8928.           WordBool(Buffer^) := WordBool(StrToInt(S));
  8929.          Except
  8930.          End;
  8931.         End;
  8932. End;
  8933.  
  8934. //************************************************************************** OK
  8935. Function TKADaoTable.DateToBuffer(Buffer: Pointer; S: String): Boolean;
  8936. var
  8937.    Ttmp : TTimeStamp;
  8938.    Dtmp : ^TDateTimeRec;
  8939.    P    : Integer;
  8940. Begin
  8941.  Result:=False;
  8942.  if Buffer=Nil Then Exit;
  8943.  P := Pos(' ',S);
  8944.  if P=0 Then Exit;
  8945.  Try
  8946.   Ttmp.Date:=StrToInt(Copy(S,1,P-1));
  8947.   System.Delete(S,1,P);
  8948.   Ttmp.Time:=StrToInt(S);
  8949.   Dtmp := Buffer;
  8950.   Dtmp^.Date := Ttmp.Date;
  8951.   Result:=True;
  8952.  Except
  8953.  End;
  8954. End;
  8955.  
  8956.  
  8957. //************************************************************************** OK
  8958. Function TKADaoTable.TimeToBuffer(Buffer: Pointer; S: String): Boolean;
  8959. var
  8960.    Ttmp : TTimeStamp;
  8961.    Dtmp : ^TTimeStamp;
  8962.    P    : Integer;
  8963. Begin
  8964.  Result:=False;
  8965.  if Buffer=Nil Then Exit;
  8966.  P := Pos(' ',S);
  8967.  if P=0 Then Exit;
  8968.  Try
  8969.   Ttmp.Date:=StrToInt(Copy(S,1,P-1));
  8970.   System.Delete(S,1,P);
  8971.   Ttmp.Time:=StrToInt(S);
  8972.   Dtmp:=Buffer;
  8973.   Dtmp^.Time:=Ttmp.Time;
  8974.   Result:=True;
  8975.  Except
  8976.  End;
  8977. End;
  8978.  
  8979. //************************************************************************** OK
  8980. Function TKADaoTable.DateTimeToBuffer(Buffer: Pointer; S: String): Boolean;
  8981. var
  8982.    Ttmp : TTimeStamp;
  8983.    Dtmp : ^TDateTimeRec;
  8984.    P    : Integer;
  8985. Begin
  8986.  Result:=False;
  8987.  if Buffer=Nil Then Exit;
  8988.  P := Pos(' ',S);
  8989.  if P=0 Then Exit;
  8990.  Try
  8991.   Ttmp.Date:=StrToInt(Copy(S,1,P-1));
  8992.   System.Delete(S,1,P);
  8993.   Ttmp.Time:=StrToInt(S);
  8994.   Dtmp := Buffer;
  8995.   Dtmp^.DateTime := TimeStampToMSecs(Ttmp);
  8996.   Result:=True;
  8997.  Except
  8998.  End;
  8999. End;
  9000.  
  9001. //************************************************************************** OK
  9002. Function TKADaoTable.GUIDToBuffer(Buffer: Pointer; S: String): Boolean;
  9003. Var
  9004.   BGUID : TGUID;
  9005.   PGUID : Pointer;
  9006.   SGUID : String;
  9007.   P     : Integer;
  9008. Begin
  9009.   Result:=False;
  9010.   if Buffer=Nil Then Exit;
  9011.   Result := (S <> '');
  9012.   if S = '' Then Exit;
  9013.   PGUID  := @BGUID;
  9014.   SGUID  := S;
  9015.   P := Pos('{guid ',SGUID);
  9016.   if P = 1 Then
  9017.      Begin
  9018.        System.Delete(SGUID,1,6);
  9019.        P := Pos('}}',SGUID);
  9020.        if P = Length(SGUID)-1 Then System.Delete(SGUID,P,1);
  9021.      End;
  9022.   BGUID := StringToGUID(AnsiUpperCase(SGUID));
  9023.   Move(PGUID^,Buffer^,SizeOf(TGUID));
  9024. End;
  9025.  
  9026. //************************************************************************** OK
  9027. Function TKADaoTable.BufferToGUID(Buffer:Pointer):String;
  9028. Var
  9029.  S  : String;
  9030. Begin
  9031.  Result := '';
  9032.  S   := AnsiUpperCase(GUIDToString(TGUID(Buffer^)));
  9033.  if S = AnsiUpperCase(GUIDToString(GUID_NULL)) Then Exit;
  9034.  Result := '{guid '+S+'}';
  9035. End;
  9036.  
  9037. //************************************************************************** OK
  9038. Function  TKADaoTable.GetGUIDAsString(GUID : String):String;
  9039. Var
  9040.   BGUID : TGUID;
  9041.   PGUID : Pointer;
  9042.   SGUID : String;
  9043. Begin
  9044.   Result  := '';
  9045.   if Length(GUID) <> SizeOF(TGUID) Then Exit;
  9046.   PGUID  := @BGUID;
  9047.   SGUID  := GUID;
  9048.   Move(SGUID[1],PGUID^,SizeOf(TGUID));
  9049.   Result := GUIDToString(BGUID);
  9050.   if AnsiUpperCase(Result)=AnsiUpperCase(GUIDToString(GUID_NULL)) Then Result:='';
  9051. End;
  9052.  
  9053. //************************************************************************** OK
  9054. Function  TKADaoTable.GetStringAsGUID(GUID : String) : TGUID;
  9055. Begin
  9056.  Result := StringToGUID(GUID);
  9057. End;
  9058.  
  9059. //************************************************************************** OK
  9060. Function  TKADaoTable.PutGUIDInString(GUID : String):String;
  9061. Var
  9062.  BGUID : TGUID;
  9063.  PGUID : Pointer;
  9064. Begin
  9065.  PGUID  := @BGUID;
  9066.  BGUID  := StringToGUID(GUID);
  9067.  SetString(Result,PChar(PGUID),SizeOf(TGUID)) ;
  9068. End;
  9069.  
  9070. //************************************************************************** OK
  9071. Function TKADaoTable.BufferToDate(Buffer: Pointer): String;
  9072. var
  9073.    Dtmp : ^TDateTimeRec;
  9074. Begin
  9075.      Result := '';
  9076.      Dtmp   := Buffer;
  9077.      if Dtmp=Nil Then Exit;
  9078.      Try
  9079.        Result := IntToStr(Dtmp.Date)+' '+IntToStr(0);
  9080.      Except
  9081.       Result := '';
  9082.      End;
  9083. End;
  9084.  
  9085. //************************************************************************** OK
  9086. Function TKADaoTable.BufferToDateTime(Buffer: Pointer): String;
  9087. var
  9088.    TTmp : TTimeStamp;
  9089.    Dtmp : ^TDateTimeRec;
  9090. Begin
  9091.      Result := '';
  9092.      Dtmp   := Buffer;
  9093.      if Dtmp=Nil Then Exit;
  9094.      Ttmp   := MsecsToTimeStamp(Dtmp.DateTime);
  9095.      Try
  9096.        Result := IntToStr(Ttmp.Date)+' '+IntToStr(Ttmp.Time);
  9097.      Except
  9098.        Result := '';
  9099.      End;
  9100. End;
  9101.  
  9102. //************************************************************************** OK
  9103. Function TKADaoTable.BufferToTime(Buffer: Pointer): String;
  9104. var
  9105.    Dtmp : ^TTimeStamp;
  9106. Begin
  9107.      Result := '';
  9108.      Dtmp   := Buffer;
  9109.      if Dtmp=Nil Then Exit;
  9110.      //******************************* SHAME MICROSOFT!!!
  9111.      Try
  9112.        Result := IntToStr(693594)+' '+IntToStr(Dtmp.Time);
  9113.      Except
  9114.        Result := '';
  9115.      End;
  9116. End;
  9117.  
  9118.  
  9119. //***************************************************************** TPARAMETERS
  9120. {$IFDEF USEPARAMS}
  9121.  {$IFNDEF VER100}
  9122.   {$IFNDEF VER110}
  9123. Procedure TKADaoTable.SetParamsList(Value: TParams);
  9124. begin
  9125.     F_Params.AssignValues(Value);
  9126. end;
  9127.  
  9128. Procedure TKADaoTable.UpdateParamsList(Sender: TObject);
  9129. var
  9130.     List: TParams;
  9131. begin
  9132.     if not (csReading in ComponentState) then
  9133.         if ParamCheck or (csDesigning in ComponentState) then
  9134.         begin
  9135.             List := TParams.Create(Self);
  9136.             try
  9137.                 List.ParseSQL(SQL.Text, True);
  9138.                 List.AssignValues(F_Params);
  9139.                 F_Params.Clear;
  9140.                 F_Params.Assign(List);
  9141.             finally
  9142.                 List.Free;
  9143.             end;
  9144.         end;
  9145. end;
  9146.  
  9147. Function TKADaoTable.GetParamsCount: Word;
  9148. begin
  9149.     Result := F_Params.Count;
  9150. end;
  9151.  
  9152. Procedure TKADaoTable.DefineProperties(Filer: TFiler);
  9153.  
  9154.     Function WriteData: Boolean;
  9155.     begin
  9156.         if Filer.Ancestor <> nil then
  9157.             Result := not F_Params.IsEqual(TKADaoTable(Filer.Ancestor).F_Params)
  9158.         else
  9159.             Result := F_Params.Count > 0;
  9160.     end;
  9161.  
  9162. begin
  9163.     inherited DefineProperties(Filer);
  9164.     Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, WriteData);
  9165. end;
  9166.  
  9167. Procedure TKADaoTable.ReadParamData(Reader: TReader);
  9168. begin
  9169.     Reader.ReadValue;
  9170.     Reader.ReadCollection(F_Params);
  9171. end;
  9172.  
  9173. Procedure TKADaoTable.WriteParamData(Writer: TWriter);
  9174. begin
  9175.     Writer.WriteCollection(Params);
  9176. end;
  9177.    {$ENDIF}
  9178.  {$ENDIF}
  9179. {$ENDIF}
  9180. //************************************************************** TPARAMETERS END
  9181.  
  9182. Procedure Register;
  9183. Begin
  9184.     RegisterComponents('KA Dao', [TKADaoTable]);
  9185. End;
  9186. end.
  9187.  
  9188.  
  9189.