sqlite3conn.pp 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782
  1. {
  2. This file is part of the Free Pascal Classes Library (FCL).
  3. Copyright (c) 2006 by the Free Pascal development team
  4. SQLite3 connection for SQLDB
  5. See the File COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {
  12. Based on an implementation by Martin Schreiber, part of MSEIDE.
  13. Reworked all code so it conforms to FCL coding standards.
  14. }
  15. unit sqlite3conn;
  16. {$mode objfpc}
  17. {$h+}
  18. interface
  19. uses
  20. classes, db, bufdataset, sqldb, sqlite3dyn, types;
  21. const
  22. sqliteerrormax = 99;
  23. type
  24. PDateTime = ^TDateTime;
  25. TSqliteOption = (sloTransactions,sloDesignTransactions);
  26. TSqliteOptions = set of TSqliteOption;
  27. TStringArray = Array of string;
  28. PStringArray = ^TStringArray;
  29. TArrayStringArray = Array of TStringArray;
  30. PArrayStringArray = ^TArrayStringArray;
  31. { TSQLite3Connection }
  32. TSQLite3Connection = class(TSQLConnection)
  33. private
  34. fhandle: psqlite3;
  35. foptions: TSQLiteOptions;
  36. procedure setoptions(const avalue: tsqliteoptions);
  37. protected
  38. function stringsquery(const asql: string): TArrayStringArray;
  39. procedure checkerror(const aerror: integer);
  40. procedure DoInternalConnect; override;
  41. procedure DoInternalDisconnect; override;
  42. function GetHandle : pointer; override;
  43. Function AllocateCursorHandle : TSQLCursor; override;
  44. //aowner used as blob cache
  45. Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); override;
  46. Function AllocateTransactionHandle : TSQLHandle; override;
  47. procedure PrepareStatement(cursor: TSQLCursor; ATransaction : TSQLTransaction;
  48. buf: string; AParams : TParams); override;
  49. procedure Execute(cursor: TSQLCursor;atransaction:tSQLtransaction; AParams : TParams); override;
  50. function Fetch(cursor : TSQLCursor) : boolean; override;
  51. procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TfieldDefs); override;
  52. procedure UnPrepareStatement(cursor : TSQLCursor); override;
  53. procedure FreeFldBuffers(cursor : TSQLCursor); override;
  54. function LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; override;
  55. //if bufsize < 0 -> buffer was to small, should be -bufsize
  56. function GetTransactionHandle(trans : TSQLHandle): pointer; override;
  57. function Commit(trans : TSQLHandle) : boolean; override;
  58. function RollBack(trans : TSQLHandle) : boolean; override;
  59. function StartdbTransaction(trans : TSQLHandle; aParams : string) : boolean; override;
  60. procedure CommitRetaining(trans : TSQLHandle); override;
  61. procedure RollBackRetaining(trans : TSQLHandle); override;
  62. procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); override;
  63. // New methods
  64. procedure execsql(const asql: string);
  65. procedure UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string); override; // Differs from SQLDB.
  66. function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
  67. function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
  68. function StrToStatementType(s : string) : TStatementType; override;
  69. public
  70. constructor Create(AOwner : TComponent); override;
  71. function GetInsertID: int64;
  72. procedure GetFieldNames(const TableName : string; List : TStrings); override;
  73. published
  74. property Options: TSqliteOptions read FOptions write SetOptions;
  75. end;
  76. Var
  77. SQLiteLibraryName : String = sqlite3lib;
  78. implementation
  79. uses
  80. dbconst, sysutils, dateutils;
  81. type
  82. TStorageType = (stNone,stInteger,stFloat,stText,stBlob,stNull);
  83. TSQLite3Cursor = class(tsqlcursor)
  84. private
  85. fhandle : psqlite3;
  86. fstatement: psqlite3_stmt;
  87. ftail: pchar;
  88. fstate: integer;
  89. fparambinding: array of Integer;
  90. procedure checkerror(const aerror: integer);
  91. procedure bindparams(AParams : TParams);
  92. Procedure Prepare(Buf : String; APArams : TParams);
  93. Procedure UnPrepare;
  94. Procedure Execute;
  95. Function Fetch : Boolean;
  96. public
  97. RowsAffected : Largeint;
  98. end;
  99. procedure freebindstring(astring: pointer); cdecl;
  100. begin
  101. StrDispose(AString);
  102. end;
  103. procedure TSQLite3Cursor.checkerror(const aerror: integer);
  104. Var
  105. S : String;
  106. begin
  107. if (aerror<>sqlite_ok) then
  108. begin
  109. S:=strpas(sqlite3_errmsg(fhandle));
  110. DatabaseError(S);
  111. end;
  112. end;
  113. Procedure TSQLite3Cursor.bindparams(AParams : TParams);
  114. Function PCharStr(Const S : String) : PChar;
  115. begin
  116. Result:=StrAlloc(Length(S)+1);
  117. If (Result<>Nil) then
  118. StrPCopy(Result,S);
  119. end;
  120. Var
  121. I : Integer;
  122. P : TParam;
  123. pc : pchar;
  124. str1: string;
  125. cu1: currency;
  126. do1: double;
  127. parms : array of Integer;
  128. begin
  129. for I:=1 to high(fparambinding)+1 do
  130. begin
  131. P:=aparams[fparambinding[I-1]];
  132. if P.isnull then
  133. checkerror(sqlite3_bind_null(fstatement,I))
  134. else
  135. case P.datatype of
  136. ftinteger,
  137. ftboolean,
  138. ftsmallint: checkerror(sqlite3_bind_int(fstatement,I,p.asinteger));
  139. ftword: checkerror(sqlite3_bind_int(fstatement,I,P.asword));
  140. ftlargeint: checkerror(sqlite3_bind_int64(fstatement,I,P.aslargeint));
  141. ftbcd,
  142. ftfloat,
  143. ftcurrency,
  144. ftdatetime,
  145. ftdate,
  146. fttime: begin
  147. do1:= P.asfloat;
  148. checkerror(sqlite3_bind_double(fstatement,I,do1));
  149. end;
  150. ftstring: begin
  151. str1:= p.asstring;
  152. checkerror(sqlite3_bind_text(fstatement,I,pcharstr(str1), length(str1),@freebindstring));
  153. end;
  154. ftblob: begin
  155. str1:= P.asstring;
  156. checkerror(sqlite3_bind_blob(fstatement,I,pcharstr(str1), length(str1),@freebindstring));
  157. end;
  158. else
  159. DatabaseErrorFmt(SUnsupportedParameter, [Fieldtypenames[P.DataType], Self]);
  160. end; { Case }
  161. end;
  162. end;
  163. Procedure TSQLite3Cursor.Prepare(Buf : String; APArams : TParams);
  164. begin
  165. if assigned(aparams) and (aparams.count > 0) then
  166. buf := aparams.parsesql(buf,false,false,false,psinterbase,fparambinding);
  167. checkerror(sqlite3_prepare(fhandle,pchar(buf),length(buf),@fstatement,@ftail));
  168. FPrepared:=True;
  169. end;
  170. Procedure TSQLite3Cursor.UnPrepare;
  171. begin
  172. sqlite3_finalize(fstatement); // No check.
  173. FPrepared:=False;
  174. end;
  175. Procedure TSQLite3Cursor.Execute;
  176. var
  177. wo1: word;
  178. begin
  179. {$ifdef i386}
  180. wo1:= get8087cw;
  181. set8087cw(wo1 or $1f); //mask exceptions, Sqlite3 has overflow
  182. Try // Why do people always forget this ??
  183. {$endif}
  184. fstate:= sqlite3_step(fstatement);
  185. {$ifdef i386}
  186. finally
  187. set8087cw(wo1); //restore
  188. end;
  189. {$endif}
  190. if (fstate<=sqliteerrormax) then
  191. checkerror(sqlite3_reset(fstatement));
  192. RowsAffected:=sqlite3_changes(fhandle);
  193. if (fstate=sqlite_row) then
  194. fstate:= sqliteerrormax; //first row
  195. end;
  196. Function TSQLite3Cursor.Fetch : Boolean;
  197. begin
  198. if (fstate=sqliteerrormax) then
  199. fstate:=sqlite_row //first row;
  200. else if (fstate=sqlite_row) then
  201. begin
  202. fstate:=sqlite3_step(fstatement);
  203. if (fstate<=sqliteerrormax) then
  204. checkerror(sqlite3_reset(fstatement)); //right error returned??
  205. end;
  206. result:=(fstate=sqlite_row);
  207. end;
  208. { TSQLite3Connection }
  209. procedure TSQLite3Connection.LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction);
  210. var
  211. int1: integer;
  212. st: psqlite3_stmt;
  213. fnum: integer;
  214. begin
  215. st:=TSQLite3Cursor(cursor).fstatement;
  216. fnum:= FieldDef.fieldno - 1;
  217. int1:= sqlite3_column_bytes(st,fnum);
  218. ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer,int1);
  219. if int1 > 0 then
  220. move(sqlite3_column_text(st,fnum)^,ABlobBuf^.BlobBuffer^.Buffer^,int1);
  221. ABlobBuf^.BlobBuffer^.Size := int1;
  222. end;
  223. function TSQLite3Connection.AllocateTransactionHandle: TSQLHandle;
  224. begin
  225. result:= tsqlhandle.create;
  226. end;
  227. function TSQLite3Connection.AllocateCursorHandle: TSQLCursor;
  228. Var
  229. Res : TSQLite3Cursor;
  230. begin
  231. Res:= TSQLite3Cursor.create;
  232. Result:=Res;
  233. end;
  234. procedure TSQLite3Connection.DeAllocateCursorHandle(var cursor: TSQLCursor);
  235. begin
  236. freeandnil(cursor);
  237. end;
  238. procedure TSQLite3Connection.PrepareStatement(cursor: TSQLCursor;
  239. ATransaction: TSQLTransaction; buf: string; AParams: TParams);
  240. begin
  241. TSQLite3Cursor(cursor).fhandle:=self.fhandle;
  242. TSQLite3Cursor(cursor).Prepare(Buf,AParams);
  243. end;
  244. procedure TSQLite3Connection.UnPrepareStatement(cursor: TSQLCursor);
  245. begin
  246. TSQLite3Cursor(cursor).UnPrepare;
  247. TSQLite3Cursor(cursor).fhandle:=nil;
  248. end;
  249. Type
  250. TFieldMap = Record
  251. N : String;
  252. T : TFieldType;
  253. end;
  254. Const
  255. FieldMapCount = 19;
  256. FieldMap : Array [1..FieldMapCount] of TFieldMap = (
  257. (n:'INT'; t: ftInteger),
  258. (n:'LARGEINT'; t:ftlargeInt),
  259. (n:'WORD'; t: ftWord),
  260. (n:'SMALLINT'; t: ftSmallint),
  261. (n:'BOOLEAN'; t: ftBoolean),
  262. (n:'REAL'; t: ftFloat),
  263. (n:'FLOAT'; t: ftFloat),
  264. (n:'DOUBLE'; t: ftFloat),
  265. (n:'TIMESTAMP'; t: ftDateTime),
  266. (n:'DATETIME'; t: ftDateTime), // MUST be before date
  267. (n:'DATE'; t: ftDate),
  268. (n:'TIME'; t: ftTime),
  269. (n:'CURRENCY'; t: ftCurrency),
  270. (n:'VARCHAR'; t: ftString),
  271. (n:'CHAR'; t: ftString),
  272. (n:'NUMERIC'; t: ftBCD),
  273. (n:'DECIMAL'; t: ftBCD),
  274. (n:'TEXT'; t: ftmemo),
  275. (n:'BLOB'; t: ftBlob)
  276. { Template:
  277. (n:''; t: ft)
  278. }
  279. );
  280. procedure TSQLite3Connection.AddFieldDefs(cursor: TSQLCursor;
  281. FieldDefs: TfieldDefs);
  282. var
  283. i : integer;
  284. FN,FD : string;
  285. ft1 : tfieldtype;
  286. size1 : word;
  287. ar1 : TStringArray;
  288. fi : integer;
  289. st : psqlite3_stmt;
  290. begin
  291. st:=TSQLite3Cursor(cursor).fstatement;
  292. for i:= 0 to sqlite3_column_count(st) - 1 do
  293. begin
  294. FN:=sqlite3_column_name(st,i);
  295. FD:=uppercase(sqlite3_column_decltype(st,i));
  296. ft1:= ftUnknown;
  297. size1:= 0;
  298. for fi := 1 to FieldMapCount do if pos(FieldMap[fi].N,FD)=1 then
  299. begin
  300. ft1:=FieldMap[fi].t;
  301. break;
  302. end;
  303. // Empty field types are allowed and used in calculated columns (aggregates)
  304. // and by pragma-statements
  305. if FD='' then ft1 := ftString;
  306. // handle some specials.
  307. size1:=0;
  308. case ft1 of
  309. ftString: begin
  310. fi:=pos('(',FD);
  311. if (fi>0) then
  312. begin
  313. System.Delete(FD,1,fi);
  314. fi:=pos(')',FD);
  315. size1:=StrToIntDef(trim(copy(FD,1,fi-1)),255);
  316. if size1 > dsMaxStringSize then size1 := dsMaxStringSize;
  317. end
  318. else size1 := 255;
  319. end;
  320. ftBCD: begin
  321. fi:=pos(',',FD);
  322. if (fi>0) then
  323. begin
  324. System.Delete(FD,1,fi);
  325. fi:=pos(')',FD);
  326. size1:=StrToIntDef(trim(copy(FD,1,fi-1)),255);
  327. end
  328. else size1 := 4;
  329. end;
  330. ftUnknown : DatabaseError('Unknown record type: '+FN);
  331. end; // Case
  332. tfielddef.create(fielddefs,FieldDefs.MakeNameUnique(FN),ft1,size1,false,i+1);
  333. end;
  334. end;
  335. procedure TSQLite3Connection.Execute(cursor: TSQLCursor; atransaction: tsqltransaction; AParams: TParams);
  336. var
  337. SC : TSQLite3Cursor;
  338. begin
  339. SC:=TSQLite3Cursor(cursor);
  340. checkerror(sqlite3_reset(sc.fstatement));
  341. If (AParams<>Nil) and (AParams.count > 0) then
  342. SC.BindParams(AParams);
  343. SC.Execute;
  344. end;
  345. Function NextWord(Var S : ShortString; Sep : Char) : String;
  346. Var
  347. P : Integer;
  348. begin
  349. P:=Pos(Sep,S);
  350. If (P=0) then
  351. P:=Length(S)+1;
  352. Result:=Copy(S,1,P-1);
  353. Delete(S,1,P);
  354. end;
  355. Function ParseSQLiteDate(S : ShortString) : TDateTime;
  356. Var
  357. Year, Month, Day : Integer;
  358. begin
  359. Result:=0;
  360. If TryStrToInt(NextWord(S,'-'),Year) then
  361. if TryStrToInt(NextWord(S,'-'),Month) then
  362. if TryStrToInt(NextWord(S,'-'),Day) then
  363. Result:=EncodeDate(Year,Month,Day);
  364. end;
  365. Function ParseSQLiteTime(S : ShortString) : TDateTime;
  366. Var
  367. Hour, Min, Sec : Integer;
  368. begin
  369. Result:=0;
  370. If TryStrToInt(NextWord(S,':'),Hour) then
  371. if TryStrToInt(NextWord(S,':'),Min) then
  372. if TryStrToInt(NextWord(S,':'),Sec) then
  373. Result:=EncodeTime(Hour,Min,Sec,0);
  374. end;
  375. Function ParseSQLiteDateTime(S : String) : TDateTime;
  376. var
  377. P : Integer;
  378. DS,TS : ShortString;
  379. begin
  380. DS:='';
  381. TS:='';
  382. P:=Pos(' ',S);
  383. If (P<>0) then
  384. begin
  385. DS:=Copy(S,1,P-1);
  386. TS:=S;
  387. Delete(TS,1,P);
  388. end
  389. else
  390. begin
  391. If (Pos('-',S)<>0) then
  392. DS:=S
  393. else if (Pos(':',S)<>0) then
  394. TS:=S;
  395. end;
  396. Result:=ComposeDateTime(ParseSQLiteDate(DS),ParseSQLiteTime(TS));
  397. end;
  398. function TSQLite3Connection.LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean;
  399. var
  400. st1: TStorageType;
  401. fnum: integer;
  402. i: integer;
  403. i64: int64;
  404. int1,int2: integer;
  405. str1: string;
  406. ar1,ar2: TStringArray;
  407. st : psqlite3_stmt;
  408. begin
  409. st:=TSQLite3Cursor(cursor).fstatement;
  410. fnum:= FieldDef.fieldno - 1;
  411. st1:= TStorageType(sqlite3_column_type(st,fnum));
  412. CreateBlob:=false;
  413. result:= st1 <> stnull;
  414. if Not result then
  415. Exit;
  416. case FieldDef.datatype of
  417. ftInteger : pinteger(buffer)^ := sqlite3_column_int(st,fnum);
  418. ftSmallInt : psmallint(buffer)^ := sqlite3_column_int(st,fnum);
  419. ftWord : pword(buffer)^ := sqlite3_column_int(st,fnum);
  420. ftBoolean : pwordbool(buffer)^ := sqlite3_column_int(st,fnum)<>0;
  421. ftLargeInt : PInt64(buffer)^:= sqlite3_column_int64(st,fnum);
  422. ftBCD : PCurrency(buffer)^:= FloattoCurr(sqlite3_column_double(st,fnum));
  423. ftFloat,
  424. ftCurrency : pdouble(buffer)^:= sqlite3_column_double(st,fnum);
  425. ftDateTime,
  426. ftDate,
  427. ftTime: if st1 = sttext then
  428. begin
  429. setlength(str1,sqlite3_column_bytes(st,fnum));
  430. move(sqlite3_column_text(st,fnum)^,str1[1],length(str1));
  431. PDateTime(Buffer)^:=ParseSqliteDateTime(str1)
  432. end
  433. else
  434. Pdatetime(buffer)^:= sqlite3_column_double(st,fnum);
  435. ftString: begin
  436. int1:= sqlite3_column_bytes(st,fnum);
  437. if int1>FieldDef.Size then
  438. int1:=FieldDef.Size;
  439. if int1 > 0 then
  440. move(sqlite3_column_text(st,fnum)^,buffer^,int1);
  441. end;
  442. ftMemo,
  443. ftBlob: CreateBlob:=True;
  444. else { Case }
  445. result:= false; // unknown
  446. end; { Case }
  447. end;
  448. function TSQLite3Connection.Fetch(cursor: TSQLCursor): boolean;
  449. begin
  450. Result:=TSQLite3Cursor(cursor).Fetch;
  451. end;
  452. procedure TSQLite3Connection.FreeFldBuffers(cursor: TSQLCursor);
  453. begin
  454. //dummy
  455. end;
  456. function TSQLite3Connection.GetTransactionHandle(trans: TSQLHandle): pointer;
  457. begin
  458. result:= nil;
  459. end;
  460. function TSQLite3Connection.Commit(trans: TSQLHandle): boolean;
  461. begin
  462. execsql('COMMIT');
  463. result:= true;
  464. end;
  465. function TSQLite3Connection.RollBack(trans: TSQLHandle): boolean;
  466. begin
  467. execsql('ROLLBACK');
  468. result:= true;
  469. end;
  470. function TSQLite3Connection.StartdbTransaction(trans: TSQLHandle;
  471. aParams: string): boolean;
  472. begin
  473. execsql('BEGIN');
  474. result:= true;
  475. end;
  476. procedure TSQLite3Connection.CommitRetaining(trans: TSQLHandle);
  477. begin
  478. commit(trans);
  479. execsql('BEGIN');
  480. end;
  481. procedure TSQLite3Connection.RollBackRetaining(trans: TSQLHandle);
  482. begin
  483. rollback(trans);
  484. execsql('BEGIN');
  485. end;
  486. procedure TSQLite3Connection.DoInternalConnect;
  487. var
  488. str1: string;
  489. begin
  490. if Length(databasename)=0 then
  491. DatabaseError(SErrNoDatabaseName,self);
  492. InitialiseSqlite(SQLiteLibraryName);
  493. str1:= databasename;
  494. checkerror(sqlite3_open(pchar(str1),@fhandle));
  495. end;
  496. procedure TSQLite3Connection.DoInternalDisconnect;
  497. begin
  498. if fhandle <> nil then
  499. begin
  500. checkerror(sqlite3_close(fhandle));
  501. fhandle:= nil;
  502. releasesqlite;
  503. end;
  504. end;
  505. function TSQLite3Connection.GetHandle: pointer;
  506. begin
  507. result:= fhandle;
  508. end;
  509. procedure TSQLite3Connection.checkerror(const aerror: integer);
  510. Var
  511. S : String;
  512. begin
  513. if (aerror<>sqlite_ok) then
  514. begin
  515. S:=strpas(sqlite3_errmsg(fhandle));
  516. DatabaseError(S,Self);
  517. end;
  518. end;
  519. procedure TSQLite3Connection.execsql(const asql: string);
  520. var
  521. err : pchar;
  522. str1 : string;
  523. res : integer;
  524. begin
  525. err:= nil;
  526. Res := sqlite3_exec(fhandle,pchar(asql),nil,nil,@err);
  527. if err <> nil then
  528. begin
  529. str1:= strpas(err);
  530. sqlite3_free(err);
  531. end;
  532. if (res<>sqlite_ok) then
  533. databaseerror(str1);
  534. end;
  535. function execcallback(adata: pointer; ncols: longint; //adata = PStringArray
  536. avalues: PPchar; anames: PPchar):longint; cdecl;
  537. var
  538. P : PStringArray;
  539. i : integer;
  540. begin
  541. P:=PStringArray(adata);
  542. SetLength(P^,ncols);
  543. for i:= 0 to ncols - 1 do
  544. P^[i]:= strPas(avalues[i]);
  545. result:= 0;
  546. end;
  547. function execscallback(adata: pointer; ncols: longint; //adata = PArrayStringArray
  548. avalues: PPchar; anames: PPchar):longint; cdecl;
  549. var
  550. I,N : integer;
  551. PP : PArrayStringArray;
  552. p : PStringArray;
  553. begin
  554. PP:=PArrayStringArray(adata);
  555. N:=high(PP^); // Length-1;
  556. setlength(PP^,N+2); // increase with 1;
  557. p:= @(PP^[N+1]); // newly added array, fill with data.
  558. setlength(p^,ncols);
  559. for i:= 0 to ncols - 1 do
  560. p^[i]:= strPas(avalues[i]);
  561. result:= 0;
  562. end;
  563. function TSQLite3Connection.stringsquery(const asql: string): TArrayStringArray;
  564. begin
  565. SetLength(result,0);
  566. checkerror(sqlite3_exec(fhandle,pchar(asql),@execscallback,@result,nil));
  567. end;
  568. function TSQLite3Connection.RowsAffected(cursor: TSQLCursor): TRowsCount;
  569. begin
  570. if assigned(cursor) then
  571. Result := (cursor as TSQLite3Cursor).RowsAffected
  572. else
  573. Result := -1;
  574. end;
  575. function TSQLite3Connection.GetSchemaInfoSQL(SchemaType: TSchemaType;
  576. SchemaObjectName, SchemaPattern: string): string;
  577. begin
  578. case SchemaType of
  579. stTables : result := 'select name as table_name from sqlite_master where type = ''table''';
  580. stColumns : result := 'pragma table_info(''' + (SchemaObjectName) + ''')';
  581. else
  582. DatabaseError(SMetadataUnavailable)
  583. end; {case}
  584. end;
  585. function TSQLite3Connection.StrToStatementType(s: string): TStatementType;
  586. begin
  587. S:=Lowercase(s);
  588. if s = 'pragma' then exit(stSelect);
  589. result := inherited StrToStatementType(s);
  590. end;
  591. constructor TSQLite3Connection.Create(AOwner: TComponent);
  592. begin
  593. inherited Create(AOwner);
  594. FConnOptions := FConnOptions + [sqEscapeRepeat] + [sqEscapeSlash];
  595. FieldNameQuoteChars:=DoubleQuotes;
  596. end;
  597. procedure TSQLite3Connection.UpdateIndexDefs(IndexDefs: TIndexDefs; TableName: string);
  598. var
  599. artableinfo, arindexlist, arindexinfo: TArrayStringArray;
  600. il,ii: integer;
  601. IndexName: string;
  602. IndexOptions: TIndexOptions;
  603. PKFields, IXFields: TStrings;
  604. l: boolean;
  605. function CheckPKFields:boolean;
  606. var i: integer;
  607. begin
  608. Result:=false;
  609. if IXFields.Count<>PKFields.Count then Exit;
  610. for i:=0 to IXFields.Count-1 do
  611. if PKFields.IndexOf(IXFields[i])<0 then Exit;
  612. Result:=true;
  613. PKFields.Clear;
  614. end;
  615. begin
  616. PKFields:=TStringList.Create;
  617. PKFields.Delimiter:=';';
  618. IXFields:=TStringList.Create;
  619. IXFields.Delimiter:=';';
  620. //primary key fields
  621. artableinfo := stringsquery('PRAGMA table_info('+TableName+');');
  622. for ii:=low(artableinfo) to high(artableinfo) do
  623. if (high(artableinfo[ii]) >= 5) and (artableinfo[ii][5] = '1') then
  624. PKFields.Add(artableinfo[ii][1]);
  625. //list of all table indexes
  626. arindexlist:=stringsquery('PRAGMA index_list('+TableName+');');
  627. for il:=low(arindexlist) to high(arindexlist) do
  628. begin
  629. IndexName:=arindexlist[il][1];
  630. if arindexlist[il][2]='1' then
  631. IndexOptions:=[ixUnique]
  632. else
  633. IndexOptions:=[];
  634. //list of columns in given index
  635. arindexinfo:=stringsquery('PRAGMA index_info('+IndexName+');');
  636. IXFields.Clear;
  637. for ii:=low(arindexinfo) to high(arindexinfo) do
  638. IXFields.Add(arindexinfo[ii][2]);
  639. if CheckPKFields then IndexOptions:=IndexOptions+[ixPrimary];
  640. IndexDefs.Add(IndexName, IXFields.DelimitedText, IndexOptions);
  641. end;
  642. if PKFields.Count > 0 then //in special case for INTEGER PRIMARY KEY column, unique index is not created
  643. IndexDefs.Add('$PRIMARY_KEY$', PKFields.DelimitedText, [ixPrimary,ixUnique]);
  644. PKFields.Free;
  645. IXFields.Free;
  646. end;
  647. function TSQLite3Connection.getinsertid: int64;
  648. begin
  649. result:= sqlite3_last_insert_rowid(fhandle);
  650. end;
  651. procedure TSQLite3Connection.GetFieldNames(const TableName: string;
  652. List: TStrings);
  653. begin
  654. GetDBInfo(stColumns,TableName,'name',List);
  655. end;
  656. procedure TSQLite3Connection.setoptions(const avalue: tsqliteoptions);
  657. begin
  658. if avalue <> foptions then
  659. begin
  660. checkdisconnected;
  661. foptions:= avalue;
  662. end;
  663. end;
  664. end.