customsqliteds.pas 56 KB

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