diff --git a/examples/database/tsqlscript/mainform.lfm b/examples/database/tsqlscript/mainform.lfm index d4694b7236..f73c79384c 100644 --- a/examples/database/tsqlscript/mainform.lfm +++ b/examples/database/tsqlscript/mainform.lfm @@ -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 diff --git a/examples/database/tsqlscript/mainform.pas b/examples/database/tsqlscript/mainform.pas index 23314fb9c6..92ee51c3b1 100644 --- a/examples/database/tsqlscript/mainform.pas +++ b/examples/database/tsqlscript/mainform.pas @@ -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. diff --git a/examples/database/tsqlscript/readme.txt b/examples/database/tsqlscript/readme.txt index c3b501229a..96756a3acf 100644 --- a/examples/database/tsqlscript/readme.txt +++ b/examples/database/tsqlscript/readme.txt @@ -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) \ No newline at end of file diff --git a/examples/database/tsqlscript/tsqlscriptsample.lpi b/examples/database/tsqlscript/tsqlscriptsample.lpi index 709a8b8079..0c7fa0f01b 100644 --- a/examples/database/tsqlscript/tsqlscriptsample.lpi +++ b/examples/database/tsqlscript/tsqlscriptsample.lpi @@ -1,4 +1,4 @@ - + @@ -32,12 +32,6 @@ - - - - - - @@ -60,7 +54,7 @@ - + @@ -68,12 +62,11 @@ - - + @@ -81,7 +74,7 @@ - + @@ -101,12 +94,6 @@ - - - - - -