/components/sqldb/registersqldb.pas

http://github.com/graemeg/lazarus · Pascal · 580 lines · 373 code · 72 blank · 135 comment · 10 complexity · 2e90dd54b99a3ba787591b4be312bd4a MD5 · raw file

  1. {
  2. ***************************************************************************
  3. * *
  4. * This source is free software; you can redistribute it and/or modify *
  5. * it under the terms of the GNU General Public License as published by *
  6. * the Free Software Foundation; either version 2 of the License, or *
  7. * (at your option) any later version. *
  8. * *
  9. * This code is distributed in the hope that it will be useful, but *
  10. * WITHOUT ANY WARRANTY; without even the implied warranty of *
  11. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
  12. * General Public License for more details. *
  13. * *
  14. * A copy of the GNU General Public License is available on the World *
  15. * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
  16. * obtain it by writing to the Free Software Foundation, *
  17. * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
  18. * *
  19. ***************************************************************************
  20. Author: Joost van der Sluis
  21. This unit registers the sqldb components of the FCL.
  22. }
  23. unit registersqldb;
  24. {$mode objfpc}{$H+}
  25. {$IFNDEF win64}
  26. {$DEFINE HASMYSQL4CONNECTION}
  27. {$DEFINE HASORACLECONNECTION}
  28. {$DEFINE HASSQLITE3CONNECTION}
  29. {$ENDIF}
  30. {$IF FPC_FULLVERSION>=20602}
  31. {$DEFINE HASSQLITE3CONNECTION} // Include for win64, if fpc > 2.6.2
  32. {$ENDIF}
  33. {$IF FPC_FULLVERSION>= 20601}
  34. {$DEFINE HASPQCONNECTION}
  35. {$ELSE}
  36. {$IFNDEF win64}
  37. {$DEFINE HASPQCONNECTION}
  38. {$ENDIF}
  39. {$ENDIF}
  40. {$IF FPC_FULLVERSION>= 20601}
  41. {$DEFINE HASMYSQL55CONNECTION}
  42. {$IF DEFINED(BEOS) OR DEFINED(HAIKU) OR DEFINED(LINUX) OR DEFINED(FREEBSD) OR DEFINED (NETBSD) OR DEFINED(OPENBSD) OR DEFINED(WIN32) OR DEFINED(WIN64)}
  43. // MS SQL Server and Sybase ASE connectors were introduced in the FPC 2.7 development branch,
  44. // and backported to 2.6.1. Operating systems should match FPC packages\fcl-db\fpmake.pp
  45. {$DEFINE HASMSSQLCONNECTION}
  46. {$DEFINE HASSYBASECONNECTION}
  47. {$ENDIF}
  48. {$ENDIF}
  49. {$IF FPC_FULLVERSION >= 20602}
  50. // These were backported to FPC 2.6.2
  51. {$DEFINE HASFBADMIN}
  52. {$DEFINE HASPQEVENT}
  53. {$DEFINE HASFBEVENT}
  54. {$DEFINE HASLIBLOADER}
  55. {$ENDIF}
  56. {$IF FPC_FULLVERSION>= 20603}
  57. {$DEFINE HASMYSQL56CONNECTION}
  58. {$ENDIF}
  59. { IFNDEF Solaris}
  60. // Reflects missing fcl-db support around FPC 2.6.1.
  61. {$DEFINE HASIBCONNECTION}
  62. { ENDIF}
  63. interface
  64. uses
  65. Classes, SysUtils, db, sqldb,
  66. {$IFDEF HASIBCONNECTION}
  67. ibconnection,
  68. {$ENDIF}
  69. {$IFDEF HASMSSQLCONNECTION}
  70. // mssqlconn provide both MS SQL Server and Sybase ASE connectors.
  71. mssqlconn,
  72. {$ENDIF}
  73. odbcconn,
  74. {$IFDEF HASPQCONNECTION}
  75. pqconnection,
  76. {$IFDEF HASPQEVENT}
  77. pqteventmonitor,
  78. {$ENDIF}
  79. {$ENDIF}
  80. {$IFDEF HASORACLECONNECTION}
  81. oracleconnection,
  82. {$ENDIF}
  83. {$IFDEF HASMYSQL4CONNECTION}
  84. mysql40conn, mysql41conn,
  85. {$ENDIF}
  86. mysql50conn,
  87. mysql51conn,
  88. {$IFDEF HASMYSQL55CONNECTION}
  89. mysql55conn,
  90. {$ENDIF}
  91. {$IFDEF HASMYSQL56CONNECTION}
  92. mysql56conn,
  93. {$ENDIF}
  94. {$IFDEF HASSQLITE3CONNECTION}
  95. sqlite3conn,
  96. {$ENDIF}
  97. {$IFDEF HASFBADMIN}
  98. fbadmin,
  99. {$ENDIF}
  100. {$IFDEF HASFBEVENT}
  101. fbeventmonitor,
  102. {$ENDIF}
  103. propedits,
  104. sqlstringspropertyeditordlg,
  105. controls,
  106. forms,
  107. {$IFDEF HASLIBLOADER}
  108. sqldblib,
  109. {$ENDIF}
  110. sqlscript, fpsqltree, fpsqlparser,
  111. LazarusPackageIntf,
  112. lazideintf,
  113. srceditorintf,
  114. ProjectIntf,
  115. IDEMsgIntf,
  116. IDEExternToolIntf,
  117. CodeCache,
  118. CodeToolManager;
  119. Type
  120. { TSQLStringsPropertyEditor }
  121. TSQLStringsPropertyEditor = class(TStringsPropertyEditor)
  122. private
  123. procedure EditSQL;
  124. public
  125. procedure Edit; override;
  126. function CreateEnhancedDlg(s: TStrings): TSQLStringsPropertyEditorDlg; virtual;
  127. function GetAttributes: TPropertyAttributes; override;
  128. end;
  129. TSQLFirebirdFileNamePropertyEditor=class(TFileNamePropertyEditor)
  130. public
  131. function GetFilter: String; override;
  132. function GetInitialDirectory: string; override;
  133. end;
  134. { TSQLFileDescriptor }
  135. TSQLFileDescriptor = class(TProjectFileDescriptor)
  136. public
  137. constructor Create; override;
  138. function GetLocalizedName: string; override;
  139. function GetLocalizedDescription: string; override;
  140. function GetResourceSource(const {%H-}ResourceName: string): string; override;
  141. function CreateSource(const {%H-}Filename, {%H-}SourceName,
  142. {%H-}ResourceName: string): string; override;
  143. end;
  144. { TSQLDBConnectorTypePropertyEditor }
  145. TSQLDBConnectorTypePropertyEditor = class(TStringPropertyEditor)
  146. public
  147. function GetAttributes: TPropertyAttributes; override;
  148. procedure GetValues(Proc: TGetStrProc); override;
  149. procedure SetValue(const NewValue: ansistring); override;
  150. end;
  151. {$IFDEF HASLIBLOADER}
  152. { TSQLDBLibraryLoaderLibraryNamePropertyEditor }
  153. TSQLDBLibraryLoaderLibraryNamePropertyEditor=class(TFileNamePropertyEditor)
  154. public
  155. function GetFilter: String; override;
  156. end;
  157. {$ENDIF}
  158. TSQLSyntaxChecker = Class(TComponent)
  159. private
  160. FStatementCount,
  161. FSQLErr : Integer;
  162. FSFN: String;
  163. procedure CheckSQLStatement(Sender: TObject; Statement: TStrings; var StopExecution: Boolean);
  164. Public
  165. Procedure ShowMessage(Const Msg : String);
  166. Procedure ShowMessage(Const Fmt : String; Args : Array of const);
  167. Procedure ShowException(Const Msg : String; E : Exception);
  168. function CheckSQL(S : TStream): TModalResult;
  169. function CheckSource(Sender: TObject; var Handled: boolean): TModalResult;
  170. Property SourceFileName : String Read FSFN;
  171. end;
  172. procedure Register;
  173. implementation
  174. {$R registersqldb.res}
  175. uses dynlibs;
  176. procedure RegisterUnitSQLdb;
  177. begin
  178. RegisterComponents('SQLdb',[
  179. TSQLQuery,
  180. TSQLTransaction,
  181. TSQLScript,
  182. TSQLConnector
  183. {$IFDEF HASMSSQLCONNECTION}
  184. ,TMSSQLConnection
  185. {$ENDIF}
  186. {$IFDEF HASSYBASECONNECTION}
  187. ,TSybaseConnection
  188. {$ENDIF}
  189. {$IFDEF HASPQCONNECTION}
  190. ,TPQConnection
  191. {$IFDEF HASPQEVENT}
  192. ,TPQTEventMonitor
  193. {$ENDIF}
  194. {$ENDIF}
  195. {$IFDEF HASORACLECONNECTION}
  196. ,TOracleConnection
  197. {$ENDIF}
  198. ,TODBCConnection
  199. {$IFDEF HASMYSQL4CONNECTION}
  200. ,TMySQL40Connection
  201. ,TMySQL41Connection
  202. {$ENDIF}
  203. ,TMySQL50Connection
  204. ,TMySQL51Connection
  205. {$IFDEF HASMYSQL55CONNECTION}
  206. ,TMySQL55Connection
  207. {$ENDIF}
  208. {$IFDEF HASMYSQL56CONNECTION}
  209. ,TMySQL56Connection
  210. {$ENDIF}
  211. {$IFDEF HASSQLITE3CONNECTION}
  212. ,TSQLite3Connection
  213. {$ENDIF}
  214. {$IFDEF HASIBCONNECTION}
  215. ,TIBConnection
  216. {$ENDIF}
  217. {$IFDEF HASFBADMIN}
  218. ,TFBAdmin
  219. {$ENDIF}
  220. {$IFDEF HASFBEVENT}
  221. ,TFBEventMonitor
  222. {$ENDIF}
  223. {$IFDEF HASLIBLOADER}
  224. ,TSQLDBLibraryLoader
  225. {$ENDIF}
  226. ]);
  227. end;
  228. Resourcestring
  229. SSQLScript = 'SQL Script file';
  230. SSQLScriptDesc = 'Create a new SQL Script file';
  231. SSQLSource = 'Insert your SQL statements here';
  232. SFireBirdDatabases = 'Firebird databases';
  233. SInterbaseDatabases = 'Interbase databases';
  234. SSQLStringsPropertyEditorDlgTitle = 'Editing %s';
  235. sLibraries = 'Shared libraries';
  236. { TSQLDBLibraryLoaderConnectionTypePropertyEditor }
  237. function TSQLDBConnectorTypePropertyEditor.GetAttributes: TPropertyAttributes;
  238. begin
  239. Result := [paMultiSelect, paSortList, paValueList, paRevertable];
  240. end;
  241. procedure TSQLDBConnectorTypePropertyEditor.GetValues(Proc: TGetStrProc);
  242. Var
  243. L : TStringList;
  244. I : Integer;
  245. begin
  246. L:=TStringList.Create;
  247. try
  248. GetConnectionList(L);
  249. for I:=0 to L.Count-1 do
  250. Proc(L[i]);
  251. finally
  252. L.Free;
  253. end;
  254. end;
  255. procedure TSQLDBConnectorTypePropertyEditor.SetValue(const NewValue: ansistring);
  256. var
  257. Comp: TPersistent;
  258. Code: TCodeBuffer;
  259. ConnDef: TConnectionDef;
  260. SrcEdit: TSourceEditorInterface;
  261. begin
  262. if not LazarusIDE.BeginCodeTools then
  263. Exit;
  264. SrcEdit := SourceEditorManagerIntf.ActiveEditor;
  265. if SrcEdit=nil then
  266. Exit;
  267. Code := TCodeBuffer(SrcEdit.CodeToolsBuffer);
  268. if Code = nil then
  269. Exit;
  270. Comp := GetComponent(0);
  271. if Comp is TSQLConnector then
  272. begin
  273. ConnDef := GetConnectionDef(NewValue);
  274. if Assigned(ConnDef) then
  275. CodeToolBoss.AddUnitToMainUsesSection(Code, ConnDef.UnitName, '');
  276. end;
  277. inherited;
  278. end;
  279. {$IFDEF HASLIBLOADER}
  280. { TSQLDBLibraryLoaderLibraryNamePropertyEditor }
  281. function TSQLDBLibraryLoaderLibraryNamePropertyEditor.GetFilter: String;
  282. begin
  283. Result := sLibraries+'|*.'+SharedSuffix;
  284. Result := Result+ '|'+ inherited GetFilter;
  285. end;
  286. {$ENDIF}
  287. { TDbfFileNamePropertyEditor }
  288. function TSQLFirebirdFileNamePropertyEditor.GetFilter: String;
  289. begin
  290. Result := sFireBirdDatabases+' (*.fb;*.fdb)|*.fb;*.fdb';
  291. Result := Result + '|' + sInterbaseDatabases +' (*.gdb)|*.gdb;*.GDB';
  292. Result:= Result+ '|'+ inherited GetFilter;
  293. end;
  294. function TSQLFirebirdFileNamePropertyEditor.GetInitialDirectory: string;
  295. begin
  296. Result:= (GetComponent(0) as TSQLConnection).DatabaseName;
  297. Result:= ExtractFilePath(Result);
  298. end;
  299. { TSQLStringsPropertyEditor }
  300. procedure TSQLStringsPropertyEditor.EditSQL;
  301. var
  302. TheDialog:TSQLStringsPropertyEditorDlg;
  303. Strings :TStrings;
  304. Query :TSQLQuery;
  305. begin
  306. Strings := TStrings(GetObjectValue);
  307. TheDialog := CreateEnhancedDlg(Strings);
  308. try
  309. TheDialog.Caption := Format(SSQLStringsPropertyEditorDlgTitle, [GetPropInfo^.Name]);
  310. if (GetComponent(0) is TSQLQuery) then
  311. begin
  312. Query := (GetComponent(0) as TSQLQuery);
  313. TheDialog.Connection := (Query.DataBase as TSQLConnection);
  314. TheDialog.Transaction := (Query.Transaction as TSQLTransaction);
  315. end
  316. else if (GetComponent(0) is TSQLScript) then
  317. TheDialog.IsSQLScript:=True;
  318. if(TheDialog.ShowModal = mrOK)then
  319. begin
  320. Strings.Text := TheDialog.SQLEditor.Text;
  321. Modified;
  322. end;
  323. finally
  324. FreeAndNil(TheDialog);
  325. end;
  326. end;
  327. procedure TSQLStringsPropertyEditor.Edit;
  328. begin
  329. try
  330. EditSQL;
  331. except
  332. on E:EDatabaseError do
  333. begin
  334. inherited Edit;
  335. end;
  336. end;
  337. end;
  338. //------------------------------------------------------------------------------------//
  339. function TSQLStringsPropertyEditor.CreateEnhancedDlg(s: TStrings): TSQLStringsPropertyEditorDlg;
  340. begin
  341. Result := TSQLStringsPropertyEditorDlg.Create(Application);
  342. Result.SQLEditor.Text := s.Text;
  343. end;
  344. //------------------------------------------------------------------//
  345. function TSQLStringsPropertyEditor.GetAttributes: TPropertyAttributes;
  346. begin
  347. Result := [paMultiSelect, paDialog, paRevertable, paReadOnly];
  348. end;
  349. { TSQLSyntaxChecker }
  350. procedure TSQLSyntaxChecker.CheckSQLStatement(Sender: TObject;
  351. Statement: TStrings; var StopExecution: Boolean);
  352. Var
  353. P : TSQLParser;
  354. S : TMemoryStream;
  355. E : TSQLElement;
  356. begin
  357. Inc(FStatementCount);
  358. S:=TMemoryStream.Create;
  359. try
  360. Statement.SaveToStream(S);
  361. S.Position:=0;
  362. P:=TSQLParser.Create(S);
  363. try
  364. try
  365. E:=P.Parse;
  366. E.Free;
  367. StopExecution:=False;
  368. except
  369. On E : Exception do
  370. begin
  371. ShowException('',E);
  372. inc(FSQLErr);
  373. end;
  374. end;
  375. finally
  376. P.Free;
  377. end;
  378. finally
  379. S.Free;
  380. end;
  381. end;
  382. procedure TSQLSyntaxChecker.ShowMessage(const Msg: String);
  383. begin
  384. IDEMessagesWindow.AddCustomMessage(mluImportant,Msg,SourceFileName);
  385. end;
  386. procedure TSQLSyntaxChecker.ShowMessage(const Fmt: String; Args: array of const);
  387. begin
  388. ShowMessage(Format(Fmt,Args));
  389. end;
  390. procedure TSQLSyntaxChecker.ShowException(const Msg: String; E: Exception);
  391. begin
  392. If (Msg<>'') then
  393. ShowMessage(Msg+' : '+E.Message)
  394. else
  395. ShowMessage(Msg+' : '+E.Message);
  396. end;
  397. function TSQLSyntaxChecker.CheckSQL(S : TStream): TModalResult;
  398. Var
  399. SQL : TEventSQLScript;
  400. begin
  401. SQL:=TEventSQLScript.Create(Self);
  402. try
  403. FStatementCount:=0;
  404. FSQLErr:=0;
  405. SQL.UseSetTerm:=True;
  406. SQL.OnSQLStatement:=@CheckSQLStatement;
  407. SQL.Script.LoadFromStream(S);
  408. SQL.Execute;
  409. If (FSQLErr=0) then
  410. ShowMessage('SQL Syntax OK: %d statements',[FStatementCount])
  411. else
  412. ShowMessage('SQL Syntax: %d errors in %d statements',[FSQLErr,FStatementCount]);
  413. finally
  414. SQL.free;
  415. end;
  416. Result:=mrOK;
  417. end;
  418. function TSQLSyntaxChecker.CheckSource(Sender: TObject; var Handled: boolean
  419. ): TModalResult;
  420. Var
  421. AE : TSourceEditorInterface;
  422. E : String;
  423. S : TStringStream;
  424. begin
  425. try
  426. Handled:=False;
  427. result:=mrNone;
  428. AE:=SourceEditorManagerIntf.ActiveEditor;
  429. If (AE<>Nil) then
  430. begin
  431. E:=ExtractFileExt(AE.FileName);
  432. FSFN:=ExtractFileName(AE.FileName);
  433. Handled:=CompareText(E,'.sql')=0;
  434. If Handled then
  435. begin
  436. S:=TStringStream.Create(AE.SourceText);
  437. try
  438. Result:=CheckSQL(S);
  439. finally
  440. S.Free;
  441. end;
  442. end;
  443. end;
  444. except
  445. On E : Exception do
  446. ShowException('Error during syntax check',E);
  447. end;
  448. end;
  449. Var
  450. AChecker : TSQLSyntaxChecker;
  451. procedure Register;
  452. begin
  453. {$IFDEF HASIBCONNECTION}
  454. RegisterPropertyEditor(TypeInfo(AnsiString),
  455. TIBConnection, 'DatabaseName', TSQLFirebirdFileNamePropertyEditor);
  456. {$ENDIF}
  457. RegisterPropertyEditor(TypeInfo(AnsiString),
  458. TSQLConnector, 'ConnectorType', TSQLDBConnectorTypePropertyEditor);
  459. {$IFDEF HASLIBLOADER}
  460. RegisterPropertyEditor(TypeInfo(AnsiString),
  461. TSQLDBLibraryLoader, 'LibraryName', TSQLDBLibraryLoaderLibraryNamePropertyEditor);
  462. RegisterPropertyEditor(TypeInfo(AnsiString),
  463. TSQLDBLibraryLoader, 'ConnectionType', TSQLDBConnectorTypePropertyEditor);
  464. {$endif}
  465. RegisterPropertyEditor(TStrings.ClassInfo, TSQLQuery, 'SQL' , TSQLStringsPropertyEditor);
  466. RegisterPropertyEditor(TStrings.ClassInfo, TSQLQuery, 'InsertSQL', TSQLStringsPropertyEditor);
  467. RegisterPropertyEditor(TStrings.ClassInfo, TSQLQuery, 'UpdateSQL', TSQLStringsPropertyEditor);
  468. RegisterPropertyEditor(TStrings.ClassInfo, TSQLQuery, 'DeleteSQL', TSQLStringsPropertyEditor);
  469. RegisterPropertyEditor(TStrings.ClassInfo, TSQLQuery, 'RefreshSQL',TSQLStringsPropertyEditor);
  470. RegisterPropertyEditor(TStrings.ClassInfo, TSQLScript, 'Script' , TSQLStringsPropertyEditor);
  471. RegisterProjectFileDescriptor(TSQLFileDescriptor.Create);
  472. RegisterUnit('sqldb',@RegisterUnitSQLdb);
  473. AChecker:=TSQLSyntaxChecker.Create(Nil);
  474. LazarusIDE.AddHandlerOnQuickSyntaxCheck(@AChecker.CheckSource,False);
  475. end;
  476. { TSQLFileDescriptor }
  477. constructor TSQLFileDescriptor.Create;
  478. begin
  479. inherited Create;
  480. Name:='SQL script file';
  481. DefaultFilename:='sqlscript.sql';
  482. DefaultResFileExt:='';
  483. DefaultFileExt:='.sql';
  484. VisibleInNewDialog:=true;
  485. end;
  486. function TSQLFileDescriptor.GetLocalizedName: string;
  487. begin
  488. Result:=SSQLScript;
  489. end;
  490. function TSQLFileDescriptor.GetLocalizedDescription: string;
  491. begin
  492. Result:=SSQLScriptDesc;
  493. end;
  494. function TSQLFileDescriptor.GetResourceSource(const ResourceName: string): string;
  495. begin
  496. Result:='';
  497. end;
  498. function TSQLFileDescriptor.CreateSource(const Filename, SourceName,
  499. ResourceName: string): string;
  500. begin
  501. Result:='/* '+SSQLSource+ '*/';
  502. end;
  503. initialization
  504. finalization
  505. FreeAndNil(AChecker);
  506. end.