DBAdmin/dlg/ExecuteSQLScriptDlgUnit.pas

(*
 * ExecuteSQLScriptDlgUnit.pas
 * Copyright (C) 2018 Tony Whyman <tony@mwasoftware.co.uk>
 *
 * DBAdmin is free software: you can redistribute it and/or modify it
 * under the terms of the GNU General Public License as published by the
 * Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * DBAdmin is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 * See the GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License along
 * with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)
unit ExecuteSQLScriptDlgUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
  StdCtrls, Buttons, ExtDlgs, ibxscript, IBDatabase, IB, DB;

type

  { TExecuteSQLScriptDlg }

  TExecuteSQLScriptDlg = class(TForm)
    IBTransaction1: TIBTransaction;
    OpenPictureDialog1: TOpenPictureDialog;
    ShowAffectedRows: TCheckBox;
    OpenDialog1: TOpenDialog;
    SourceFileName: TEdit;
    Button1: TButton;
    Button2: TButton;
    AutoDDL: TCheckBox;
    IgnoreGrants: TCheckBox;
    ShowPerformanceStats: TCheckBox;
    StopOnFirstError: TCheckBox;
    DBName: TEdit;
    IBXScript1: TIBXScript;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    PageControl1: TPageControl;
    Report: TMemo;
    ReportTab: TTabSheet;
    SelectTab: TTabSheet;
    ServerName: TEdit;
    SpeedButton1: TSpeedButton;
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure IBXScript1ErrorLog(Sender: TObject; Msg: string);
    procedure IBXScript1GetParamValue(Sender: TObject; ParamName: string;
      var aBlobID: TISC_QUAD);
    procedure IBXScript1SelectSQL(Sender: TObject; SQLText: string);
    procedure SpeedButton1Click(Sender: TObject);
  private
    procedure DoExecScript(Data: PtrInt);
  public

  end;

var
  ExecuteSQLScriptDlg: TExecuteSQLScriptDlg;

implementation

uses SelectSQLResultsUnit, DataModule, IBBlob;

{$R *.lfm}

{ TExecuteSQLScriptDlg }

procedure TExecuteSQLScriptDlg.IBXScript1SelectSQL(Sender: TObject;
  SQLText: string);
begin
  with TSelectSQLResults.Create(Application) do
    Show(IBXScript1,SQLText,IBXScript1.ShowPerformanceStats);
end;

procedure TExecuteSQLScriptDlg.SpeedButton1Click(Sender: TObject);
begin
  OpenDialog1.FileName := SourceFileName.Text;
  if OpenDialog1.Execute then
    SourceFileName.Text := OpenDialog1.FileName;
end;

procedure TExecuteSQLScriptDlg.DoExecScript(Data: PtrInt);
begin
  IBXScript1.AutoDDL := AutoDDl.Checked;
  IBXScript1.StopOnFirstError := StopOnFirstError.Checked;
  IBXScript1.ShowPerformanceStats := ShowPerformanceStats.Checked;
  IBXScript1.ShowAffectedRows := ShowAffectedRows.Checked;
  IBXScript1.IgnoreGrants := IgnoreGrants.Checked;
  IBXScript1.RunScript(SourceFileName.Text);
end;

procedure TExecuteSQLScriptDlg.FormShow(Sender: TObject);
begin
  PageControl1.ActivePage := SelectTab;
  ServerName.Text := DBDataModule.ServerName;
  DBName.Text := DBDataModule.DatabaseName;
  SourceFileName.Text := '';
  Report.Lines.Clear;
end;

procedure TExecuteSQLScriptDlg.IBXScript1ErrorLog(Sender: TObject; Msg: string);
begin
  Report.Lines.Add(Msg);
  Report.VertScrollBar.Position:=10000;
  Application.ProcessMessages;
end;

procedure TExecuteSQLScriptDlg.IBXScript1GetParamValue(Sender: TObject;
  ParamName: string; var aBlobID: TISC_QUAD);
begin
  OpenPictureDialog1.Title := 'Select Source File for ' + ParamName;
  if OpenPictureDialog1.Execute then
    with TIBBlobStream.Create do
    try
      Database := IBXScript1.Database;
      Transaction := IBTransaction1;
      Mode := bmWrite;
      LoadFromFile(OpenPictureDialog1.FileName);
      Finalize;
      aBlobID := BlobID;
    finally
      Free
    end;
end;

procedure TExecuteSQLScriptDlg.FormClose(Sender: TObject;
  var CloseAction: TCloseAction);
begin
  if ModalResult <> mrOK then Exit;

  if PageControl1.ActivePage = SelectTab then
  begin
    CloseAction := caNone;
    if SourceFileName.Text = '' then
      raise Exception.Create('A Source File Name must be given');
    PageControl1.ActivePage := ReportTab;
    Application.ProcessMessages;
    Application.QueueAsyncCall(@DoExecScript,0)
  end;
end;

end.

Revision:	272
Committed:	Mon Feb 4 13:34:37 2019 UTC (5 years, 2 months ago) by tony
Content type:	text/x-pascal
File size:	4447 byte(s)
Log Message:	Fixes merged
#	User	Rev	Content
1	tony	234	(*
2			* ExecuteSQLScriptDlgUnit.pas
3			* Copyright (C) 2018 Tony Whyman <tony@mwasoftware.co.uk>
4			*
5			* DBAdmin is free software: you can redistribute it and/or modify it
6			* under the terms of the GNU General Public License as published by the
7			* Free Software Foundation, either version 3 of the License, or
8			* (at your option) any later version.
9			*
10			* DBAdmin is distributed in the hope that it will be useful, but
11			* WITHOUT ANY WARRANTY; without even the implied warranty of
12			* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13			* See the GNU General Public License for more details.
14			*
15			* You should have received a copy of the GNU General Public License along
16			* with this program. If not, see <http://www.gnu.org/licenses/>.
17			*)
18			unit ExecuteSQLScriptDlgUnit;
19
20			{$mode objfpc}{$H+}
21
22			interface
23
24			uses
25			Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
26			StdCtrls, Buttons, ExtDlgs, ibxscript, IBDatabase, IB, DB;
27
28			type
29
30			{ TExecuteSQLScriptDlg }
31
32			TExecuteSQLScriptDlg = class(TForm)
33			IBTransaction1: TIBTransaction;
34			OpenPictureDialog1: TOpenPictureDialog;
35			ShowAffectedRows: TCheckBox;
36			OpenDialog1: TOpenDialog;
37			SourceFileName: TEdit;
38			Button1: TButton;
39			Button2: TButton;
40			AutoDDL: TCheckBox;
41			IgnoreGrants: TCheckBox;
42			ShowPerformanceStats: TCheckBox;
43			StopOnFirstError: TCheckBox;
44			DBName: TEdit;
45			IBXScript1: TIBXScript;
46			Label1: TLabel;
47			Label2: TLabel;
48			Label3: TLabel;
49			PageControl1: TPageControl;
50			Report: TMemo;
51			ReportTab: TTabSheet;
52			SelectTab: TTabSheet;
53			ServerName: TEdit;
54			SpeedButton1: TSpeedButton;
55			procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
56			procedure FormShow(Sender: TObject);
57			procedure IBXScript1ErrorLog(Sender: TObject; Msg: string);
58			procedure IBXScript1GetParamValue(Sender: TObject; ParamName: string;
59			var aBlobID: TISC_QUAD);
60			procedure IBXScript1SelectSQL(Sender: TObject; SQLText: string);
61			procedure SpeedButton1Click(Sender: TObject);
62			private
63			procedure DoExecScript(Data: PtrInt);
64			public
65
66			end;
67
68			var
69			ExecuteSQLScriptDlg: TExecuteSQLScriptDlg;
70
71			implementation
72
73			uses SelectSQLResultsUnit, DataModule, IBBlob;
74
75			{$R *.lfm}
76
77			{ TExecuteSQLScriptDlg }
78
79			procedure TExecuteSQLScriptDlg.IBXScript1SelectSQL(Sender: TObject;
80			SQLText: string);
81			begin
82			with TSelectSQLResults.Create(Application) do
83			Show(IBXScript1,SQLText,IBXScript1.ShowPerformanceStats);
84			end;
85
86			procedure TExecuteSQLScriptDlg.SpeedButton1Click(Sender: TObject);
87			begin
88			OpenDialog1.FileName := SourceFileName.Text;
89			if OpenDialog1.Execute then
90			SourceFileName.Text := OpenDialog1.FileName;
91			end;
92
93			procedure TExecuteSQLScriptDlg.DoExecScript(Data: PtrInt);
94			begin
95			IBXScript1.AutoDDL := AutoDDl.Checked;
96			IBXScript1.StopOnFirstError := StopOnFirstError.Checked;
97			IBXScript1.ShowPerformanceStats := ShowPerformanceStats.Checked;
98			IBXScript1.ShowAffectedRows := ShowAffectedRows.Checked;
99			IBXScript1.IgnoreGrants := IgnoreGrants.Checked;
100			IBXScript1.RunScript(SourceFileName.Text);
101			end;
102
103			procedure TExecuteSQLScriptDlg.FormShow(Sender: TObject);
104			begin
105			PageControl1.ActivePage := SelectTab;
106	tony	272	ServerName.Text := DBDataModule.ServerName;
107			DBName.Text := DBDataModule.DatabaseName;
108	tony	234	SourceFileName.Text := '';
109			Report.Lines.Clear;
110			end;
111
112			procedure TExecuteSQLScriptDlg.IBXScript1ErrorLog(Sender: TObject; Msg: string);
113			begin
114			Report.Lines.Add(Msg);
115			Report.VertScrollBar.Position:=10000;
116			Application.ProcessMessages;
117			end;
118
119			procedure TExecuteSQLScriptDlg.IBXScript1GetParamValue(Sender: TObject;
120			ParamName: string; var aBlobID: TISC_QUAD);
121			begin
122			OpenPictureDialog1.Title := 'Select Source File for ' + ParamName;
123			if OpenPictureDialog1.Execute then
124			with TIBBlobStream.Create do
125			try
126			Database := IBXScript1.Database;
127			Transaction := IBTransaction1;
128			Mode := bmWrite;
129			LoadFromFile(OpenPictureDialog1.FileName);
130			Finalize;
131			aBlobID := BlobID;
132			finally
133			Free
134			end;
135			end;
136
137			procedure TExecuteSQLScriptDlg.FormClose(Sender: TObject;
138			var CloseAction: TCloseAction);
139			begin
140			if ModalResult <> mrOK then Exit;
141
142			if PageControl1.ActivePage = SelectTab then
143			begin
144			CloseAction := caNone;
145			if SourceFileName.Text = '' then
146			raise Exception.Create('A Source File Name must be given');
147			PageControl1.ActivePage := ReportTab;
148			Application.ProcessMessages;
149			Application.QueueAsyncCall(@DoExecScript,0)
150			end;
151			end;
152
153			end.
154