sqlite3ds.pas 10 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344
  1. unit sqlite3ds;
  2. {
  3. This is TSqlite3Dataset, a TDataset descendant class for use with fpc compiler
  4. Copyright (C) 2004 Luiz Américo Pereira Câmara
  5. Email: [email protected]
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU Lesser General Public License as published by
  8. the Free Software Foundation; either version 2.1 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU Lesser General Public License for more details.
  14. You should have received a copy of the GNU Lesser General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  17. }
  18. {$mode objfpc}
  19. {$H+}
  20. { $Define DEBUG}
  21. interface
  22. uses
  23. Classes, SysUtils, customsqliteds;
  24. type
  25. { TSqlite3Dataset }
  26. TSqlite3Dataset = class (TCustomSqliteDataset)
  27. private
  28. function SqliteExec(ASql:PChar; ACallback: TSqliteCdeclCallback; Data: Pointer):Integer;override;
  29. function InternalGetHandle: Pointer; override;
  30. function GetSqliteVersion: String; override;
  31. procedure InternalCloseHandle;override;
  32. procedure BuildLinkedList; override;
  33. protected
  34. procedure InternalInitFieldDefs; override;
  35. function GetRowsAffected:Integer; override;
  36. public
  37. procedure ExecuteDirect(const ASql: String);override;
  38. function ReturnString: String; override;
  39. function QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;override;
  40. end;
  41. implementation
  42. uses
  43. sqlite3,db;
  44. function GetAutoIncValue(NextValue: Pointer; Columns: Integer; ColumnValues: PPChar; ColumnNames: PPChar): integer; cdecl;
  45. var
  46. CodeError, TempInt: Integer;
  47. begin
  48. TempInt:=-1;
  49. if ColumnValues[0] <> nil then
  50. begin
  51. Val(StrPas(ColumnValues[0]),TempInt,CodeError);
  52. if CodeError <> 0 then
  53. DatabaseError('SqliteDs - Error trying to get last autoinc value');
  54. end;
  55. Integer(NextValue^):=Succ(TempInt);
  56. Result:=1;
  57. end;
  58. { TSqlite3Dataset }
  59. function TSqlite3Dataset.SqliteExec(ASql: PChar; ACallback: TSqliteCdeclCallback; Data: Pointer): Integer;
  60. begin
  61. Result:=sqlite3_exec(FSqliteHandle, ASql, ACallback, Data, nil);
  62. end;
  63. procedure TSqlite3Dataset.InternalCloseHandle;
  64. begin
  65. sqlite3_close(FSqliteHandle);
  66. FSqliteHandle:=nil;
  67. //todo:handle return data
  68. end;
  69. function TSqlite3Dataset.InternalGetHandle: Pointer;
  70. begin
  71. FReturnCode:=sqlite3_open(PChar(FFileName),@Result);
  72. end;
  73. procedure TSqlite3Dataset.InternalInitFieldDefs;
  74. var
  75. vm:Pointer;
  76. ColumnStr:String;
  77. i,ColumnCount,FieldSize:Integer;
  78. AType:TFieldType;
  79. begin
  80. {$ifdef DEBUG}
  81. WriteLn('##TSqlite3Dataset.InternalInitFieldDefs##');
  82. {$endif}
  83. FAutoIncFieldNo:=-1;
  84. FieldDefs.Clear;
  85. sqlite3_prepare(FSqliteHandle,PChar(FSql),-1,@vm,nil);
  86. sqlite3_step(vm);
  87. ColumnCount:=sqlite3_column_count(vm);
  88. //Set BufferSize
  89. FRowBufferSize:=(SizeOf(PPChar)*ColumnCount);
  90. //Prepare the array of pchar2sql functions
  91. SetLength(FGetSqlStr,ColumnCount);
  92. for i:= 0 to ColumnCount - 1 do
  93. begin
  94. ColumnStr:= UpperCase(StrPas(sqlite3_column_decltype(vm,i)));
  95. if (ColumnStr = 'INTEGER') or (ColumnStr = 'INT') then
  96. begin
  97. if AutoIncrementKey and (UpperCase(StrPas(sqlite3_column_name(vm,i))) = UpperCase(PrimaryKey)) then
  98. begin
  99. AType:= ftAutoInc;
  100. FAutoIncFieldNo:=i;
  101. end
  102. else
  103. AType:= ftInteger;
  104. FieldSize:=SizeOf(LongInt);
  105. end else if Pos('VARCHAR',ColumnStr) = 1 then
  106. begin
  107. AType:= ftString;
  108. FieldSize:=0;
  109. end else if Pos('BOOL',ColumnStr) = 1 then
  110. begin
  111. AType:= ftBoolean;
  112. FieldSize:=SizeOf(WordBool);
  113. end else if Pos('AUTOINC',ColumnStr) = 1 then
  114. begin
  115. AType:= ftAutoInc;
  116. FieldSize:=SizeOf(LongInt);
  117. if FAutoIncFieldNo = -1 then
  118. FAutoIncFieldNo:= i;
  119. end else if (Pos('FLOAT',ColumnStr)=1) or (Pos('NUMERIC',ColumnStr)=1) then
  120. begin
  121. AType:= ftFloat;
  122. FieldSize:=SizeOf(Double);
  123. end else if (ColumnStr = 'DATETIME') then
  124. begin
  125. AType:= ftDateTime;
  126. FieldSize:=SizeOf(TDateTime);
  127. end else if (ColumnStr = 'DATE') then
  128. begin
  129. AType:= ftDate;
  130. FieldSize:=SizeOf(TDateTime);
  131. end else if (ColumnStr = 'LARGEINT') then
  132. begin
  133. AType:= ftLargeInt;
  134. FieldSize:=SizeOf(Int64);
  135. end else if (ColumnStr = 'TIME') then
  136. begin
  137. AType:= ftTime;
  138. FieldSize:=SizeOf(TDateTime);
  139. end else if (ColumnStr = 'TEXT') then
  140. begin
  141. AType:= ftMemo;
  142. FieldSize:=0;
  143. end else if (ColumnStr = 'CURRENCY') then
  144. begin
  145. AType:= ftCurrency;
  146. FieldSize:=SizeOf(Double);
  147. end else if (ColumnStr = 'WORD') then
  148. begin
  149. AType:= ftWord;
  150. FieldSize:=SizeOf(Word);
  151. end else
  152. begin
  153. AType:= ftString;
  154. FieldSize:=0;
  155. end;
  156. FieldDefs.Add(StrPas(sqlite3_column_name(vm,i)), AType, FieldSize, False);
  157. //Set the pchar2sql function
  158. if AType in [ftString,ftMemo] then
  159. FGetSqlStr[i]:=@Char2SqlStr
  160. else
  161. FGetSqlStr[i]:=@Num2SqlStr;
  162. {$ifdef DEBUG}
  163. writeln(' Field[',i,'] Name: ',sqlite3_column_name(vm,i));
  164. writeln(' Field[',i,'] Type: ',sqlite3_column_decltype(vm,i));
  165. {$endif}
  166. end;
  167. sqlite3_finalize(vm);
  168. {$ifdef DEBUG}
  169. writeln(' FieldDefs.Count: ',FieldDefs.Count);
  170. {$endif}
  171. end;
  172. function TSqlite3Dataset.GetRowsAffected: Integer;
  173. begin
  174. Result:=sqlite3_changes(FSqliteHandle);
  175. end;
  176. procedure TSqlite3Dataset.ExecuteDirect(const ASql: String);
  177. var
  178. vm:Pointer;
  179. begin
  180. FReturnCode:=sqlite3_prepare(FSqliteHandle,Pchar(ASql),-1,@vm,nil);
  181. if FReturnCode <> SQLITE_OK then
  182. DatabaseError(ReturnString,Self);
  183. FReturnCode:=sqlite3_step(vm);
  184. sqlite3_finalize(vm);
  185. end;
  186. procedure TSqlite3Dataset.BuildLinkedList;
  187. var
  188. TempItem:PDataRecord;
  189. vm:Pointer;
  190. Counter:Integer;
  191. begin
  192. //Get AutoInc Field initial value
  193. if FAutoIncFieldNo <> -1 then
  194. sqlite3_exec(FSqliteHandle,PChar('Select Max('+Fields[FAutoIncFieldNo].FieldName+') from ' + FTableName),
  195. @GetAutoIncValue,@FNextAutoInc,nil);
  196. FReturnCode:=sqlite3_prepare(FSqliteHandle,Pchar(FSql),-1,@vm,nil);
  197. if FReturnCode <> SQLITE_OK then
  198. DatabaseError(ReturnString,Self);
  199. FDataAllocated:=True;
  200. TempItem:=FBeginItem;
  201. FRecordCount:=0;
  202. FRowCount:=sqlite3_column_count(vm);
  203. FReturnCode:=sqlite3_step(vm);
  204. while FReturnCode = SQLITE_ROW do
  205. begin
  206. Inc(FRecordCount);
  207. New(TempItem^.Next);
  208. TempItem^.Next^.Previous:=TempItem;
  209. TempItem:=TempItem^.Next;
  210. GetMem(TempItem^.Row,FRowBufferSize);
  211. for Counter := 0 to FRowCount - 1 do
  212. TempItem^.Row[Counter]:=StrNew(sqlite3_column_text(vm,Counter));
  213. FReturnCode:=sqlite3_step(vm);
  214. end;
  215. sqlite3_finalize(vm);
  216. // Attach EndItem
  217. TempItem^.Next:=FEndItem;
  218. FEndItem^.Previous:=TempItem;
  219. // Alloc temporary item used in append/insert
  220. GetMem(FCacheItem^.Row,FRowBufferSize);
  221. for Counter := 0 to FRowCount - 1 do
  222. FCacheItem^.Row[Counter]:=nil;
  223. // Fill FBeginItem.Row with nil -> necessary for avoid exceptions in empty datasets
  224. GetMem(FBeginItem^.Row,FRowBufferSize);
  225. //Todo: see if is better to nullif using FillDWord
  226. for Counter := 0 to FRowCount - 1 do
  227. FBeginItem^.Row[Counter]:=nil;
  228. end;
  229. function TSqlite3Dataset.ReturnString: String;
  230. begin
  231. case FReturnCode of
  232. SQLITE_OK : Result := 'SQLITE_OK';
  233. SQLITE_ERROR : Result := 'SQLITE_ERROR';
  234. SQLITE_INTERNAL : Result := 'SQLITE_INTERNAL';
  235. SQLITE_PERM : Result := 'SQLITE_PERM';
  236. SQLITE_ABORT : Result := 'SQLITE_ABORT';
  237. SQLITE_BUSY : Result := 'SQLITE_BUSY';
  238. SQLITE_LOCKED : Result := 'SQLITE_LOCKED';
  239. SQLITE_NOMEM : Result := 'SQLITE_NOMEM';
  240. SQLITE_READONLY : Result := 'SQLITE_READONLY';
  241. SQLITE_INTERRUPT : Result := 'SQLITE_INTERRUPT';
  242. SQLITE_IOERR : Result := 'SQLITE_IOERR';
  243. SQLITE_CORRUPT : Result := 'SQLITE_CORRUPT';
  244. SQLITE_NOTFOUND : Result := 'SQLITE_NOTFOUND';
  245. SQLITE_FULL : Result := 'SQLITE_FULL';
  246. SQLITE_CANTOPEN : Result := 'SQLITE_CANTOPEN';
  247. SQLITE_PROTOCOL : Result := 'SQLITE_PROTOCOL';
  248. SQLITE_EMPTY : Result := 'SQLITE_EMPTY';
  249. SQLITE_SCHEMA : Result := 'SQLITE_SCHEMA';
  250. SQLITE_TOOBIG : Result := 'SQLITE_TOOBIG';
  251. SQLITE_CONSTRAINT : Result := 'SQLITE_CONSTRAINT';
  252. SQLITE_MISMATCH : Result := 'SQLITE_MISMATCH';
  253. SQLITE_MISUSE : Result := 'SQLITE_MISUSE';
  254. SQLITE_NOLFS : Result := 'SQLITE_NOLFS';
  255. SQLITE_AUTH : Result := 'SQLITE_AUTH';
  256. SQLITE_FORMAT : Result := 'SQLITE_FORMAT';
  257. SQLITE_RANGE : Result := 'SQLITE_RANGE';
  258. SQLITE_ROW : Result := 'SQLITE_ROW';
  259. SQLITE_NOTADB : Result := 'SQLITE_NOTADB';
  260. SQLITE_DONE : Result := 'SQLITE_DONE';
  261. else
  262. Result:='Unknow Return Value';
  263. end;
  264. Result:=Result+' - '+sqlite3_errmsg(FSqliteHandle);
  265. end;
  266. function TSqlite3Dataset.GetSqliteVersion: String;
  267. begin
  268. Result:=StrPas(sqlite3_version);
  269. end;
  270. function TSqlite3Dataset.QuickQuery(const ASql:String;const AStrList: TStrings;FillObjects:Boolean):String;
  271. var
  272. vm:Pointer;
  273. procedure FillStrings;
  274. begin
  275. while FReturnCode = SQLITE_ROW do
  276. begin
  277. AStrList.Add(StrPas(sqlite3_column_text(vm,0)));
  278. FReturnCode:=sqlite3_step(vm);
  279. end;
  280. end;
  281. procedure FillStringsAndObjects;
  282. begin
  283. while FReturnCode = SQLITE_ROW do
  284. begin
  285. AStrList.AddObject(StrPas(sqlite3_column_text(vm,0)),TObject(PtrInt(sqlite3_column_int(vm,1))));
  286. FReturnCode:=sqlite3_step(vm);
  287. end;
  288. end;
  289. begin
  290. if FSqliteHandle = nil then
  291. GetSqliteHandle;
  292. Result:='';
  293. FReturnCode:=sqlite3_prepare(FSqliteHandle,Pchar(ASql),-1,@vm,nil);
  294. if FReturnCode <> SQLITE_OK then
  295. DatabaseError(ReturnString,Self);
  296. FReturnCode:=sqlite3_step(vm);
  297. if (FReturnCode = SQLITE_ROW) and (sqlite3_column_count(vm) > 0) then
  298. begin
  299. Result:=StrPas(sqlite3_column_text(vm,0));
  300. if AStrList <> nil then
  301. begin
  302. if FillObjects and (sqlite3_column_count(vm) > 1) then
  303. FillStringsAndObjects
  304. else
  305. FillStrings;
  306. end;
  307. end;
  308. sqlite3_finalize(vm);
  309. end;
  310. end.