sqlite3conn.pp 22 KB

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