customsqliteds.pas 52 KB

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