customsqliteds.pas 45 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578
  1. unit customsqliteds;
  2. {
  3. This is TCustomSqliteDataset, a TDataset descendant class for use with fpc compiler
  4. Copyright (C) 2004 Luiz Américo Pereira Câmara
  5. Email: [email protected]
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU Lesser General Public License as published by
  8. the Free Software Foundation; either version 2.1 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU Lesser General Public License for more details.
  14. You should have received a copy of the GNU Lesser General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  17. }
  18. {$Mode ObjFpc}
  19. {$H+}
  20. { $Define DEBUG}
  21. { $Define DEBUGACTIVEBUFFER}
  22. interface
  23. uses
  24. Classes, SysUtils, Db;
  25. type
  26. PDataRecord = ^DataRecord;
  27. PPDataRecord = ^PDataRecord;
  28. DataRecord = record
  29. Row: PPchar;
  30. BookmarkFlag: TBookmarkFlag;
  31. Next: PDataRecord;
  32. Previous: PDataRecord;
  33. end;
  34. TDSStream = class(TStream)
  35. private
  36. FActiveItem:PDataRecord;
  37. FFieldRow:PChar;
  38. FFieldIndex:Integer;
  39. FRowSize: Integer;
  40. FPosition: Longint;
  41. public
  42. constructor Create(const ActiveItem: PDataRecord; FieldIndex:Integer);
  43. function Write(const Buffer; Count: Longint): Longint; override;
  44. function Read(var Buffer; Count: Longint): Longint; override;
  45. function Seek(Offset: Longint; Origin: Word): Longint; override;
  46. end;
  47. //callback types
  48. TSqliteCdeclCallback = function (UserData:Pointer; Count:LongInt; Values:PPChar; Names:PPChar):LongInt;cdecl;
  49. TSqliteCallback = function (UserData:Pointer; Count:LongInt; Values:PPChar; Names:PPChar):LongInt of Object;
  50. TCallbackInfo = record
  51. Proc: TSqliteCallback;
  52. Data: Pointer;
  53. end;
  54. PCallbackInfo = ^TCallbackInfo;
  55. TRecordState = (rsAdded,rsDeleted,rsUpdated);
  56. TRecordStateSet = set of TRecordState;
  57. TQueryUpdatesCallback = procedure (UserData: Pointer; Values: PPChar; ABookmark: TBookmark; RecordState: TRecordState) of Object;
  58. TGetSqlStrFunction = function (APChar: PChar): String;
  59. { TCustomSqliteDataset }
  60. TCustomSqliteDataset = class(TDataSet)
  61. private
  62. {$ifdef DEBUGACTIVEBUFFER}
  63. FFCurrentItem: PDataRecord;
  64. {$else}
  65. FCurrentItem: PDataRecord;
  66. {$endif}
  67. FInternalActiveBuffer: PDataRecord;
  68. FInsertBookmark: PDataRecord;
  69. FBufferSize: Integer;
  70. FExpectedAppends: Integer;
  71. FExpectedDeletes: Integer;
  72. FExpectedUpdates: Integer;
  73. FOnCallback: TSqliteCallback;
  74. FSaveOnClose: Boolean;
  75. FSaveOnRefetch: Boolean;
  76. FAutoIncrementKey: Boolean;
  77. FMasterLink: TMasterDataLink;
  78. FIndexFieldNames: String;
  79. FIndexFieldList: TList;
  80. FSqlList:TStrings;
  81. procedure CopyCacheToItem(AItem: PDataRecord);
  82. function GetIndexFields(Value: Integer): TField;
  83. procedure UpdateIndexFields;
  84. function FindRecordItem(StartItem: PDataRecord; const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions; DoResync:Boolean):PDataRecord;
  85. protected
  86. FPrimaryKey: String;
  87. FPrimaryKeyNo: Integer;
  88. FFileName: String;
  89. FSql: String;
  90. FTableName: String;
  91. FSelectSqlStr: String;
  92. FAutoIncFieldNo: Integer;
  93. FNextAutoInc:Integer;
  94. FUpdatedItems: TFPList;
  95. FAddedItems: TFPList;
  96. FDeletedItems: TFPList;
  97. FOrphanItems: TFPList;
  98. FReturnCode: Integer;
  99. FSqliteHandle: Pointer;
  100. FDataAllocated: Boolean;
  101. FRowBufferSize: Integer;
  102. FRowCount: Integer;
  103. FRecordCount: Integer;
  104. FBeginItem: PDataRecord;
  105. FEndItem: PDataRecord;
  106. FCacheItem: PDataRecord;
  107. FGetSqlStr: array of TGetSqlStrFunction;
  108. function SqliteExec(Sql:PChar; ACallback: TSqliteCdeclCallback; Data: Pointer):Integer;virtual; abstract;
  109. procedure InternalCloseHandle;virtual;abstract;
  110. function InternalGetHandle: Pointer; virtual; abstract;
  111. procedure GetSqliteHandle;
  112. function GetSqliteVersion: String; virtual; abstract;
  113. procedure BuildLinkedList; virtual; abstract;
  114. procedure DisposeLinkedList;
  115. procedure SetDetailFilter;
  116. procedure MasterChanged(Sender: TObject);
  117. procedure MasterDisabled(Sender: TObject);
  118. procedure SetMasterFields(Value:String);
  119. function GetMasterFields:String;
  120. procedure SetMasterSource(Value: TDataSource);
  121. function GetMasterSource:TDataSource;
  122. procedure SetFileName(Value: String);
  123. function GetRowsAffected:Integer; virtual;abstract;
  124. //TDataSet overrides
  125. function AllocRecordBuffer: PChar; override;
  126. function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
  127. procedure DoAfterInsert; override;
  128. procedure DoBeforeInsert; override;
  129. procedure FreeRecordBuffer(var Buffer: PChar); override;
  130. procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
  131. function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
  132. function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
  133. function GetRecordCount: Integer; override;
  134. function GetRecNo: Integer; override;
  135. function GetRecordSize: Word; override;
  136. procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
  137. procedure InternalClose; override;
  138. procedure InternalCancel; override;
  139. procedure InternalDelete; override;
  140. procedure InternalEdit; override;
  141. procedure InternalFirst; override;
  142. procedure InternalGotoBookmark(ABookmark: Pointer); override;
  143. procedure InternalInitRecord(Buffer: PChar); override;
  144. procedure InternalLast; override;
  145. procedure InternalOpen; override;
  146. procedure InternalPost; override;
  147. procedure InternalSetToRecord(Buffer: PChar); override;
  148. function IsCursorOpen: Boolean; override;
  149. procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  150. procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
  151. procedure SetExpectedAppends(AValue:Integer);
  152. procedure SetExpectedUpdates(AValue:Integer);
  153. procedure SetExpectedDeletes(AValue:Integer);
  154. procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  155. procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); override;
  156. procedure SetRecNo(Value: Integer); override;
  157. public
  158. constructor Create(AOwner: TComponent); override;
  159. destructor Destroy; override;
  160. function BookmarkValid(ABookmark: TBookmark): Boolean; override;
  161. function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
  162. function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
  163. function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; override;
  164. function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean; override;
  165. function LocateNext(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean;
  166. function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant;{$ifndef ver2_0_0}override;{$endif}
  167. // Additional procedures
  168. function ApplyUpdates: Boolean;
  169. function CreateTable: Boolean;
  170. function CreateTable(const ATableName: String): Boolean;
  171. procedure ExecCallback(const ASql: String; UserData: Pointer = nil);
  172. procedure ExecSQL;
  173. procedure ExecSQL(const ASql:String);
  174. procedure ExecSQLList;
  175. procedure ExecuteDirect(const ASql: String);virtual;abstract;
  176. procedure QueryUpdates(RecordStates: TRecordStateSet; Callback: TQueryUpdatesCallback; UserData: Pointer=nil);
  177. function QuickQuery(const ASql:String):String;overload;
  178. function QuickQuery(const ASql:String;const AStrList: TStrings):String;overload;
  179. function QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;virtual;abstract;overload;
  180. procedure RefetchData;
  181. function ReturnString: String; virtual;abstract;
  182. function TableExists: Boolean;
  183. function TableExists(const ATableName:String):Boolean;
  184. function UpdatesPending: Boolean;
  185. {$ifdef DEBUGACTIVEBUFFER}
  186. procedure SetCurrentItem(Value:PDataRecord);
  187. property FCurrentItem: PDataRecord read FFCurrentItem write SetCurrentItem;
  188. {$endif}
  189. property ExpectedAppends: Integer read FExpectedAppends write SetExpectedAppends;
  190. property ExpectedUpdates: Integer read FExpectedUpdates write SetExpectedUpdates;
  191. property ExpectedDeletes: Integer read FExpectedDeletes write SetExpectedDeletes;
  192. property IndexFields[Value: Integer]: TField read GetIndexFields;
  193. property RowsAffected: Integer read GetRowsAffected;
  194. property ReturnCode: Integer read FReturnCode;
  195. property SqliteHandle: Pointer read FSqliteHandle;
  196. property SqliteVersion: String read GetSqliteVersion;
  197. property SQLList:TStrings read FSqlList;
  198. published
  199. property AutoIncrementKey: Boolean read FAutoIncrementKey write FAutoIncrementKey;
  200. property IndexFieldNames: string read FIndexFieldNames write FIndexFieldNames;
  201. property FileName: String read FFileName write SetFileName;
  202. property OnCallback: TSqliteCallback read FOnCallback write FOnCallback;
  203. property PrimaryKey: String read FPrimaryKey write FPrimaryKey;
  204. property SaveOnClose: Boolean read FSaveOnClose write FSaveOnClose;
  205. property SaveOnRefetch: Boolean read FSaveOnRefetch write FSaveOnRefetch;
  206. property SQL: String read FSql write FSql;
  207. property TableName: String read FTableName write FTableName;
  208. property MasterSource: TDataSource read GetMasterSource write SetMasterSource;
  209. property MasterFields: string read GetMasterFields write SetMasterFields;
  210. property Active;
  211. //Events
  212. property BeforeOpen;
  213. property AfterOpen;
  214. property BeforeClose;
  215. property AfterClose;
  216. property BeforeInsert;
  217. property AfterInsert;
  218. property BeforeEdit;
  219. property AfterEdit;
  220. property BeforePost;
  221. property AfterPost;
  222. property BeforeCancel;
  223. property AfterCancel;
  224. property BeforeDelete;
  225. property AfterDelete;
  226. property BeforeScroll;
  227. property AfterScroll;
  228. property OnDeleteError;
  229. property OnEditError;
  230. end;
  231. function Num2SqlStr(APChar: PChar): String;
  232. function Char2SqlStr(APChar: PChar): String;
  233. implementation
  234. uses
  235. strutils, variants, dbconst;
  236. const
  237. //sqlite2.x.x and sqlite3.x.x define these constants equally
  238. SQLITE_OK = 0;
  239. SQLITE_ROW = 100;
  240. NullString = 'NULL';
  241. function CallbackDispatcher(UserData:Pointer; Count:LongInt; Values:PPchar; Names:PPchar):LongInt;cdecl;
  242. begin
  243. with PCallbackInfo(UserData)^ do
  244. Result:= Proc(Data,Count,Values,Names);
  245. end;
  246. function Num2SqlStr(APChar: PChar): String;
  247. begin
  248. if APChar = nil then
  249. begin
  250. Result:=NullString;
  251. Exit;
  252. end;
  253. Result:=StrPas(APChar);
  254. end;
  255. function Char2SqlStr(APChar: PChar): String;
  256. begin
  257. if APChar = nil then
  258. begin
  259. Result:=NullString;
  260. Exit;
  261. end;
  262. //todo: create custom routine to directly transform PChar -> SQL str
  263. Result:=StrPas(APChar);
  264. if Pos('''',Result) > 0 then
  265. Result:=AnsiReplaceStr(Result,'''','''''');
  266. Result:=''''+Result+'''';
  267. end;
  268. // TDSStream
  269. constructor TDSStream.Create(const ActiveItem: PDataRecord; FieldIndex:Integer);
  270. begin
  271. inherited Create;
  272. FPosition:=0;
  273. FActiveItem:=ActiveItem;
  274. FFieldIndex:=FieldIndex;
  275. FFieldRow:=ActiveItem^.Row[FieldIndex];
  276. if FFieldRow <> nil then
  277. FRowSize:=StrLen(FFieldRow)
  278. else
  279. FRowSize:=0;
  280. end;
  281. function TDSStream.Seek(Offset: Longint; Origin: Word): Longint;
  282. begin
  283. Case Origin of
  284. soFromBeginning : FPosition:=Offset;
  285. soFromEnd : FPosition:=FRowSize+Offset;
  286. soFromCurrent : FPosition:=FPosition+Offset;
  287. end;
  288. Result:=FPosition;
  289. end;
  290. function TDSStream.Write(const Buffer; Count: Longint): Longint;
  291. var
  292. NewRow:PChar;
  293. begin
  294. Result:=Count;
  295. if Count = 0 then
  296. Exit;
  297. //FRowSize is always 0 when FPosition = 0,
  298. //so there's no need to check FPosition
  299. NewRow:=StrAlloc(FRowSize+Count+1);
  300. (NewRow+Count+FRowSize)^:=#0;
  301. if FRowSize > 0 then
  302. Move(FFieldRow^,NewRow^,FRowSize);
  303. Move(Buffer,(NewRow+FRowSize)^,Count);
  304. FActiveItem^.Row[FFieldIndex]:=NewRow;
  305. StrDispose(FFieldRow);
  306. {$ifdef DEBUG}
  307. WriteLn('##TDSStream.Write##');
  308. WriteLn(' FPosition(Before): ',FPosition);
  309. WriteLn(' FRowSize(Before): ',FRowSize);
  310. WriteLn(' FPosition(After): ',FPosition+Count);
  311. WriteLn(' FRowSize(After): ',StrLen(NewRow));
  312. //WriteLn(' Stream Value: ',NewRow);
  313. {$endif}
  314. FFieldRow:=NewRow;
  315. FRowSize:=StrLen(NewRow);
  316. Inc(FPosition,Count);
  317. end;
  318. function TDSStream.Read(var Buffer; Count: Longint): Longint;
  319. var
  320. BytesToMove:Integer;
  321. begin
  322. if (FRowSize - FPosition) >= Count then
  323. BytesToMove:=Count
  324. else
  325. BytesToMove:=FRowSize - FPosition;
  326. Move((FFieldRow+FPosition)^,Buffer,BytesToMove);
  327. Inc(FPosition,BytesToMove);
  328. Result:=BytesToMove;
  329. {$ifdef DEBUG}
  330. WriteLn('##TDSStream.Read##');
  331. WriteLn(' Bytes requested: ',Count);
  332. WriteLn(' Bytes moved: ',BytesToMove);
  333. WriteLn(' Stream.Size: ',FRowSize);
  334. //WriteLn(' Stream Value: ',FFieldRow);
  335. {$endif}
  336. end;
  337. // TCustomSqliteDataset override methods
  338. function TCustomSqliteDataset.AllocRecordBuffer: PChar;
  339. var
  340. APointer:Pointer;
  341. begin
  342. APointer := AllocMem(FBufferSize);
  343. PDataRecord(APointer^):=FBeginItem;
  344. Result:=APointer;
  345. end;
  346. constructor TCustomSqliteDataset.Create(AOwner: TComponent);
  347. begin
  348. // setup special items
  349. New(FBeginItem);
  350. New(FCacheItem);
  351. New(FEndItem);
  352. FBeginItem^.Previous:=nil;
  353. FEndItem^.Next:=nil;
  354. FBeginItem^.BookMarkFlag:=bfBOF;
  355. FEndItem^.BookMarkFlag:=bfEOF;
  356. FMasterLink:=TMasterDataLink.Create(Self);
  357. FMasterLink.OnMasterChange:=@MasterChanged;
  358. FMasterLink.OnMasterDisable:=@MasterDisabled;
  359. FIndexFieldList:=TList.Create;
  360. BookmarkSize := SizeOf(Pointer);
  361. FBufferSize := SizeOf(PPDataRecord);
  362. FUpdatedItems:= TFPList.Create;
  363. FAddedItems:= TFPList.Create;
  364. FOrphanItems:= TFPList.Create;
  365. FDeletedItems:= TFPList.Create;
  366. FSqlList:=TStringList.Create;
  367. inherited Create(AOwner);
  368. end;
  369. function TCustomSqliteDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
  370. begin
  371. if Mode = bmWrite then
  372. begin
  373. if not (State in [dsEdit, dsInsert]) then
  374. begin
  375. DatabaseErrorFmt(SNotInEditState,[Name],Self);
  376. Exit;
  377. end;
  378. StrDispose(FCacheItem^.Row[Field.FieldNo - 1]);
  379. FCacheItem^.Row[Field.FieldNo - 1]:=nil;
  380. end;
  381. Result:= TDSStream.Create(PPDataRecord(ActiveBuffer)^,Field.FieldNo - 1);
  382. end;
  383. procedure TCustomSqliteDataset.DoAfterInsert;
  384. begin
  385. //an append or an insert in an empty dataset
  386. if EOF then
  387. FInsertBookmark:=FEndItem
  388. else
  389. FInsertBookmark:=FInternalActiveBuffer;
  390. inherited DoAfterInsert;
  391. end;
  392. procedure TCustomSqliteDataset.DoBeforeInsert;
  393. begin
  394. FInternalActiveBuffer:=PPDataRecord(ActiveBuffer)^;
  395. inherited DoBeforeInsert;
  396. end;
  397. destructor TCustomSqliteDataset.Destroy;
  398. begin
  399. inherited Destroy;
  400. if FSqliteHandle <> nil then
  401. InternalCloseHandle;
  402. FUpdatedItems.Destroy;
  403. FAddedItems.Destroy;
  404. FDeletedItems.Destroy;
  405. FOrphanItems.Destroy;
  406. FMasterLink.Destroy;
  407. FIndexFieldList.Destroy;
  408. FSqlList.Destroy;
  409. // dispose special items
  410. Dispose(FBeginItem);
  411. Dispose(FCacheItem);
  412. Dispose(FEndItem);
  413. end;
  414. function TCustomSqliteDataset.BookmarkValid(ABookmark: TBookmark): Boolean;
  415. var
  416. TempItem: PDataRecord;
  417. begin
  418. Result:=False;
  419. TempItem:=FBeginItem^.Next;
  420. while TempItem <> FEndItem do
  421. begin
  422. if TempItem = PPDataRecord(ABookmark)^ then
  423. begin
  424. Result:=True;
  425. Exit;
  426. end;
  427. TempItem:=TempItem^.Next;
  428. end;
  429. end;
  430. function TCustomSqliteDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark
  431. ): Longint;
  432. var
  433. TempItem: PDataRecord;
  434. begin
  435. if PPDataRecord(Bookmark1)^ = PPDataRecord(Bookmark2)^ then
  436. begin
  437. Result:=0;
  438. Exit;
  439. end;
  440. //assume Bookmark1 < Bookmark2
  441. Result:=-1;
  442. TempItem:=PPDataRecord(Bookmark1)^^.Previous;
  443. while TempItem <> FBeginItem do
  444. begin
  445. if TempItem = PPDataRecord(Bookmark2)^ then
  446. begin
  447. //Bookmark1 is greater than Bookmark2
  448. Result:=1;
  449. Exit;
  450. end;
  451. TempItem:=TempItem^.Previous;
  452. end;
  453. end;
  454. procedure TCustomSqliteDataset.CopyCacheToItem(AItem: PDataRecord);
  455. var
  456. i:Integer;
  457. begin
  458. for i := 0 to FRowCount - 1 do
  459. begin
  460. StrDispose(AItem^.Row[i]);
  461. AItem^.Row[i]:=FCacheItem^.Row[i];
  462. FCacheItem^.Row[i]:=nil;
  463. end;
  464. AItem^.BookmarkFlag:=FCacheItem^.BookmarkFlag;
  465. end;
  466. function TCustomSqliteDataset.GetIndexFields(Value: Integer): TField;
  467. begin
  468. if (Value < 0) or (Value > FIndexFieldList.Count - 1) then
  469. DatabaseError('Error acessing IndexFields: Index out of bonds',Self);
  470. Result:= TField(FIndexFieldList[Value]);
  471. end;
  472. procedure TCustomSqliteDataset.DisposeLinkedList;
  473. var
  474. TempItem:PDataRecord;
  475. Counter,I:Integer;
  476. begin
  477. //Todo: insert debug info
  478. //Todo: see if FDataAllocated is still necessary
  479. FDataAllocated:=False;
  480. TempItem:=FBeginItem^.Next;
  481. //Todo: see if is necessary to check if TempItem is nil (aparently is not)
  482. if TempItem <> nil then
  483. while TempItem^.Next <> nil do
  484. begin
  485. //Todo: Add procedure to Dispose and Free a Row ?
  486. for Counter:= 0 to FRowCount - 1 do
  487. StrDispose(TempItem^.Row[Counter]);
  488. FreeMem(TempItem^.Row,FRowBufferSize);
  489. TempItem:=TempItem^.Next;
  490. Dispose(TempItem^.Previous);
  491. end;
  492. //Dispose FBeginItem.Row
  493. FreeMem(FBeginItem^.Row,FRowBufferSize);
  494. //Dispose cache item
  495. for Counter:= 0 to FRowCount - 1 do
  496. StrDispose(FCacheItem^.Row[Counter]);
  497. FreeMem(FCacheItem^.Row,FRowBufferSize);
  498. //Dispose OrphanItems
  499. for Counter:= 0 to FOrphanItems.Count - 1 do
  500. begin
  501. TempItem:=PDataRecord(FOrphanItems[Counter]);
  502. for I:= 0 to FRowCount - 1 do
  503. StrDispose(TempItem^.Row[I]);
  504. FreeMem(TempItem^.Row,FRowBufferSize);
  505. Dispose(TempItem);
  506. end;
  507. end;
  508. procedure TCustomSqliteDataset.FreeRecordBuffer(var Buffer: PChar);
  509. begin
  510. FreeMem(Buffer);
  511. end;
  512. procedure TCustomSqliteDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
  513. begin
  514. Pointer(Data^) := PPDataRecord(Buffer)^;
  515. end;
  516. function TCustomSqliteDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
  517. begin
  518. Result := PPDataRecord(Buffer)^^.BookmarkFlag;
  519. end;
  520. function TCustomSqliteDataset.GetFieldData(Field: TField; Buffer: Pointer;
  521. NativeFormat: Boolean): Boolean;
  522. var
  523. ValError:Word;
  524. FieldRow:PChar;
  525. begin
  526. FieldRow:=PPDataRecord(ActiveBuffer)^^.Row[Field.FieldNo - 1];
  527. Result := FieldRow <> nil;
  528. if Result and (Buffer <> nil) then //supports GetIsNull
  529. begin
  530. case Field.Datatype of
  531. ftString:
  532. begin
  533. Move(FieldRow^,PChar(Buffer)^,StrLen(FieldRow)+1);
  534. end;
  535. ftInteger,ftAutoInc:
  536. begin
  537. Val(StrPas(FieldRow),LongInt(Buffer^),ValError);
  538. Result:= ValError = 0;
  539. end;
  540. ftBoolean,ftWord:
  541. begin
  542. Val(StrPas(FieldRow),Word(Buffer^),ValError);
  543. Result:= ValError = 0;
  544. end;
  545. ftFloat,ftDateTime,ftTime,ftDate,ftCurrency:
  546. begin
  547. Val(StrPas(FieldRow),Double(Buffer^),ValError);
  548. Result:= ValError = 0;
  549. end;
  550. ftLargeInt:
  551. begin
  552. Val(StrPas(FieldRow),Int64(Buffer^),ValError);
  553. Result:= ValError = 0;
  554. end;
  555. end;
  556. end;
  557. end;
  558. function TCustomSqliteDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
  559. begin
  560. Result:=GetFieldData(Field, Buffer, False);
  561. end;
  562. function TCustomSqliteDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
  563. begin
  564. Result := grOk;
  565. case GetMode of
  566. gmPrior:
  567. if (FCurrentItem^.Previous = FBeginItem) or (FCurrentItem = FBeginItem) then
  568. begin
  569. Result := grBOF;
  570. FCurrentItem := FBeginItem;
  571. end
  572. else
  573. FCurrentItem:=FCurrentItem^.Previous;
  574. gmCurrent:
  575. if (FCurrentItem = FBeginItem) or (FCurrentItem = FEndItem) then
  576. Result := grError;
  577. gmNext:
  578. if (FCurrentItem = FEndItem) or (FCurrentItem^.Next = FEndItem) then
  579. Result := grEOF
  580. else
  581. FCurrentItem:=FCurrentItem^.Next;
  582. end; //case
  583. if Result = grOk then
  584. begin
  585. PDataRecord(Pointer(Buffer)^):=FCurrentItem;
  586. FCurrentItem^.BookmarkFlag := bfCurrent;
  587. end
  588. else if (Result = grError) and DoCheck then
  589. DatabaseError('No records found',Self);
  590. end;
  591. function TCustomSqliteDataset.GetRecordCount: Integer;
  592. begin
  593. Result := FRecordCount;
  594. end;
  595. function TCustomSqliteDataset.GetRecNo: Integer;
  596. var
  597. TempItem,TempActive:PDataRecord;
  598. begin
  599. Result:= -1;
  600. if (FRecordCount = 0) or (State = dsInsert) then
  601. Exit;
  602. TempItem:=FBeginItem;
  603. TempActive:=PPDataRecord(ActiveBuffer)^;
  604. if TempActive = FCacheItem then // Record is being edited
  605. begin
  606. TempActive:=FInternalActiveBuffer;
  607. end;
  608. //RecNo is 1 based
  609. inc(Result);
  610. while TempActive <> TempItem do
  611. begin
  612. if TempItem^.Next <> nil then
  613. begin
  614. inc(Result);
  615. TempItem:=TempItem^.Next;
  616. end
  617. else
  618. begin
  619. Result:=-1;
  620. DatabaseError('GetRecNo - ActiveItem Not Found',Self);
  621. break;
  622. end;
  623. end;
  624. end;
  625. function TCustomSqliteDataset.GetRecordSize: Word;
  626. begin
  627. Result := FBufferSize; //??
  628. end;
  629. procedure TCustomSqliteDataset.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
  630. var
  631. NewItem: PDataRecord;
  632. begin
  633. {$ifdef DEBUG}
  634. if PPDataRecord(Buffer)^ <> FCacheItem then
  635. DatabaseError('PPDataRecord(Buffer) <> FCacheItem - Problem',Self);
  636. {$endif}
  637. New(NewItem);
  638. GetMem(NewItem^.Row,FRowBufferSize);
  639. //necessary to nullify the Row before copy the cache
  640. FillChar(NewItem^.Row^,FRowBufferSize,#0);
  641. CopyCacheToItem(NewItem);
  642. //insert in the linked list
  643. FInsertBookmark^.Previous^.Next:=NewItem;
  644. NewItem^.Next:=FInsertBookmark;
  645. NewItem^.Previous:=FInsertBookmark^.Previous;
  646. FInsertBookmark^.Previous:=NewItem;
  647. //update the cursor
  648. FCurrentItem:=NewItem;
  649. Inc(FRecordCount);
  650. if FAutoIncFieldNo <> - 1 then
  651. Inc(FNextAutoInc);
  652. FAddedItems.Add(NewItem);
  653. end;
  654. procedure TCustomSqliteDataset.InternalClose;
  655. begin
  656. if FSaveOnClose then
  657. ApplyUpdates;
  658. //BindFields(False);
  659. if DefaultFields then
  660. DestroyFields;
  661. if FDataAllocated then
  662. DisposeLinkedList;
  663. FAddedItems.Clear;
  664. FUpdatedItems.Clear;
  665. FDeletedItems.Clear;
  666. FOrphanItems.Clear;
  667. FRecordCount:=0;
  668. end;
  669. procedure TCustomSqliteDataset.InternalCancel;
  670. var
  671. i: Integer;
  672. begin
  673. PPDataRecord(ActiveBuffer)^:=FInternalActiveBuffer;
  674. //free the cache
  675. for i:= 0 to FRowCount - 1 do
  676. begin
  677. StrDispose(FCacheItem^.Row[i]);
  678. FCacheItem^.Row[i]:=nil;
  679. end;
  680. end;
  681. procedure TCustomSqliteDataset.InternalDelete;
  682. var
  683. TempItem:PDataRecord;
  684. ValError,TempInteger:Integer;
  685. begin
  686. If FRecordCount = 0 then
  687. Exit;
  688. Dec(FRecordCount);
  689. TempItem:=PPDataRecord(ActiveBuffer)^;
  690. // Remove from changed list
  691. FUpdatedItems.Remove(TempItem);
  692. if FAddedItems.Remove(TempItem) = -1 then
  693. FDeletedItems.Add(TempItem);
  694. //Todo: see if FOrphanItems is necessary:
  695. // in ApplyUpdates a check could be done
  696. // to avoid "delete" the AddedItems
  697. FOrphanItems.Add(TempItem);
  698. TempItem^.Next^.Previous:=TempItem^.Previous;
  699. TempItem^.Previous^.Next:=TempItem^.Next;
  700. if FCurrentItem = TempItem then
  701. begin
  702. if FCurrentItem^.Previous <> FBeginItem then
  703. FCurrentItem:= FCurrentItem^.Previous
  704. else
  705. FCurrentItem:= FCurrentItem^.Next;
  706. end;
  707. // Dec FNextAutoInc (only if deleted item is the last record)
  708. if FAutoIncFieldNo <> -1 then
  709. begin
  710. Val(StrPas(TempItem^.Row[FAutoIncFieldNo]),TempInteger,ValError);
  711. if (ValError = 0) and (TempInteger = (FNextAutoInc - 1)) then
  712. Dec(FNextAutoInc);
  713. end;
  714. end;
  715. procedure TCustomSqliteDataset.InternalEdit;
  716. var
  717. i: Integer;
  718. begin
  719. FInternalActiveBuffer:=PPDataRecord(ActiveBuffer)^;
  720. //copy active item to cache
  721. for i:= 0 to FRowCount - 1 do
  722. FCacheItem^.Row[i]:=StrNew(FInternalActiveBuffer^.Row[i]);
  723. FCacheItem^.BookmarkFlag:=FInternalActiveBuffer^.BookmarkFlag;
  724. //now active buffer is the cache item
  725. PPDataRecord(ActiveBuffer)^:=FCacheItem;
  726. end;
  727. procedure TCustomSqliteDataset.InternalFirst;
  728. begin
  729. FCurrentItem := FBeginItem;
  730. end;
  731. procedure TCustomSqliteDataset.InternalGotoBookmark(ABookmark: Pointer);
  732. begin
  733. FCurrentItem := PDataRecord(ABookmark^);
  734. end;
  735. procedure TCustomSqliteDataset.InternalInitRecord(Buffer: PChar);
  736. var
  737. TempStr:String;
  738. begin
  739. if FAutoIncFieldNo <> - 1 then
  740. begin
  741. Str(FNextAutoInc,TempStr);
  742. FCacheItem^.Row[FAutoIncFieldNo]:=StrAlloc(Length(TempStr)+1);
  743. StrPCopy(FCacheItem^.Row[FAutoIncFieldNo],TempStr);
  744. end;
  745. PPDataRecord(Buffer)^:=FCacheItem;
  746. FCacheItem^.BookmarkFlag:=bfInserted;
  747. end;
  748. procedure TCustomSqliteDataset.InternalLast;
  749. begin
  750. FCurrentItem := FEndItem;
  751. end;
  752. procedure TCustomSqliteDataset.InternalOpen;
  753. var
  754. i:Integer;
  755. begin
  756. if MasterSource <> nil then
  757. begin
  758. //todo: retrieve only necessary fields
  759. FSql := 'Select * from '+FTableName+';'; // forced to obtain all fields
  760. FMasterLink.FieldNames:=FMasterLink.FieldNames; //workaround to fill MasterLinks.Fields
  761. //if FMasterLink.Fields.Count = 0 MasterChanged will not be called anyway so ignore it
  762. end;
  763. if FSql = '' then
  764. begin
  765. if FTablename = '' then
  766. DatabaseError('Tablename not set',Self);
  767. FSql := 'Select * from '+FTableName+';';
  768. end;
  769. if FSqliteHandle = nil then
  770. GetSqliteHandle;
  771. InternalInitFieldDefs;
  772. //todo: move this to InitFieldDefs
  773. FSelectSqlStr:='SELECT ';
  774. for i:= 0 to FieldDefs.Count - 2 do
  775. FSelectSqlStr:=FSelectSqlStr+FieldDefs[i].Name+',';
  776. FSelectSqlStr:=FSelectSqlStr+FieldDefs[FieldDefs.Count - 1].Name+
  777. ' FROM '+FTableName;
  778. if DefaultFields then
  779. CreateFields;
  780. BindFields(True);
  781. UpdateIndexFields;
  782. if FMasterLink.Active then
  783. begin
  784. if FIndexFieldList.Count <> FMasterLink.Fields.Count then
  785. DatabaseError('MasterFields count doesn''t match IndexFields count',Self);
  786. //Set FSql considering MasterSource active record
  787. SetDetailFilter;
  788. end;
  789. // Get PrimaryKeyNo if available
  790. if Fields.FindField(FPrimaryKey) <> nil then
  791. FPrimaryKeyNo:=Fields.FindField(FPrimaryKey).FieldNo - 1
  792. else
  793. FPrimaryKeyNo:=FAutoIncFieldNo; // -1 if there's no AutoIncField
  794. BuildLinkedList;
  795. FCurrentItem:=FBeginItem;
  796. end;
  797. procedure TCustomSqliteDataset.InternalPost;
  798. begin
  799. if State <> dsEdit then
  800. InternalAddRecord(ActiveBuffer,True)
  801. else
  802. begin
  803. CopyCacheToItem(FInternalActiveBuffer);
  804. PPDataRecord(ActiveBuffer)^:=FInternalActiveBuffer;
  805. if (FUpdatedItems.IndexOf(FInternalActiveBuffer) = -1) and
  806. (FAddedItems.IndexOf(FInternalActiveBuffer) = -1) then
  807. FUpdatedItems.Add(FInternalActiveBuffer);
  808. end;
  809. end;
  810. procedure TCustomSqliteDataset.InternalSetToRecord(Buffer: PChar);
  811. begin
  812. FCurrentItem:=PPDataRecord(Buffer)^;
  813. end;
  814. function TCustomSqliteDataset.IsCursorOpen: Boolean;
  815. begin
  816. Result := FDataAllocated;
  817. end;
  818. function TCustomSqliteDataset.FindRecordItem(StartItem: PDataRecord; const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions; DoResync:Boolean):PDataRecord;
  819. var
  820. ValueArray: array of string;
  821. IndexArray: array of integer;
  822. AFieldList: TList;
  823. i,AFieldCount:Integer;
  824. MatchRecord: Boolean;
  825. AValue:String;
  826. TempItem:PDataRecord;
  827. begin
  828. Result:=nil;
  829. // Currently ignore options
  830. AFieldList:=TList.Create;
  831. try
  832. GetFieldList(AFieldList,KeyFields);
  833. AFieldCount:=AFieldList.Count;
  834. if AFieldCount > 1 then
  835. begin
  836. if VarIsArray(KeyValues) then
  837. begin
  838. if Succ(VarArrayHighBound(KeyValues,1)) <> AFieldCount then
  839. DatabaseError('Number of fields does not correspond to number of values',Self);
  840. end
  841. else
  842. DatabaseError('Wrong number of values specified: expected an array of variants got a variant',Self);
  843. end;
  844. //set the array of values and indexes
  845. SetLength(ValueArray,AFieldCount);
  846. SetLength(IndexArray,AFieldCount);
  847. for i:= 0 to AFieldCount - 1 do
  848. with TField(AFieldList[i]) do
  849. begin
  850. //get float types in appropriate format
  851. if not (DataType in [ftFloat,ftDateTime,ftTime,ftDate]) then
  852. begin
  853. if VarIsArray(KeyValues) then
  854. ValueArray[i]:=keyvalues[i]
  855. else
  856. ValueArray[i]:=keyvalues;
  857. end
  858. else
  859. begin
  860. if VarIsArray(KeyValues) then
  861. Str(VarToDateTime(keyvalues[i]),AValue)
  862. else
  863. Str(VarToDateTime(keyvalues),AValue);
  864. ValueArray[i]:=Trim(AValue);
  865. end;
  866. IndexArray[i]:=FieldNo - 1;
  867. end;
  868. finally
  869. AFieldList.Destroy;
  870. end;
  871. {$ifdef DEBUG}
  872. writeln('##TCustomSqliteDataset.FindRecordItem##');
  873. writeln(' KeyFields: ',keyfields);
  874. writeln(' KeyValues: ',keyvalues);
  875. writeln(' AValue: ',AValue);
  876. {$endif}
  877. //Search the list
  878. TempItem:=StartItem;
  879. while TempItem <> FEndItem do
  880. begin
  881. MatchRecord:=True;
  882. for i:= 0 to AFieldCount - 1 do
  883. begin
  884. //todo: handle null values??
  885. if (TempItem^.Row[IndexArray[i]] = nil) or
  886. (StrComp(TempItem^.Row[IndexArray[i]],PChar(ValueArray[i])) <> 0) then
  887. begin
  888. MatchRecord:= False;
  889. Break;//for
  890. end;
  891. end;
  892. if MatchRecord then
  893. begin
  894. Result:=TempItem;
  895. if DoResync then
  896. begin
  897. FCurrentItem:=TempItem;
  898. Resync([]);
  899. end;
  900. Break;//while
  901. end;
  902. TempItem:=TempItem^.Next;
  903. end;
  904. end;
  905. procedure TCustomSqliteDataset.GetSqliteHandle;
  906. begin
  907. if FFileName = '' then
  908. DatabaseError ('Filename not set',Self);
  909. //todo:Handle opening non db files
  910. FSqliteHandle:=InternalGetHandle;
  911. end;
  912. function TCustomSqliteDataset.Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean;
  913. begin
  914. Result:=FindRecordItem(FBeginItem^.Next,KeyFields,KeyValues,Options,True) <> nil;
  915. end;
  916. function TCustomSqliteDataset.LocateNext(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean;
  917. begin
  918. Result:=FindRecordItem(PPDataRecord(ActiveBuffer)^^.Next,KeyFields,KeyValues,Options,True) <> nil;
  919. end;
  920. function TCustomSqliteDataset.Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant;
  921. var
  922. TempItem:PDataRecord;
  923. begin
  924. TempItem:=FindRecordItem(FBeginItem^.Next,KeyFields,KeyValues,[],False);
  925. if TempItem <> nil then
  926. Result:=TempItem^.Row[FieldByName(ResultFields).FieldNo - 1]
  927. else
  928. Result:=False;
  929. end;
  930. procedure TCustomSqliteDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
  931. begin
  932. //The BookMarkData is the Buffer itself: no need to set nothing;
  933. end;
  934. procedure TCustomSqliteDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
  935. begin
  936. PPDataRecord(Buffer)^^.BookmarkFlag := Value;
  937. end;
  938. procedure TCustomSqliteDataset.SetExpectedAppends(AValue:Integer);
  939. begin
  940. FAddedItems.Capacity:=AValue;
  941. end;
  942. procedure TCustomSqliteDataset.SetExpectedUpdates(AValue:Integer);
  943. begin
  944. FUpdatedItems.Capacity:=AValue;
  945. end;
  946. procedure TCustomSqliteDataset.SetExpectedDeletes(AValue:Integer);
  947. begin
  948. FDeletedItems.Capacity:=AValue;
  949. FOrphanItems.Capacity:=AValue;
  950. end;
  951. procedure TCustomSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer;
  952. NativeFormat: Boolean);
  953. var
  954. TempStr:String;
  955. begin
  956. if not (State in [dsEdit, dsInsert]) then
  957. begin
  958. DatabaseErrorFmt(SNotInEditState,[Name],Self);
  959. Exit;
  960. end;
  961. StrDispose(FCacheItem^.Row[Pred(Field.FieldNo)]);
  962. if Buffer <> nil then
  963. begin
  964. case Field.Datatype of
  965. ftString:
  966. begin
  967. FCacheItem^.Row[Pred(Field.FieldNo)]:=StrNew(PChar(Buffer));
  968. end;
  969. ftInteger:
  970. begin
  971. Str(LongInt(Buffer^),TempStr);
  972. FCacheItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr)+1);
  973. Move(PChar(TempStr)^,(FCacheItem^.Row[Pred(Field.FieldNo)])^,Length(TempStr)+1);
  974. end;
  975. ftBoolean,ftWord:
  976. begin
  977. Str(Word(Buffer^),TempStr);
  978. FCacheItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr)+1);
  979. Move(PChar(TempStr)^,(FCacheItem^.Row[Pred(Field.FieldNo)])^,Length(TempStr)+1);
  980. end;
  981. ftFloat,ftDateTime,ftDate,ftTime,ftCurrency:
  982. begin
  983. Str(Double(Buffer^),TempStr);
  984. FCacheItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr));
  985. //Skips the first space that str returns
  986. //todo: make a custom Str?
  987. Move((PChar(TempStr)+1)^,(FCacheItem^.Row[Pred(Field.FieldNo)])^,Length(TempStr));
  988. end;
  989. ftLargeInt:
  990. begin
  991. Str(Int64(Buffer^),TempStr);
  992. FCacheItem^.Row[Pred(Field.FieldNo)]:=StrAlloc(Length(TempStr)+1);
  993. Move(PChar(TempStr)^,(FCacheItem^.Row[Pred(Field.FieldNo)])^,Length(TempStr)+1);
  994. end;
  995. end;// case
  996. end//if
  997. else
  998. FCacheItem^.Row[Pred(Field.FieldNo)]:=nil;
  999. if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
  1000. DataEvent(deFieldChange, Ptrint(Field));
  1001. end;
  1002. procedure TCustomSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer);
  1003. begin
  1004. SetFieldData(Field, Buffer, False);
  1005. end;
  1006. procedure TCustomSqliteDataset.SetRecNo(Value: Integer);
  1007. var
  1008. Counter:Integer;
  1009. TempItem:PDataRecord;
  1010. begin
  1011. if (Value > FRecordCount) or (Value <= 0) then
  1012. DatabaseError('Record Number Out Of Range',Self);
  1013. CheckBrowseMode;
  1014. TempItem:=FBeginItem;
  1015. for Counter := 1 to Value do
  1016. TempItem:=TempItem^.Next;
  1017. FCurrentItem:=TempItem;
  1018. Resync([]);
  1019. end;
  1020. // Specific functions
  1021. procedure TCustomSqliteDataset.SetDetailFilter;
  1022. function FieldToSqlStr(AField:TField):String;
  1023. begin
  1024. if not AField.IsNull then
  1025. begin
  1026. case AField.DataType of
  1027. ftString,ftMemo: Result:='"'+AField.AsString+'"';//todo: handle " caracter properly
  1028. ftDateTime,ftDate,ftTime:Str(AField.AsDateTime,Result);
  1029. else
  1030. Result:=AField.AsString;
  1031. end;//case
  1032. end
  1033. else
  1034. Result:=NullString;
  1035. end;//function
  1036. var
  1037. AFilter:String;
  1038. i:Integer;
  1039. begin
  1040. if FMasterLink.Dataset.RecordCount = 0 then //Retrieve all data
  1041. FSql:='Select * from '+FTableName
  1042. else
  1043. begin
  1044. AFilter:=' where ';
  1045. for i:= 0 to FMasterLink.Fields.Count - 1 do
  1046. begin
  1047. AFilter:=AFilter + IndexFields[i].FieldName +' = '+ FieldToSqlStr(TField(FMasterLink.Fields[i]));
  1048. if i <> FMasterLink.Fields.Count - 1 then
  1049. AFilter:= AFilter + ' and ';
  1050. end;
  1051. FSql:='Select * from '+FTableName+AFilter;
  1052. end;
  1053. end;
  1054. procedure TCustomSqliteDataset.MasterChanged(Sender: TObject);
  1055. begin
  1056. SetDetailFilter;
  1057. {$ifdef DEBUG}
  1058. writeln('##TCustomSqliteDataset.MasterChanged##');
  1059. writeln(' SQL used to filter detail dataset:');
  1060. writeln(' ',FSql);
  1061. {$endif}
  1062. RefetchData;
  1063. end;
  1064. procedure TCustomSqliteDataset.MasterDisabled(Sender: TObject);
  1065. begin
  1066. FSql:='Select * from '+FTableName+';';
  1067. RefetchData;
  1068. end;
  1069. procedure TCustomSqliteDataset.SetMasterFields(Value: String);
  1070. begin
  1071. FMasterLink.FieldNames:=Value;
  1072. if Active and FMasterLink.Active then
  1073. begin
  1074. UpdateIndexFields;
  1075. if (FIndexFieldList.Count <> FMasterLink.Fields.Count) then
  1076. DatabaseError('MasterFields count doesn''t match IndexFields count',Self);
  1077. end;
  1078. end;
  1079. function TCustomSqliteDataset.GetMasterFields: String;
  1080. begin
  1081. Result:=FMasterLink.FieldNames;
  1082. end;
  1083. procedure TCustomSqliteDataset.UpdateIndexFields;
  1084. begin
  1085. FIndexFieldList.Clear;
  1086. if FIndexFieldNames <> '' then
  1087. begin
  1088. try
  1089. GetFieldList(FIndexFieldList, FIndexFieldNames);
  1090. except
  1091. FIndexFieldList.Clear;
  1092. raise;
  1093. end;
  1094. end;
  1095. end;
  1096. function TCustomSqliteDataset.GetMasterSource: TDataSource;
  1097. begin
  1098. Result := FMasterLink.DataSource;
  1099. end;
  1100. procedure TCustomSqliteDataset.SetFileName(Value: String);
  1101. begin
  1102. if Value <> FFileName then
  1103. begin
  1104. if Active then
  1105. DatabaseError('It''s not allowed to change Filename in an open dataset',Self);
  1106. if FSqliteHandle <> nil then
  1107. InternalCloseHandle;
  1108. FFileName:=Value;
  1109. end;
  1110. end;
  1111. procedure TCustomSqliteDataset.SetMasterSource(Value: TDataSource);
  1112. begin
  1113. FMasterLink.DataSource := Value;
  1114. end;
  1115. procedure TCustomSqliteDataset.ExecSQL(const ASql:String);
  1116. begin
  1117. if FSqliteHandle = nil then
  1118. GetSqliteHandle;
  1119. ExecuteDirect(ASql);
  1120. end;
  1121. procedure TCustomSqliteDataset.ExecSQLList;
  1122. begin
  1123. if FSqliteHandle = nil then
  1124. GetSqliteHandle;
  1125. SqliteExec(PChar(FSqlList.Text),nil,nil);
  1126. end;
  1127. procedure TCustomSqliteDataset.ExecSQL;
  1128. begin
  1129. ExecSQL(FSql);
  1130. end;
  1131. function TCustomSqliteDataset.ApplyUpdates:Boolean;
  1132. var
  1133. iFields,iItems,StatementsCounter:Integer;
  1134. SqlTemp,WhereKeyNameEqual,ASqlLine,TemplateStr:String;
  1135. begin
  1136. if not UpdatesPending then
  1137. begin
  1138. Result:=True;
  1139. Exit;
  1140. end;
  1141. Result:=False;
  1142. if FPrimaryKeyNo <> -1 then
  1143. begin
  1144. StatementsCounter:=0;
  1145. WhereKeyNameEqual:=' WHERE '+Fields[FPrimaryKeyNo].FieldName+' = ';
  1146. {$ifdef DEBUG}
  1147. WriteLn('##TCustomSqliteDataset.ApplyUpdates##');
  1148. if FPrimaryKeyNo = FAutoIncFieldNo then
  1149. WriteLn(' Using an AutoInc field as primary key');
  1150. WriteLn(' PrimaryKey: ',WhereKeyNameEqual);
  1151. WriteLn(' PrimaryKeyNo: ',FPrimaryKeyNo);
  1152. {$endif}
  1153. SqlTemp:='BEGIN;';
  1154. // Delete Records
  1155. if FDeletedItems.Count > 0 then
  1156. TemplateStr:='DELETE FROM '+FTableName+WhereKeyNameEqual;
  1157. for iItems:= 0 to FDeletedItems.Count - 1 do
  1158. begin
  1159. SqlTemp:=SqlTemp+(TemplateStr+
  1160. StrPas(PDataRecord(FDeletedItems[iItems])^.Row[FPrimaryKeyNo])+';');
  1161. inc(StatementsCounter);
  1162. //ApplyUpdates each 400 statements
  1163. if StatementsCounter = 400 then
  1164. begin
  1165. SqlTemp:=SqlTemp+'COMMIT;';
  1166. FReturnCode:=SqliteExec(PChar(SqlTemp),nil,nil);
  1167. StatementsCounter:=0;
  1168. SqlTemp:='BEGIN;';
  1169. end;
  1170. end;
  1171. // Update changed records
  1172. if FUpdatedItems.Count > 0 then
  1173. TemplateStr:='UPDATE '+FTableName+' SET ';
  1174. for iItems:= 0 to FUpdatedItems.Count - 1 do
  1175. begin
  1176. ASqlLine:=TemplateStr;
  1177. for iFields:= 0 to Fields.Count - 2 do
  1178. begin
  1179. ASqlLine:=ASqlLine + (Fields[iFields].FieldName +' = '+
  1180. FGetSqlStr[iFields](PDataRecord(FUpdatedItems[iItems])^.Row[iFields])+',');
  1181. end;
  1182. iFields:=Fields.Count - 1;
  1183. ASqlLine:=ASqlLine + (Fields[iFields].FieldName +' = '+
  1184. FGetSqlStr[iFields](PDataRecord(FUpdatedItems[iItems])^.Row[iFields])+
  1185. WhereKeyNameEqual+StrPas(PDataRecord(FUpdatedItems[iItems])^.Row[FPrimaryKeyNo])+';');
  1186. SqlTemp:=SqlTemp + ASqlLine;
  1187. inc(StatementsCounter);
  1188. //ApplyUpdates each 400 statements
  1189. if StatementsCounter = 400 then
  1190. begin
  1191. SqlTemp:=SqlTemp+'COMMIT;';
  1192. FReturnCode:=SqliteExec(PChar(SqlTemp),nil,nil);
  1193. StatementsCounter:=0;
  1194. SqlTemp:='BEGIN;';
  1195. end;
  1196. end;
  1197. // Add new records
  1198. // Build TemplateStr
  1199. if FAddedItems.Count > 0 then
  1200. begin
  1201. TemplateStr:='INSERT INTO '+FTableName+ ' (';
  1202. for iFields:= 0 to Fields.Count - 2 do
  1203. begin
  1204. TemplateStr:=TemplateStr + Fields[iFields].FieldName+',';
  1205. end;
  1206. TemplateStr:= TemplateStr+Fields[Fields.Count - 1].FieldName+') VALUES (';
  1207. end;
  1208. for iItems:= 0 to FAddedItems.Count - 1 do
  1209. begin
  1210. ASqlLine:=TemplateStr;
  1211. for iFields:= 0 to Fields.Count - 2 do
  1212. begin
  1213. ASqlLine:=ASqlLine + (FGetSqlStr[iFields](PDataRecord(FAddedItems[iItems])^.Row[iFields])+',');
  1214. end;
  1215. //todo: see if i can assume iFields = Fields.Count-2 safely
  1216. iFields:=Fields.Count - 1;
  1217. ASqlLine:=ASqlLine + (FGetSqlStr[iFields](PDataRecord(FAddedItems[iItems])^.Row[iFields])+');');
  1218. SqlTemp:=SqlTemp + ASqlLine;
  1219. inc(StatementsCounter);
  1220. //ApplyUpdates each 400 statements
  1221. if StatementsCounter = 400 then
  1222. begin
  1223. SqlTemp:=SqlTemp+'COMMIT;';
  1224. FReturnCode:=SqliteExec(PChar(SqlTemp),nil,nil);
  1225. StatementsCounter:=0;
  1226. SqlTemp:='BEGIN;';
  1227. end;
  1228. end;
  1229. SqlTemp:=SqlTemp+'COMMIT;';
  1230. {$ifdef DEBUG}
  1231. writeln(' SQL: ',SqlTemp);
  1232. {$endif}
  1233. FAddedItems.Clear;
  1234. FUpdatedItems.Clear;
  1235. FDeletedItems.Clear;
  1236. FReturnCode:=SqliteExec(PChar(SqlTemp),nil,nil);
  1237. Result:= FReturnCode = SQLITE_OK;
  1238. end;
  1239. {$ifdef DEBUG}
  1240. writeln(' Result: ',Result);
  1241. {$endif}
  1242. end;
  1243. function TCustomSqliteDataset.CreateTable: Boolean;
  1244. begin
  1245. Result:=CreateTable(FTableName);
  1246. end;
  1247. function TCustomSqliteDataset.CreateTable(const ATableName: String): Boolean;
  1248. var
  1249. SqlTemp:String;
  1250. i:Integer;
  1251. begin
  1252. {$ifdef DEBUG}
  1253. writeln('##TCustomSqliteDataset.CreateTable##');
  1254. if ATableName = '' then
  1255. WriteLn(' TableName Not Set');
  1256. if FieldDefs.Count = 0 then
  1257. WriteLn(' FieldDefs Not Initialized');
  1258. {$endif}
  1259. if (ATableName <> '') and (FieldDefs.Count > 0) then
  1260. begin
  1261. SqlTemp:='CREATE TABLE '+ATableName+' (';
  1262. for i := 0 to FieldDefs.Count-1 do
  1263. begin
  1264. //todo: add index to autoinc field
  1265. SqlTemp:=SqlTemp + FieldDefs[i].Name;
  1266. case FieldDefs[i].DataType of
  1267. ftInteger:
  1268. SqlTemp:=SqlTemp + ' INTEGER';
  1269. ftString:
  1270. SqlTemp:=SqlTemp + ' VARCHAR';
  1271. ftBoolean:
  1272. SqlTemp:=SqlTemp + ' BOOL_INT';
  1273. ftFloat:
  1274. SqlTemp:=SqlTemp + ' FLOAT';
  1275. ftWord:
  1276. SqlTemp:=SqlTemp + ' WORD';
  1277. ftDateTime:
  1278. SqlTemp:=SqlTemp + ' DATETIME';
  1279. ftDate:
  1280. SqlTemp:=SqlTemp + ' DATE';
  1281. ftTime:
  1282. SqlTemp:=SqlTemp + ' TIME';
  1283. ftLargeInt:
  1284. SqlTemp:=SqlTemp + ' LARGEINT';
  1285. ftCurrency:
  1286. SqlTemp:=SqlTemp + ' CURRENCY';
  1287. ftAutoInc:
  1288. SqlTemp:=SqlTemp + ' AUTOINC_INT';
  1289. ftMemo:
  1290. SqlTemp:=SqlTemp + ' TEXT';
  1291. else
  1292. DatabaseError('Field type "'+FieldTypeNames[FieldDefs[i].DataType]+'" not supported',Self);
  1293. end;
  1294. if UpperCase(FieldDefs[i].Name) = UpperCase(FPrimaryKey) then
  1295. SqlTemp:=SqlTemp + ' PRIMARY KEY';
  1296. if i <> FieldDefs.Count - 1 then
  1297. SqlTemp:=SqlTemp+ ' , ';
  1298. end;
  1299. SqlTemp:=SqlTemp+');';
  1300. {$ifdef DEBUG}
  1301. writeln(' SQL: ',SqlTemp);
  1302. {$endif}
  1303. ExecSQL(SqlTemp);
  1304. Result:= FReturnCode = SQLITE_OK;
  1305. end
  1306. else
  1307. Result:=False;
  1308. end;
  1309. procedure TCustomSqliteDataset.ExecCallback(const ASql: String; UserData: Pointer = nil);
  1310. var
  1311. CallbackInfo: TCallbackInfo;
  1312. begin
  1313. if not Assigned(FOnCallback) then
  1314. DatabaseError('OnCallback property not set',Self);
  1315. if FSqliteHandle = nil then
  1316. GetSqliteHandle;
  1317. CallbackInfo.Data:=UserData;
  1318. CallbackInfo.Proc:=FOnCallback;
  1319. SqliteExec(PChar(ASql),@CallbackDispatcher,@CallbackInfo);
  1320. end;
  1321. procedure TCustomSqliteDataset.QueryUpdates(RecordStates: TRecordStateSet; Callback: TQueryUpdatesCallback;
  1322. UserData: Pointer = nil);
  1323. var
  1324. i: Integer;
  1325. TempItem: PDataRecord;
  1326. begin
  1327. if not Assigned(Callback) then
  1328. DatabaseError('Callback parameter not set',Self);
  1329. if rsDeleted in RecordStates then
  1330. with FDeletedItems do
  1331. for i:= 0 to Count - 1 do
  1332. Callback(UserData,PDataRecord(Items[i])^.Row,nil,rsDeleted);
  1333. if rsUpdated in RecordStates then
  1334. with FUpdatedItems do
  1335. for i:= 0 to Count - 1 do
  1336. begin
  1337. TempItem:=PDataRecord(Items[i]);
  1338. Callback(UserData,TempItem^.Row,TBookmark(@TempItem),rsUpdated);
  1339. end;
  1340. if rsAdded in RecordStates then
  1341. with FAddedItems do
  1342. for i:= 0 to Count - 1 do
  1343. begin
  1344. TempItem:=PDataRecord(Items[i]);
  1345. Callback(UserData,TempItem^.Row,TBookmark(@TempItem),rsAdded);
  1346. end;
  1347. end;
  1348. procedure TCustomSqliteDataset.RefetchData;
  1349. var
  1350. i:Integer;
  1351. begin
  1352. //Close
  1353. if FSaveOnRefetch then
  1354. ApplyUpdates;
  1355. if FDataAllocated then
  1356. DisposeLinkedList;
  1357. FAddedItems.Clear;
  1358. FUpdatedItems.Clear;
  1359. FDeletedItems.Clear;
  1360. FOrphanItems.Clear;
  1361. //Reopen
  1362. BuildLinkedList;
  1363. FCurrentItem:=FBeginItem;
  1364. for i := 0 to BufferCount - 1 do
  1365. PPDataRecord(Buffers[i])^:=FBeginItem;
  1366. Resync([]);
  1367. DoAfterScroll;
  1368. end;
  1369. function TCustomSqliteDataset.TableExists: Boolean;
  1370. begin
  1371. Result:=TableExists(FTableName);
  1372. end;
  1373. function TCustomSqliteDataset.TableExists(const ATableName: String): Boolean;
  1374. begin
  1375. Result:=False;
  1376. if not (ATableName = '') and FileExists(FFileName) then
  1377. begin
  1378. ExecSql('SELECT name FROM SQLITE_MASTER WHERE type = ''table'' AND name LIKE '''+ ATableName+ ''';');
  1379. Result:=FReturnCode = SQLITE_ROW;
  1380. end;
  1381. end;
  1382. function TCustomSqliteDataset.UpdatesPending: Boolean;
  1383. begin
  1384. Result:= (FUpdatedItems.Count > 0) or
  1385. (FAddedItems.Count > 0) or (FDeletedItems.Count > 0);
  1386. end;
  1387. function TCustomSqliteDataset.QuickQuery(const ASql:String):String;
  1388. begin
  1389. Result:=QuickQuery(ASql,nil,False);
  1390. end;
  1391. function TCustomSqliteDataset.QuickQuery(const ASql:String;const AStrList: TStrings):String;
  1392. begin
  1393. Result:=QuickQuery(ASql,AStrList,False)
  1394. end;
  1395. {$ifdef DEBUGACTIVEBUFFER}
  1396. procedure TCustomSqliteDataset.SetCurrentItem(Value:PDataRecord);
  1397. var
  1398. ANo:Integer;
  1399. function GetItemPos:Integer;
  1400. var
  1401. TempItem:PDataRecord;
  1402. begin
  1403. Result:= -1;
  1404. TempItem:=FBeginItem;
  1405. if Value = FCacheItem then
  1406. Result:=-2
  1407. else
  1408. while Value <> TempItem do
  1409. begin
  1410. if TempItem^.Next <> nil then
  1411. begin
  1412. inc(Result);
  1413. TempItem:=TempItem^.Next;
  1414. end
  1415. else
  1416. begin
  1417. Result:=-1;
  1418. break;
  1419. end;
  1420. end;
  1421. end;
  1422. begin
  1423. if Value = FBeginItem then
  1424. begin
  1425. writeln('FCurrentItem set to FBeginItem: ',IntToHex(Integer(Value),0));
  1426. FFCurrentItem:=Value;
  1427. end
  1428. else
  1429. if Value = FEndItem then
  1430. begin
  1431. writeln('FCurrentItem set to FEndItem: ',IntToHex(Integer(Value),0));
  1432. FFCurrentItem:=Value;
  1433. end
  1434. else
  1435. if Value = FCacheItem then
  1436. begin
  1437. writeln('FCurrentItem set to FCacheItem: ',IntToHex(Integer(Value),0));
  1438. FFCurrentItem:=Value;
  1439. end
  1440. else
  1441. begin
  1442. writeln('FCurrentItem set from ',IntToHex(Integer(FFCurrentItem),0),' to ',IntToHex(Integer(Value),0));
  1443. Ano:=GetItemPos;
  1444. writeln('Item position is ',ANo);
  1445. FFCurrentItem:=Value;
  1446. end;
  1447. end;
  1448. {$endif}
  1449. end.