customsqliteds.pas 57 KB

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