Examples: added TSQLScript database sample program by Reinier Olislagers, bug #25350

git-svn-id: trunk@43472 -

.gitattributes

@@ -4394,6 +4394,16 @@ examples/database/sqldbtutorial3/readme.txt svneol=native#text/plain
 examples/database/sqldbtutorial3/sqldbtutorial3.ini svneol=native#text/plain
 examples/database/sqldbtutorial3/sqldbtutorial3.lpi svneol=native#text/plain
 examples/database/sqldbtutorial3/sqldbtutorial3.lpr svneol=native#text/pascal
+examples/database/tsqlscript/dbconfig.pas svneol=native#text/pascal
+examples/database/tsqlscript/dbconfiggui.lfm svneol=native#text/plain
+examples/database/tsqlscript/dbconfiggui.pas svneol=native#text/pascal
+examples/database/tsqlscript/mainform.lfm svneol=native#text/plain
+examples/database/tsqlscript/mainform.pas svneol=native#text/pascal
+examples/database/tsqlscript/readme.txt svneol=native#text/plain
+examples/database/tsqlscript/sqldbtutorial0.ini svneol=native#text/plain
+examples/database/tsqlscript/tsqlscriptsample.lpi svneol=native#text/plain
+examples/database/tsqlscript/tsqlscriptsample.lpr svneol=native#text/pascal
+examples/database/tsqlscript/tsqlscriptsample.res -text
 examples/dbeditmask/Unit1.lfm svneol=native#text/plain
 examples/dbeditmask/Unit1.pas svneol=native#text/plain
 examples/dbeditmask/project1.lpi svneol=native#text/plain

examples/database/tsqlscript/dbconfig.pas

@@ -0,0 +1,190 @@
+unit dbconfig;
+
+{ Small unit that retrieves connection settings for your database
+
+  Copyright (c) 2012 Reinier Olislagers
+
+  Permission is hereby granted, free of charge, to any person obtaining a copy
+  of this software and associated documentation files (the "Software"), to
+  deal in the Software without restriction, including without limitation the
+  rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+  sell copies of the Software, and to permit persons to whom the Software is
+  furnished to do so, subject to the following conditions:
+
+  The above copyright notice and this permission notice shall be included in
+  all copies or substantial portions of the Software.
+
+  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+  IN THE SOFTWARE.
+}
+
+//todo: add command line support (--dbtype=, --db=, --dbhost=, dbuser=, dbpass=, dbcharset=
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, IniFiles;
+
+type
+  { TDBConnectionConfig }
+  TDBConnectionConfig = class(TObject)
+  private
+    FDBCharset: string;
+    FDBType: string;
+    FDBHost: string;
+    FDBPath: string;
+    FDBUser: string;
+    FDBPassword: string;
+    FSettingsFileIsRead: boolean; //indicates if we read in settings file
+    FSettingsFile: string;
+    function GetDBCharset: string;
+    function GetDBHost: string;
+    function GetDBPassword: string;
+    function GetDBPath: string;
+    function GetDBType: string;
+    function GetDBUser: string;
+    function GetDefaultSettingsFile:string;
+    procedure ReadINIFile;
+    procedure SetDBType(AValue: string);
+    procedure SetSettingsFile(AValue: string);
+  public
+    property DBCharset: string read GetDBCharset write FDBCharset; //Character set used for database (e.g. UTF8)
+    property DBHost: string read GetDBHost write FDBHost; //Database host/server (name or IP address). Leave empty for embedded
+    property DBPath: string read GetDBPath write FDBPath; //Path/database name
+    property DBUser: string read GetDBUser write FDBUser; //User name needed for database (e.g. sa, SYSDBA)
+    property DBPassword: string read GetDBPassword write FDBPassword; //Password needed for user name
+    property DBType: string read GetDBType write SetDBType; //Type of database connection, e.g. Firebird, Oracle
+    property SettingsFile: string read FSettingsFile write SetSettingsFile; //ini file to read settings from. If empty defaults to <programname>.ini
+    constructor Create;
+    constructor Create(DefaultType:string; DefaultHost:string=''; DefaultPath:string='data.fdb';
+      DefaultUser:string='SYSDBA'; DefaultPassword:string='masterkey'; DefaultCharSet:string='UTF8');
+    destructor Destroy; override;
+  end;
+
+implementation
+
+{ TDBConnectionConfig }
+
+function TDBConnectionConfig.GetDBHost: string;
+begin
+  if not(FSettingsFileIsRead) then ReadINIFile;
+  result:=FDBHost;
+end;
+
+function TDBConnectionConfig.GetDBCharset: string;
+begin
+  if not(FSettingsFileIsRead) then ReadINIFile;
+  result:=FDBCharset;
+end;
+
+function TDBConnectionConfig.GetDBPassword: string;
+begin
+  if not(FSettingsFileIsRead) then ReadINIFile;
+  result:=FDBPassword;
+end;
+
+function TDBConnectionConfig.GetDBPath: string;
+begin
+  if not(FSettingsFileIsRead) then ReadINIFile;
+  result:=FDBPath;
+end;
+
+function TDBConnectionConfig.GetDBType: string;
+begin
+  if not(FSettingsFileIsRead) then ReadINIFile;
+  result:=FDBType;
+end;
+
+function TDBConnectionConfig.GetDBUser: string;
+begin
+  if not(FSettingsFileIsRead) then ReadINIFile;
+  result:=FDBUser;
+end;
+
+function TDBConnectionConfig.GetDefaultSettingsFile:string;
+begin
+  result:=ChangeFileExt(ExtractFileName(ParamStr(0)), '.ini');
+end;
+
+procedure TDBConnectionConfig.SetSettingsFile(AValue: string);
+begin
+  // If empty value given, use the program name
+  if AValue='' then AValue:=GetDefaultSettingsFile;
+  if FSettingsFile=AValue then Exit;
+  FSettingsFile:=AValue;
+  // Read from file if present
+  ReadINIFile;
+end;
+
+
+procedure TDBConnectionConfig.SetDBType(AValue: string);
+begin
+  if FDBType=AValue then Exit;
+  case UpperCase(AValue) of
+    'FIREBIRD': FDBType:='Firebird';
+    'POSTGRES', 'POSTGRESQL': FDBType:='PostgreSQL';
+    'SQLITE','SQLITE3': FDBType:='SQLite';
+  else FDBType:=AValue;
+  end;
+end;
+
+procedure TDBConnectionConfig.ReadINIFile;
+var
+  INI: TIniFile;
+begin
+  if FileExists(FSettingsFile) then
+  begin
+    INI := TINIFile.Create(FSettingsFile);
+    try
+      FDBType := INI.ReadString('Database', 'DatabaseType', FDBType); //Default to Firebird
+      FDBHost := INI.ReadString('Database', 'Host', FDBHost);
+      FDBPath := INI.ReadString('Database', 'Database', FDBPath);
+      FDBUser := INI.ReadString('Database', 'User', 'SYSDBA');
+      FDBPassword := INI.ReadString('Database', 'Password', 'masterkey');
+      FSettingsFileIsRead:=true;
+    finally
+      INI.Free;
+    end;
+  end;
+end;
+
+constructor TDBConnectionConfig.Create;
+begin
+  inherited Create;
+  // Defaults
+  FSettingsFile:=GetDefaultSettingsFile;
+  FSettingsFileIsRead:=false;
+  FDBType := 'Firebird';
+  FDBHost := ''; //embedded: no hostname
+  FDBPath := 'data.fdb';
+  FDBUser := 'SYSDBA';
+  FDBPassword := 'masterkey';
+end;
+
+constructor TDBConnectionConfig.Create(DefaultType:string; DefaultHost:string=''; DefaultPath:string='data.fdb';
+  DefaultUser:string='SYSDBA'; DefaultPassword:string='masterkey'; DefaultCharSet:string='UTF8');
+begin
+  // First call regular constructor:
+  Create;
+  //... then override properties with what we specified:
+  FDBCharset:=DefaultCharset;
+  FDBHost:=DefaultHost;
+  FDBPassword:=DefaultPassword;
+  FDBPath:=DefaultPath;
+  FDBType:=DefaultType;
+  FDBUser:=DefaultUser;
+end;
+
+destructor TDBConnectionConfig.Destroy;
+begin
+  inherited Destroy;
+end;
+
+end.
+

examples/database/tsqlscript/dbconfiggui.lfm

@@ -0,0 +1,125 @@
+object DBConfigForm: TDBConfigForm
+  Left = 342
+  Height = 400
+  Top = 218
+  Width = 499
+  Caption = 'Database credentials'
+  ClientHeight = 400
+  ClientWidth = 499
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  OnShow = FormShow
+  LCLVersion = '1.0.2.0'
+  object ConnectorType: TComboBox
+    Left = 112
+    Height = 23
+    Top = 42
+    Width = 364
+    ItemHeight = 15
+    OnEditingDone = ConnectorTypeEditingDone
+    TabOrder = 0
+    Text = 'ConnectorType'
+  end
+  object Host: TEdit
+    Left = 112
+    Height = 23
+    Top = 87
+    Width = 192
+    OnEditingDone = HostEditingDone
+    TabOrder = 1
+  end
+  object Database: TEdit
+    Left = 112
+    Height = 23
+    Top = 128
+    Width = 192
+    OnEditingDone = DatabaseEditingDone
+    TabOrder = 2
+  end
+  object Password: TEdit
+    Left = 112
+    Height = 23
+    Top = 217
+    Width = 192
+    EchoMode = emPassword
+    OnEditingDone = PasswordEditingDone
+    PasswordChar = '*'
+    TabOrder = 4
+  end
+  object User: TEdit
+    Left = 112
+    Height = 23
+    Top = 176
+    Width = 192
+    OnEditingDone = UserEditingDone
+    TabOrder = 3
+  end
+  object Label1: TLabel
+    Left = 16
+    Height = 16
+    Top = 42
+    Width = 75
+    Caption = 'Database type'
+    ParentColor = False
+  end
+  object Label2: TLabel
+    Left = 16
+    Height = 16
+    Top = 87
+    Width = 26
+    Caption = 'Host'
+    ParentColor = False
+  end
+  object Label3: TLabel
+    Left = 16
+    Height = 16
+    Top = 128
+    Width = 49
+    Caption = 'Database'
+    ParentColor = False
+  end
+  object Label4: TLabel
+    Left = 16
+    Height = 16
+    Top = 176
+    Width = 24
+    Caption = 'User'
+    ParentColor = False
+  end
+  object Label5: TLabel
+    Left = 16
+    Height = 16
+    Top = 217
+    Width = 51
+    Caption = 'Password'
+    ParentColor = False
+  end
+  object OKButton: TButton
+    Left = 407
+    Height = 25
+    Top = 356
+    Width = 75
+    Caption = 'OK'
+    ModalResult = 1
+    TabOrder = 5
+  end
+  object CancelButton: TButton
+    Left = 312
+    Height = 25
+    Top = 356
+    Width = 75
+    Cancel = True
+    Caption = 'Cancel'
+    ModalResult = 2
+    TabOrder = 6
+  end
+  object TestButton: TButton
+    Left = 229
+    Height = 25
+    Top = 264
+    Width = 75
+    Caption = 'Test'
+    OnClick = TestButtonClick
+    TabOrder = 7
+  end
+end

examples/database/tsqlscript/dbconfiggui.pas

@@ -0,0 +1,121 @@
+unit dbconfiggui;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, dbconfig;
+
+type
+  TConnectionTestFunction = function(ChosenConfig: TDBConnectionConfig): boolean of object;
+  { TDBConfigForm }
+
+  TDBConfigForm = class(TForm)
+    OKButton: TButton;
+    CancelButton: TButton;
+    TestButton: TButton;
+    ConnectorType: TComboBox;
+    Host: TEdit;
+    Database: TEdit;
+    Label1: TLabel;
+    Label2: TLabel;
+    Label3: TLabel;
+    Label4: TLabel;
+    Label5: TLabel;
+    Password: TEdit;
+    User: TEdit;
+    procedure ConnectorTypeEditingDone(Sender: TObject);
+    procedure DatabaseEditingDone(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+    procedure HostEditingDone(Sender: TObject);
+    procedure PasswordEditingDone(Sender: TObject);
+    procedure TestButtonClick(Sender: TObject);
+    procedure UserEditingDone(Sender: TObject);
+  private
+    FConnectionConfig: TDBConnectionConfig;
+    FConnectionTestFunction: TConnectionTestFunction;
+    FSetupComplete: boolean;
+    { private declarations }
+  public
+    property Config: TDBConnectionConfig read FConnectionConfig;
+    property ConnectionTestCallback: TConnectionTestFunction write FConnectionTestFunction;
+    { public declarations }
+  end;
+
+var
+  DBConfigForm: TDBConfigForm;
+
+implementation
+
+{$R *.lfm}
+
+{ TDBConfigForm }
+
+procedure TDBConfigForm.TestButtonClick(Sender: TObject);
+begin
+  // Call callback with settings, let it figure out if connection succeeded and
+  // get test result back
+  if assigned(FConnectionTestFunction) and assigned(FConnectionConfig) then
+    if FConnectionTestFunction(FConnectionConfig) then
+       showmessage('Connection test succeeded.')
+      else
+        showmessage('Connection test failed.')
+  else
+    showmessage('Error: connection test code has not been implemented.');
+end;
+
+procedure TDBConfigForm.UserEditingDone(Sender: TObject);
+begin
+  FConnectionConfig.DBUser:=User.Text;
+end;
+
+procedure TDBConfigForm.FormCreate(Sender: TObject);
+begin
+  FConnectionConfig:=TDBConnectionConfig.Create;
+  FSetupComplete:=false;
+end;
+
+procedure TDBConfigForm.ConnectorTypeEditingDone(Sender: TObject);
+begin
+  FConnectionConfig.DBType:=ConnectorType.Text;
+end;
+
+procedure TDBConfigForm.DatabaseEditingDone(Sender: TObject);
+begin
+  FConnectionConfig.DBPath:=Database.Text;
+end;
+
+procedure TDBConfigForm.FormDestroy(Sender: TObject);
+begin
+  FConnectionConfig.Free;
+end;
+
+procedure TDBConfigForm.FormShow(Sender: TObject);
+begin
+  if not FSetupComplete then
+  begin
+    // Only do this once in form's lifetime
+    FSetupComplete:=true;
+    ConnectorType.Text:=FConnectionConfig.DBType;
+    Host.Text:=FConnectionConfig.DBHost;
+    Database.Text:=FConnectionConfig.DBPath;
+    User.Text:=FConnectionConfig.DBUser;
+    Password.Text:=FConnectionConfig.DBPassword;
+  end;
+end;
+
+procedure TDBConfigForm.HostEditingDone(Sender: TObject);
+begin
+  FConnectionConfig.DBHost:=Host.Text;
+end;
+
+procedure TDBConfigForm.PasswordEditingDone(Sender: TObject);
+begin
+  FConnectionConfig.DBPassword:=Password.Text;
+end;
+
+end.
+

examples/database/tsqlscript/mainform.lfm

@@ -0,0 +1,47 @@
+object Form1: TForm1
+  Left = 361
+  Height = 387
+  Top = 162
+  Width = 515
+  Caption = 'TSQLScriptSample'
+  ClientHeight = 387
+  ClientWidth = 515
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  LCLVersion = '1.0.12.0'
+  object ScriptMemo: TMemo
+    Left = 8
+    Height = 272
+    Top = 48
+    Width = 496
+    ScrollBars = ssAutoBoth
+    TabOrder = 0
+  end
+  object CmdCopyDDL: TButton
+    Left = 40
+    Height = 25
+    Top = 16
+    Width = 147
+    Caption = 'Copy table creation script'
+    OnClick = CmdCopyDDLClick
+    TabOrder = 1
+  end
+  object CmdCopyDML: TButton
+    Left = 232
+    Height = 25
+    Top = 16
+    Width = 147
+    Caption = 'Copy sample data script'
+    OnClick = CmdCopyDMLClick
+    TabOrder = 2
+  end
+  object CmdRunScript: TButton
+    Left = 184
+    Height = 25
+    Top = 336
+    Width = 75
+    Caption = 'Run script'
+    OnClick = CmdRunScriptClick
+    TabOrder = 3
+  end
+end

examples/database/tsqlscript/mainform.pas

@@ -0,0 +1,237 @@
+unit mainform;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids,
+  StdCtrls, dbconfiggui, dbconfig,
+  {General db unit}sqldb,
+  {For EDataBaseError}db,
+  {Now we add all databases we want to support, otherwise their drivers won't be loaded}
+  {$IFNDEF Solaris}IBConnection,{$ENDIF}pqconnection,sqlite3conn,
+  mssqlconn,mysql50conn,mysql51conn,mysql55conn,odbcconn,oracleconnection,
+  sqlscript {the unit that contains tsqlscript};
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    CmdCopyDDL: TButton;
+    CmdCopyDML: TButton;
+    CmdRunScript: TButton;
+    ScriptMemo: TMemo;
+    procedure CmdCopyDDLClick(Sender: TObject);
+    procedure CmdCopyDMLClick(Sender: TObject);
+    procedure CmdRunScriptClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+  private
+    { private declarations }
+    FConn: TSQLConnector;
+    FQuery: TSQLQuery;
+    FTran: TSQLTransaction;
+    function ConnectionTest(ChosenConfig: TDBConnectionConfig): boolean;
+  public
+    { public declarations }
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.FormCreate(Sender: TObject);
+var
+  LoginForm: TDBConfigForm;
+begin
+  FConn:=TSQLConnector.Create(nil);
+  FQuery:=TSQLQuery.Create(nil);
+  FTran:=TSQLTransaction.Create(nil);
+  FConn.Transaction:=FTran;
+  FQuery.DataBase:=FConn;
+
+  LoginForm:=TDBConfigForm.Create(self);
+  try
+    // The test button on dbconfiggui will link to this procedure:
+    LoginForm.ConnectionTestCallback:=@ConnectionTest;
+    LoginForm.ConnectorType.Clear; //remove any default connectors
+    // Now add the dbs that you support - use the name of the *ConnectionDef.TypeName property
+    {$IFNDEF Solaris}
+    // Not available on Solaris
+    LoginForm.ConnectorType.AddItem('Firebird', nil);
+    {$ENDIF}
+    LoginForm.ConnectorType.AddItem('MSSQLServer', nil);
+    LoginForm.ConnectorType.AddItem('MySQL50', nil);
+    LoginForm.ConnectorType.AddItem('MySQL51', nil);
+    LoginForm.ConnectorType.AddItem('MySQL55', nil);
+    LoginForm.ConnectorType.AddItem('ODBC', nil);
+    LoginForm.ConnectorType.AddItem('Oracle', nil);
+    LoginForm.ConnectorType.AddItem('PostGreSQL', nil);
+    LoginForm.ConnectorType.AddItem('SQLite3', nil);
+    LoginForm.ConnectorType.AddItem('Sybase', nil);
+    case LoginForm.ShowModal of
+    mrOK:
+      begin
+        //user wants to connect, so copy over db info
+        FConn.ConnectorType:=LoginForm.Config.DBType;
+        FConn.HostName:=LoginForm.Config.DBHost;
+        FConn.DatabaseName:=LoginForm.Config.DBPath;
+        FConn.UserName:=LoginForm.Config.DBUser;
+        FConn.Password:=LoginForm.Config.DBPassword;
+        FConn.Transaction:=FTran;
+      end;
+    mrCancel:
+      begin
+        ShowMessage('You canceled the database login. Application will terminate.');
+        Close;
+      end;
+    end;
+  finally
+    LoginForm.Free;
+  end;
+  // Get a script before the user's eyes:
+  CmdCopyDDLClick(nil);
+end;
+
+procedure TForm1.CmdCopyDDLClick(Sender: TObject);
+// Script that sets up tables as used in SQLdb_Tutorial1..3
+// Notice we include 2 SQL statements, each terminated with ;
+const ScriptText=
+  'CREATE TABLE CUSTOMER '+LineEnding+
+  '( '+LineEnding+
+  '  CUST_NO INTEGER NOT NULL, '+LineEnding+
+  '  CUSTOMER VARCHAR(25) NOT NULL, '+LineEnding+
+  '  CITY VARCHAR(25), '+LineEnding+
+  '  COUNTRY VARCHAR(15), '+LineEnding+
+  '  CONSTRAINT CT_CUSTOMER_PK PRIMARY KEY (CUST_NO) '+LineEnding+
+  '); '+LineEnding+
+  'CREATE TABLE EMPLOYEE '+LineEnding+
+  '( '+LineEnding+
+  '  EMP_NO INTEGER NOT NULL, '+LineEnding+
+  '  FIRST_NAME VARCHAR(15) NOT NULL, '+LineEnding+
+  '  LAST_NAME VARCHAR(20) NOT NULL, '+LineEnding+
+  '  PHONE_EXT VARCHAR(4), '+LineEnding+
+  '  JOB_CODE VARCHAR(5) NOT NULL, '+LineEnding+
+  '  JOB_GRADE INTEGER NOT NULL, '+LineEnding+
+  '  JOB_COUNTRY VARCHAR(15) NOT NULL, '+LineEnding+
+  '  SALARY NUMERIC(10,2) NOT NULL, '+LineEnding+
+  '  CONSTRAINT CT_EMPLOYEE_PK PRIMARY KEY (EMP_NO) '+LineEnding+
+  ');';
+begin
+  Scriptmemo.Lines.Text:=ScriptText;
+end;
+
+procedure TForm1.CmdCopyDMLClick(Sender: TObject);
+// Script that fills the table with sample data as used in SQLdb_Tutorial1..3
+// The double quotes inside the statements will be parsed by the Pascal compiler and
+// end up as single quotes in the actual ScriptText string, like SQL expects it.
+const ScriptText=
+  'INSERT INTO CUSTOMER (CUST_NO, CUSTOMER, CITY, COUNTRY) VALUES (1, ''Michael Design'', ''San Diego'', ''USA''); '+LineEnding+
+  'INSERT INTO CUSTOMER (CUST_NO, CUSTOMER, CITY, COUNTRY) VALUES (2, ''VC Technologies'', ''Dallas'', ''USA''); '+LineEnding+
+  'INSERT INTO CUSTOMER (CUST_NO, CUSTOMER, CITY, COUNTRY) VALUES (3, ''Klämpfl, Van Canneyt'', ''Boston'', ''USA''); '+LineEnding+
+  'INSERT INTO CUSTOMER (CUST_NO, CUSTOMER, CITY, COUNTRY) VALUES (4, ''Felipe Bank'', ''Manchester'', ''England''); '+LineEnding+
+  'INSERT INTO CUSTOMER (CUST_NO, CUSTOMER, CITY, COUNTRY) VALUES (5, ''Joost Systems, LTD.'', ''Central Hong Kong'', ''Hong Kong''); '+LineEnding+
+  'INSERT INTO CUSTOMER (CUST_NO, CUSTOMER, CITY, COUNTRY) VALUES (6, ''Van der Voort Int.'', ''Ottawa'', ''Canada''); '+LineEnding+
+  'INSERT INTO CUSTOMER (CUST_NO, CUSTOMER, CITY, COUNTRY) VALUES (7, ''Mrs. Mauvais'', ''Pebble Beach'', ''USA''); '+LineEnding+
+  'INSERT INTO CUSTOMER (CUST_NO, CUSTOMER, CITY, COUNTRY) VALUES (8, ''Asinine Vacation Rentals'', ''Lihue'', ''USA''); '+LineEnding+
+  'INSERT INTO CUSTOMER (CUST_NO, CUSTOMER, CITY, COUNTRY) VALUES (9, ''Fax'', ''Turtle Island'', ''Fiji''); '+LineEnding+
+  'INSERT INTO CUSTOMER (CUST_NO, CUSTOMER, CITY, COUNTRY) VALUES (10, ''FPC Corporation'', ''Tokyo'', ''Japan''); '+LineEnding+
+  'INSERT INTO CUSTOMER (CUST_NO, CUSTOMER, CITY, COUNTRY) VALUES (11, ''Dynamic Intelligence Corp'', ''Zurich'', ''Switzerland''); '+LineEnding+
+  'INSERT INTO CUSTOMER (CUST_NO, CUSTOMER, CITY, COUNTRY) VALUES (12, ''3D-Pad Corp.'', ''Paris'', ''France''); '+LineEnding+
+  'INSERT INTO CUSTOMER (CUST_NO, CUSTOMER, CITY, COUNTRY) VALUES (13, ''Swen Export, Ltd.'', ''Milan'', ''Italy''); '+LineEnding+
+  'INSERT INTO CUSTOMER (CUST_NO, CUSTOMER, CITY, COUNTRY) VALUES (14, ''Graeme Consulting'', ''Brussels'', ''Belgium''); '+LineEnding+
+  'INSERT INTO CUSTOMER (CUST_NO, CUSTOMER, CITY, COUNTRY) VALUES (15, ''Klenin Inc.'', ''Den Haag'', ''Netherlands''); '+LineEnding+
+  'INSERT INTO employee(emp_no, first_name, last_name, phone_ext, job_code, job_grade,  '+LineEnding+
+  '  job_country, salary) '+LineEnding+
+  '  VALUES (1,''William'',''Shatner'',''1702'',''CEO'',1,''USA'',48000); '+LineEnding+
+  'INSERT INTO employee(emp_no, first_name, last_name, phone_ext, job_code, job_grade,  '+LineEnding+
+  '  job_country, salary) '+LineEnding+
+  '  VALUES (2,''Ivan'',''Rzeszow'',''9802'',''Eng'',2,''Russia'',38000); '+LineEnding+
+  'INSERT INTO employee(emp_no, first_name, last_name, phone_ext, job_code, job_grade,  '+LineEnding+
+  '  job_country, salary) '+LineEnding+
+  '  VALUES (3,''Erin'',''Powell'',''1703'',''Admin'',2,''USA'',45368); ';
+begin
+  Scriptmemo.Lines.Text:=ScriptText;
+end;
+
+procedure TForm1.CmdRunScriptClick(Sender: TObject);
+// The heart of the program: runs the script in the memo
+var
+  OurScript: TSQLScript;
+begin
+  OurScript:=TSQLScript.Create(nil);
+  try
+    OurScript.Database:=FConn; //Indicate what db & ...
+    OurScript.Transaction:=FTran; // ... transaction we actually want to run the script against
+    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
+    try
+      if not(FTran.Active) then
+        FTran.StartTransaction; //better safe than sorry
+      OurScript.Execute;
+      FTran.Commit; //Make sure entire script is committed to the db
+      ShowMessage('Script was succesfully run.');
+    except
+      on E: EDataBaseError do
+      begin
+        ShowMessage('Error running script: '+E.Message);
+        FTran.Rollback;
+      end;
+    end;
+  finally
+    OurScript.Free;
+  end;
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  FQuery.Free;
+  FTran.Free;
+  FConn.Free;
+end;
+
+function TForm1.ConnectionTest(ChosenConfig: TDBConnectionConfig): boolean;
+// Callback function that uses the info in dbconfiggui to test a connection
+// and return the result of the test to dbconfiggui
+var
+  // Generic database connector...
+  Conn: TSQLConnector;
+begin
+  result:=false;
+  Conn:=TSQLConnector.Create(nil);
+  Screen.Cursor:=crHourglass;
+  try
+    // ...actual connector type is determined by this property.
+    // Make sure the ChosenConfig.DBType string matches
+    // the connectortype (e.g. see the string in the
+    // T*ConnectionDef.TypeName for that connector .
+    Conn.ConnectorType:=ChosenConfig.DBType;
+    Conn.HostName:=ChosenConfig.DBHost;
+    Conn.DatabaseName:=ChosenConfig.DBPath;
+    Conn.UserName:=ChosenConfig.DBUser;
+    Conn.Password:=ChosenConfig.DBPassword;
+    try
+      Conn.Open;
+      result:=Conn.Connected;
+    except
+      // Result is already false
+    end;
+    Conn.Close;
+  finally
+    Screen.Cursor:=crDefault;
+    Conn.Free;
+  end;
+end;
+
+end.
+

examples/database/tsqlscript/readme.txt

@@ -0,0 +1,23 @@
+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.
+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.
+- 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.
+- The logon form is taken from SQLdb_Tutorial3.
+
+Incidentally, it sets up a database with tables and sample data for the Lazarus wiki tutorials:
+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
+
+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/sqldbtutorial0.ini

@@ -0,0 +1,6 @@
+[Database]
+DatabaseType=Firebird
+Host=127.0.0.1
+Database=employee
+User=SYSDBA
+Password=masterkey

examples/database/tsqlscript/tsqlscriptsample.lpi

@@ -0,0 +1,124 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="tsqlscriptsample"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="2">
+      <Item1 Name="Default" Default="True"/>
+      <Item2 Name="Debug">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+          </SearchPaths>
+          <Linking>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+          <Other>
+            <CompilerMessages>
+              <UseMsgFile Value="True"/>
+            </CompilerMessages>
+            <CompilerPath Value="$(CompPath)"/>
+          </Other>
+        </CompilerOptions>
+      </Item2>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="4">
+      <Unit0>
+        <Filename Value="tsqlscriptsample.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tsqlscriptsample"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="mainform.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="mainform"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="dbconfig.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="dbconfig"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="dbconfiggui.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="DBConfigForm"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="dbconfiggui"/>
+      </Unit3>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="False"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

examples/database/tsqlscript/tsqlscriptsample.lpr

@@ -0,0 +1,26 @@
+program tsqlscriptsample;
+{
+This is the accompanying project for
+http://wiki.lazarus.freepascal.org/SQLdb_Tutorial3
+
+Please see that article for instructions and requirements.
+(You'll need database clients and a sample database; see the article)
+}
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, mainform, dbconfiggui;
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource := True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+