mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-01 02:32:40 +02:00
Examples; TSQLScript:
- add support for LazReport tutorial (with PHOTO blob field) - allow loading your own script - better error reporting - support SET TERM if using Firebird - various small fixes patch from Reinier Olislagers, issue #26355 git-svn-id: trunk@45575 -
This commit is contained in:
mattias
parent
7a606f8061
commit
a828ed780c
@ -8,30 +8,30 @@ object Form1: TForm1
|
||||
ClientWidth = 515
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
LCLVersion = '1.0.12.0'
|
||||
LCLVersion = '1.3'
|
||||
object ScriptMemo: TMemo
|
||||
Left = 8
|
||||
Height = 272
|
||||
Top = 48
|
||||
Width = 496
|
||||
ScrollBars = ssAutoBoth
|
||||
TabOrder = 0
|
||||
TabOrder = 3
|
||||
end
|
||||
object CmdCopyDDL: TButton
|
||||
Left = 40
|
||||
Left = 168
|
||||
Height = 25
|
||||
Top = 16
|
||||
Width = 147
|
||||
Caption = 'Copy table creation script'
|
||||
Caption = 'Copy &table creation script'
|
||||
OnClick = CmdCopyDDLClick
|
||||
TabOrder = 1
|
||||
end
|
||||
object CmdCopyDML: TButton
|
||||
Left = 232
|
||||
Left = 357
|
||||
Height = 25
|
||||
Top = 16
|
||||
Width = 147
|
||||
Caption = 'Copy sample data script'
|
||||
Caption = 'Copy &sample data script'
|
||||
OnClick = CmdCopyDMLClick
|
||||
TabOrder = 2
|
||||
end
|
||||
@ -40,8 +40,24 @@ object Form1: TForm1
|
||||
Height = 25
|
||||
Top = 336
|
||||
Width = 75
|
||||
Caption = 'Run script'
|
||||
Caption = '&Run script'
|
||||
OnClick = CmdRunScriptClick
|
||||
TabOrder = 3
|
||||
TabOrder = 4
|
||||
end
|
||||
object CmdOpenSQL: TButton
|
||||
Left = 8
|
||||
Height = 25
|
||||
Hint = 'Loads a file containing SQL script/SQL commands'
|
||||
Top = 16
|
||||
Width = 147
|
||||
Caption = '&Open SQL file...'
|
||||
OnClick = CmdOpenSQLClick
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 0
|
||||
end
|
||||
object OpenDialog1: TOpenDialog
|
||||
left = 16
|
||||
top = 336
|
||||
end
|
||||
end
|
||||
|
||||
@ -20,11 +20,14 @@ type
|
||||
|
||||
TForm1 = class(TForm)
|
||||
CmdCopyDDL: TButton;
|
||||
CmdOpenSQL: TButton;
|
||||
CmdCopyDML: TButton;
|
||||
CmdRunScript: TButton;
|
||||
OpenDialog1: TOpenDialog;
|
||||
ScriptMemo: TMemo;
|
||||
procedure CmdCopyDDLClick(Sender: TObject);
|
||||
procedure CmdCopyDMLClick(Sender: TObject);
|
||||
procedure CmdOpenSQLClick(Sender: TObject);
|
||||
procedure CmdRunScriptClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
@ -33,7 +36,10 @@ type
|
||||
FConn: TSQLConnector;
|
||||
FQuery: TSQLQuery;
|
||||
FTran: TSQLTransaction;
|
||||
// Run database connection test when asked
|
||||
function ConnectionTest(ChosenConfig: TDBConnectionConfig): boolean;
|
||||
// Display script error to the user
|
||||
procedure ShowScriptException(Sender: TObject; Statement: TStrings; TheException: Exception; var Continue: boolean);
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
@ -79,7 +85,7 @@ begin
|
||||
case LoginForm.ShowModal of
|
||||
mrOK:
|
||||
begin
|
||||
//user wants to connect, so copy over db info
|
||||
// User wants to connect, so copy over db info
|
||||
FConn.ConnectorType:=LoginForm.Config.DBType;
|
||||
FConn.HostName:=LoginForm.Config.DBHost;
|
||||
FConn.DatabaseName:=LoginForm.Config.DBPath;
|
||||
@ -90,7 +96,7 @@ begin
|
||||
mrCancel:
|
||||
begin
|
||||
ShowMessage('You canceled the database login. Application will terminate.');
|
||||
Close;
|
||||
Application.Terminate;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
@ -102,6 +108,7 @@ end;
|
||||
|
||||
procedure TForm1.CmdCopyDDLClick(Sender: TObject);
|
||||
// Script that sets up tables as used in SQLdb_Tutorial1..3
|
||||
// Also includes a photo blob used in the LazReport tutorial
|
||||
// Notice we include 2 SQL statements, each terminated with ;
|
||||
const ScriptText=
|
||||
'CREATE TABLE CUSTOMER '+LineEnding+
|
||||
@ -122,6 +129,7 @@ const ScriptText=
|
||||
' JOB_GRADE INTEGER NOT NULL, '+LineEnding+
|
||||
' JOB_COUNTRY VARCHAR(15) NOT NULL, '+LineEnding+
|
||||
' SALARY NUMERIC(10,2) NOT NULL, '+LineEnding+
|
||||
' PHOTO BLOB SUB_TYPE BINARY, '+LineEnding+
|
||||
' CONSTRAINT CT_EMPLOYEE_PK PRIMARY KEY (EMP_NO) '+LineEnding+
|
||||
');';
|
||||
begin
|
||||
@ -161,6 +169,15 @@ begin
|
||||
Scriptmemo.Lines.Text:=ScriptText;
|
||||
end;
|
||||
|
||||
procedure TForm1.CmdOpenSQLClick(Sender: TObject);
|
||||
begin
|
||||
if OpenDialog1.Execute then
|
||||
begin
|
||||
ScriptMemo.Clear;
|
||||
ScriptMemo.Lines.LoadFromFile(OpenDialog1.FileName);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.CmdRunScriptClick(Sender: TObject);
|
||||
// The heart of the program: runs the script in the memo
|
||||
var
|
||||
@ -173,8 +190,13 @@ begin
|
||||
OurScript.Script.Assign(ScriptMemo.Lines); //Copy over the script itself
|
||||
//Now set some options:
|
||||
OurScript.UseCommit:=true; //try process any COMMITs inside the script, instead of batching everything together. See readme.txt though
|
||||
OurScript.UseSetTerm:=false; //SET TERM is Firebird specific, used when creating stored procedures etc. It's not needed here
|
||||
OurScript.CommentsInSQL:=true; //Send commits to db server as well; could be useful to troubleshoot by monitoring all SQL statements at the server
|
||||
//SET TERM is Firebird specific, used when creating stored procedures etc.
|
||||
if FConn.ConnectorType='Firebird' then
|
||||
OurScript.UseSetTerm:=true
|
||||
else
|
||||
OurScript.UseSetTerm:=false;
|
||||
OurScript.CommentsInSQL:=false; //Send commits to db server as well; could be useful to troubleshoot by monitoring all SQL statements at the server
|
||||
OurScript.OnException:=@ShowScriptException; //when errors occur, let this procedure handle the error display
|
||||
try
|
||||
if not(FTran.Active) then
|
||||
FTran.StartTransaction; //better safe than sorry
|
||||
@ -184,7 +206,8 @@ begin
|
||||
except
|
||||
on E: EDataBaseError do
|
||||
begin
|
||||
ShowMessage('Error running script: '+E.Message);
|
||||
// Error was already displayed via ShowScriptException, so no need for this:
|
||||
//ShowMessage('Error running script: '+E.Message);
|
||||
FTran.Rollback;
|
||||
end;
|
||||
end;
|
||||
@ -233,5 +256,15 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.ShowScriptException(Sender: TObject; Statement: TStrings;
|
||||
TheException: Exception; var Continue: boolean);
|
||||
begin
|
||||
// Shows script execution error to user
|
||||
// todo: should really be a separate form with a memo big enough to display a large statement
|
||||
ShowMessage('Script error: '+TheException.Message+LineEnding+
|
||||
Statement.Text);
|
||||
Continue:=false; //indicate script should stop
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -3,11 +3,11 @@ TSQLScript
|
||||
|
||||
This directory shows how to use TSQLScript to run a batch of SQL statements.
|
||||
|
||||
TSQLScript ican be used to run multiple SQL statements - terminated by ; - after each other.
|
||||
TSQLScript can be used to run multiple SQL statements - terminated by ; - after each other.
|
||||
It is provided by FPC's SQLDB database layer and available in Lazarus.
|
||||
|
||||
Notes:
|
||||
- You must/should have created an empty database on your server/embedded database system first. The scripts will try to create tables and insert sample data.
|
||||
- You must/should have created an empty database on your server/embedded database system first. The scripts will try to create tables and insert sample data. You can also load your own SQL script or paste it in the memo.
|
||||
- FPC 2.6.x versions currently have a bug that prevents running statements with : in them (e.g. Firebird stored procedure creation). FPC trunk/development version revision 26112 has fixed this, and it may be backported to 2.6.x; please check release notes and documentation.
|
||||
- Firebird DDL (e.g. table creation) and DML (e.g. inserting data) must be separated by a COMMIT. This may also apply to other databases. FPC bug 17829 tracks this, but FPC 2.6.x or trunk currently contains no fix.
|
||||
A workaround is to split the script into 2, see the sample program.
|
||||
@ -18,6 +18,7 @@ http://wiki.lazarus.freepascal.org/SQLdb_Tutorial0
|
||||
http://wiki.lazarus.freepascal.org/SQLdb_Tutorial1
|
||||
http://wiki.lazarus.freepascal.org/SQLdb_Tutorial2
|
||||
http://wiki.lazarus.freepascal.org/SQLdb_Tutorial3
|
||||
http://wiki.lazarus.freepascal.org/LazReport_Tutorial
|
||||
|
||||
Please see the SQLdb_Tutorial0 article for instructions and requirements.
|
||||
(You'll need database clients and a sample database; see the article)
|
||||
@ -1,4 +1,4 @@
|
||||
<?xml version="1.0"?>
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
@ -32,12 +32,6 @@
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<UseMsgFile Value="True"/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</Item2>
|
||||
</BuildModes>
|
||||
@ -60,7 +54,7 @@
|
||||
<Unit0>
|
||||
<Filename Value="tsqlscriptsample.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="tsqlscriptsample"/>
|
||||
<UnitName Value=""/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="mainform.pas"/>
|
||||
@ -68,12 +62,11 @@
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="mainform"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="dbconfig.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="dbconfig"/>
|
||||
<UnitName Value=""/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="dbconfiggui.pas"/>
|
||||
@ -81,7 +74,7 @@
|
||||
<ComponentName Value="DBConfigForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="dbconfiggui"/>
|
||||
<UnitName Value=""/>
|
||||
</Unit3>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
@ -101,12 +94,6 @@
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<UseMsgFile Value="True"/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
|
||||
Loading…
Reference in New Issue
Block a user