customsqliteds.pas 49 KB

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