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