sqliteds.pas 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820
  1. unit SqliteDS;
  2. {
  3. This is SqliteDS/TSqliteDataset, 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. interface
  22. uses Classes, SysUtils, Db;
  23. type
  24. PDataRecord = ^DataRecord;
  25. PPDataRecord = ^PDataRecord;
  26. DataRecord = record
  27. Row: PPchar;
  28. BookmarkData: Pointer;
  29. BookmarkFlag: TBookmarkFlag;
  30. Next: PDataRecord;
  31. Previous: PDataRecord;
  32. end;
  33. TSqliteDataset = class(TDataSet)
  34. private
  35. FFileName: String;
  36. FSql: String;
  37. FTableName: String;
  38. FCurrentItem: PDataRecord;
  39. FBeginItem: PDataRecord;
  40. FEndItem: PDataRecord;
  41. FCacheItem: PDataRecord;
  42. FBufferSize: Integer;
  43. FRowBufferSize: Integer;
  44. FRowCount: Integer;
  45. FRecordCount: Integer;
  46. FSqliteReturnId: Integer;
  47. FDataAllocated: Boolean;
  48. FSaveOnClose: Boolean;
  49. FSqliteHandle: Pointer;
  50. FDBError: PPChar;
  51. FUpdatedItems: TList;
  52. FAddedItems: TList;
  53. FDeletedItems: TList;
  54. FOrphanItems: TList;
  55. procedure BuildLinkedList;
  56. procedure DisposeLinkedList;
  57. procedure SetSql (AValue:String);
  58. protected
  59. function AllocRecordBuffer: PChar; override;
  60. procedure FreeRecordBuffer(var Buffer: PChar); override;
  61. procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
  62. function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
  63. function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
  64. function GetRecordCount: Integer; override;
  65. function GetRecNo: Integer; override;
  66. function GetRecordSize: Word; override;
  67. procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
  68. procedure InternalClose; override;
  69. procedure InternalDelete; override;
  70. procedure InternalFirst; override;
  71. procedure InternalGotoBookmark(ABookmark: Pointer); override;
  72. procedure InternalHandleException; override;
  73. procedure InternalInitFieldDefs; override;
  74. procedure InternalInitRecord(Buffer: PChar); override;
  75. procedure InternalLast; override;
  76. procedure InternalOpen; override;
  77. procedure InternalPost; override;
  78. procedure InternalSetToRecord(Buffer: PChar); override;
  79. function IsCursorOpen: Boolean; override;
  80. procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  81. procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
  82. procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  83. procedure SetRecNo(Value: Integer); override;
  84. public
  85. constructor Create(AOwner: TComponent); override;
  86. destructor Destroy; override;
  87. function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
  88. // Additional procedures
  89. function ApplyUpdates: Boolean;
  90. function CreateTable: Boolean;
  91. function ExecSQL:Integer;
  92. function ExecSQL(ASql:String):Integer;
  93. function SqliteReturnString: String;
  94. {$Ifdef DEBUG}
  95. property BeginItem: PDataRecord read FBeginItem;
  96. property EndItem: PDataRecord read FEndItem;
  97. {$Endif}
  98. property SqliteReturnId: Integer read FSqliteReturnId;
  99. property SQL: String read FSql write SetSql;
  100. property TableName: String read FTableName write FTableName;
  101. property FileName: String read FFileName write FFileName;
  102. property SaveOnClose: Boolean read FSaveOnClose write FSaveOnClose;
  103. published
  104. property Active;
  105. property BeforeOpen;
  106. property AfterOpen;
  107. property BeforeClose;
  108. property AfterClose;
  109. property BeforeInsert;
  110. property AfterInsert;
  111. property BeforeEdit;
  112. property AfterEdit;
  113. property BeforePost;
  114. property AfterPost;
  115. property BeforeCancel;
  116. property AfterCancel;
  117. property BeforeDelete;
  118. property AfterDelete;
  119. property BeforeScroll;
  120. property AfterScroll;
  121. property OnDeleteError;
  122. property OnEditError;
  123. end;
  124. procedure Register;
  125. implementation
  126. uses SQLite;
  127. function GetFieldDefs(TheDataset: Pointer; Columns: Integer; ColumnValues: PPChar; ColumnNames: PPChar): integer; cdecl;
  128. var
  129. FieldSize:Word;
  130. Counter:Integer;
  131. AType:TFieldType;
  132. ColumnStr:String;
  133. TempAttributes:TFieldAttributes;
  134. begin
  135. // Sqlite is typeless (allows any type in any field)
  136. // regardless of what is in Create Table, but returns
  137. // exactly what is in Create Table statement
  138. // here is a trick to get the datatype.
  139. // If the field contains another type, there will be problems
  140. For Counter:= 0 to Columns - 1 do
  141. begin
  142. ColumnStr:= UpCase(StrPas(ColumnNames[Counter + Columns]));
  143. If (ColumnStr = 'INTEGER') or (ColumnStr = 'INT') then
  144. begin
  145. AType:= ftInteger;
  146. FieldSize:=SizeOf(Integer);
  147. end else if (ColumnStr = 'BOOLEAN') then
  148. begin
  149. AType:= ftBoolean;
  150. FieldSize:=SizeOf(Boolean);
  151. end else if (ColumnStr = 'FLOAT') then
  152. begin
  153. AType:= ftFloat;
  154. FieldSize:=SizeOf(Double);
  155. end else if (ColumnStr = 'WORD') then
  156. begin
  157. AType:= ftWord;
  158. FieldSize:=SizeOf(Word);
  159. end else if (ColumnStr = 'DATETIME') then
  160. begin
  161. AType:= ftDateTime;
  162. FieldSize:=SizeOf(TDateTime);
  163. end else if (ColumnStr = 'DATE') then
  164. begin
  165. AType:= ftDate;
  166. FieldSize:=SizeOf(TDateTime);
  167. end else if (ColumnStr = 'TIME') then
  168. begin
  169. AType:= ftTime;
  170. FieldSize:=SizeOf(TDateTime);
  171. end else
  172. begin
  173. AType:= ftString;
  174. FieldSize:=0;
  175. end;
  176. with TDataset(TheDataset).FieldDefs do
  177. begin
  178. Add(StrPas(ColumnNames[Counter]), AType, FieldSize, False);
  179. If Items[Counter].Name = '_ROWID_' then
  180. begin
  181. TempAttributes:=Items[Counter].Attributes;
  182. System.Include(TempAttributes,faReadonly);
  183. Items[Counter].Attributes:=TempAttributes;
  184. end;
  185. end;
  186. end;
  187. result:=-1;
  188. end;
  189. // TSqliteDataset override methods
  190. function TSqliteDataset.AllocRecordBuffer: PChar;
  191. begin
  192. Result := AllocMem(FBufferSize);
  193. end;
  194. procedure TSqliteDataset.BuildLinkedList;
  195. var
  196. TempItem:PDataRecord;
  197. vm:Pointer;
  198. ColumnNames,ColumnValues:PPChar;
  199. Counter:Integer;
  200. begin
  201. FSqliteReturnId:=sqlite_compile(FSqliteHandle,Pchar(FSql),nil,@vm,nil);
  202. if FSqliteReturnId <> SQLITE_OK then
  203. case FSqliteReturnId of
  204. SQLITE_ERROR:
  205. DatabaseError('Invalid Sql',Self);
  206. else
  207. DatabaseError('Unknow Error',Self);
  208. end;
  209. FDataAllocated:=True;
  210. New(FBeginItem);
  211. FBeginItem^.Next:=nil;
  212. FBeginItem^.Previous:=nil;
  213. TempItem:=FBeginItem;
  214. FRecordCount:=0;
  215. FSqliteReturnId:=sqlite_step(vm,@FRowCount,@ColumnValues,@ColumnNames);
  216. while FSqliteReturnId = SQLITE_ROW do
  217. begin
  218. Inc(FRecordCount);
  219. New(TempItem^.Next);
  220. TempItem^.Next^.Previous:=TempItem;
  221. TempItem:=TempItem^.Next;
  222. GetMem(TempItem^.Row,FRowBufferSize);
  223. For Counter := 0 to FRowCount - 1 do
  224. TempItem^.Row[Counter]:=StrNew(ColumnValues[Counter]);
  225. FSqliteReturnId:=sqlite_step(vm,@FRowCount,@ColumnValues,@ColumnNames);
  226. end;
  227. sqlite_finalize(vm, nil);
  228. // Init EndItem
  229. if FRecordCount <> 0 then
  230. begin
  231. New(TempItem^.Next);
  232. TempItem^.Next^.Previous:=TempItem;
  233. FEndItem:=TempItem^.Next;
  234. end
  235. else
  236. begin
  237. New(FEndItem);
  238. FEndItem^.Previous:=FBeginItem;
  239. FBeginItem^.Next:=FEndItem;
  240. end;
  241. FEndItem^.Next:=nil;
  242. // Alloc item used in append/insert
  243. New(FCacheItem);
  244. GetMem(FCacheItem^.Row,FRowBufferSize);
  245. For Counter := 0 to FRowCount - 1 do
  246. FCacheItem^.Row[Counter]:=nil;
  247. end;
  248. constructor TSqliteDataset.Create(AOwner: TComponent);
  249. begin
  250. BookmarkSize := SizeOf(Pointer);
  251. FBufferSize := SizeOf(PPDataRecord);
  252. FUpdatedItems:= TList.Create;
  253. FUpdatedItems.Capacity:=20;
  254. FAddedItems:= TList.Create;
  255. FAddedItems.Capacity:=20;
  256. FOrphanItems:= TList.Create;
  257. FOrphanItems.Capacity:=20;
  258. FDeletedItems:= TList.Create;
  259. FDeletedItems.Capacity:=20;
  260. FSaveOnClose:=False;
  261. inherited Create(AOwner);
  262. end;
  263. destructor TSqliteDataset.Destroy;
  264. begin
  265. inherited Destroy;
  266. FUpdatedItems.Destroy;
  267. FAddedItems.Destroy;
  268. FDeletedItems.Destroy;
  269. FOrphanItems.Destroy;
  270. end;
  271. procedure TSqliteDataset.DisposeLinkedList;
  272. var
  273. TempItem:PDataRecord;
  274. Counter,I:Integer;
  275. begin
  276. //Todo insert debug info
  277. FDataAllocated:=False;
  278. //Dispose cache item
  279. for Counter:= 0 to FRowCount - 1 do
  280. StrDispose(FCacheItem^.Row[Counter]);
  281. FreeMem(FCacheItem^.Row,FRowBufferSize);
  282. Dispose(FCacheItem);
  283. If FBeginItem^.Next = nil then //remove it??
  284. exit;
  285. TempItem:=FBeginItem^.Next;
  286. Dispose(FBeginItem);
  287. while TempItem^.Next <> nil do
  288. begin
  289. for Counter:= 0 to FRowCount - 1 do
  290. StrDispose(TempItem^.Row[Counter]);
  291. FreeMem(TempItem^.Row,FRowBufferSize);
  292. TempItem:=TempItem^.Next;
  293. Dispose(TempItem^.Previous);
  294. end;
  295. // Free last item
  296. Dispose(TempItem);
  297. for Counter:= 0 to FOrphanItems.Count - 1 do
  298. begin
  299. TempItem:=PDataRecord(FOrphanItems[Counter]);
  300. for I:= 0 to FRowCount - 1 do
  301. StrDispose(TempItem^.Row[I]);
  302. FreeMem(TempItem^.Row,FRowBufferSize);
  303. Dispose(TempItem);
  304. end;
  305. end;
  306. procedure TSqliteDataset.FreeRecordBuffer(var Buffer: PChar);
  307. begin
  308. FreeMem(Buffer);
  309. end;
  310. procedure TSqliteDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
  311. begin
  312. Pointer(Data^) := PPDataRecord(Buffer)^^.BookmarkData;
  313. end;
  314. function TSqliteDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
  315. begin
  316. Result := PPDataRecord(Buffer)^^.BookmarkFlag;
  317. end;
  318. function TSqliteDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
  319. var
  320. ValError:Word;
  321. FieldRow:PChar;
  322. begin
  323. if FRecordCount = 0 then // avoid exception in empty datasets
  324. begin
  325. Result:=False;
  326. Exit;
  327. end;
  328. FieldRow:=PPDataRecord(ActiveBuffer)^^.Row[Field.Index];
  329. Result := FieldRow <> nil;
  330. if Result and (Buffer <> nil) then //supports GetIsNull
  331. begin
  332. case Field.Datatype of
  333. ftString:
  334. begin
  335. Move(FieldRow^,PChar(Buffer)^,StrLen(FieldRow)+1);
  336. end;
  337. ftInteger,ftBoolean,ftWord:
  338. begin
  339. Val(StrPas(FieldRow),LongInt(Buffer^),ValError);
  340. Result:= ValError = 0;
  341. end;
  342. ftFloat,ftDateTime,ftTime,ftDate:
  343. begin
  344. Val(StrPas(FieldRow),Double(Buffer^),ValError);
  345. Result:= ValError = 0;
  346. end;
  347. end;
  348. end;
  349. end;
  350. function TSqliteDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
  351. begin
  352. Result := grOk;
  353. case GetMode of
  354. gmPrior:
  355. if (FCurrentItem^.Previous = FBeginItem) or (FCurrentItem = FBeginItem) then
  356. begin
  357. Result := grBOF;
  358. FCurrentItem := FBeginItem;
  359. end
  360. else
  361. FCurrentItem:=FCurrentItem^.Previous;
  362. gmCurrent:
  363. if (FCurrentItem = FBeginItem) or (FCurrentItem = FEndItem) then
  364. Result := grError;
  365. gmNext:
  366. if (FCurrentItem = FEndItem) or (FCurrentItem^.Next = FEndItem) then
  367. Result := grEOF
  368. else
  369. FCurrentItem:=FCurrentItem^.Next;
  370. end; //case
  371. if Result = grOk then
  372. begin
  373. PDataRecord(Pointer(Buffer)^):=FCurrentItem;
  374. with FCurrentItem^ do
  375. begin
  376. BookmarkData := FCurrentItem;
  377. BookmarkFlag := bfCurrent;
  378. end;
  379. end
  380. else if (Result = grError) and DoCheck then
  381. DatabaseError('SqliteDs - No records',Self);
  382. end;
  383. function TSqliteDataset.GetRecordCount: Integer;
  384. begin
  385. Result := FRecordCount;
  386. end;
  387. function TSqliteDataset.GetRecNo: Integer;
  388. var
  389. TempItem,TempActive:PDataRecord;
  390. begin
  391. Result:= -1;
  392. TempItem:=FBeginItem;
  393. TempActive:=PPDataRecord(ActiveBuffer)^;
  394. while TempActive <> TempItem do
  395. begin
  396. if TempItem^.Next <> nil then
  397. begin
  398. inc(Result);
  399. TempItem:=TempItem^.Next;
  400. end
  401. else
  402. begin
  403. Result:=-1;
  404. DatabaseError('GetRecNo - ActiveItem Not Found',Self);
  405. break;
  406. end;
  407. end;
  408. end;
  409. function TSqliteDataset.GetRecordSize: Word;
  410. begin
  411. Result := FBufferSize; //??
  412. end;
  413. procedure TSqliteDataset.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
  414. var
  415. NewItem: PDataRecord;
  416. Counter:Integer;
  417. begin
  418. //Todo: implement insert ??
  419. if PPDataRecord(Buffer)^ <> FCacheItem then
  420. DatabaseError('PPDataRecord(Buffer) <> FCacheItem - Problem',Self);
  421. New(NewItem);
  422. GetMem(NewItem^.Row,FRowBufferSize);
  423. for Counter := 0 to FRowCount - 1 do
  424. NewItem^.Row[Counter]:=StrNew(FCacheItem^.Row[Counter]);
  425. FEndItem^.Previous^.Next:=NewItem;
  426. NewItem^.Previous:=FEndItem^.Previous;
  427. NewItem^.Next:=FEndItem;
  428. FEndItem^.Previous:=NewItem;
  429. Inc(FRecordCount);
  430. FAddedItems.Add(NewItem);
  431. end;
  432. procedure TSqliteDataset.InternalClose;
  433. begin
  434. if FSaveOnClose then
  435. ApplyUpdates;
  436. if DefaultFields then
  437. DestroyFields;
  438. if FDataAllocated then
  439. DisposeLinkedList;
  440. if FSqliteHandle <> nil then
  441. begin
  442. sqlite_close(FSqliteHandle);
  443. FSqliteHandle := nil;
  444. end;
  445. FAddedItems.Clear;
  446. FUpdatedItems.Clear;
  447. FDeletedItems.Clear;
  448. FOrphanItems.Clear;
  449. FRecordCount:=0;
  450. end;
  451. procedure TSqliteDataset.InternalDelete;
  452. var
  453. TempItem:PDataRecord;
  454. begin
  455. Dec(FRecordCount);
  456. TempItem:=PPDataRecord(ActiveBuffer)^;
  457. // Remove from changed list
  458. FUpdatedItems.Remove(TempItem);
  459. if FAddedItems.Remove(TempItem) = -1 then
  460. FDeletedItems.Add(TempItem);
  461. FOrphanItems.Add(TempItem);
  462. TempItem^.Next^.Previous:=TempItem^.Previous;
  463. TempItem^.Previous^.Next:=TempItem^.Next;
  464. if FCurrentItem = TempItem then
  465. begin
  466. if FCurrentItem^.Previous <> FBeginItem then
  467. FCurrentItem:= FCurrentItem^.Previous
  468. else
  469. FCurrentItem:= FCurrentItem^.Next;
  470. end;
  471. end;
  472. procedure TSqliteDataset.InternalFirst;
  473. begin
  474. FCurrentItem := FBeginItem;
  475. end;
  476. procedure TSqliteDataset.InternalGotoBookmark(ABookmark: Pointer);
  477. begin
  478. FCurrentItem := PDataRecord(ABookmark^);
  479. end;
  480. procedure TSqliteDataset.InternalHandleException;
  481. begin
  482. //??
  483. end;
  484. procedure TSqliteDataset.InternalInitFieldDefs;
  485. begin
  486. FieldDefs.Clear;
  487. sqlite_exec(FSqliteHandle,PChar('PRAGMA empty_result_callbacks = ON;PRAGMA show_datatypes = ON;'),nil,nil,nil);
  488. FSqliteReturnId:=sqlite_exec(FSqliteHandle,PChar(FSql),@GetFieldDefs,Self,nil);
  489. {
  490. if FSqliteReturnId <> SQLITE_ABORT then
  491. DatabaseError(SqliteReturnString,Self);
  492. }
  493. FRowBufferSize:=(SizeOf(PPChar)*FieldDefs.Count);
  494. end;
  495. procedure TSqliteDataset.InternalInitRecord(Buffer: PChar);
  496. var
  497. Counter:Integer;
  498. begin
  499. for Counter:= 0 to FRowCount - 1 do
  500. begin
  501. StrDispose(FCacheItem^.Row[Counter]);
  502. FCacheItem^.Row[Counter]:=nil;
  503. end;
  504. PPDataRecord(Buffer)^:=FCacheItem;
  505. end;
  506. procedure TSqliteDataset.InternalLast;
  507. begin
  508. FCurrentItem := FEndItem;
  509. end;
  510. procedure TSqliteDataset.InternalOpen;
  511. begin
  512. if not FileExists(FFileName) then
  513. DatabaseError('File '+FFileName+' not found',Self);
  514. FSqliteHandle:=sqlite_open(PChar(FFileName),0,FDBError);
  515. InternalInitFieldDefs;
  516. BuildLinkedList;
  517. FCurrentItem:=FBeginItem;
  518. if DefaultFields then
  519. CreateFields;
  520. BindFields(True);
  521. end;
  522. procedure TSqliteDataset.InternalPost;
  523. begin
  524. if (State<>dsEdit) then
  525. InternalAddRecord(ActiveBuffer,True);
  526. end;
  527. procedure TSqliteDataset.InternalSetToRecord(Buffer: PChar);
  528. begin
  529. FCurrentItem:=PPDataRecord(Buffer)^;
  530. end;
  531. function TSqliteDataset.IsCursorOpen: Boolean;
  532. begin
  533. Result := FDataAllocated;
  534. end;
  535. procedure TSqliteDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
  536. begin
  537. PPDataRecord(Buffer)^^.BookmarkData := Pointer(Data^);
  538. end;
  539. procedure TSqliteDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
  540. begin
  541. PPDataRecord(Buffer)^^.BookmarkFlag := Value;
  542. end;
  543. procedure TSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer);
  544. var
  545. TempStr:String;
  546. ActiveItem:PDataRecord;
  547. begin
  548. if (FRecordCount = 0) and (State <> dsInsert) then //avoid exception in win32 + lcl + TDbEdit
  549. Exit;
  550. ActiveItem:=PPDataRecord(ActiveBuffer)^;
  551. if (ActiveItem <> FCacheItem) and (FUpdatedItems.IndexOf(ActiveItem) = -1) and (FAddedItems.IndexOf(ActiveItem) = -1) then
  552. FUpdatedItems.Add(ActiveItem);
  553. if Buffer = nil then
  554. ActiveItem^.Row[Field.Index]:=nil
  555. else
  556. case Field.Datatype of
  557. ftString:
  558. begin
  559. StrDispose(ActiveItem^.Row[Field.Index]);
  560. ActiveItem^.Row[Field.Index]:=StrNew(PChar(Buffer));
  561. end;
  562. ftInteger,ftBoolean,ftWord:
  563. begin
  564. StrDispose(ActiveItem^.Row[Field.Index]);
  565. Str(LongInt(Buffer^),TempStr);
  566. ActiveItem^.Row[Field.Index]:=StrAlloc(Length(TempStr)+1);
  567. StrPCopy(ActiveItem^.Row[Field.Index],TempStr);
  568. end;
  569. ftFloat,ftDateTime,ftDate,ftTime:
  570. begin
  571. StrDispose(ActiveItem^.Row[Field.Index]);
  572. Str(Double(Buffer^),TempStr);
  573. ActiveItem^.Row[Field.Index]:=StrAlloc(Length(TempStr)+1);
  574. StrPCopy(ActiveItem^.Row[Field.Index],TempStr);
  575. end;
  576. end;
  577. end;
  578. procedure TSqliteDataset.SetRecNo(Value: Integer);
  579. begin
  580. //
  581. end;
  582. // Specific functions
  583. procedure TSqliteDataset.SetSql(AValue:String);
  584. begin
  585. FSql:=AValue;
  586. // Todo: Retrieve Tablename from SQL ??
  587. end;
  588. function TSqliteDataset.ExecSQL(ASql:String):Integer;
  589. begin
  590. Result:=0;
  591. if FSqliteHandle <> nil then
  592. begin
  593. FSqliteReturnId:= sqlite_exec(FSqliteHandle,PChar(ASql),nil,nil,nil);
  594. Result:=sqlite_changes(FSqliteHandle);
  595. end;
  596. end;
  597. function TSqliteDataset.ExecSQL:Integer;
  598. begin
  599. Result:=ExecSQL(FSql);
  600. end;
  601. function TSqliteDataset.ApplyUpdates:Boolean;
  602. var
  603. CounterFields,CounterItems:Integer;
  604. SqlTemp:String;
  605. Quote:Char;
  606. begin
  607. Result:=False;
  608. if (FTableName <> '') and (Fields[0].FieldName = '_ROWID_') then
  609. begin
  610. SqlTemp:='BEGIN TRANSACTION; ';
  611. // Update changed records
  612. For CounterItems:= 0 to FUpdatedItems.Count - 1 do
  613. begin
  614. SqlTemp:=SqlTemp+'UPDATE '+FTableName+' SET ';
  615. for CounterFields:= 1 to Fields.Count - 1 do
  616. begin
  617. if PDataRecord(FUpdatedItems[CounterItems])^.Row[CounterFields] <> nil then
  618. begin
  619. if Fields[CounterFields].DataType = ftString then
  620. Quote:='"'
  621. else
  622. Quote:=' ';
  623. SqlTemp:=SqlTemp + Fields[CounterFields].FieldName +' = '+Quote+
  624. StrPas(PDataRecord(FUpdatedItems[CounterItems])^.Row[CounterFields])+Quote+' , ';
  625. end
  626. else
  627. SqlTemp:=SqlTemp + Fields[CounterFields].FieldName +' = NULL , ';
  628. end;
  629. system.delete(SqlTemp,Length(SqlTemp)-2,2);
  630. SqlTemp:=SqlTemp+'WHERE _ROWID_ = '+StrPas(PDataRecord(FUpdatedItems[CounterItems])^.Row[0])+';';
  631. end;
  632. // Add new records
  633. For CounterItems:= 0 to FAddedItems.Count - 1 do
  634. begin
  635. SqlTemp:=SqlTemp+'INSERT INTO '+FTableName+ ' ( ';
  636. for CounterFields:= 1 to Fields.Count - 1 do
  637. begin
  638. SqlTemp:=SqlTemp + Fields[CounterFields].FieldName;
  639. if CounterFields <> Fields.Count - 1 then
  640. SqlTemp:=SqlTemp+' , ';
  641. end;
  642. SqlTemp:=SqlTemp+') VALUES ( ';
  643. for CounterFields:= 1 to Fields.Count - 1 do
  644. begin
  645. if PDataRecord(FAddedItems[CounterItems])^.Row[CounterFields] <> nil then
  646. begin
  647. if Fields[CounterFields].DataType = ftString then
  648. Quote:='"'
  649. else
  650. Quote:=' ';
  651. SqlTemp:=SqlTemp + Quote+ StrPas(PDataRecord(FAddedItems[CounterItems])^.Row[CounterFields])+Quote;
  652. end
  653. else
  654. SqlTemp:=SqlTemp + 'NULL';
  655. if CounterFields <> Fields.Count - 1 then
  656. SqlTemp:=SqlTemp+' , ';
  657. end;
  658. SqlTemp:=SqlTemp+') ;';
  659. end;
  660. // Delete Items
  661. For CounterItems:= 0 to FDeletedItems.Count - 1 do
  662. begin
  663. SqlTemp:=SqlTemp+'DELETE FROM '+FTableName+ ' WHERE _ROWID_ = '+
  664. StrPas(PDataRecord(FDeletedItems[CounterItems])^.Row[0])+';';
  665. end;
  666. SqlTemp:=SqlTemp+'END TRANSACTION; ';
  667. {$ifdef DEBUG}
  668. writeln('ApplyUpdates Sql: ',SqlTemp);
  669. {$endif}
  670. FAddedItems.Clear;
  671. FUpdatedItems.Clear;
  672. FDeletedItems.Clear;
  673. FSqliteReturnId:=sqlite_exec(FSqliteHandle,PChar(SqlTemp),nil,nil,nil);
  674. Result:= FSqliteReturnId = SQLITE_OK;
  675. end;
  676. {$ifdef DEBUG}
  677. writeln('ApplyUpdates Result: ',Result);
  678. {$endif}
  679. end;
  680. function TSqliteDataset.CreateTable: Boolean;
  681. var
  682. SqlTemp:String;
  683. Counter:Integer;
  684. begin
  685. if (FTableName <> '') and (FieldDefs.Count > 0) then
  686. begin
  687. FSqliteHandle:= sqlite_open(PChar(FFileName),0,FDBError);
  688. SqlTemp:='CREATE TABLE '+FTableName+' (';
  689. for Counter := 0 to FieldDefs.Count-1 do
  690. begin
  691. SqlTemp:=SqlTemp + FieldDefs[Counter].Name;
  692. case FieldDefs[Counter].DataType of
  693. ftInteger:
  694. SqlTemp:=SqlTemp + ' INTEGER';
  695. ftString:
  696. SqlTemp:=SqlTemp + ' VARCHAR';
  697. ftBoolean:
  698. SqlTemp:=SqlTemp + ' BOOLEAN';
  699. ftFloat:
  700. SqlTemp:=SqlTemp + ' FLOAT';
  701. ftWord:
  702. SqlTemp:=SqlTemp + ' WORD';
  703. ftDateTime:
  704. SqlTemp:=SqlTemp + ' DATETIME';
  705. ftDate:
  706. SqlTemp:=SqlTemp + ' DATE';
  707. ftTime:
  708. SqlTemp:=SqlTemp + ' TIME';
  709. else
  710. SqlTemp:=SqlTemp + ' VARCHAR';
  711. end;
  712. if Counter <> FieldDefs.Count - 1 then
  713. SqlTemp:=SqlTemp+ ' , ';
  714. end;
  715. SqlTemp:=SqlTemp+');';
  716. {$ifdef DEBUG}
  717. writeln('CreateTable Sql: ',SqlTemp);
  718. {$endif}
  719. FSqliteReturnId:=sqlite_exec(FSqliteHandle,PChar(SqlTemp),nil,nil,nil);
  720. Result:= FSqliteReturnId = SQLITE_OK;
  721. sqlite_close(FSqliteHandle);
  722. end
  723. else
  724. Result:=False;
  725. end;
  726. function TSqliteDataset.SqliteReturnString: String;
  727. begin
  728. case FSqliteReturnId of
  729. SQLITE_OK : Result := 'SQLITE_OK ';
  730. SQLITE_ERROR : Result := 'SQLITE_ERROR ';
  731. SQLITE_INTERNAL : Result := 'SQLITE_INTERNAL ';
  732. SQLITE_PERM : Result := 'SQLITE_PERM ';
  733. SQLITE_ABORT : Result := 'SQLITE_ABORT ';
  734. SQLITE_BUSY : Result := 'SQLITE_BUSY ';
  735. SQLITE_LOCKED : Result := 'SQLITE_LOCKED ';
  736. SQLITE_NOMEM : Result := 'SQLITE_NOMEM ';
  737. SQLITE_READONLY : Result := 'SQLITE_READONLY ';
  738. SQLITE_INTERRUPT : Result := 'SQLITE_INTERRUPT ';
  739. SQLITE_IOERR : Result := 'SQLITE_IOERR ';
  740. SQLITE_CORRUPT : Result := 'SQLITE_CORRUPT ';
  741. SQLITE_NOTFOUND : Result := 'SQLITE_NOTFOUND ';
  742. SQLITE_FULL : Result := 'SQLITE_FULL ';
  743. SQLITE_CANTOPEN : Result := 'SQLITE_CANTOPEN ';
  744. SQLITE_PROTOCOL : Result := 'SQLITE_PROTOCOL ';
  745. SQLITE_EMPTY : Result := 'SQLITE_EMPTY ';
  746. SQLITE_SCHEMA : Result := 'SQLITE_SCHEMA ';
  747. SQLITE_TOOBIG : Result := 'SQLITE_TOOBIG ';
  748. SQLITE_CONSTRAINT : Result := 'SQLITE_CONSTRAINT ';
  749. SQLITE_MISMATCH : Result := 'SQLITE_MISMATCH ';
  750. SQLITE_MISUSE : Result := 'SQLITE_MISUSE ';
  751. SQLITE_NOLFS : Result := 'SQLITE_NOLFS ';
  752. SQLITE_AUTH : Result := 'SQLITE_AUTH ';
  753. SQLITE_FORMAT : Result := 'SQLITE_FORMAT ';
  754. // SQLITE_RANGE : Result := 'SQLITE_RANGE ';
  755. SQLITE_ROW : Result := 'SQLITE_ROW ';
  756. SQLITE_DONE : Result := 'SQLITE_DONE ';
  757. else
  758. Result:='Unknow Return Value';
  759. end;
  760. end;
  761. procedure Register;
  762. begin
  763. RegisterComponents('Data Access', [TSqliteDataset]);
  764. end;
  765. end.