/components/sqldb/registersqldb.pas

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