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