lazarus/components/sqldb/sqlstringspropertyeditordlg.pas

unit SQLStringsPropertyEditorDlg;

{$IFDEF VER2_5_1}
{$DEFINE HASSQLPARSER}
{$ENDIF}

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  SynEdit, ButtonPanel, SynHighlighterSQL, ComCtrls, SQLDb, db, DBGrids, Menus,
  SrcEditorIntf,clipbrd;

type

  { TSQLStringsPropertyEditorDlg }

  TSQLStringsPropertyEditorDlg = class(TForm)
    ButtonsPanel: TButtonPanel;
    ImageList: TImageList;
    MICheck: TMenuItem;
    MICreateConstant: TMenuItem;
    MICleanup: TMenuItem;
    PMSQL: TPopupMenu;
    ResultDBGrid: TDBGrid;
    SQLDataSource: TDatasource;
    OpenDialog: TOpenDialog;
    PageControl: TPageControl;
    SaveDialog: TSaveDialog;
    SQLEditor: TSynEdit;
    SQLHighlighter: TSynSQLSyn;
    EditorTabSheet: TTabSheet;
    ResultTabSheet: TTabSheet;
    SQLQuery: TSQLQuery;
    ToolBar: TToolBar;
    OpenToolButton: TToolButton;
    SaveToolButton: TToolButton;
    DividerToolButton: TToolButton;
    ExecuteToolButton: TToolButton;
    TBCheck: TToolButton;
    procedure ExecuteToolButtonClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure MICleanupClick(Sender: TObject);
    procedure MICreateConstantClick(Sender: TObject);
    procedure OpenToolButtonClick(Sender: TObject);
    procedure SaveToolButtonClick(Sender: TObject);
    procedure TBCheckClick(Sender: TObject);
  private
    { private declarations }
    FConnection:TSQLConnection;
    FISSQLScript: Boolean;
    FTransaction:TSQLTransaction;

    function CheckConnection:boolean;
    procedure CheckSQLSyntax(SQL: TStrings);
    procedure CleanupDelphiCode;
    procedure CreateConstant;
  public
    { public declarations }
    constructor Create(AOwner:TComponent);override;
  published
    property Connection: TSQLConnection   read FConnection  write FConnection;
    property Transaction:TSQLTransaction read FTransaction write FTransaction;
    Property IsSQLScript : Boolean Read FISSQLScript Write FIsSQLScript;
  end; 

implementation

uses
{$IFDEF HASSQLPARSER}
  fpsqltree,fpsqlparser,
{$ENDIF}
  strutils;

{$R *.lfm}

resourcestring
  SSQLTabCaption    = 'SQL Code';
  SResultTabCaption = 'Results';
  SSQLOK            = 'SQL OK';
  SQLSyntaxOK       = 'No syntax errors in SQL statement.';
  SSQLError         = 'SQL Error';
  SSQLSyntaxError   = 'Syntax error in SQL statement:'+slineBreak+'%s';

{ TSQLStringsPropertyEditorDlg }

//----------------------------------------------------------------//
constructor TSQLStringsPropertyEditorDlg.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SourceEditorManagerIntf.GetEditorControlSettings(SQLEditor);
  SourceEditorManagerIntf.GetHighlighterSettings(SQLHighlighter);
  EditorTabSheet.Caption := SSQLTabCaption;
  ResultTabSheet.Caption := SResultTabCaption;
end;

//----------------------------------------------------------//
function TSQLStringsPropertyEditorDlg.CheckConnection:boolean;
begin
  Result := (Assigned(FConnection)) and (Assigned(FTransaction))
             and(FConnection.Connected);
end;

//------------------------------------------------------------------------//
procedure TSQLStringsPropertyEditorDlg.OpenToolButtonClick(Sender: TObject);
begin
  if(OpenDialog.Execute)then
    SQLEditor.Lines.LoadFromFile(UTF8ToSys(OpenDialog.FileName));
end;

//---------------------------------------------------------------------------//
procedure TSQLStringsPropertyEditorDlg.ExecuteToolButtonClick(Sender: TObject);
begin
  try
    SQLQuery.Close;
    SQLQuery.SQL.Text := SQLEditor.Text;
    SQLQuery.Open;
    PageControl.ActivePage := ResultTabSheet;
  except
    on e:Exception do
      MessageDlg(e.Message, mtError, [mbOK], 0);
  end;
end;

//-------------------------------------------------------------//
procedure TSQLStringsPropertyEditorDlg.FormShow(Sender: TObject);

Var
  D : TSQLDialect;

begin
  {$IFDEF HASSQLPARSER}
  TBCheck.Visible:=True;
  MICheck.Visible:=True;
  {$ELSE}
  TBCheck.Visible:=False;
  MICheck.Visible:=True;
  {$ENDIF}
  D:=sqlStandard;
  If Assigned(FConnection) then
    begin
    if (copy(LowerCase(FConnection.ClassName),1,3)='tib') then
      D:=sqlinterbase6
    else if (copy(LowerCase(FConnection.ClassName),1,7)='toracle') then
      D:=sqloracle
    else if (Copy(LowerCase(FConnection.ClassName),1,6)='tmysql') then
      D:=sqlmysql;
    end;
  if (CheckConnection) then
    begin
    SQLQuery.DataBase    := FConnection;
    SQLQuery.Transaction := FTransaction;
    ResultTabSheet.TabVisible    := True;
    ExecuteToolButton.Visible := True;
    FConnection.GetTableNames(SQLHighLighter.TableNames);
    end
  else
    begin
    ResultTabSheet.TabVisible    := False;
    ExecuteToolButton.Visible := False;
    end;
  SQLHighlighter.SQLDIalect:=D;
  SQLHighlighter.Enabled:=True;
{$ifdef unix}
  {$ifndef darwin}
  SQLEditor.Font.Name:='-adobe-courier-medium-r-normal-*-8-*-*-*-m-*-iso10646-1';
  {$endif}
{$endif}
  SQLEditor.SetFocus;
end;

procedure TSQLStringsPropertyEditorDlg.MICleanupClick(Sender: TObject);

begin
  CleanupDelphiCode;
end;

procedure TSQLStringsPropertyEditorDlg.CleanupDelphiCode;

Var
  L : TStringList;
  I,J,K : Integer;
  S : String;
begin
  L:=TStringList.Create;
  try
    L.Assign(SQLEditor.Lines);
    For I:=0 to L.Count-1 do
      begin
      S:=L[i];
      K:=0;
      For J:=1 to Length(S) do
        If S[j]='''' then
          Inc(K);
      if (K<>0) and ((K mod 2)=0) then
        begin
        J:=Pos('''',S);
        Delete(S,1,J);
        J:=RPos('''',S);
        S:=Copy(S,1,J-1);
        L[i]:=S;
        end;
      end;
    SQLEditor.Lines:=L;
  finally
    L.Free;
  end;
end;

procedure TSQLStringsPropertyEditorDlg.MICreateConstantClick(Sender: TObject);
begin
  CreateConstant;
end;

procedure TSQLStringsPropertyEditorDlg.CreateConstant;

Var
  C,S : String;
  I : Integer;

begin
  For I:=0 to SQLEditor.Lines.Count-1 do
    begin
    S:=SQLEditor.Lines[i];
    If (C<>'') then
      C:=C+'+sLineBreak+'+sLineBreak;
    C:=C+''''+StringReplace(S,'''','''''',[rfReplaceAll])+'''';
    end;
  C:='SQL = '+C+';';
  Clipboard.AsText:=C;
end;

//------------------------------------------------------------------------//
procedure TSQLStringsPropertyEditorDlg.SaveToolButtonClick(Sender: TObject);
begin
  if(SaveDialog.Execute)then
    SQLEditor.Lines.SaveToFile(UTF8ToSys(SaveDialog.FileName));
end;

procedure TSQLStringsPropertyEditorDlg.TBCheckClick(Sender: TObject);
begin
  CheckSQLSyntax(SQLEditor.Lines)
end;

procedure TSQLStringsPropertyEditorDlg.CheckSQLSyntax(SQL : TStrings);
{$IFDEF HASSQLPARSER}
Var
  S : TStream;
  P : TSQLParser;
  E : TSQLElement;
  EL : TSQLElementList;
  Msg : String;
{$ENDIF}
begin
  {$IFDEF HASSQLPARSER}
  S:=TMemoryStream.Create;
  try
    SQL.SaveToStream(S);
    S.Position:=0;
    P:=TSQLParser.Create(S);
    try
      try
        E:=Nil;
        EL:=Nil;
        If IsSQLScript then
          EL:=P.ParseScript
        else
          E:=P.Parse;
        E.Free;
        EL.Free;
        MessageDLG(SSQLOK,SQLSyntaxOK,mtInformation,[mbOK],0);
      except
        On E : Exception do
          begin
          Msg:=Format(SSQLSyntaxError,[E.Message]);
          MessageDLG(SSQLError,Msg,mtError,[mbOK],0);
          end;
      end;
    finally
      P.Free;
    end;
  finally
    S.Free;
  end;
  {$ENDIF}
end;
end.