customsqliteds.pas 52 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783
  1. unit CustomSqliteDS;
  2. {
  3. This is TCustomSqliteDataset, a TDataset descendant class for use with fpc compiler
  4. Copyright (C) 2004-2007 Luiz Américo Pereira Câmara
  5. Email: [email protected]
  6. This library is free software; you can redistribute it and/or modify it
  7. under the terms of the GNU Library General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or (at your
  9. option) any later version with the following modification:
  10. As a special exception, the copyright holders of this library give you
  11. permission to link this library with independent modules to produce an
  12. executable, regardless of the license terms of these independent modules,and
  13. to copy and distribute the resulting executable under terms of your choice,
  14. provided that you also meet, for each linked independent module, the terms
  15. and conditions of the license of that module. An independent module is a
  16. module which is not derived from or based on this library. If you modify
  17. this library, you may extend this exception to your version of the library,
  18. but you are not obligated to do so. If you do not wish to do so, delete this
  19. exception statement from your version.
  20. This program is distributed in the hope that it will be useful, but WITHOUT
  21. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  22. FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
  23. for more details.
  24. You should have received a copy of the GNU Library General Public License
  25. along with this library; if not, write to the Free Software Foundation,
  26. Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  27. }
  28. {$Mode ObjFpc}
  29. {$H+}
  30. {.$Define DEBUG_SQLITEDS}
  31. {.$Define DEBUGACTIVEBUFFER}
  32. interface
  33. uses
  34. Classes, SysUtils, db;
  35. type
  36. PDataRecord = ^DataRecord;
  37. PPDataRecord = ^PDataRecord;
  38. DataRecord = record
  39. Row: PPChar;
  40. BookmarkFlag: TBookmarkFlag;
  41. Next: PDataRecord;
  42. Previous: PDataRecord;
  43. end;
  44. TDSStream = class(TStream)
  45. private
  46. FActiveItem: PDataRecord;
  47. FFieldRow: PChar;
  48. FFieldIndex: Integer;
  49. FRowSize: Integer;
  50. FPosition: LongInt;
  51. public
  52. constructor Create(const ActiveItem: PDataRecord; FieldIndex: Integer);
  53. function Write(const Buffer; Count: LongInt): LongInt; override;
  54. function Read(var Buffer; Count: LongInt): LongInt; override;
  55. function Seek(Offset: LongInt; Origin: Word): LongInt; override;
  56. end;
  57. //callback types
  58. TSqliteCdeclCallback = function(UserData: Pointer; Count: LongInt; Values: PPChar; Names: PPChar): LongInt; cdecl;
  59. TSqliteCallback = function(UserData: Pointer; Count: LongInt; Values: PPChar; Names: PPChar): LongInt of object;
  60. TCallbackInfo = record
  61. Proc: TSqliteCallback;
  62. Data: Pointer;
  63. end;
  64. PCallbackInfo = ^TCallbackInfo;
  65. TRecordState = (rsAdded, rsDeleted, rsUpdated);
  66. TRecordStateSet = set of TRecordState;
  67. TQueryUpdatesCallback = procedure(UserData: Pointer; Values: PPChar; ABookmark: TBookmark; RecordState: TRecordState) of object;
  68. TGetSqlStrFunction = function(APChar: PChar): String;
  69. TSqliteOption = (soWildcardKey);
  70. TSqliteOptions = set of TSqliteOption;
  71. { TCustomSqliteDataset }
  72. TCustomSqliteDataset = class(TDataSet)
  73. private
  74. {$ifdef DEBUGACTIVEBUFFER}
  75. FFCurrentItem: PDataRecord;
  76. {$else}
  77. FCurrentItem: PDataRecord;
  78. {$endif}
  79. FInternalActiveBuffer: PDataRecord;
  80. FInsertBookmark: PDataRecord;
  81. FOnCallback: TSqliteCallback;
  82. FMasterLink: TMasterDataLink;
  83. FIndexFieldNames: String;
  84. FIndexFieldList: TList;
  85. FOnGetHandle: TDataSetNotifyEvent;
  86. FOptions: TSqliteOptions;
  87. FSQLList: TStrings;
  88. procedure CopyCacheToItem(AItem: PDataRecord);
  89. function GetIndexFields(Value: Integer): TField;
  90. procedure SetMasterIndexValue;
  91. procedure SetOptions(const AValue: TSqliteOptions);
  92. procedure UpdateCalcFieldList;
  93. procedure UpdateIndexFieldList;
  94. function FindRecordItem(StartItem: PDataRecord; const KeyFields: string; const KeyValues: Variant; LocateOptions: TLocateOptions; DoResync: Boolean): PDataRecord;
  95. procedure UpdateMasterDetailProperties;
  96. protected
  97. FPrimaryKey: String;
  98. FPrimaryKeyNo: Integer;
  99. FFileName: String;
  100. FSQL: String;
  101. FTableName: String;
  102. FSqlFilterTemplate: String;
  103. FAutoIncFieldNo: Integer;
  104. FNextAutoInc: Integer;
  105. FUpdatedItems: TFPList;
  106. FAddedItems: TFPList;
  107. FDeletedItems: TFPList;
  108. FCalcFieldList: TFPList;
  109. FReturnCode: Integer;
  110. FSqliteHandle: Pointer;
  111. FRowBufferSize: Integer;
  112. FRowCount: Integer;
  113. FRecordCount: Integer;
  114. FBeginItem: PDataRecord;
  115. FEndItem: PDataRecord;
  116. FCacheItem: PDataRecord;
  117. FGetSqlStr: array of TGetSqlStrFunction;
  118. FSaveOnClose: Boolean;
  119. FSaveOnRefetch: Boolean;
  120. FAutoIncrementKey: Boolean;
  121. FDataAllocated: Boolean;
  122. function SqliteExec(Sql: PChar; ACallback: TSqliteCdeclCallback; Data: Pointer): Integer; virtual; abstract;
  123. procedure InternalCloseHandle; virtual; abstract;
  124. function InternalGetHandle: Pointer; virtual; abstract;
  125. procedure GetSqliteHandle;
  126. function GetSqliteVersion: String; virtual; abstract;
  127. procedure BuildLinkedList; virtual; abstract;
  128. procedure FreeItem(AItem: PDataRecord);
  129. procedure DisposeLinkedList;
  130. procedure SetDetailFilter;
  131. procedure MasterChanged(Sender: TObject);
  132. procedure SetMasterFields(const Value: String);
  133. function GetMasterFields: String;
  134. procedure SetMasterSource(Value: TDataSource);
  135. function GetMasterSource: TDataSource;
  136. procedure SetFileName(const Value: String);
  137. function GetRowsAffected: Integer; virtual; abstract;
  138. procedure RetrieveFieldDefs; virtual; abstract;
  139. //TDataSet overrides
  140. function AllocRecordBuffer: PChar; override;
  141. procedure ClearCalcFields(Buffer: PChar); override;
  142. function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
  143. procedure DoBeforeClose; override;
  144. procedure DoAfterInsert; override;
  145. procedure DoBeforeInsert; override;
  146. procedure FreeRecordBuffer(var Buffer: PChar); override;
  147. procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
  148. function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
  149. function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
  150. function GetRecordCount: Integer; override;
  151. function GetRecNo: Integer; override;
  152. function GetRecordSize: Word; override;
  153. procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
  154. procedure InternalClose; override;
  155. procedure InternalCancel; override;
  156. procedure InternalDelete; override;
  157. procedure InternalEdit; override;
  158. procedure InternalFirst; override;
  159. procedure InternalGotoBookmark(ABookmark: Pointer); override;
  160. procedure InternalInitFieldDefs; override;
  161. procedure InternalInitRecord(Buffer: PChar); override;
  162. procedure InternalLast; override;
  163. procedure InternalOpen; override;
  164. procedure InternalPost; override;
  165. procedure InternalSetToRecord(Buffer: PChar); override;
  166. function IsCursorOpen: Boolean; override;
  167. procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  168. procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
  169. procedure SetExpectedAppends(AValue: Integer);
  170. procedure SetExpectedUpdates(AValue: Integer);
  171. procedure SetExpectedDeletes(AValue: Integer);
  172. procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  173. procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); override;
  174. procedure SetRecNo(Value: Integer); override;
  175. public
  176. constructor Create(AOwner: TComponent); override;
  177. destructor Destroy; override;
  178. function BookmarkValid(ABookmark: TBookmark): Boolean; override;
  179. function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
  180. function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
  181. function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; override;
  182. function Locate(const KeyFields: String; const KeyValues: Variant; LocateOptions: TLocateOptions) : Boolean; override;
  183. function LocateNext(const KeyFields: String; const KeyValues: Variant; LocateOptions: TLocateOptions) : Boolean;
  184. function Lookup(const KeyFields: String; const KeyValues: Variant; const ResultFields: String): Variant; override;
  185. // Additional procedures
  186. function ApplyUpdates: Boolean;
  187. function CreateTable: Boolean;
  188. function CreateTable(const ATableName: String): Boolean;
  189. procedure ExecCallback(const ASql: String; UserData: Pointer = nil);
  190. procedure ExecSQL;
  191. procedure ExecSQL(const ASql: String);
  192. procedure ExecSQLList;
  193. procedure ExecuteDirect(const ASql: String); virtual; abstract;
  194. procedure QueryUpdates(RecordStates: TRecordStateSet; Callback: TQueryUpdatesCallback; UserData: Pointer = nil);
  195. function QuickQuery(const ASql: String):String;overload;
  196. function QuickQuery(const ASql: String; const AStrList: TStrings): String; overload;
  197. function QuickQuery(const ASql: String; const AStrList: TStrings; FillObjects: Boolean):String; virtual; abstract; overload;
  198. procedure RefetchData;
  199. function ReturnString: String; virtual; abstract;
  200. function TableExists: Boolean;
  201. function TableExists(const ATableName: String): Boolean;
  202. function UpdatesPending: Boolean;
  203. {$ifdef DEBUGACTIVEBUFFER}
  204. procedure SetCurrentItem(Value: PDataRecord);
  205. property FCurrentItem: PDataRecord read FFCurrentItem write SetCurrentItem;
  206. {$endif}
  207. property ExpectedAppends: Integer write SetExpectedAppends;
  208. property ExpectedUpdates: Integer write SetExpectedUpdates;
  209. property ExpectedDeletes: Integer write SetExpectedDeletes;
  210. property IndexFields[Value: Integer]: TField read GetIndexFields;
  211. property RowsAffected: Integer read GetRowsAffected;
  212. property ReturnCode: Integer read FReturnCode;
  213. property SqliteHandle: Pointer read FSqliteHandle;
  214. property SqliteVersion: String read GetSqliteVersion;
  215. property SQLList:TStrings read FSQLList;
  216. published
  217. property AutoIncrementKey: Boolean read FAutoIncrementKey write FAutoIncrementKey;
  218. property IndexFieldNames: string read FIndexFieldNames write FIndexFieldNames;
  219. property FileName: String read FFileName write SetFileName;
  220. property OnCallback: TSqliteCallback read FOnCallback write FOnCallback;
  221. property OnGetHandle: TDataSetNotifyEvent read FOnGetHandle write FOnGetHandle;
  222. property Options: TSqliteOptions read FOptions write SetOptions;
  223. property PrimaryKey: String read FPrimaryKey write FPrimaryKey;
  224. property SaveOnClose: Boolean read FSaveOnClose write FSaveOnClose;
  225. property SaveOnRefetch: Boolean read FSaveOnRefetch write FSaveOnRefetch;
  226. property SQL: String read FSQL write FSQL;
  227. property TableName: String read FTableName write FTableName;
  228. property MasterSource: TDataSource read GetMasterSource write SetMasterSource;
  229. property MasterFields: String read GetMasterFields write SetMasterFields;
  230. property Active;
  231. property FieldDefs;
  232. //Events
  233. property BeforeOpen;
  234. property AfterOpen;
  235. property BeforeClose;
  236. property AfterClose;
  237. property BeforeInsert;
  238. property AfterInsert;
  239. property BeforeEdit;
  240. property AfterEdit;
  241. property BeforePost;
  242. property AfterPost;
  243. property BeforeCancel;
  244. property AfterCancel;
  245. property BeforeDelete;
  246. property AfterDelete;
  247. property BeforeScroll;
  248. property AfterScroll;
  249. property BeforeRefresh;
  250. property AfterRefresh;
  251. property OnCalcFields;
  252. property OnDeleteError;
  253. property OnEditError;
  254. property OnNewRecord;
  255. property OnPostError;
  256. end;
  257. function Num2SQLStr(APChar: PChar): String;
  258. function Char2SQLStr(APChar: PChar): String;
  259. implementation
  260. uses
  261. strutils, variants, dbconst;
  262. const
  263. //sqlite2.x.x and sqlite3.x.x define these constants equally
  264. SQLITE_OK = 0;
  265. SQLITE_ROW = 100;
  266. NullString = 'NULL';
  267. function CallbackDispatcher(UserData: Pointer; Count: LongInt; Values: PPchar; Names: PPchar): LongInt; cdecl;
  268. begin
  269. with PCallbackInfo(UserData)^ do
  270. Result:= Proc(Data, Count, Values, Names);
  271. end;
  272. function Num2SQLStr(APChar: PChar): String;
  273. begin
  274. if APChar = nil then
  275. begin
  276. Result := NullString;
  277. Exit;
  278. end;
  279. Result := String(APChar);
  280. end;
  281. function Char2SQLStr(APChar: PChar): String;
  282. begin
  283. if APChar = nil then
  284. begin
  285. Result := NullString;
  286. Exit;
  287. end;
  288. //todo: create custom routine to directly transform PChar -> SQL str
  289. Result := String(APChar);
  290. if Pos('''', Result) > 0 then
  291. Result := AnsiReplaceStr(Result, '''', '''''');
  292. Result := '''' + Result + '''';
  293. end;
  294. // TDSStream
  295. constructor TDSStream.Create(const ActiveItem: PDataRecord; FieldIndex: Integer);
  296. begin
  297. inherited Create;
  298. //FPosition := 0;
  299. FActiveItem := ActiveItem;
  300. FFieldIndex := FieldIndex;
  301. FFieldRow := ActiveItem^.Row[FieldIndex];
  302. if FFieldRow <> nil then
  303. FRowSize := StrLen(FFieldRow);
  304. //else
  305. // FRowSize := 0;
  306. end;
  307. function TDSStream.Seek(Offset: LongInt; Origin: Word): LongInt;
  308. begin
  309. Case Origin of
  310. soFromBeginning : FPosition := Offset;
  311. soFromEnd : FPosition := FRowSize + Offset;
  312. soFromCurrent : FPosition := FPosition + Offset;
  313. end;
  314. Result := FPosition;
  315. end;
  316. function TDSStream.Write(const Buffer; Count: LongInt): LongInt;
  317. var
  318. NewRow: PChar;
  319. begin
  320. Result := Count;
  321. if Count = 0 then
  322. Exit;
  323. //FRowSize is always 0 when FPosition = 0,
  324. //so there's no need to check FPosition
  325. NewRow := StrAlloc(FRowSize + Count + 1);
  326. (NewRow + Count + FRowSize)^ := #0;
  327. if FRowSize > 0 then
  328. Move(FFieldRow^, NewRow^, FRowSize);
  329. Move(Buffer, (NewRow + FRowSize)^, Count);
  330. FActiveItem^.Row[FFieldIndex] := NewRow;
  331. StrDispose(FFieldRow);
  332. {$ifdef DEBUG_SQLITEDS}
  333. WriteLn('##TDSStream.Write##');
  334. WriteLn(' FPosition(Before): ', FPosition);
  335. WriteLn(' FRowSize(Before): ', FRowSize);
  336. WriteLn(' FPosition(After): ', FPosition+Count);
  337. WriteLn(' FRowSize(After): ', StrLen(NewRow));
  338. //WriteLn(' Stream Value: ',NewRow);
  339. {$endif}
  340. FFieldRow := NewRow;
  341. FRowSize := StrLen(NewRow);
  342. Inc(FPosition, Count);
  343. end;
  344. function TDSStream.Read(var Buffer; Count: Longint): LongInt;
  345. var
  346. BytesToMove: Integer;
  347. begin
  348. if (FRowSize - FPosition) >= Count then
  349. BytesToMove := Count
  350. else
  351. BytesToMove := FRowSize - FPosition;
  352. Move((FFieldRow + FPosition)^, Buffer, BytesToMove);
  353. Inc(FPosition, BytesToMove);
  354. Result := BytesToMove;
  355. {$ifdef DEBUG_SQLITEDS}
  356. WriteLn('##TDSStream.Read##');
  357. WriteLn(' Bytes requested: ', Count);
  358. WriteLn(' Bytes moved: ', BytesToMove);
  359. WriteLn(' Stream.Size: ', FRowSize);
  360. //WriteLn(' Stream Value: ', FFieldRow);
  361. {$endif}
  362. end;
  363. // TCustomSqliteDataset override methods
  364. function TCustomSqliteDataset.AllocRecordBuffer: PChar;
  365. begin
  366. Result := AllocMem(SizeOf(PPDataRecord));
  367. PDataRecord(Pointer(Result)^) := FBeginItem;
  368. end;
  369. procedure TCustomSqliteDataset.ClearCalcFields(Buffer: PChar);
  370. begin
  371. //todo
  372. end;
  373. constructor TCustomSqliteDataset.Create(AOwner: TComponent);
  374. begin
  375. // setup special items
  376. New(FBeginItem);
  377. New(FCacheItem);
  378. New(FEndItem);
  379. FBeginItem^.Previous := nil;
  380. FEndItem^.Next := nil;
  381. FBeginItem^.BookmarkFlag := bfBOF;
  382. FEndItem^.BookmarkFlag := bfEOF;
  383. FMasterLink := TMasterDataLink.Create(Self);
  384. FMasterLink.OnMasterChange := @MasterChanged;
  385. FMasterLink.OnMasterDisable := @MasterChanged;
  386. BookmarkSize := SizeOf(Pointer);
  387. FUpdatedItems := TFPList.Create;
  388. FAddedItems := TFPList.Create;
  389. FDeletedItems := TFPList.Create;
  390. FSQLList := TStringList.Create;
  391. inherited Create(AOwner);
  392. end;
  393. function TCustomSqliteDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
  394. begin
  395. if Mode = bmWrite then
  396. begin
  397. if not (State in [dsEdit, dsInsert]) then
  398. begin
  399. DatabaseErrorFmt(SNotEditing,[Name],Self);
  400. Exit;
  401. end;
  402. StrDispose(FCacheItem^.Row[Field.FieldNo - 1]);
  403. FCacheItem^.Row[Field.FieldNo - 1] := nil;
  404. end;
  405. Result:= TDSStream.Create(PPDataRecord(ActiveBuffer)^, Field.FieldNo - 1);
  406. end;
  407. procedure TCustomSqliteDataset.DoBeforeClose;
  408. begin
  409. if FSaveOnClose then
  410. ApplyUpdates;
  411. inherited DoBeforeClose;
  412. end;
  413. procedure TCustomSqliteDataset.DoAfterInsert;
  414. begin
  415. //an append or an insert in an empty dataset
  416. if EOF then
  417. FInsertBookmark := FEndItem
  418. else
  419. FInsertBookmark := FInternalActiveBuffer;
  420. inherited DoAfterInsert;
  421. end;
  422. procedure TCustomSqliteDataset.DoBeforeInsert;
  423. begin
  424. FInternalActiveBuffer := PPDataRecord(ActiveBuffer)^;
  425. inherited DoBeforeInsert;
  426. end;
  427. destructor TCustomSqliteDataset.Destroy;
  428. begin
  429. inherited Destroy;
  430. if FSqliteHandle <> nil then
  431. InternalCloseHandle;
  432. FUpdatedItems.Destroy;
  433. FAddedItems.Destroy;
  434. FDeletedItems.Destroy;
  435. FMasterLink.Destroy;
  436. FSQLList.Destroy;
  437. //lists created on demand
  438. FIndexFieldList.Free;
  439. FCalcFieldList.Free;
  440. // dispose special items
  441. Dispose(FBeginItem);
  442. Dispose(FCacheItem);
  443. Dispose(FEndItem);
  444. end;
  445. function TCustomSqliteDataset.BookmarkValid(ABookmark: TBookmark): Boolean;
  446. var
  447. TempItem: PDataRecord;
  448. begin
  449. Result := False;
  450. TempItem := FBeginItem^.Next;
  451. while TempItem <> FEndItem do
  452. begin
  453. if TempItem = PPDataRecord(ABookmark)^ then
  454. begin
  455. Result := True;
  456. Exit;
  457. end;
  458. TempItem := TempItem^.Next;
  459. end;
  460. end;
  461. function TCustomSqliteDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark
  462. ): LongInt;
  463. var
  464. TempItem: PDataRecord;
  465. begin
  466. if PPDataRecord(Bookmark1)^ = PPDataRecord(Bookmark2)^ then
  467. begin
  468. Result := 0;
  469. Exit;
  470. end;
  471. //assume Bookmark1 < Bookmark2
  472. Result := -1;
  473. TempItem := PPDataRecord(Bookmark1)^^.Previous;
  474. while TempItem <> FBeginItem do
  475. begin
  476. if TempItem = PPDataRecord(Bookmark2)^ then
  477. begin
  478. //Bookmark1 is greater than Bookmark2
  479. Result := 1;
  480. Exit;
  481. end;
  482. TempItem := TempItem^.Previous;
  483. end;
  484. end;
  485. procedure TCustomSqliteDataset.CopyCacheToItem(AItem: PDataRecord);
  486. var
  487. i: Integer;
  488. begin
  489. for i := 0 to FRowCount - 1 do
  490. begin
  491. StrDispose(AItem^.Row[i]);
  492. AItem^.Row[i] := FCacheItem^.Row[i];
  493. FCacheItem^.Row[i] := nil;
  494. end;
  495. AItem^.BookmarkFlag := FCacheItem^.BookmarkFlag;
  496. end;
  497. function TCustomSqliteDataset.GetIndexFields(Value: Integer): TField;
  498. begin
  499. Result := TField(FIndexFieldList[Value]);
  500. end;
  501. procedure TCustomSqliteDataset.SetMasterIndexValue;
  502. var
  503. i: Integer;
  504. begin
  505. for i := 0 to FIndexFieldList.Count - 1 do
  506. TField(FIndexFieldList[i]).AsString := TField(FMasterLink.Fields[i]).AsString;
  507. end;
  508. procedure TCustomSqliteDataset.SetOptions(const AValue: TSqliteOptions);
  509. begin
  510. FOptions := AValue;
  511. end;
  512. procedure TCustomSqliteDataset.UpdateCalcFieldList;
  513. var
  514. i: Integer;
  515. AField: TField;
  516. begin
  517. if FCalcFieldList = nil then
  518. FCalcFieldList := TFPList.Create
  519. else
  520. FCalcFieldList.Clear;
  521. for i := 0 to Fields.Count - 1 do
  522. begin
  523. AField := Fields[i];
  524. if AField.FieldKind in [fkCalculated, fkLookup] then
  525. FCalcFieldList.Add(AField);
  526. end;
  527. end;
  528. procedure TCustomSqliteDataset.DisposeLinkedList;
  529. var
  530. TempItem: PDataRecord;
  531. i: Integer;
  532. begin
  533. //Todo: insert debug info
  534. //Todo: see if FDataAllocated is still necessary
  535. FDataAllocated := False;
  536. TempItem := FBeginItem^.Next;
  537. while TempItem^.Next <> nil do
  538. begin
  539. TempItem := TempItem^.Next;
  540. FreeItem(TempItem^.Previous);
  541. end;
  542. //Dispose Deleted Items
  543. //Directly access list pointer since the index check is already done in the loop
  544. for i := 0 to FDeletedItems.Count - 1 do
  545. FreeItem(PDataRecord(FDeletedItems.List^[i]));
  546. //Dispose FBeginItem.Row
  547. FreeMem(FBeginItem^.Row, FRowBufferSize);
  548. //Dispose cache item row
  549. for i:= 0 to FRowCount - 1 do
  550. StrDispose(FCacheItem^.Row[i]);
  551. FreeMem(FCacheItem^.Row, FRowBufferSize);
  552. end;
  553. procedure TCustomSqliteDataset.FreeRecordBuffer(var Buffer: PChar);
  554. begin
  555. FreeMem(Buffer);
  556. end;
  557. procedure TCustomSqliteDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
  558. begin
  559. Pointer(Data^) := PPDataRecord(Buffer)^;
  560. end;
  561. function TCustomSqliteDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
  562. begin
  563. Result := PPDataRecord(Buffer)^^.BookmarkFlag;
  564. end;
  565. function TCustomSqliteDataset.GetFieldData(Field: TField; Buffer: Pointer;
  566. NativeFormat: Boolean): Boolean;
  567. var
  568. ValError: Word;
  569. FieldRow: PChar;
  570. FieldOffset: Integer;
  571. begin
  572. if Field.FieldNo >= 0 then
  573. FieldOffset := Field.FieldNo - 1
  574. else
  575. FieldOffset := Fields.Count + FCalcFieldList.IndexOf(Field) - 1;
  576. if State <> dsCalcFields then
  577. FieldRow := PPDataRecord(ActiveBuffer)^^.Row[FieldOffset]
  578. else
  579. FieldRow := PPDataRecord(CalcBuffer)^^.Row[FieldOffset];
  580. Result := FieldRow <> nil;
  581. if Result and (Buffer <> nil) then //supports GetIsNull
  582. begin
  583. case Field.Datatype of
  584. ftString:
  585. begin
  586. Move(FieldRow^, PChar(Buffer)^, StrLen(FieldRow) + 1);
  587. end;
  588. ftInteger, ftAutoInc:
  589. begin
  590. Val(String(FieldRow), LongInt(Buffer^), ValError);
  591. Result := ValError = 0;
  592. end;
  593. ftBoolean, ftWord:
  594. begin
  595. Val(String(FieldRow), Word(Buffer^), ValError);
  596. Result := ValError = 0;
  597. end;
  598. ftFloat, ftDateTime, ftTime, ftDate, ftCurrency:
  599. begin
  600. Val(String(FieldRow), Double(Buffer^), ValError);
  601. Result := ValError = 0;
  602. end;
  603. ftLargeInt:
  604. begin
  605. Val(String(FieldRow), Int64(Buffer^), ValError);
  606. Result := ValError = 0;
  607. end;
  608. end;
  609. end;
  610. end;
  611. function TCustomSqliteDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
  612. begin
  613. Result := GetFieldData(Field, Buffer, False);
  614. end;
  615. function TCustomSqliteDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
  616. begin
  617. Result := grOk;
  618. case GetMode of
  619. gmPrior:
  620. if (FCurrentItem^.Previous = FBeginItem) or (FCurrentItem = FBeginItem) then
  621. begin
  622. Result := grBOF;
  623. FCurrentItem := FBeginItem;
  624. end
  625. else
  626. FCurrentItem:=FCurrentItem^.Previous;
  627. gmCurrent:
  628. if (FCurrentItem = FBeginItem) or (FCurrentItem = FEndItem) then
  629. Result := grError;
  630. gmNext:
  631. if (FCurrentItem = FEndItem) or (FCurrentItem^.Next = FEndItem) then
  632. Result := grEOF
  633. else
  634. FCurrentItem := FCurrentItem^.Next;
  635. end; //case
  636. if Result = grOk then
  637. begin
  638. PDataRecord(Pointer(Buffer)^) := FCurrentItem;
  639. FCurrentItem^.BookmarkFlag := bfCurrent;
  640. GetCalcFields(Buffer);
  641. end
  642. else if (Result = grError) and DoCheck then
  643. DatabaseError('No records found', Self);
  644. end;
  645. function TCustomSqliteDataset.GetRecordCount: Integer;
  646. begin
  647. Result := FRecordCount;
  648. end;
  649. function TCustomSqliteDataset.GetRecNo: Integer;
  650. var
  651. TempItem, TempActive: PDataRecord;
  652. begin
  653. Result := -1;
  654. if (FRecordCount = 0) or (State = dsInsert) then
  655. Exit;
  656. TempItem := FBeginItem;
  657. TempActive := PPDataRecord(ActiveBuffer)^;
  658. if TempActive = FCacheItem then // Record is being edited
  659. TempActive := FInternalActiveBuffer;
  660. //RecNo is 1 based
  661. Inc(Result);
  662. while TempActive <> TempItem do
  663. begin
  664. if TempItem^.Next <> nil then
  665. begin
  666. Inc(Result);
  667. TempItem := TempItem^.Next;
  668. end
  669. else
  670. begin
  671. Result := -1;
  672. DatabaseError('GetRecNo - ActiveItem Not Found', Self);
  673. break;
  674. end;
  675. end;
  676. end;
  677. function TCustomSqliteDataset.GetRecordSize: Word;
  678. begin
  679. Result := SizeOf(PPDataRecord); //??
  680. end;
  681. procedure TCustomSqliteDataset.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
  682. var
  683. NewItem: PDataRecord;
  684. begin
  685. {$ifdef DEBUG_SQLITEDS}
  686. if PPDataRecord(ActiveBuffer)^ <> FCacheItem then
  687. DatabaseError('PPDataRecord(ActiveBuffer) <> FCacheItem - Problem', Self);
  688. {$endif}
  689. New(NewItem);
  690. GetMem(NewItem^.Row, FRowBufferSize);
  691. //if is a detail dataset then set the index value
  692. if FMasterLink.Active then
  693. SetMasterIndexValue;
  694. //necessary to nullify the Row before copy the cache
  695. FillChar(NewItem^.Row^, FRowBufferSize, #0);
  696. CopyCacheToItem(NewItem);
  697. //insert in the linked list
  698. FInsertBookmark^.Previous^.Next := NewItem;
  699. NewItem^.Next := FInsertBookmark;
  700. NewItem^.Previous := FInsertBookmark^.Previous;
  701. FInsertBookmark^.Previous := NewItem;
  702. //update the cursor
  703. FCurrentItem := NewItem;
  704. Inc(FRecordCount);
  705. if FAutoIncFieldNo <> - 1 then
  706. Inc(FNextAutoInc);
  707. FAddedItems.Add(NewItem);
  708. end;
  709. procedure TCustomSqliteDataset.InternalClose;
  710. begin
  711. //BindFields(False);
  712. if DefaultFields then
  713. DestroyFields;
  714. if FDataAllocated then
  715. DisposeLinkedList;
  716. FAddedItems.Clear;
  717. FUpdatedItems.Clear;
  718. FDeletedItems.Clear;
  719. FRecordCount := 0;
  720. end;
  721. procedure TCustomSqliteDataset.InternalCancel;
  722. var
  723. i: Integer;
  724. begin
  725. PPDataRecord(ActiveBuffer)^ := FInternalActiveBuffer;
  726. //free the cache
  727. for i:= 0 to FRowCount - 1 do
  728. begin
  729. StrDispose(FCacheItem^.Row[i]);
  730. FCacheItem^.Row[i] := nil;
  731. end;
  732. end;
  733. procedure TCustomSqliteDataset.InternalDelete;
  734. var
  735. TempItem: PDataRecord;
  736. ValError, TempInteger: Integer;
  737. begin
  738. Dec(FRecordCount);
  739. TempItem := PPDataRecord(ActiveBuffer)^;
  740. TempItem^.Next^.Previous := TempItem^.Previous;
  741. TempItem^.Previous^.Next := TempItem^.Next;
  742. if FCurrentItem = TempItem then
  743. begin
  744. if FCurrentItem^.Previous <> FBeginItem then
  745. FCurrentItem := FCurrentItem^.Previous
  746. else
  747. FCurrentItem := FCurrentItem^.Next;
  748. end;
  749. // Dec FNextAutoInc (only if deleted item is the last record)
  750. if FAutoIncFieldNo <> -1 then
  751. begin
  752. Val(String(TempItem^.Row[FAutoIncFieldNo]), TempInteger, ValError);
  753. if (ValError = 0) and (TempInteger = (FNextAutoInc - 1)) then
  754. Dec(FNextAutoInc);
  755. end;
  756. // Update item lists
  757. FUpdatedItems.Remove(TempItem);
  758. if FAddedItems.Remove(TempItem) = -1 then
  759. FDeletedItems.Add(TempItem)
  760. else
  761. FreeItem(TempItem);
  762. end;
  763. procedure TCustomSqliteDataset.InternalEdit;
  764. var
  765. i: Integer;
  766. begin
  767. FInternalActiveBuffer := PPDataRecord(ActiveBuffer)^;
  768. //copy active item to cache
  769. for i:= 0 to FRowCount - 1 do
  770. FCacheItem^.Row[i] := StrNew(FInternalActiveBuffer^.Row[i]);
  771. FCacheItem^.BookmarkFlag := FInternalActiveBuffer^.BookmarkFlag;
  772. //now active buffer is the cache item
  773. PPDataRecord(ActiveBuffer)^ := FCacheItem;
  774. end;
  775. procedure TCustomSqliteDataset.InternalFirst;
  776. begin
  777. FCurrentItem := FBeginItem;
  778. end;
  779. procedure TCustomSqliteDataset.InternalGotoBookmark(ABookmark: Pointer);
  780. begin
  781. FCurrentItem := PDataRecord(ABookmark^);
  782. end;
  783. procedure TCustomSqliteDataset.InternalInitFieldDefs;
  784. begin
  785. if FSQL = '' then
  786. begin
  787. if FTablename = '' then
  788. DatabaseError('Tablename not set', Self);
  789. FSQL := 'Select * from ' + FTableName + ';';
  790. end;
  791. if FSqliteHandle = nil then
  792. GetSqliteHandle;
  793. RetrieveFieldDefs;
  794. end;
  795. procedure TCustomSqliteDataset.InternalInitRecord(Buffer: PChar);
  796. var
  797. TempStr: String;
  798. begin
  799. if FAutoIncFieldNo <> - 1 then
  800. begin
  801. Str(FNextAutoInc, TempStr);
  802. FCacheItem^.Row[FAutoIncFieldNo] := StrAlloc(Length(TempStr) + 1);
  803. StrPCopy(FCacheItem^.Row[FAutoIncFieldNo], TempStr);
  804. end;
  805. PPDataRecord(Buffer)^ := FCacheItem;
  806. FCacheItem^.BookmarkFlag := bfInserted;
  807. end;
  808. procedure TCustomSqliteDataset.InternalLast;
  809. begin
  810. FCurrentItem := FEndItem;
  811. end;
  812. procedure TCustomSqliteDataset.InternalOpen;
  813. begin
  814. InternalInitFieldDefs;
  815. if DefaultFields then
  816. CreateFields;
  817. BindFields(True);
  818. if CalcFieldsSize > 0 then
  819. UpdateCalcFieldList;
  820. if FIndexFieldNames <> '' then
  821. UpdateIndexFieldList;
  822. if FMasterLink.DataSource <> nil then
  823. UpdateMasterDetailProperties;
  824. // Get PrimaryKeyNo if available
  825. if TDefCollection(FieldDefs).Find(FPrimaryKey) <> nil then
  826. FPrimaryKeyNo := FieldDefs.Find(FPrimaryKey).FieldNo - 1
  827. else
  828. FPrimaryKeyNo := FAutoIncFieldNo; // -1 if there's no AutoIncField
  829. BuildLinkedList;
  830. FCurrentItem := FBeginItem;
  831. end;
  832. procedure TCustomSqliteDataset.InternalPost;
  833. begin
  834. if State <> dsEdit then
  835. InternalAddRecord(nil, True)
  836. else
  837. begin
  838. CopyCacheToItem(FInternalActiveBuffer);
  839. PPDataRecord(ActiveBuffer)^ := FInternalActiveBuffer;
  840. if (FUpdatedItems.IndexOf(FInternalActiveBuffer) = -1) and
  841. (FAddedItems.IndexOf(FInternalActiveBuffer) = -1) then
  842. FUpdatedItems.Add(FInternalActiveBuffer);
  843. end;
  844. end;
  845. procedure TCustomSqliteDataset.InternalSetToRecord(Buffer: PChar);
  846. begin
  847. FCurrentItem := PPDataRecord(Buffer)^;
  848. end;
  849. function TCustomSqliteDataset.IsCursorOpen: Boolean;
  850. begin
  851. Result := FDataAllocated;
  852. end;
  853. type
  854. TLocateCompareFunction = function (Value: PChar; const Key: String): Boolean;
  855. TLocateFieldInfo = record
  856. Index: Integer;
  857. Key: String;
  858. CompFunction: TLocateCompareFunction;
  859. end;
  860. function CompInsensitivePartial(Value: PChar; const Key: String): Boolean;
  861. begin
  862. if Value <> nil then
  863. Result := StrLIComp(Value, PChar(Key), Length(Key)) = 0
  864. else
  865. Result := False;
  866. end;
  867. function CompSensitivePartial(Value: PChar; const Key: String): Boolean;
  868. begin
  869. if Value <> nil then
  870. Result := StrLComp(Value, PChar(Key), Length(Key)) = 0
  871. else
  872. Result := False;
  873. end;
  874. function CompInsensitive(Value: PChar; const Key: String): Boolean;
  875. begin
  876. if Value <> nil then
  877. Result := StrIComp(Value, PChar(Key)) = 0
  878. else
  879. Result := False;
  880. end;
  881. function CompSensitive(Value: PChar; const Key: String): Boolean;
  882. begin
  883. if Value <> nil then
  884. Result := StrComp(Value, PChar(Key)) = 0
  885. else
  886. Result := False;
  887. end;
  888. function CompSensitiveWild(Value: PChar; const Key: String): Boolean;
  889. begin
  890. if Value <> nil then
  891. Result := IsWild(String(Value), Key, False)
  892. else
  893. Result := False;
  894. end;
  895. function CompInsensitiveWild(Value: PChar; const Key: String): Boolean;
  896. begin
  897. if Value <> nil then
  898. Result := IsWild(String(Value), Key, True)
  899. else
  900. Result := False;
  901. end;
  902. function TCustomSqliteDataset.FindRecordItem(StartItem: PDataRecord; const KeyFields: string; const KeyValues: Variant; LocateOptions: TLocateOptions; DoResync:Boolean): PDataRecord;
  903. var
  904. LocateFields: array of TLocateFieldInfo;
  905. AFieldList: TList;
  906. i, AFieldCount: Integer;
  907. MatchRecord: Boolean;
  908. AValue: String;
  909. TempItem: PDataRecord;
  910. begin
  911. Result := nil;
  912. AFieldList := TList.Create;
  913. try
  914. GetFieldList(AFieldList, KeyFields);
  915. AFieldCount := AFieldList.Count;
  916. if AFieldCount > 1 then
  917. begin
  918. if VarIsArray(KeyValues) then
  919. begin
  920. if Succ(VarArrayHighBound(KeyValues, 1)) <> AFieldCount then
  921. DatabaseError('Number of fields does not correspond to number of values', Self);
  922. end
  923. else
  924. DatabaseError('Wrong number of values specified: expected an array of variants got a variant', Self);
  925. end;
  926. //set the array of the fields info
  927. SetLength(LocateFields, AFieldCount);
  928. for i := 0 to AFieldCount - 1 do
  929. with TField(AFieldList[i]) do
  930. begin
  931. if not (DataType in [ftFloat, ftDateTime, ftTime, ftDate]) then
  932. begin
  933. //the loPartialKey and loCaseInsensitive is ignored in numeric fields
  934. if DataType in [ftString, ftMemo] then
  935. begin
  936. if loPartialKey in LocateOptions then
  937. begin
  938. if loCaseInsensitive in LocateOptions then
  939. LocateFields[i].CompFunction := @CompInsensitivePartial
  940. else
  941. LocateFields[i].CompFunction := @CompSensitivePartial;
  942. end
  943. else
  944. if soWildcardKey in FOptions then
  945. begin
  946. if loCaseInsensitive in LocateOptions then
  947. LocateFields[i].CompFunction := @CompInsensitiveWild
  948. else
  949. LocateFields[i].CompFunction := @CompSensitiveWild;
  950. end
  951. else
  952. begin
  953. if loCaseInsensitive in LocateOptions then
  954. LocateFields[i].CompFunction := @CompInsensitive
  955. else
  956. LocateFields[i].CompFunction := @CompSensitive;
  957. end;
  958. end
  959. else
  960. LocateFields[i].CompFunction := @CompSensitive;
  961. if VarIsArray(KeyValues) then
  962. LocateFields[i].Key := VarToStr(KeyValues[i])
  963. else
  964. LocateFields[i].Key := VarToStr(KeyValues);
  965. end
  966. else
  967. begin
  968. LocateFields[i].CompFunction := @CompSensitive;
  969. //get float types in appropriate format
  970. if VarIsArray(KeyValues) then
  971. Str(VarToDateTime(keyvalues[i]), AValue)
  972. else
  973. Str(VarToDateTime(keyvalues), AValue);
  974. LocateFields[i].Key := Trim(AValue);
  975. end;
  976. LocateFields[i].Index := FieldNo - 1;
  977. end;
  978. finally
  979. AFieldList.Destroy;
  980. end;
  981. {$ifdef DEBUG_SQLITEDS}
  982. WriteLn('##TCustomSqliteDataset.FindRecordItem##');
  983. WriteLn(' KeyFields: ', KeyFields);
  984. for i := 0 to AFieldCount - 1 do
  985. begin
  986. WriteLn('LocateFields[', i, ']');
  987. WriteLn(' Key: ', LocateFields[i].Key);
  988. WriteLn(' Index: ', LocateFields[i].Index);
  989. end;
  990. {$endif}
  991. //Search the list
  992. TempItem := StartItem;
  993. while TempItem <> FEndItem do
  994. begin
  995. MatchRecord := True;
  996. for i:= 0 to AFieldCount - 1 do
  997. begin
  998. with LocateFields[i] do
  999. if not CompFunction(TempItem^.Row[Index], Key) then
  1000. begin
  1001. MatchRecord := False;
  1002. break; //for
  1003. end;
  1004. end;
  1005. if MatchRecord then
  1006. begin
  1007. Result := TempItem;
  1008. if DoResync and (TempItem <> PPDataRecord(ActiveBuffer)^) then
  1009. begin
  1010. DoBeforeScroll;
  1011. FCurrentItem := TempItem;
  1012. Resync([]);
  1013. DoAfterScroll;
  1014. end;
  1015. break; //while
  1016. end;
  1017. TempItem := TempItem^.Next;
  1018. end;
  1019. end;
  1020. procedure TCustomSqliteDataset.UpdateMasterDetailProperties;
  1021. var
  1022. i: Integer;
  1023. begin
  1024. if FMasterLink.Active and (FIndexFieldList.Count <> FMasterLink.Fields.Count) then
  1025. DatabaseError('MasterFields count doesn''t match IndexFields count', Self);
  1026. if FieldDefs.Count > 0 then
  1027. begin
  1028. //build the sql template used to filter the dataset
  1029. FSqlFilterTemplate := 'SELECT ';
  1030. for i := 0 to FieldDefs.Count - 2 do
  1031. FSqlFilterTemplate := FSqlFilterTemplate + FieldDefs[i].Name + ',';
  1032. FSqlFilterTemplate := FSqlFilterTemplate + FieldDefs[FieldDefs.Count - 1].Name +
  1033. ' FROM ' + FTableName;
  1034. end;
  1035. //set FSQL considering MasterSource active record
  1036. SetDetailFilter;
  1037. end;
  1038. procedure TCustomSqliteDataset.GetSqliteHandle;
  1039. begin
  1040. if FFileName = '' then
  1041. DatabaseError('Filename not set', Self);
  1042. FSqliteHandle := InternalGetHandle;
  1043. if Assigned(FOnGetHandle) then
  1044. FOnGetHandle(Self);
  1045. end;
  1046. procedure TCustomSqliteDataset.FreeItem(AItem: PDataRecord);
  1047. var
  1048. i: Integer;
  1049. begin
  1050. for i:= 0 to FRowCount - 1 do
  1051. StrDispose(AItem^.Row[i]);
  1052. FreeMem(AItem^.Row, FRowBufferSize);
  1053. Dispose(AItem);
  1054. end;
  1055. function TCustomSqliteDataset.Locate(const KeyFields: String; const KeyValues: Variant; LocateOptions: TLocateOptions): Boolean;
  1056. begin
  1057. CheckBrowseMode;
  1058. Result := FindRecordItem(FBeginItem^.Next, KeyFields, KeyValues, LocateOptions, True) <> nil;
  1059. end;
  1060. function TCustomSqliteDataset.LocateNext(const KeyFields: String; const KeyValues: Variant; LocateOptions: TLocateOptions): Boolean;
  1061. begin
  1062. CheckBrowseMode;
  1063. Result := FindRecordItem(PPDataRecord(ActiveBuffer)^^.Next, KeyFields, KeyValues, LocateOptions, True) <> nil;
  1064. end;
  1065. function TCustomSqliteDataset.Lookup(const KeyFields: String; const KeyValues: Variant; const ResultFields: String): Variant;
  1066. var
  1067. TempItem: PDataRecord;
  1068. begin
  1069. CheckBrowseMode;
  1070. TempItem := FindRecordItem(FBeginItem^.Next, KeyFields, KeyValues, [], False);
  1071. if TempItem <> nil then
  1072. Result := TempItem^.Row[FieldByName(ResultFields).FieldNo - 1]
  1073. else
  1074. Result := Null;
  1075. end;
  1076. procedure TCustomSqliteDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
  1077. begin
  1078. //The BookMarkData is the Buffer itself: no need to set nothing;
  1079. end;
  1080. procedure TCustomSqliteDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
  1081. begin
  1082. PPDataRecord(Buffer)^^.BookmarkFlag := Value;
  1083. end;
  1084. procedure TCustomSqliteDataset.SetExpectedAppends(AValue: Integer);
  1085. begin
  1086. FAddedItems.Capacity := AValue;
  1087. end;
  1088. procedure TCustomSqliteDataset.SetExpectedUpdates(AValue: Integer);
  1089. begin
  1090. FUpdatedItems.Capacity := AValue;
  1091. end;
  1092. procedure TCustomSqliteDataset.SetExpectedDeletes(AValue: Integer);
  1093. begin
  1094. FDeletedItems.Capacity := AValue;
  1095. end;
  1096. procedure TCustomSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer;
  1097. NativeFormat: Boolean);
  1098. var
  1099. TempStr: String;
  1100. FloatStr: PChar;
  1101. FloatLen, FieldOffset: Integer;
  1102. EditItem: PDataRecord;
  1103. begin
  1104. if not (State in [dsEdit, dsInsert, dsCalcFields]) then
  1105. DatabaseErrorFmt(SNotEditing, [Name], Self);
  1106. if Field.FieldNo >= 0 then
  1107. begin
  1108. FieldOffset := Field.FieldNo - 1;
  1109. EditItem := FCacheItem;
  1110. end
  1111. else
  1112. begin
  1113. FieldOffset := Fields.Count + FCalcFieldList.IndexOf(Field) - 1;
  1114. EditItem := PPDataRecord(CalcBuffer)^;
  1115. end;
  1116. StrDispose(EditItem^.Row[FieldOffset]);
  1117. if Buffer <> nil then
  1118. begin
  1119. case Field.Datatype of
  1120. ftString:
  1121. begin
  1122. EditItem^.Row[FieldOffset] := StrNew(PChar(Buffer));
  1123. TempStr := PChar(Buffer);
  1124. TempStr := EditItem^.Row[1];
  1125. end;
  1126. ftInteger:
  1127. begin
  1128. Str(LongInt(Buffer^), TempStr);
  1129. EditItem^.Row[FieldOffset] := StrAlloc(Length(TempStr) + 1);
  1130. Move(PChar(TempStr)^, (EditItem^.Row[FieldOffset])^, Length(TempStr) + 1);
  1131. end;
  1132. ftBoolean, ftWord:
  1133. begin
  1134. Str(Word(Buffer^), TempStr);
  1135. EditItem^.Row[FieldOffset] := StrAlloc(Length(TempStr) + 1);
  1136. Move(PChar(TempStr)^, (EditItem^.Row[FieldOffset])^, Length(TempStr) + 1);
  1137. end;
  1138. ftFloat, ftDateTime, ftDate, ftTime, ftCurrency:
  1139. begin
  1140. Str(Double(Buffer^), TempStr);
  1141. //Str returns an space as the first character for positive values
  1142. //and the - sign for negative values. It's necessary to remove the extra
  1143. //space while keeping the - sign
  1144. if TempStr[1] = ' ' then
  1145. begin
  1146. FloatStr := PChar(TempStr) + 1;
  1147. FloatLen := Length(TempStr);
  1148. end
  1149. else
  1150. begin
  1151. FloatStr := PChar(TempStr);
  1152. FloatLen := Length(TempStr) + 1;
  1153. end;
  1154. EditItem^.Row[FieldOffset] := StrAlloc(FloatLen);
  1155. Move(FloatStr^, (EditItem^.Row[FieldOffset])^, FloatLen);
  1156. end;
  1157. ftLargeInt:
  1158. begin
  1159. Str(Int64(Buffer^), TempStr);
  1160. EditItem^.Row[FieldOffset] := StrAlloc(Length(TempStr) + 1);
  1161. Move(PChar(TempStr)^, (EditItem^.Row[FieldOffset])^, Length(TempStr) + 1);
  1162. end;
  1163. end;// case
  1164. end//if
  1165. else
  1166. EditItem^.Row[FieldOffset] := nil;
  1167. if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
  1168. DataEvent(deFieldChange, Ptrint(Field));
  1169. end;
  1170. procedure TCustomSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer);
  1171. begin
  1172. SetFieldData(Field, Buffer, False);
  1173. end;
  1174. procedure TCustomSqliteDataset.SetRecNo(Value: Integer);
  1175. var
  1176. Counter: Integer;
  1177. TempItem: PDataRecord;
  1178. begin
  1179. if (Value > FRecordCount) or (Value <= 0) then
  1180. DatabaseError('Record Number Out Of Range',Self);
  1181. CheckBrowseMode;
  1182. TempItem := FBeginItem;
  1183. for Counter := 1 to Value do
  1184. TempItem := TempItem^.Next;
  1185. if TempItem <> PPDataRecord(ActiveBuffer)^ then
  1186. begin
  1187. DoBeforeScroll;
  1188. FCurrentItem := TempItem;
  1189. Resync([]);
  1190. DoAfterScroll;
  1191. end;
  1192. end;
  1193. // Specific functions
  1194. procedure TCustomSqliteDataset.SetDetailFilter;
  1195. function FieldToSqlStr(AField: TField): String;
  1196. begin
  1197. if not AField.IsNull then
  1198. begin
  1199. case AField.DataType of
  1200. //todo: handle " caracter properly
  1201. ftString, ftMemo:
  1202. Result := '"' + AField.AsString + '"';
  1203. ftDateTime, ftDate, ftTime:
  1204. Str(AField.AsDateTime, Result);
  1205. else
  1206. Result := AField.AsString;
  1207. end; //case
  1208. end
  1209. else
  1210. Result:=NullString;
  1211. end; //function
  1212. var
  1213. AFilter: String;
  1214. i: Integer;
  1215. begin
  1216. if (FMasterLink.Dataset.RecordCount = 0) or not FMasterLink.Active then //Retrieve all data
  1217. FSQL := FSqlFilterTemplate
  1218. else
  1219. begin
  1220. AFilter := ' where ';
  1221. for i := 0 to FMasterLink.Fields.Count - 1 do
  1222. begin
  1223. AFilter := AFilter + IndexFields[i].FieldName + ' = ' + FieldToSqlStr(TField(FMasterLink.Fields[i]));
  1224. if i <> FMasterLink.Fields.Count - 1 then
  1225. AFilter := AFilter + ' and ';
  1226. end;
  1227. FSQL := FSqlFilterTemplate + AFilter;
  1228. end;
  1229. end;
  1230. procedure TCustomSqliteDataset.MasterChanged(Sender: TObject);
  1231. begin
  1232. SetDetailFilter;
  1233. {$ifdef DEBUG_SQLITEDS}
  1234. WriteLn('##TCustomSqliteDataset.MasterChanged##');
  1235. WriteLn(' SQL used to filter detail dataset:');
  1236. WriteLn(' ', FSQL);
  1237. {$endif}
  1238. RefetchData;
  1239. end;
  1240. procedure TCustomSqliteDataset.SetMasterFields(const Value: String);
  1241. begin
  1242. FMasterLink.FieldNames := Value;
  1243. if Active and FMasterLink.Active then
  1244. begin
  1245. UpdateIndexFieldList;
  1246. if (FIndexFieldList.Count <> FMasterLink.Fields.Count) then
  1247. DatabaseError('MasterFields count doesn''t match IndexFields count', Self);
  1248. end;
  1249. end;
  1250. function TCustomSqliteDataset.GetMasterFields: String;
  1251. begin
  1252. Result := FMasterLink.FieldNames;
  1253. end;
  1254. procedure TCustomSqliteDataset.UpdateIndexFieldList;
  1255. begin
  1256. if FIndexFieldList = nil then
  1257. FIndexFieldList := TList.Create
  1258. else
  1259. FIndexFieldList.Clear;
  1260. try
  1261. GetFieldList(FIndexFieldList, FIndexFieldNames);
  1262. except
  1263. on E: Exception do
  1264. begin
  1265. FIndexFieldList.Clear;
  1266. DatabaseError('Error retrieving index fields: ' + E.Message);
  1267. end;
  1268. end;
  1269. end;
  1270. function TCustomSqliteDataset.GetMasterSource: TDataSource;
  1271. begin
  1272. Result := FMasterLink.DataSource;
  1273. end;
  1274. procedure TCustomSqliteDataset.SetFileName(const Value: String);
  1275. begin
  1276. if Value <> FFileName then
  1277. begin
  1278. if Active then
  1279. DatabaseError('It''s not allowed to change Filename in an open dataset', Self);
  1280. if FSqliteHandle <> nil then
  1281. InternalCloseHandle;
  1282. FFileName := Value;
  1283. end;
  1284. end;
  1285. procedure TCustomSqliteDataset.SetMasterSource(Value: TDataSource);
  1286. begin
  1287. FMasterLink.DataSource := Value;
  1288. end;
  1289. procedure TCustomSqliteDataset.ExecSQL(const ASQL: String);
  1290. begin
  1291. if FSqliteHandle = nil then
  1292. GetSqliteHandle;
  1293. ExecuteDirect(ASQL);
  1294. end;
  1295. procedure TCustomSqliteDataset.ExecSQLList;
  1296. begin
  1297. if FSqliteHandle = nil then
  1298. GetSqliteHandle;
  1299. SqliteExec(PChar(FSQLList.Text), nil, nil);
  1300. end;
  1301. procedure TCustomSqliteDataset.ExecSQL;
  1302. begin
  1303. ExecSQL(FSQL);
  1304. end;
  1305. function TCustomSqliteDataset.ApplyUpdates: Boolean;
  1306. var
  1307. iFields, iItems, StatementsCounter, TempReturnCode: Integer;
  1308. SQLTemp, WhereKeyNameEqual, SQLLine, TemplateStr: String;
  1309. TempItem: PDataRecord;
  1310. begin
  1311. CheckBrowseMode;
  1312. if not UpdatesPending then
  1313. begin
  1314. Result := True;
  1315. Exit;
  1316. end;
  1317. Result := False;
  1318. if FPrimaryKeyNo <> -1 then
  1319. begin
  1320. FReturnCode := SQLITE_OK;
  1321. StatementsCounter := 0;
  1322. WhereKeyNameEqual := ' WHERE ' + FieldDefs[FPrimaryKeyNo].Name + ' = ';
  1323. {$ifdef DEBUG_SQLITEDS}
  1324. WriteLn('##TCustomSqliteDataset.ApplyUpdates##');
  1325. if FPrimaryKeyNo = FAutoIncFieldNo then
  1326. WriteLn(' Using an AutoInc field as primary key');
  1327. WriteLn(' PrimaryKey: ', WhereKeyNameEqual);
  1328. WriteLn(' PrimaryKeyNo: ', FPrimaryKeyNo);
  1329. {$endif}
  1330. SQLTemp := 'BEGIN;';
  1331. // Delete Records
  1332. if FDeletedItems.Count > 0 then
  1333. TemplateStr := 'DELETE FROM ' + FTableName + WhereKeyNameEqual;
  1334. for iItems := 0 to FDeletedItems.Count - 1 do
  1335. begin
  1336. TempItem := PDataRecord(FDeletedItems.List^[iItems]);
  1337. SQLTemp := SQLTemp + (TemplateStr +
  1338. String(TempItem^.Row[FPrimaryKeyNo]) + ';');
  1339. FreeItem(TempItem);
  1340. inc(StatementsCounter);
  1341. //ApplyUpdates each 400 statements
  1342. if StatementsCounter = 400 then
  1343. begin
  1344. SQLTemp := SQLTemp + 'COMMIT;';
  1345. TempReturnCode := SqliteExec(PChar(SQLTemp), nil, nil);
  1346. if TempReturnCode <> SQLITE_OK then
  1347. FReturnCode := TempReturnCode;
  1348. StatementsCounter := 0;
  1349. SQLTemp := 'BEGIN;';
  1350. end;
  1351. end;
  1352. // Update changed records
  1353. if FUpdatedItems.Count > 0 then
  1354. TemplateStr := 'UPDATE ' + FTableName + ' SET ';
  1355. for iItems := 0 to FUpdatedItems.Count - 1 do
  1356. begin
  1357. SQLLine := TemplateStr;
  1358. for iFields := 0 to FieldDefs.Count - 2 do
  1359. begin
  1360. SQLLine := SQLLine + (FieldDefs[iFields].Name + ' = ' +
  1361. FGetSqlStr[iFields](PDataRecord(FUpdatedItems[iItems])^.Row[iFields]) + ',');
  1362. end;
  1363. iFields := FieldDefs.Count - 1;
  1364. SQLLine := SQLLine + (FieldDefs[iFields].Name + ' = ' +
  1365. FGetSqlStr[iFields](PDataRecord(FUpdatedItems[iItems])^.Row[iFields]) +
  1366. WhereKeyNameEqual +
  1367. String(PDataRecord(FUpdatedItems[iItems])^.Row[FPrimaryKeyNo]) + ';');
  1368. SQLTemp := SQLTemp + SQLLine;
  1369. inc(StatementsCounter);
  1370. //ApplyUpdates each 400 statements
  1371. if StatementsCounter = 400 then
  1372. begin
  1373. SQLTemp := SQLTemp + 'COMMIT;';
  1374. TempReturnCode := SqliteExec(PChar(SQLTemp), nil, nil);
  1375. if TempReturnCode <> SQLITE_OK then
  1376. FReturnCode := TempReturnCode;
  1377. StatementsCounter := 0;
  1378. SQLTemp := 'BEGIN;';
  1379. end;
  1380. end;
  1381. // Add new records
  1382. // Build TemplateStr
  1383. if FAddedItems.Count > 0 then
  1384. begin
  1385. TemplateStr := 'INSERT INTO ' + FTableName + ' (';
  1386. for iFields := 0 to FieldDefs.Count - 2 do
  1387. TemplateStr := TemplateStr + FieldDefs[iFields].Name + ',';
  1388. TemplateStr := TemplateStr + FieldDefs[FieldDefs.Count - 1].Name + ') VALUES (';
  1389. end;
  1390. for iItems := 0 to FAddedItems.Count - 1 do
  1391. begin
  1392. SQLLine := TemplateStr;
  1393. for iFields := 0 to FieldDefs.Count - 2 do
  1394. SQLLine := SQLLine + (FGetSqlStr[iFields](PDataRecord(FAddedItems[iItems])^.Row[iFields]) + ',');
  1395. iFields := FieldDefs.Count - 1;
  1396. SQLLine := SQLLine + (FGetSqlStr[iFields](PDataRecord(FAddedItems[iItems])^.Row[iFields]) + ');' );
  1397. SQLTemp := SQLTemp + SQLLine;
  1398. Inc(StatementsCounter);
  1399. //ApplyUpdates each 400 statements
  1400. if StatementsCounter = 400 then
  1401. begin
  1402. SQLTemp := SQLTemp + 'COMMIT;';
  1403. TempReturnCode := SqliteExec(PChar(SQLTemp), nil, nil);
  1404. if TempReturnCode <> SQLITE_OK then
  1405. FReturnCode := TempReturnCode;
  1406. StatementsCounter := 0;
  1407. SQLTemp := 'BEGIN;';
  1408. end;
  1409. end;
  1410. SQLTemp := SQLTemp + 'COMMIT;';
  1411. {$ifdef DEBUG_SQLITEDS}
  1412. WriteLn(' SQL: ',SqlTemp);
  1413. {$endif}
  1414. FAddedItems.Clear;
  1415. FUpdatedItems.Clear;
  1416. FDeletedItems.Clear;
  1417. TempReturnCode := SqliteExec(PChar(SQLTemp), nil, nil);
  1418. if TempReturnCode <> SQLITE_OK then
  1419. FReturnCode := TempReturnCode;
  1420. Result := FReturnCode = SQLITE_OK;
  1421. end;
  1422. {$ifdef DEBUG_SQLITEDS}
  1423. WriteLn(' Result: ', Result);
  1424. {$endif}
  1425. end;
  1426. function TCustomSqliteDataset.CreateTable: Boolean;
  1427. begin
  1428. Result := CreateTable(FTableName);
  1429. end;
  1430. function TCustomSqliteDataset.CreateTable(const ATableName: String): Boolean;
  1431. var
  1432. SQLTemp: String;
  1433. i: Integer;
  1434. begin
  1435. {$ifdef DEBUG_SQLITEDS}
  1436. WriteLn('##TCustomSqliteDataset.CreateTable##');
  1437. if ATableName = '' then
  1438. WriteLn(' TableName Not Set');
  1439. if FieldDefs.Count = 0 then
  1440. WriteLn(' FieldDefs Not Initialized');
  1441. {$endif}
  1442. if (ATableName <> '') and (FieldDefs.Count > 0) then
  1443. begin
  1444. SQLTemp := 'CREATE TABLE ' + ATableName + ' (';
  1445. for i := 0 to FieldDefs.Count - 1 do
  1446. begin
  1447. //todo: add index to autoinc field
  1448. SQLTemp := SQLTemp + FieldDefs[i].Name;
  1449. case FieldDefs[i].DataType of
  1450. ftInteger:
  1451. SQLTemp := SQLTemp + ' INTEGER';
  1452. ftString:
  1453. SQLTemp := SQLTemp + ' VARCHAR';
  1454. ftBoolean:
  1455. SQLTemp := SQLTemp + ' BOOL_INT';
  1456. ftFloat:
  1457. SQLTemp := SQLTemp + ' FLOAT';
  1458. ftWord:
  1459. SQLTemp := SQLTemp + ' WORD';
  1460. ftDateTime:
  1461. SQLTemp := SQLTemp + ' DATETIME';
  1462. ftDate:
  1463. SQLTemp := SQLTemp + ' DATE';
  1464. ftTime:
  1465. SQLTemp := SQLTemp + ' TIME';
  1466. ftLargeInt:
  1467. SQLTemp := SQLTemp + ' LARGEINT';
  1468. ftCurrency:
  1469. SQLTemp := SQLTemp + ' CURRENCY';
  1470. ftAutoInc:
  1471. SQLTemp := SQLTemp + ' AUTOINC_INT';
  1472. ftMemo:
  1473. SQLTemp := SQLTemp + ' TEXT';
  1474. else
  1475. DatabaseError('Field type "' + FieldTypeNames[FieldDefs[i].DataType] +
  1476. '" not supported', Self);
  1477. end;
  1478. if UpperCase(FieldDefs[i].Name) = UpperCase(FPrimaryKey) then
  1479. SQLTemp := SQLTemp + ' PRIMARY KEY';
  1480. if i <> FieldDefs.Count - 1 then
  1481. SQLTemp := SQLTemp + ' , ';
  1482. end;
  1483. SQLTemp := SQLTemp + ');';
  1484. {$ifdef DEBUG_SQLITEDS}
  1485. WriteLn(' SQL: ',SqlTemp);
  1486. {$endif}
  1487. ExecSQL(SQLTemp);
  1488. Result := FReturnCode = SQLITE_OK;
  1489. end
  1490. else
  1491. Result := False;
  1492. end;
  1493. procedure TCustomSqliteDataset.ExecCallback(const ASQL: String; UserData: Pointer = nil);
  1494. var
  1495. CallbackInfo: TCallbackInfo;
  1496. begin
  1497. if not Assigned(FOnCallback) then
  1498. DatabaseError('OnCallback property not set', Self);
  1499. if FSqliteHandle = nil then
  1500. GetSqliteHandle;
  1501. CallbackInfo.Data := UserData;
  1502. CallbackInfo.Proc := FOnCallback;
  1503. SqliteExec(PChar(ASQL), @CallbackDispatcher, @CallbackInfo);
  1504. end;
  1505. procedure TCustomSqliteDataset.QueryUpdates(RecordStates: TRecordStateSet; Callback: TQueryUpdatesCallback;
  1506. UserData: Pointer = nil);
  1507. var
  1508. i: Integer;
  1509. TempItem: PDataRecord;
  1510. begin
  1511. if not Assigned(Callback) then
  1512. DatabaseError('Callback parameter not set', Self);
  1513. CheckBrowseMode;
  1514. if rsDeleted in RecordStates then
  1515. with FDeletedItems do
  1516. for i := 0 to Count - 1 do
  1517. Callback(UserData,PDataRecord(Items[i])^.Row, nil, rsDeleted);
  1518. if rsUpdated in RecordStates then
  1519. with FUpdatedItems do
  1520. for i := 0 to Count - 1 do
  1521. begin
  1522. TempItem := PDataRecord(Items[i]);
  1523. Callback(UserData, TempItem^.Row, TBookmark(@TempItem), rsUpdated);
  1524. end;
  1525. if rsAdded in RecordStates then
  1526. with FAddedItems do
  1527. for i := 0 to Count - 1 do
  1528. begin
  1529. TempItem := PDataRecord(Items[i]);
  1530. Callback(UserData, TempItem^.Row, TBookmark(@TempItem), rsAdded);
  1531. end;
  1532. end;
  1533. procedure TCustomSqliteDataset.RefetchData;
  1534. var
  1535. i: Integer;
  1536. begin
  1537. //Close
  1538. if FSaveOnRefetch then
  1539. ApplyUpdates;
  1540. if FDataAllocated then
  1541. DisposeLinkedList;
  1542. FAddedItems.Clear;
  1543. FUpdatedItems.Clear;
  1544. FDeletedItems.Clear;
  1545. //Reopen
  1546. BuildLinkedList;
  1547. FCurrentItem := FBeginItem;
  1548. for i := 0 to BufferCount - 1 do
  1549. PPDataRecord(Buffers[i])^ := FBeginItem;
  1550. Resync([]);
  1551. DoAfterScroll;
  1552. end;
  1553. function TCustomSqliteDataset.TableExists: Boolean;
  1554. begin
  1555. Result:=TableExists(FTableName);
  1556. end;
  1557. function TCustomSqliteDataset.TableExists(const ATableName: String): Boolean;
  1558. begin
  1559. ExecSql('SELECT name FROM SQLITE_MASTER WHERE type = ''table'' AND name LIKE ''' + ATableName + ''';');
  1560. Result := FReturnCode = SQLITE_ROW;
  1561. end;
  1562. function TCustomSqliteDataset.UpdatesPending: Boolean;
  1563. begin
  1564. Result := (FUpdatedItems.Count > 0) or
  1565. (FAddedItems.Count > 0) or (FDeletedItems.Count > 0);
  1566. end;
  1567. function TCustomSqliteDataset.QuickQuery(const ASQL: String): String;
  1568. begin
  1569. Result := QuickQuery(ASQL, nil, False);
  1570. end;
  1571. function TCustomSqliteDataset.QuickQuery(const ASQL: String; const AStrList: TStrings): String;
  1572. begin
  1573. Result := QuickQuery(ASQL, AStrList, False)
  1574. end;
  1575. {$ifdef DEBUGACTIVEBUFFER}
  1576. procedure TCustomSqliteDataset.SetCurrentItem(Value:PDataRecord);
  1577. var
  1578. ANo:Integer;
  1579. function GetItemPos:Integer;
  1580. var
  1581. TempItem:PDataRecord;
  1582. begin
  1583. Result:= -1;
  1584. TempItem:=FBeginItem;
  1585. if Value = FCacheItem then
  1586. Result:=-2
  1587. else
  1588. while Value <> TempItem do
  1589. begin
  1590. if TempItem^.Next <> nil then
  1591. begin
  1592. inc(Result);
  1593. TempItem:=TempItem^.Next;
  1594. end
  1595. else
  1596. begin
  1597. Result:=-1;
  1598. break;
  1599. end;
  1600. end;
  1601. end;
  1602. begin
  1603. if Value = FBeginItem then
  1604. begin
  1605. writeln('FCurrentItem set to FBeginItem: ',IntToHex(Integer(Value),0));
  1606. FFCurrentItem:=Value;
  1607. end
  1608. else
  1609. if Value = FEndItem then
  1610. begin
  1611. writeln('FCurrentItem set to FEndItem: ',IntToHex(Integer(Value),0));
  1612. FFCurrentItem:=Value;
  1613. end
  1614. else
  1615. if Value = FCacheItem then
  1616. begin
  1617. writeln('FCurrentItem set to FCacheItem: ',IntToHex(Integer(Value),0));
  1618. FFCurrentItem:=Value;
  1619. end
  1620. else
  1621. begin
  1622. writeln('FCurrentItem set from ',IntToHex(Integer(FFCurrentItem),0),' to ',IntToHex(Integer(Value),0));
  1623. Ano:=GetItemPos;
  1624. writeln('Item position is ',ANo);
  1625. FFCurrentItem:=Value;
  1626. end;
  1627. end;
  1628. {$endif}
  1629. end.