customsqliteds.pas 56 KB

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