customsqliteds.pas 48 KB

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