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