customsqliteds.pas 48 KB

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