sqlite3conn.pp 20 KB

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