sqlite3conn.pp 22 KB

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