customsqliteds.pas 48 KB

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