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. begin
  692. Result := grBOF;
  693. FCurrentItem := FBeginItem;
  694. end
  695. else
  696. FCurrentItem:=FCurrentItem^.Previous;
  697. gmCurrent:
  698. if (FCurrentItem = FBeginItem) or (FCurrentItem = FEndItem) then
  699. Result := grError;
  700. gmNext:
  701. if (FCurrentItem = FEndItem) or (FCurrentItem^.Next = FEndItem) then
  702. Result := grEOF
  703. else
  704. FCurrentItem := FCurrentItem^.Next;
  705. end; //case
  706. if Result = grOk then
  707. begin
  708. PDataRecord(Pointer(Buffer)^) := FCurrentItem;
  709. FCurrentItem^.BookmarkFlag := bfCurrent;
  710. GetCalcFields(Buffer);
  711. end
  712. else if (Result = grError) and DoCheck then
  713. DatabaseError('No records found', Self);
  714. end;
  715. function TCustomSqliteDataset.GetRecordCount: Integer;
  716. begin
  717. Result := FRecordCount;
  718. end;
  719. function TCustomSqliteDataset.GetRecNo: Integer;
  720. var
  721. TempItem, TempActive: PDataRecord;
  722. begin
  723. Result := -1;
  724. if (FRecordCount = 0) or (State = dsInsert) then
  725. Exit;
  726. TempItem := FBeginItem;
  727. TempActive := PPDataRecord(ActiveBuffer)^;
  728. if TempActive = FCacheItem then // Record is being edited
  729. TempActive := FInternalActiveBuffer;
  730. //RecNo is 1 based
  731. Inc(Result);
  732. while TempActive <> TempItem do
  733. begin
  734. if TempItem^.Next <> nil then
  735. begin
  736. Inc(Result);
  737. TempItem := TempItem^.Next;
  738. end
  739. else
  740. begin
  741. Result := -1;
  742. DatabaseError('GetRecNo - ActiveItem Not Found', Self);
  743. break;
  744. end;
  745. end;
  746. end;
  747. function TCustomSqliteDataset.GetRecordSize: Word;
  748. begin
  749. Result := SizeOf(PPDataRecord); //??
  750. end;
  751. procedure TCustomSqliteDataset.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
  752. var
  753. NewItem: PDataRecord;
  754. begin
  755. {$ifdef DEBUG_SQLITEDS}
  756. if PPDataRecord(ActiveBuffer)^ <> FCacheItem then
  757. DatabaseError('PPDataRecord(ActiveBuffer) <> FCacheItem - Problem', Self);
  758. {$endif}
  759. New(NewItem);
  760. GetMem(NewItem^.Row, FRowBufferSize);
  761. //if is a detail dataset then set the index value
  762. if FMasterLink.Active then
  763. SetMasterIndexValue;
  764. //necessary to nullify the Row before copy the cache
  765. FillChar(NewItem^.Row^, FRowBufferSize, #0);
  766. CopyCacheToItem(NewItem);
  767. //insert in the linked list
  768. FInsertBookmark^.Previous^.Next := NewItem;
  769. NewItem^.Next := FInsertBookmark;
  770. NewItem^.Previous := FInsertBookmark^.Previous;
  771. FInsertBookmark^.Previous := NewItem;
  772. //update the cursor
  773. FCurrentItem := NewItem;
  774. Inc(FRecordCount);
  775. if FAutoIncFieldNo <> - 1 then
  776. Inc(FNextAutoInc);
  777. FAddedItems.Add(NewItem);
  778. end;
  779. procedure TCustomSqliteDataset.InternalClose;
  780. begin
  781. //BindFields(False);
  782. if DefaultFields then
  783. DestroyFields;
  784. if FDataAllocated then
  785. DisposeLinkedList;
  786. FAddedItems.Clear;
  787. FUpdatedItems.Clear;
  788. FDeletedItems.Clear;
  789. FRecordCount := 0;
  790. end;
  791. procedure TCustomSqliteDataset.InternalCancel;
  792. var
  793. i: Integer;
  794. begin
  795. PPDataRecord(ActiveBuffer)^ := FInternalActiveBuffer;
  796. //free the cache
  797. for i:= 0 to FRowCount - 1 do
  798. begin
  799. StrDispose(FCacheItem^.Row[i]);
  800. FCacheItem^.Row[i] := nil;
  801. end;
  802. end;
  803. procedure TCustomSqliteDataset.InternalDelete;
  804. var
  805. TempItem: PDataRecord;
  806. ValError, TempInteger: Integer;
  807. begin
  808. Dec(FRecordCount);
  809. TempItem := PPDataRecord(ActiveBuffer)^;
  810. TempItem^.Next^.Previous := TempItem^.Previous;
  811. TempItem^.Previous^.Next := TempItem^.Next;
  812. if FCurrentItem = TempItem then
  813. begin
  814. if FCurrentItem^.Previous <> FBeginItem then
  815. FCurrentItem := FCurrentItem^.Previous
  816. else
  817. FCurrentItem := FCurrentItem^.Next;
  818. end;
  819. // Dec FNextAutoInc (only if deleted item is the last record)
  820. if FAutoIncFieldNo <> -1 then
  821. begin
  822. Val(String(TempItem^.Row[FAutoIncFieldNo]), TempInteger, ValError);
  823. if (ValError = 0) and (TempInteger = (FNextAutoInc - 1)) then
  824. Dec(FNextAutoInc);
  825. end;
  826. // Update item lists
  827. FUpdatedItems.Remove(TempItem);
  828. if FAddedItems.Remove(TempItem) = -1 then
  829. FDeletedItems.Add(TempItem)
  830. else
  831. FreeItem(TempItem);
  832. end;
  833. procedure TCustomSqliteDataset.InternalEdit;
  834. var
  835. i: Integer;
  836. begin
  837. FInternalActiveBuffer := PPDataRecord(ActiveBuffer)^;
  838. //copy active item to cache
  839. for i:= 0 to FRowCount - 1 do
  840. FCacheItem^.Row[i] := StrNew(FInternalActiveBuffer^.Row[i]);
  841. FCacheItem^.BookmarkFlag := FInternalActiveBuffer^.BookmarkFlag;
  842. //now active buffer is the cache item
  843. PPDataRecord(ActiveBuffer)^ := FCacheItem;
  844. end;
  845. procedure TCustomSqliteDataset.InternalFirst;
  846. begin
  847. FCurrentItem := FBeginItem;
  848. end;
  849. procedure TCustomSqliteDataset.InternalGotoBookmark(ABookmark: Pointer);
  850. begin
  851. FCurrentItem := PDataRecord(ABookmark^);
  852. end;
  853. procedure TCustomSqliteDataset.InternalInitFieldDefs;
  854. begin
  855. if FSQL = '' then
  856. begin
  857. if FTablename = '' then
  858. DatabaseError('Tablename not set', Self);
  859. FEffectiveSQL := 'Select * from ' + FTableName + ';';
  860. end
  861. else
  862. FEffectiveSQL := FSQL;
  863. if FSqliteHandle = nil then
  864. GetSqliteHandle;
  865. RetrieveFieldDefs;
  866. end;
  867. procedure TCustomSqliteDataset.InternalInitRecord(Buffer: TRecordBuffer);
  868. var
  869. TempStr: String;
  870. begin
  871. if FAutoIncFieldNo <> - 1 then
  872. begin
  873. Str(FNextAutoInc, TempStr);
  874. FCacheItem^.Row[FAutoIncFieldNo] := StrAlloc(Length(TempStr) + 1);
  875. StrPCopy(FCacheItem^.Row[FAutoIncFieldNo], TempStr);
  876. end;
  877. PPDataRecord(Buffer)^ := FCacheItem;
  878. FCacheItem^.BookmarkFlag := bfInserted;
  879. end;
  880. procedure TCustomSqliteDataset.InternalLast;
  881. begin
  882. FCurrentItem := FEndItem;
  883. end;
  884. procedure TCustomSqliteDataset.InternalOpen;
  885. begin
  886. InternalInitFieldDefs;
  887. if DefaultFields then
  888. CreateFields;
  889. BindFields(True);
  890. if CalcFieldsSize > 0 then
  891. UpdateCalcFieldList;
  892. if FIndexFieldNames <> '' then
  893. UpdateIndexFieldList;
  894. if FMasterLink.DataSource <> nil then
  895. UpdateMasterDetailProperties;
  896. // Get PrimaryKeyNo if available
  897. if TDefCollection(FieldDefs).Find(FPrimaryKey) <> nil then
  898. FPrimaryKeyNo := FieldDefs.Find(FPrimaryKey).FieldNo - 1
  899. else
  900. FPrimaryKeyNo := FAutoIncFieldNo; // -1 if there's no AutoIncField
  901. BuildLinkedList;
  902. FCurrentItem := FBeginItem;
  903. end;
  904. procedure TCustomSqliteDataset.InternalPost;
  905. begin
  906. if State <> dsEdit then
  907. InternalAddRecord(nil, True)
  908. else
  909. begin
  910. CopyCacheToItem(FInternalActiveBuffer);
  911. PPDataRecord(ActiveBuffer)^ := FInternalActiveBuffer;
  912. if (FUpdatedItems.IndexOf(FInternalActiveBuffer) = -1) and
  913. (FAddedItems.IndexOf(FInternalActiveBuffer) = -1) then
  914. FUpdatedItems.Add(FInternalActiveBuffer);
  915. end;
  916. end;
  917. procedure TCustomSqliteDataset.InternalSetToRecord(Buffer: TRecordBuffer);
  918. begin
  919. FCurrentItem := PPDataRecord(Buffer)^;
  920. end;
  921. function TCustomSqliteDataset.IsCursorOpen: Boolean;
  922. begin
  923. Result := FDataAllocated;
  924. end;
  925. type
  926. TLocateCompareFunction = function (Value: PAnsiChar; const Key: String): Boolean;
  927. TLocateFieldInfo = record
  928. Index: Integer;
  929. Key: String;
  930. CompFunction: TLocateCompareFunction;
  931. end;
  932. function CompInsensitivePartial(UTF8Value: PAnsiChar; const AnsiKey: String): Boolean;
  933. var
  934. AnsiValue: AnsiString;
  935. begin
  936. //see comments of CompInsensitive and CompInsensitiveWild functions
  937. if UTF8Value <> nil then
  938. begin
  939. AnsiValue := UTF8Decode(UTF8Value);
  940. Result := AnsiStrLIComp(PAnsiChar(AnsiValue), PAnsiChar(AnsiKey), Length(AnsiKey)) = 0;
  941. end
  942. else
  943. Result := False;
  944. end;
  945. function CompSensitivePartial(UTF8Value: PAnsiChar; const UTF8Key: String): Boolean;
  946. begin
  947. if UTF8Value <> nil then
  948. Result := StrLComp(UTF8Value, PAnsiChar(UTF8Key), Length(UTF8Key)) = 0
  949. else
  950. Result := False;
  951. end;
  952. function CompInsensitive(UTF8Value: PAnsiChar; const AnsiKey: String): Boolean;
  953. begin
  954. //fpc does not provide a function to compare UTF8 directly, so convert the
  955. //UTF8Value string to ansi through a temporary widestring and compare with the
  956. //AnsiKey (already encoded in the system ansi encoding).
  957. //In unix systems where UTF8 is the system ansi encoding this would not be
  958. //necessary but there's no direct way to check that
  959. //todo: change this code when fpc has better support for unicode
  960. if UTF8Value <> nil then
  961. Result := AnsiCompareText(UTF8Decode(UTF8Value), AnsiKey) = 0
  962. else
  963. Result := False;
  964. end;
  965. function CompSensitive(UTF8Value: PAnsiChar; const UTF8Key: String): Boolean;
  966. begin
  967. if UTF8Value <> nil then
  968. Result := StrComp(UTF8Value, PAnsiChar(UTF8Key)) = 0
  969. else
  970. Result := False;
  971. end;
  972. function CompSensitiveWild(UTF8Value: PAnsiChar; const UTF8Key: String): Boolean;
  973. begin
  974. if UTF8Value <> nil then
  975. Result := IsWild(String(UTF8Value), UTF8Key, False)
  976. else
  977. Result := False;
  978. end;
  979. function CompDouble(UTF8Value: PAnsiChar; const UTF8Key: String): Boolean;
  980. var e1,e2:double;
  981. begin
  982. if UTF8Value <> nil then
  983. begin
  984. val(UTF8Value,e1);
  985. val(UTF8Key,e2);
  986. result:=e1=e2;
  987. end
  988. else
  989. Result := False;
  990. end;
  991. function CompInsensitiveWild(UTF8Value: PAnsiChar; const AnsiKey: String): Boolean;
  992. begin
  993. //IsWild does not work with UTF8 encoded strings for case insensitive searches,
  994. //so convert UTF8Value to the system ansi encoding before passing to IsWild.
  995. //AnsiKey is already encoded in ansi
  996. //todo: change this code when fpc has better support for unicode
  997. if UTF8Value <> nil then
  998. Result := IsWild(UTF8Decode(UTF8Value), AnsiKey, True)
  999. else
  1000. Result := False;
  1001. end;
  1002. function TCustomSqliteDataset.FindRecordItem(StartItem: PDataRecord; const KeyFields: string; const KeyValues: Variant; LocateOptions: TLocateOptions; DoResync:Boolean): PDataRecord;
  1003. var
  1004. LocateFields: array of TLocateFieldInfo;
  1005. AFieldList: TList;
  1006. i, AFieldCount: Integer;
  1007. MatchRecord: Boolean;
  1008. TempItem: PDataRecord;
  1009. begin
  1010. Result := nil;
  1011. AFieldList := TList.Create;
  1012. try
  1013. GetFieldList(AFieldList, KeyFields);
  1014. AFieldCount := AFieldList.Count;
  1015. if AFieldCount > 1 then
  1016. begin
  1017. if VarIsArray(KeyValues) then
  1018. begin
  1019. if Succ(VarArrayHighBound(KeyValues, 1)) <> AFieldCount then
  1020. DatabaseError('Number of fields does not correspond to number of values', Self);
  1021. end
  1022. else
  1023. DatabaseError('Wrong number of values specified: expected an array of variants got a variant', Self);
  1024. end;
  1025. //set the array of the fields info
  1026. SetLength(LocateFields, AFieldCount);
  1027. for i := 0 to AFieldCount - 1 do
  1028. with TField(AFieldList[i]) do
  1029. begin
  1030. if not (DataType in [ftFloat, ftDateTime, ftTime, ftDate]) then
  1031. begin
  1032. //the loPartialKey and loCaseInsensitive is ignored in numeric fields
  1033. if DataType in [ftString, ftMemo] then
  1034. begin
  1035. if loPartialKey in LocateOptions then
  1036. begin
  1037. if loCaseInsensitive in LocateOptions then
  1038. LocateFields[i].CompFunction := @CompInsensitivePartial
  1039. else
  1040. LocateFields[i].CompFunction := @CompSensitivePartial;
  1041. end
  1042. else
  1043. if soWildcardKey in FOptions then
  1044. begin
  1045. if loCaseInsensitive in LocateOptions then
  1046. LocateFields[i].CompFunction := @CompInsensitiveWild
  1047. else
  1048. LocateFields[i].CompFunction := @CompSensitiveWild;
  1049. end
  1050. else
  1051. begin
  1052. if loCaseInsensitive in LocateOptions then
  1053. LocateFields[i].CompFunction := @CompInsensitive
  1054. else
  1055. LocateFields[i].CompFunction := @CompSensitive;
  1056. end;
  1057. end
  1058. else
  1059. LocateFields[i].CompFunction := @CompSensitive;
  1060. if VarIsArray(KeyValues) then
  1061. LocateFields[i].Key := VarToStr(KeyValues[i])
  1062. else
  1063. LocateFields[i].Key := VarToStr(KeyValues);
  1064. //store Key encoded as the system ansi encoding
  1065. if loCaseInsensitive in LocateOptions then
  1066. LocateFields[i].Key := UTF8Decode(LocateFields[i].Key);
  1067. end
  1068. else
  1069. begin
  1070. LocateFields[i].CompFunction := @CompDouble;
  1071. //get float types in appropriate format
  1072. if VarIsArray(KeyValues) then
  1073. Str(VarToDateTime(keyvalues[i]), LocateFields[i].Key)
  1074. else
  1075. Str(VarToDateTime(keyvalues), LocateFields[i].Key);
  1076. end;
  1077. LocateFields[i].Index := FieldNo - 1;
  1078. end;
  1079. finally
  1080. AFieldList.Destroy;
  1081. end;
  1082. {$ifdef DEBUG_SQLITEDS}
  1083. WriteLn('##TCustomSqliteDataset.FindRecordItem##');
  1084. WriteLn(' KeyFields: ', KeyFields);
  1085. for i := 0 to AFieldCount - 1 do
  1086. begin
  1087. WriteLn('LocateFields[', i, ']');
  1088. WriteLn(' Key: ', LocateFields[i].Key);
  1089. WriteLn(' Index: ', LocateFields[i].Index);
  1090. end;
  1091. {$endif}
  1092. //Search the list
  1093. TempItem := StartItem;
  1094. while TempItem <> FEndItem do
  1095. begin
  1096. MatchRecord := True;
  1097. for i:= 0 to AFieldCount - 1 do
  1098. begin
  1099. with LocateFields[i] do
  1100. if not CompFunction(TempItem^.Row[Index], Key) then
  1101. begin
  1102. MatchRecord := False;
  1103. break; //for
  1104. end;
  1105. end;
  1106. if MatchRecord then
  1107. begin
  1108. Result := TempItem;
  1109. if DoResync and (TempItem <> PPDataRecord(ActiveBuffer)^) then
  1110. begin
  1111. DoBeforeScroll;
  1112. FCurrentItem := TempItem;
  1113. Resync([]);
  1114. DoAfterScroll;
  1115. end;
  1116. break; //while
  1117. end;
  1118. TempItem := TempItem^.Next;
  1119. end;
  1120. end;
  1121. procedure TCustomSqliteDataset.UpdateMasterDetailProperties;
  1122. var
  1123. i: Integer;
  1124. begin
  1125. if FMasterLink.Active and (FIndexFieldList.Count <> FMasterLink.Fields.Count) then
  1126. DatabaseError('MasterFields count doesn''t match IndexFields count', Self);
  1127. if FieldDefs.Count > 0 then
  1128. begin
  1129. //build the sql template used to filter the dataset
  1130. FSqlFilterTemplate := 'SELECT ';
  1131. for i := 0 to FieldDefs.Count - 2 do
  1132. FSqlFilterTemplate := FSqlFilterTemplate + FieldDefs[i].Name + ',';
  1133. FSqlFilterTemplate := FSqlFilterTemplate + FieldDefs[FieldDefs.Count - 1].Name +
  1134. ' FROM ' + FTableName;
  1135. end;
  1136. //set FEffectiveSQL considering MasterSource active record
  1137. SetDetailFilter;
  1138. end;
  1139. function TCustomSqliteDataset.FieldDefsStored: Boolean;
  1140. begin
  1141. Result := FStoreDefs and (FieldDefs.Count > 0);
  1142. end;
  1143. procedure TCustomSqliteDataset.GetSqliteHandle;
  1144. begin
  1145. if FFileName = '' then
  1146. DatabaseError('Filename not set', Self);
  1147. FSqliteHandle := InternalGetHandle;
  1148. if Assigned(FOnGetHandle) then
  1149. FOnGetHandle(Self);
  1150. end;
  1151. procedure TCustomSqliteDataset.FreeItem(AItem: PDataRecord);
  1152. var
  1153. i: Integer;
  1154. begin
  1155. for i:= 0 to FRowCount - 1 do
  1156. StrDispose(AItem^.Row[i]);
  1157. FreeMem(AItem^.Row, FRowBufferSize);
  1158. Dispose(AItem);
  1159. end;
  1160. function TCustomSqliteDataset.Locate(const KeyFields: String; const KeyValues: Variant; LocateOptions: TLocateOptions): Boolean;
  1161. begin
  1162. CheckBrowseMode;
  1163. Result := FindRecordItem(FBeginItem^.Next, KeyFields, KeyValues, LocateOptions, True) <> nil;
  1164. end;
  1165. function TCustomSqliteDataset.LocateNext(const KeyFields: String; const KeyValues: Variant; LocateOptions: TLocateOptions): Boolean;
  1166. begin
  1167. CheckBrowseMode;
  1168. Result := FindRecordItem(PPDataRecord(ActiveBuffer)^^.Next, KeyFields, KeyValues, LocateOptions, True) <> nil;
  1169. end;
  1170. function TCustomSqliteDataset.Lookup(const KeyFields: String; const KeyValues: Variant; const ResultFields: String): Variant;
  1171. var
  1172. TempItem: PDataRecord;
  1173. SaveState: TDataSetState;
  1174. begin
  1175. CheckBrowseMode;
  1176. TempItem := FindRecordItem(FBeginItem^.Next, KeyFields, KeyValues, [], False);
  1177. if TempItem <> nil then
  1178. begin
  1179. SaveState := SetTempState(dsInternalCalc);
  1180. try
  1181. CalculateFields(TRecordBuffer(@TempItem));
  1182. Result := FieldByName(ResultFields).Value;
  1183. finally
  1184. RestoreState(SaveState);
  1185. end;
  1186. end
  1187. else
  1188. Result := Null;
  1189. end;
  1190. procedure TCustomSqliteDataset.SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
  1191. begin
  1192. //The BookMarkData is the Buffer itself: no need to set nothing;
  1193. end;
  1194. procedure TCustomSqliteDataset.SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag);
  1195. begin
  1196. PPDataRecord(Buffer)^^.BookmarkFlag := Value;
  1197. end;
  1198. procedure TCustomSqliteDataset.SetExpectedAppends(AValue: Integer);
  1199. begin
  1200. FAddedItems.Capacity := AValue;
  1201. end;
  1202. procedure TCustomSqliteDataset.SetExpectedUpdates(AValue: Integer);
  1203. begin
  1204. FUpdatedItems.Capacity := AValue;
  1205. end;
  1206. procedure TCustomSqliteDataset.SetExpectedDeletes(AValue: Integer);
  1207. begin
  1208. FDeletedItems.Capacity := AValue;
  1209. end;
  1210. procedure TCustomSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer;
  1211. NativeFormat: Boolean);
  1212. var
  1213. TempStr: String;
  1214. FieldOffset: Integer;
  1215. EditItem: PDataRecord;
  1216. begin
  1217. if not (State in [dsEdit, dsInsert, dsCalcFields]) then
  1218. DatabaseErrorFmt(SNotEditing, [Name], Self);
  1219. if Field.FieldNo >= 0 then
  1220. begin
  1221. if State in [dsEdit, dsInsert] then
  1222. Field.Validate(Buffer);
  1223. FieldOffset := Field.FieldNo - 1;
  1224. EditItem := FCacheItem;
  1225. end
  1226. else
  1227. begin
  1228. FieldOffset := FieldDefs.Count + FCalcFieldList.IndexOf(Field);
  1229. EditItem := PPDataRecord(CalcBuffer)^;
  1230. end;
  1231. StrDispose(EditItem^.Row[FieldOffset]);
  1232. if Buffer <> nil then
  1233. begin
  1234. case Field.Datatype of
  1235. ftString:
  1236. begin
  1237. EditItem^.Row[FieldOffset] := StrNew(PAnsiChar(Buffer));
  1238. end;
  1239. ftInteger:
  1240. begin
  1241. Str(LongInt(Buffer^), TempStr);
  1242. EditItem^.Row[FieldOffset] := StrAlloc(Length(TempStr) + 1);
  1243. Move(PAnsiChar(TempStr)^, (EditItem^.Row[FieldOffset])^, Length(TempStr) + 1);
  1244. end;
  1245. ftBoolean, ftWord:
  1246. begin
  1247. //ensure that boolean True value is stored as 1
  1248. if Field.DataType = ftBoolean then
  1249. TempStr := IfThen(Boolean(Buffer^), '1', '0')
  1250. else
  1251. Str(Word(Buffer^), TempStr);
  1252. EditItem^.Row[FieldOffset] := StrAlloc(Length(TempStr) + 1);
  1253. Move(PAnsiChar(TempStr)^, (EditItem^.Row[FieldOffset])^, Length(TempStr) + 1);
  1254. end;
  1255. ftFloat, ftDateTime, ftDate, ftTime, ftCurrency:
  1256. begin
  1257. Str(Double(Buffer^), TempStr);
  1258. EditItem^.Row[FieldOffset] := StrAlloc(Length(TempStr) + 1);
  1259. Move(PAnsiChar(TempStr)^, (EditItem^.Row[FieldOffset])^, Length(TempStr) + 1);
  1260. end;
  1261. ftLargeInt:
  1262. begin
  1263. Str(Int64(Buffer^), TempStr);
  1264. EditItem^.Row[FieldOffset] := StrAlloc(Length(TempStr) + 1);
  1265. Move(PAnsiChar(TempStr)^, (EditItem^.Row[FieldOffset])^, Length(TempStr) + 1);
  1266. end;
  1267. end;// case
  1268. end//if
  1269. else
  1270. EditItem^.Row[FieldOffset] := nil;
  1271. if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
  1272. DataEvent(deFieldChange, Ptrint(Field));
  1273. end;
  1274. procedure TCustomSqliteDataset.SetFieldData(Field: TField; Buffer: Pointer);
  1275. begin
  1276. SetFieldData(Field, Buffer, False);
  1277. end;
  1278. procedure TCustomSqliteDataset.SetRecNo(Value: Integer);
  1279. var
  1280. Counter: Integer;
  1281. TempItem: PDataRecord;
  1282. begin
  1283. if (Value > FRecordCount) or (Value <= 0) then
  1284. DatabaseError('Record Number Out Of Range',Self);
  1285. CheckBrowseMode;
  1286. TempItem := FBeginItem;
  1287. for Counter := 1 to Value do
  1288. TempItem := TempItem^.Next;
  1289. if TempItem <> PPDataRecord(ActiveBuffer)^ then
  1290. begin
  1291. DoBeforeScroll;
  1292. FCurrentItem := TempItem;
  1293. Resync([]);
  1294. DoAfterScroll;
  1295. end;
  1296. end;
  1297. // Specific functions
  1298. procedure TCustomSqliteDataset.SetDetailFilter;
  1299. function FieldToSqlStr(AField: TField): String;
  1300. begin
  1301. if not AField.IsNull then
  1302. begin
  1303. case AField.DataType of
  1304. //todo: handle " caracter properly
  1305. ftString, ftMemo:
  1306. Result := '"' + AField.AsString + '"';
  1307. ftDateTime, ftDate, ftTime:
  1308. Str(AField.AsDateTime, Result);
  1309. else
  1310. Result := AField.AsString;
  1311. end; //case
  1312. end
  1313. else
  1314. Result:=NullString;
  1315. end; //function
  1316. var
  1317. AFilter: String;
  1318. i: Integer;
  1319. begin
  1320. if not FMasterLink.Active or (FMasterLink.Dataset.RecordCount = 0) 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 + ' = ' + FieldToSqlStr(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.