customsqliteds.pas 55 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878
  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. procedure DoBeforeClose; override;
  147. procedure DoAfterInsert; override;
  148. procedure DoBeforeInsert; override;
  149. procedure FreeRecordBuffer(var Buffer: PChar); override;
  150. procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
  151. function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
  152. function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
  153. function GetRecordCount: Integer; override;
  154. function GetRecNo: Integer; override;
  155. function GetRecordSize: Word; override;
  156. procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
  157. procedure InternalClose; override;
  158. procedure InternalCancel; override;
  159. procedure InternalDelete; override;
  160. procedure InternalEdit; override;
  161. procedure InternalFirst; override;
  162. procedure InternalGotoBookmark(ABookmark: Pointer); override;
  163. procedure InternalInitFieldDefs; override;
  164. procedure InternalInitRecord(Buffer: PChar); override;
  165. procedure InternalLast; override;
  166. procedure InternalOpen; override;
  167. procedure InternalPost; override;
  168. procedure InternalSetToRecord(Buffer: PChar); override;
  169. function IsCursorOpen: Boolean; override;
  170. procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  171. procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
  172. procedure SetExpectedAppends(AValue: Integer);
  173. procedure SetExpectedUpdates(AValue: Integer);
  174. procedure SetExpectedDeletes(AValue: Integer);
  175. procedure SetRecNo(Value: Integer); override;
  176. public
  177. constructor Create(AOwner: TComponent); override;
  178. destructor Destroy; override;
  179. function BookmarkValid(ABookmark: TBookmark): Boolean; override;
  180. function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
  181. function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
  182. function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
  183. function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; override;
  184. function Locate(const KeyFields: String; const KeyValues: Variant; LocateOptions: TLocateOptions) : Boolean; override;
  185. function LocateNext(const KeyFields: String; const KeyValues: Variant; LocateOptions: TLocateOptions) : Boolean;
  186. function Lookup(const KeyFields: String; const KeyValues: Variant; const ResultFields: String): Variant; override;
  187. procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  188. procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); 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 not (State in [dsCalcFields, dsInternalCalc]) 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. SaveState: TDataSetState;
  1111. begin
  1112. CheckBrowseMode;
  1113. TempItem := FindRecordItem(FBeginItem^.Next, KeyFields, KeyValues, [], False);
  1114. if TempItem <> nil then
  1115. begin
  1116. SaveState := SetTempState(dsInternalCalc);
  1117. try
  1118. CalculateFields(PChar(@TempItem));
  1119. Result := FieldByName(ResultFields).Value;
  1120. finally
  1121. RestoreState(SaveState);
  1122. end;
  1123. end
  1124. else
  1125. Result := Null;
  1126. end;
  1127. procedure TCustomSqliteDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
  1128. begin
  1129. //The BookMarkData is the Buffer itself: no need to set nothing;
  1130. end;
  1131. procedure TCustomSqliteDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
  1132. begin
  1133. PPDataRecord(Buffer)^^.BookmarkFlag := Value;
  1134. end;
  1135. procedure TCustomSqliteDataset.SetExpectedAppends(AValue: Integer);
  1136. begin
  1137. FAddedItems.Capacity := AValue;
  1138. end;
  1139. procedure TCustomSqliteDataset.SetExpectedUpdates(AValue: Integer);
  1140. begin
  1141. FUpdatedItems.Capacity := AValue;
  1142. end;
  1143. procedure TCustomSqliteDataset.SetExpectedDeletes(AValue: Integer);
  1144. begin
  1145. FDeletedItems.Capacity := AValue;
  1146. end;
  1147. procedure TCustomSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer;
  1148. NativeFormat: Boolean);
  1149. var
  1150. TempStr: String;
  1151. FloatStr: PChar;
  1152. FloatLen, FieldOffset: Integer;
  1153. EditItem: PDataRecord;
  1154. begin
  1155. if not (State in [dsEdit, dsInsert, dsCalcFields]) then
  1156. DatabaseErrorFmt(SNotEditing, [Name], Self);
  1157. if Field.FieldNo >= 0 then
  1158. begin
  1159. FieldOffset := Field.FieldNo - 1;
  1160. EditItem := FCacheItem;
  1161. end
  1162. else
  1163. begin
  1164. FieldOffset := FieldDefs.Count + FCalcFieldList.IndexOf(Field);
  1165. EditItem := PPDataRecord(CalcBuffer)^;
  1166. end;
  1167. StrDispose(EditItem^.Row[FieldOffset]);
  1168. if Buffer <> nil then
  1169. begin
  1170. case Field.Datatype of
  1171. ftString:
  1172. begin
  1173. EditItem^.Row[FieldOffset] := StrNew(PChar(Buffer));
  1174. end;
  1175. ftInteger:
  1176. begin
  1177. Str(LongInt(Buffer^), TempStr);
  1178. EditItem^.Row[FieldOffset] := StrAlloc(Length(TempStr) + 1);
  1179. Move(PChar(TempStr)^, (EditItem^.Row[FieldOffset])^, Length(TempStr) + 1);
  1180. end;
  1181. ftBoolean, ftWord:
  1182. begin
  1183. Str(Word(Buffer^), TempStr);
  1184. EditItem^.Row[FieldOffset] := StrAlloc(Length(TempStr) + 1);
  1185. Move(PChar(TempStr)^, (EditItem^.Row[FieldOffset])^, Length(TempStr) + 1);
  1186. end;
  1187. ftFloat, ftDateTime, ftDate, ftTime, ftCurrency:
  1188. begin
  1189. Str(Double(Buffer^), TempStr);
  1190. //Str returns an space as the first character for positive values
  1191. //and the - sign for negative values. It's necessary to remove the extra
  1192. //space while keeping the - sign
  1193. if TempStr[1] = ' ' then
  1194. begin
  1195. FloatStr := PChar(TempStr) + 1;
  1196. FloatLen := Length(TempStr);
  1197. end
  1198. else
  1199. begin
  1200. FloatStr := PChar(TempStr);
  1201. FloatLen := Length(TempStr) + 1;
  1202. end;
  1203. EditItem^.Row[FieldOffset] := StrAlloc(FloatLen);
  1204. Move(FloatStr^, (EditItem^.Row[FieldOffset])^, FloatLen);
  1205. end;
  1206. ftLargeInt:
  1207. begin
  1208. Str(Int64(Buffer^), TempStr);
  1209. EditItem^.Row[FieldOffset] := StrAlloc(Length(TempStr) + 1);
  1210. Move(PChar(TempStr)^, (EditItem^.Row[FieldOffset])^, Length(TempStr) + 1);
  1211. end;
  1212. end;// case
  1213. end//if
  1214. else
  1215. EditItem^.Row[FieldOffset] := nil;
  1216. if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
  1217. DataEvent(deFieldChange, Ptrint(Field));
  1218. end;
  1219. procedure TCustomSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer);
  1220. begin
  1221. SetFieldData(Field, Buffer, False);
  1222. end;
  1223. procedure TCustomSqliteDataset.SetRecNo(Value: Integer);
  1224. var
  1225. Counter: Integer;
  1226. TempItem: PDataRecord;
  1227. begin
  1228. if (Value > FRecordCount) or (Value <= 0) then
  1229. DatabaseError('Record Number Out Of Range',Self);
  1230. CheckBrowseMode;
  1231. TempItem := FBeginItem;
  1232. for Counter := 1 to Value do
  1233. TempItem := TempItem^.Next;
  1234. if TempItem <> PPDataRecord(ActiveBuffer)^ then
  1235. begin
  1236. DoBeforeScroll;
  1237. FCurrentItem := TempItem;
  1238. Resync([]);
  1239. DoAfterScroll;
  1240. end;
  1241. end;
  1242. // Specific functions
  1243. procedure TCustomSqliteDataset.SetDetailFilter;
  1244. function FieldToSqlStr(AField: TField): String;
  1245. begin
  1246. if not AField.IsNull then
  1247. begin
  1248. case AField.DataType of
  1249. //todo: handle " caracter properly
  1250. ftString, ftMemo:
  1251. Result := '"' + AField.AsString + '"';
  1252. ftDateTime, ftDate, ftTime:
  1253. Str(AField.AsDateTime, Result);
  1254. else
  1255. Result := AField.AsString;
  1256. end; //case
  1257. end
  1258. else
  1259. Result:=NullString;
  1260. end; //function
  1261. var
  1262. AFilter: String;
  1263. i: Integer;
  1264. begin
  1265. if (FMasterLink.Dataset.RecordCount = 0) or not FMasterLink.Active then //Retrieve all data
  1266. FSQL := FSqlFilterTemplate
  1267. else
  1268. begin
  1269. AFilter := ' where ';
  1270. for i := 0 to FMasterLink.Fields.Count - 1 do
  1271. begin
  1272. AFilter := AFilter + IndexFields[i].FieldName + ' = ' + FieldToSqlStr(TField(FMasterLink.Fields[i]));
  1273. if i <> FMasterLink.Fields.Count - 1 then
  1274. AFilter := AFilter + ' and ';
  1275. end;
  1276. FSQL := FSqlFilterTemplate + AFilter;
  1277. end;
  1278. end;
  1279. procedure TCustomSqliteDataset.MasterChanged(Sender: TObject);
  1280. begin
  1281. SetDetailFilter;
  1282. {$ifdef DEBUG_SQLITEDS}
  1283. WriteLn('##TCustomSqliteDataset.MasterChanged##');
  1284. WriteLn(' SQL used to filter detail dataset:');
  1285. WriteLn(' ', FSQL);
  1286. {$endif}
  1287. RefetchData;
  1288. end;
  1289. procedure TCustomSqliteDataset.SetMasterFields(const Value: String);
  1290. begin
  1291. FMasterLink.FieldNames := Value;
  1292. if Active and FMasterLink.Active then
  1293. begin
  1294. UpdateIndexFieldList;
  1295. if (FIndexFieldList.Count <> FMasterLink.Fields.Count) then
  1296. DatabaseError('MasterFields count doesn''t match IndexFields count', Self);
  1297. end;
  1298. end;
  1299. function TCustomSqliteDataset.GetMasterFields: String;
  1300. begin
  1301. Result := FMasterLink.FieldNames;
  1302. end;
  1303. procedure TCustomSqliteDataset.UpdateIndexFieldList;
  1304. begin
  1305. if FIndexFieldList = nil then
  1306. FIndexFieldList := TList.Create
  1307. else
  1308. FIndexFieldList.Clear;
  1309. try
  1310. GetFieldList(FIndexFieldList, FIndexFieldNames);
  1311. except
  1312. on E: Exception do
  1313. begin
  1314. FIndexFieldList.Clear;
  1315. DatabaseError('Error retrieving index fields: ' + E.Message);
  1316. end;
  1317. end;
  1318. end;
  1319. function TCustomSqliteDataset.GetMasterSource: TDataSource;
  1320. begin
  1321. Result := FMasterLink.DataSource;
  1322. end;
  1323. procedure TCustomSqliteDataset.SetFileName(const Value: String);
  1324. begin
  1325. if Value <> FFileName then
  1326. begin
  1327. if Active then
  1328. DatabaseError('It''s not allowed to change Filename in an open dataset', Self);
  1329. if FSqliteHandle <> nil then
  1330. InternalCloseHandle;
  1331. FFileName := Value;
  1332. end;
  1333. end;
  1334. procedure TCustomSqliteDataset.SetMasterSource(Value: TDataSource);
  1335. begin
  1336. FMasterLink.DataSource := Value;
  1337. end;
  1338. procedure TCustomSqliteDataset.ExecSQL(const ASQL: String);
  1339. begin
  1340. if FSqliteHandle = nil then
  1341. GetSqliteHandle;
  1342. ExecuteDirect(ASQL);
  1343. end;
  1344. procedure TCustomSqliteDataset.ExecSQLList;
  1345. begin
  1346. if FSqliteHandle = nil then
  1347. GetSqliteHandle;
  1348. FReturnCode := SqliteExec(PChar(FSQLList.Text), nil, nil);
  1349. if FReturnCode <> SQLITE_OK then
  1350. DatabaseError(ReturnString, Self);
  1351. end;
  1352. function TCustomSqliteDataset.GetSQLValue(Values: PPChar; FieldIndex: Integer
  1353. ): String;
  1354. begin
  1355. if (State = dsInactive) or (FieldIndex < 0) or (FieldIndex >= FieldDefs.Count) then
  1356. DatabaseError('Error retrieving SQL value: dataset inactive or field out of range', Self);
  1357. Result := FGetSqlStr[FieldIndex](Values[FieldIndex]);
  1358. end;
  1359. procedure TCustomSqliteDataset.ExecSQL;
  1360. begin
  1361. ExecSQL(FSQL);
  1362. end;
  1363. function TCustomSqliteDataset.ApplyUpdates: Boolean;
  1364. var
  1365. iFields, iItems, StatementsCounter: Integer;
  1366. SQLTemp, WhereKeyNameEqual, SQLLine, TemplateStr: String;
  1367. TempItem: PDataRecord;
  1368. begin
  1369. Result := False;
  1370. CheckBrowseMode;
  1371. if not UpdatesPending then
  1372. begin
  1373. Result := True;
  1374. Exit;
  1375. end;
  1376. //A PrimaryKey is only necessary to update or delete records
  1377. if FPrimaryKeyNo <> -1 then
  1378. begin
  1379. WhereKeyNameEqual := ' WHERE ' + FieldDefs[FPrimaryKeyNo].Name + ' = ';
  1380. Result := True;
  1381. end else if (FUpdatedItems.Count + FDeletedItems.Count) = 0 then
  1382. Result := True;
  1383. if not Result then
  1384. Exit;
  1385. FReturnCode := SQLITE_OK;
  1386. StatementsCounter := 0;
  1387. SQLTemp := 'BEGIN;';
  1388. {$ifdef DEBUG_SQLITEDS}
  1389. WriteLn('##TCustomSqliteDataset.ApplyUpdates##');
  1390. if FPrimaryKeyNo = FAutoIncFieldNo then
  1391. WriteLn(' Using an AutoInc field as primary key');
  1392. WriteLn(' PrimaryKey: ', WhereKeyNameEqual);
  1393. WriteLn(' PrimaryKeyNo: ', FPrimaryKeyNo);
  1394. {$endif}
  1395. // Delete Records
  1396. if FDeletedItems.Count > 0 then
  1397. begin
  1398. TemplateStr := 'DELETE FROM ' + FTableName + WhereKeyNameEqual;
  1399. for iItems := 0 to FDeletedItems.Count - 1 do
  1400. begin
  1401. TempItem := PDataRecord(FDeletedItems.List^[iItems]);
  1402. SQLTemp := SQLTemp + (TemplateStr +
  1403. FGetSqlStr[FPrimaryKeyNo](TempItem^.Row[FPrimaryKeyNo]) + ';');
  1404. FreeItem(TempItem);
  1405. Inc(StatementsCounter);
  1406. //ApplyUpdates each 400 statements
  1407. if StatementsCounter = 400 then
  1408. begin
  1409. SQLTemp := SQLTemp + 'COMMIT;';
  1410. FReturnCode := SqliteExec(PChar(SQLTemp), nil, nil);
  1411. StatementsCounter := 0;
  1412. SQLTemp := 'BEGIN;';
  1413. if FReturnCode <> SQLITE_OK then
  1414. begin
  1415. SqliteExec('ROLLBACK;', nil, nil);
  1416. Break;
  1417. end;
  1418. end;
  1419. end;
  1420. end;
  1421. // Update changed records
  1422. if (FUpdatedItems.Count > 0) and (FReturnCode = SQLITE_OK) then
  1423. begin
  1424. TemplateStr := 'UPDATE ' + FTableName + ' SET ';
  1425. for iItems := 0 to FUpdatedItems.Count - 1 do
  1426. begin
  1427. SQLLine := TemplateStr;
  1428. for iFields := 0 to FieldDefs.Count - 2 do
  1429. begin
  1430. SQLLine := SQLLine + (FieldDefs[iFields].Name + ' = ' +
  1431. FGetSqlStr[iFields](PDataRecord(FUpdatedItems[iItems])^.Row[iFields]) + ',');
  1432. end;
  1433. iFields := FieldDefs.Count - 1;
  1434. SQLLine := SQLLine + (FieldDefs[iFields].Name + ' = ' +
  1435. FGetSqlStr[iFields](PDataRecord(FUpdatedItems[iItems])^.Row[iFields]) +
  1436. WhereKeyNameEqual +
  1437. FGetSqlStr[FPrimaryKeyNo](PDataRecord(FUpdatedItems[iItems])^.Row[FPrimaryKeyNo]) + ';');
  1438. SQLTemp := SQLTemp + SQLLine;
  1439. Inc(StatementsCounter);
  1440. //ApplyUpdates each 400 statements
  1441. if StatementsCounter = 400 then
  1442. begin
  1443. SQLTemp := SQLTemp + 'COMMIT;';
  1444. FReturnCode := SqliteExec(PChar(SQLTemp), nil, nil);
  1445. StatementsCounter := 0;
  1446. SQLTemp := 'BEGIN;';
  1447. if FReturnCode <> SQLITE_OK then
  1448. begin
  1449. SqliteExec('ROLLBACK;', nil, nil);
  1450. Break;
  1451. end;
  1452. end;
  1453. end;
  1454. end;
  1455. // Add new records
  1456. if (FAddedItems.Count > 0) and (FReturnCode = SQLITE_OK) then
  1457. begin
  1458. // Build TemplateStr
  1459. TemplateStr := 'INSERT INTO ' + FTableName + ' (';
  1460. for iFields := 0 to FieldDefs.Count - 2 do
  1461. TemplateStr := TemplateStr + FieldDefs[iFields].Name + ',';
  1462. TemplateStr := TemplateStr + FieldDefs[FieldDefs.Count - 1].Name + ') VALUES (';
  1463. for iItems := 0 to FAddedItems.Count - 1 do
  1464. begin
  1465. SQLLine := TemplateStr;
  1466. for iFields := 0 to FieldDefs.Count - 2 do
  1467. SQLLine := SQLLine + (FGetSqlStr[iFields](PDataRecord(FAddedItems[iItems])^.Row[iFields]) + ',');
  1468. iFields := FieldDefs.Count - 1;
  1469. SQLLine := SQLLine + (FGetSqlStr[iFields](PDataRecord(FAddedItems[iItems])^.Row[iFields]) + ');' );
  1470. SQLTemp := SQLTemp + SQLLine;
  1471. Inc(StatementsCounter);
  1472. //ApplyUpdates each 400 statements
  1473. if StatementsCounter = 400 then
  1474. begin
  1475. SQLTemp := SQLTemp + 'COMMIT;';
  1476. FReturnCode := SqliteExec(PChar(SQLTemp), nil, nil);
  1477. StatementsCounter := 0;
  1478. SQLTemp := 'BEGIN;';
  1479. if FReturnCode <> SQLITE_OK then
  1480. begin
  1481. SqliteExec('ROLLBACK;', nil, nil);
  1482. Break;
  1483. end;
  1484. end;
  1485. end;
  1486. end;
  1487. FAddedItems.Clear;
  1488. FUpdatedItems.Clear;
  1489. FDeletedItems.Clear;
  1490. if FReturnCode = SQLITE_OK then
  1491. begin
  1492. SQLTemp := SQLTemp + 'COMMIT;';
  1493. FReturnCode := SqliteExec(PChar(SQLTemp), nil, nil);
  1494. if FReturnCode <> SQLITE_OK then
  1495. SqliteExec('ROLLBACK;', nil, nil);
  1496. end;
  1497. Result := FReturnCode = SQLITE_OK;
  1498. {$ifdef DEBUG_SQLITEDS}
  1499. WriteLn(' Result: ', Result);
  1500. {$endif}
  1501. end;
  1502. procedure TCustomSqliteDataset.ClearUpdates(RecordStates: TRecordStateSet);
  1503. begin
  1504. if rsUpdated in RecordStates then
  1505. FUpdatedItems.Clear;
  1506. if rsDeleted in RecordStates then
  1507. FDeletedItems.Clear;
  1508. if rsAdded in RecordStates then
  1509. FAddedItems.Clear;
  1510. end;
  1511. function TCustomSqliteDataset.CreateTable: Boolean;
  1512. begin
  1513. Result := CreateTable(FTableName);
  1514. end;
  1515. function TCustomSqliteDataset.CreateTable(const ATableName: String): Boolean;
  1516. var
  1517. SQLTemp: String;
  1518. i, StrSize: Integer;
  1519. begin
  1520. {$ifdef DEBUG_SQLITEDS}
  1521. WriteLn('##TCustomSqliteDataset.CreateTable##');
  1522. if ATableName = '' then
  1523. WriteLn(' TableName Not Set');
  1524. if FieldDefs.Count = 0 then
  1525. WriteLn(' FieldDefs Not Initialized');
  1526. {$endif}
  1527. if (ATableName <> '') and (FieldDefs.Count > 0) then
  1528. begin
  1529. SQLTemp := 'CREATE TABLE ' + ATableName + ' (';
  1530. for i := 0 to FieldDefs.Count - 1 do
  1531. begin
  1532. //todo: add index to autoinc field
  1533. SQLTemp := SQLTemp + FieldDefs[i].Name;
  1534. case FieldDefs[i].DataType of
  1535. ftInteger:
  1536. SQLTemp := SQLTemp + ' INTEGER';
  1537. ftString:
  1538. begin
  1539. StrSize := FieldDefs[i].Size;
  1540. if StrSize = 0 then
  1541. StrSize := DefaultStringSize;
  1542. SQLTemp := SQLTemp + ' VARCHAR(' + IntToStr(StrSize) + ')';
  1543. end;
  1544. ftBoolean:
  1545. SQLTemp := SQLTemp + ' BOOL_INT';
  1546. ftFloat:
  1547. SQLTemp := SQLTemp + ' FLOAT';
  1548. ftWord:
  1549. SQLTemp := SQLTemp + ' WORD';
  1550. ftDateTime:
  1551. SQLTemp := SQLTemp + ' DATETIME';
  1552. ftDate:
  1553. SQLTemp := SQLTemp + ' DATE';
  1554. ftTime:
  1555. SQLTemp := SQLTemp + ' TIME';
  1556. ftLargeInt:
  1557. SQLTemp := SQLTemp + ' LARGEINT';
  1558. ftCurrency:
  1559. SQLTemp := SQLTemp + ' CURRENCY';
  1560. ftAutoInc:
  1561. SQLTemp := SQLTemp + ' AUTOINC_INT';
  1562. ftMemo:
  1563. SQLTemp := SQLTemp + ' TEXT';
  1564. else
  1565. DatabaseError('Field type "' + FieldTypeNames[FieldDefs[i].DataType] +
  1566. '" not supported', Self);
  1567. end;
  1568. if UpperCase(FieldDefs[i].Name) = UpperCase(FPrimaryKey) then
  1569. SQLTemp := SQLTemp + ' PRIMARY KEY';
  1570. if i <> FieldDefs.Count - 1 then
  1571. SQLTemp := SQLTemp + ' , ';
  1572. end;
  1573. SQLTemp := SQLTemp + ');';
  1574. {$ifdef DEBUG_SQLITEDS}
  1575. WriteLn(' SQL: ',SqlTemp);
  1576. {$endif}
  1577. ExecSQL(SQLTemp);
  1578. Result := FReturnCode = SQLITE_OK;
  1579. end
  1580. else
  1581. Result := False;
  1582. end;
  1583. procedure TCustomSqliteDataset.ExecCallback(const ASQL: String; UserData: Pointer = nil);
  1584. var
  1585. CallbackInfo: TCallbackInfo;
  1586. begin
  1587. if not Assigned(FOnCallback) then
  1588. DatabaseError('OnCallback property not set', Self);
  1589. if FSqliteHandle = nil then
  1590. GetSqliteHandle;
  1591. CallbackInfo.Data := UserData;
  1592. CallbackInfo.Proc := FOnCallback;
  1593. SqliteExec(PChar(ASQL), @CallbackDispatcher, @CallbackInfo);
  1594. end;
  1595. procedure TCustomSqliteDataset.QueryUpdates(RecordStates: TRecordStateSet; Callback: TQueryUpdatesCallback;
  1596. UserData: Pointer = nil);
  1597. var
  1598. i: Integer;
  1599. TempItem: PDataRecord;
  1600. begin
  1601. if not Assigned(Callback) then
  1602. DatabaseError('Callback parameter not set', Self);
  1603. CheckBrowseMode;
  1604. if rsDeleted in RecordStates then
  1605. with FDeletedItems do
  1606. for i := 0 to Count - 1 do
  1607. Callback(UserData,PDataRecord(Items[i])^.Row, nil, rsDeleted);
  1608. if rsUpdated in RecordStates then
  1609. with FUpdatedItems do
  1610. for i := 0 to Count - 1 do
  1611. begin
  1612. TempItem := PDataRecord(Items[i]);
  1613. Callback(UserData, TempItem^.Row, TBookmark(@TempItem), rsUpdated);
  1614. end;
  1615. if rsAdded in RecordStates then
  1616. with FAddedItems do
  1617. for i := 0 to Count - 1 do
  1618. begin
  1619. TempItem := PDataRecord(Items[i]);
  1620. Callback(UserData, TempItem^.Row, TBookmark(@TempItem), rsAdded);
  1621. end;
  1622. end;
  1623. procedure TCustomSqliteDataset.RefetchData;
  1624. var
  1625. i: Integer;
  1626. begin
  1627. //Close
  1628. if FSaveOnRefetch then
  1629. ApplyUpdates;
  1630. if FDataAllocated then
  1631. DisposeLinkedList;
  1632. FAddedItems.Clear;
  1633. FUpdatedItems.Clear;
  1634. FDeletedItems.Clear;
  1635. //Reopen
  1636. BuildLinkedList;
  1637. FCurrentItem := FBeginItem;
  1638. for i := 0 to BufferCount - 1 do
  1639. PPDataRecord(Buffers[i])^ := FBeginItem;
  1640. Resync([]);
  1641. DoAfterScroll;
  1642. end;
  1643. function TCustomSqliteDataset.TableExists: Boolean;
  1644. begin
  1645. Result:=TableExists(FTableName);
  1646. end;
  1647. function TCustomSqliteDataset.TableExists(const ATableName: String): Boolean;
  1648. begin
  1649. ExecSql('SELECT name FROM SQLITE_MASTER WHERE type = ''table'' AND name LIKE ''' + ATableName + ''';');
  1650. Result := FReturnCode = SQLITE_ROW;
  1651. end;
  1652. function TCustomSqliteDataset.UpdatesPending: Boolean;
  1653. begin
  1654. Result := (FUpdatedItems.Count > 0) or
  1655. (FAddedItems.Count > 0) or (FDeletedItems.Count > 0);
  1656. end;
  1657. function TCustomSqliteDataset.QuickQuery(const ASQL: String): String;
  1658. begin
  1659. Result := QuickQuery(ASQL, nil, False);
  1660. end;
  1661. function TCustomSqliteDataset.QuickQuery(const ASQL: String; const AStrList: TStrings): String;
  1662. begin
  1663. Result := QuickQuery(ASQL, AStrList, False)
  1664. end;
  1665. {$ifdef DEBUGACTIVEBUFFER}
  1666. procedure TCustomSqliteDataset.SetCurrentItem(Value:PDataRecord);
  1667. var
  1668. ANo:Integer;
  1669. function GetItemPos:Integer;
  1670. var
  1671. TempItem:PDataRecord;
  1672. begin
  1673. Result:= -1;
  1674. TempItem:=FBeginItem;
  1675. if Value = FCacheItem then
  1676. Result:=-2
  1677. else
  1678. while Value <> TempItem do
  1679. begin
  1680. if TempItem^.Next <> nil then
  1681. begin
  1682. inc(Result);
  1683. TempItem:=TempItem^.Next;
  1684. end
  1685. else
  1686. begin
  1687. Result:=-1;
  1688. break;
  1689. end;
  1690. end;
  1691. end;
  1692. begin
  1693. if Value = FBeginItem then
  1694. begin
  1695. writeln('FCurrentItem set to FBeginItem: ',IntToHex(Integer(Value),0));
  1696. FFCurrentItem:=Value;
  1697. end
  1698. else
  1699. if Value = FEndItem then
  1700. begin
  1701. writeln('FCurrentItem set to FEndItem: ',IntToHex(Integer(Value),0));
  1702. FFCurrentItem:=Value;
  1703. end
  1704. else
  1705. if Value = FCacheItem then
  1706. begin
  1707. writeln('FCurrentItem set to FCacheItem: ',IntToHex(Integer(Value),0));
  1708. FFCurrentItem:=Value;
  1709. end
  1710. else
  1711. begin
  1712. writeln('FCurrentItem set from ',IntToHex(Integer(FFCurrentItem),0),' to ',IntToHex(Integer(Value),0));
  1713. Ano:=GetItemPos;
  1714. writeln('Item position is ',ANo);
  1715. FFCurrentItem:=Value;
  1716. end;
  1717. end;
  1718. {$endif}
  1719. end.