customsqliteds.pas 55 KB

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