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 -

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

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
+    //SET TERM is Firebird specific, used when creating stored procedures etc.
-    OurScript.CommentsInSQL:=true; //Send commits to db server as well; could be useful to troubleshoot by monitoring all SQL statements at the server
+    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.
 

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)

examples/database/tsqlscript/tsqlscriptsample.lpi

@@ -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">