Remove custom TSQLScript as it still does not solve the problems in TurboBird. Hopefully this makes it easier for other contirbutors to contribute.

TurboBird.lpi

@@ -18,7 +18,7 @@
       <AutoIncrementBuild Value="True"/>
       <MajorVersionNr Value="1"/>
       <MinorVersionNr Value="2"/>
-      <BuildNr Value="1102"/>
+      <BuildNr Value="1103"/>
       <StringTable ProductVersion="0.9"/>
     </VersionInfo>
     <BuildModes Count="2">
@@ -57,9 +57,6 @@
             </Options>
           </Linking>
           <Other>
-            <CompilerMessages>
-              <UseMsgFile Value="True"/>
-            </CompilerMessages>
             <CustomOptions Value="-dDEBUG -O-1"/>
             <CompilerPath Value="$(CompPath)"/>
           </Other>
@@ -105,7 +102,6 @@
       <Unit0>
         <Filename Value="TurboBird.lpr"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="TurboBird"/>
       </Unit0>
       <Unit1>
         <Filename Value="main.pas"/>
@@ -113,7 +109,6 @@
         <ComponentName Value="fmMain"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="main"/>
       </Unit1>
       <Unit2>
         <Filename Value="createdb.pas"/>
@@ -121,7 +116,6 @@
         <ComponentName Value="fmCreateDB"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="CreateDb"/>
       </Unit2>
       <Unit3>
         <Filename Value="reg.pas"/>
@@ -129,7 +123,6 @@
         <ComponentName Value="fmReg"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="Reg"/>
       </Unit3>
       <Unit4>
         <Filename Value="querywindow.pas"/>
@@ -145,7 +138,6 @@
         <ComponentName Value="fmViewView"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="ViewView"/>
       </Unit5>
       <Unit6>
         <Filename Value="viewtrigger.pas"/>
@@ -153,7 +145,6 @@
         <ComponentName Value="fmViewTrigger"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="ViewTrigger"/>
       </Unit6>
       <Unit7>
         <Filename Value="viewsproc.pas"/>
@@ -161,7 +152,6 @@
         <ComponentName Value="fmViewSProc"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="ViewSProc"/>
       </Unit7>
       <Unit8>
         <Filename Value="viewgen.pas"/>
@@ -169,7 +159,6 @@
         <ComponentName Value="fmViewGen"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="ViewGen"/>
       </Unit8>
       <Unit9>
         <Filename Value="newtable.pas"/>
@@ -177,7 +166,6 @@
         <ComponentName Value="fmNewTable"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="NewTable"/>
       </Unit9>
       <Unit10>
         <Filename Value="newgen.pas"/>
@@ -185,7 +173,6 @@
         <ComponentName Value="fmNewGen"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="NewGen"/>
       </Unit10>
       <Unit11>
         <Filename Value="enterpass.pas"/>
@@ -193,7 +180,6 @@
         <ComponentName Value="fmEnterPass"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="EnterPass"/>
       </Unit11>
       <Unit12>
         <Filename Value="about.pas"/>
@@ -201,14 +187,12 @@
         <ComponentName Value="fmAbout"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="About"/>
       </Unit12>
       <Unit13>
         <Filename Value="createtrigger.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="fmCreateTrigger"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="CreateTrigger"/>
       </Unit13>
       <Unit14>
         <Filename Value="edittable.pas"/>
@@ -216,14 +200,12 @@
         <ComponentName Value="fmEditTable"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="EditTable"/>
       </Unit14>
       <Unit15>
         <Filename Value="callproc.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="fmCallProc"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="CallProc"/>
       </Unit15>
       <Unit16>
         <Filename Value="editdatafullrec.pas"/>
@@ -231,7 +213,6 @@
         <ComponentName Value="fmEditDataFullRec"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="EditDataFullRec"/>
       </Unit16>
       <Unit17>
         <Filename Value="udfinfo.pas"/>
@@ -239,7 +220,6 @@
         <ComponentName Value="fmUDFInfo"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UDFInfo"/>
       </Unit17>
       <Unit18>
         <Filename Value="viewdomain.pas"/>
@@ -247,14 +227,12 @@
         <ComponentName Value="fmViewDomain"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="ViewDomain"/>
       </Unit18>
       <Unit19>
         <Filename Value="newdomain.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="fmNewDomain"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="NewDomain"/>
       </Unit19>
       <Unit20>
         <Filename Value="systables.pas"/>
@@ -262,14 +240,12 @@
         <ComponentName Value="dmSysTables"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="DataModule"/>
-        <UnitName Value="SysTables"/>
       </Unit20>
       <Unit21>
         <Filename Value="newconstraint.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="fmNewConstraint"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="NewConstraint"/>
       </Unit21>
       <Unit22>
         <Filename Value="neweditfield.pas"/>
@@ -277,7 +253,6 @@
         <ComponentName Value="fmNewEditField"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="NewEditField"/>
       </Unit22>
       <Unit23>
         <Filename Value="calen.pas"/>
@@ -290,7 +265,6 @@
       <Unit24>
         <Filename Value="scriptdb.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="Scriptdb"/>
       </Unit24>
       <Unit25>
         <Filename Value="userpermissions.pas"/>
@@ -298,7 +272,6 @@
         <ComponentName Value="fmUserPermissions"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UserPermissions"/>
       </Unit25>
       <Unit26>
         <Filename Value="tablemanage.pas"/>
@@ -306,7 +279,6 @@
         <ComponentName Value="fmTableManage"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="TableManage"/>
       </Unit26>
       <Unit27>
         <Filename Value="backuprestore.pas"/>
@@ -314,7 +286,6 @@
         <ComponentName Value="fmBackupRestore"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="BackupRestore"/>
       </Unit27>
       <Unit28>
         <Filename Value="createuser.pas"/>
@@ -322,7 +293,6 @@
         <ComponentName Value="fmCreateUser"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="CreateUser"/>
       </Unit28>
       <Unit29>
         <Filename Value="changepass.pas"/>
@@ -330,7 +300,6 @@
         <ComponentName Value="fmChangePass"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="ChangePass"/>
       </Unit29>
       <Unit30>
         <Filename Value="permissionmanage.pas"/>
@@ -338,7 +307,6 @@
         <ComponentName Value="fmPermissionManage"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="PermissionManage"/>
       </Unit30>
       <Unit31>
         <Filename Value="sqlhistory.pas"/>
@@ -346,7 +314,6 @@
         <ComponentName Value="fmSQLHistory"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="SQLHistory"/>
       </Unit31>
       <Unit32>
         <Filename Value="copytable.pas"/>
@@ -354,7 +321,6 @@
         <ComponentName Value="fmCopyTable"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="CopyTable"/>
       </Unit32>
       <Unit33>
         <Filename Value="dbinfo.pas"/>
@@ -362,7 +328,6 @@
         <ComponentName Value="fmDBInfo"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="dbInfo"/>
       </Unit33>
       <Unit34>
         <Filename Value="comparison.pas"/>
@@ -370,7 +335,6 @@
         <ComponentName Value="fmComparison"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="Comparison"/>
       </Unit34>
       <Unit35>
         <Filename Value="procmod.pas"/>
@@ -378,7 +342,6 @@
         <ComponentName Value="fmProcMod"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="ProcMod"/>
       </Unit35>
       <Unit36>
         <Filename Value="update.pas"/>
@@ -386,17 +349,14 @@
         <ComponentName Value="fmUpdate"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="Update"/>
       </Unit36>
       <Unit37>
         <Filename Value="topologicalsort.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="topologicalsort"/>
       </Unit37>
       <Unit38>
         <Filename Value="unitfirebirdservices.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="UnitFirebirdServices"/>
       </Unit38>
       <Unit39>
         <Filename Value="turbocommon.inc"/>
@@ -405,12 +365,10 @@
       <Unit40>
         <Filename Value="trunksqlscript.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="trunksqlscript"/>
       </Unit40>
       <Unit41>
         <Filename Value="turbocommon.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="turbocommon"/>
       </Unit41>
     </Units>
   </ProjectOptions>
@@ -440,9 +398,6 @@
       </Options>
     </Linking>
     <Other>
-      <CompilerMessages>
-        <UseMsgFile Value="True"/>
-      </CompilerMessages>
       <CompilerPath Value="$(CompPath)"/>
     </Other>
   </CompilerOptions>

TurboBird.lpr

@@ -23,7 +23,7 @@ uses
   UserPermissions, TableManage, BackupRestore, CreateUser, ChangePass,
   PermissionManage, SQLHistory, CopyTable, dynlibs, ibase60dyn, dbInfo,
   sysutils, Comparison, Update, topologicalsort, UnitFirebirdServices, 
-  trunksqlscript, turbocommon, sqldblib;
+  turbocommon, sqldblib;
 
 const
   Major = 1;

modsqlscript.pas

@@ -1,184 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2008 by the Free Pascal development team
-
-    Abstract SQL scripting engine.
-		DB header file with interface section.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program 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.
-
- **********************************************************************}
-{ Updated SQLScript.
-Modified from FPC  sqldb.pp and sqlscript.pp to solve bugs with
-parameters. See 
-http://wiki.lazarus.freepascal.org/User_Changes_Trunk#TSQLScript_supports_:.2C_backtick_quotes_and_explicit_COMMIT.2FCOMMIT_RETAIN
-}
-{ Note regarding SQLScript bug in FPC <= 2.7.1:
-If parameters are used in the script e.g. as in the sample EMPLOYEE.FDB
-CREATE Procedure DELETE_EMPLOYEE
-...
-SELECT count(po_number)
-FROM sales
-WHERE sales_rep = :emp_num
-INTO :any_sales;
-you may get this error
-: PrepareStatement :
--Dynamic SQL Error
--SQL error code = -104
--Token unknown - line 19, column 7
--?
-because the TSQLScript tries to process parameters as if they were sqldb
-parameters
-}
-
-unit modsqlscript;
-
-{$mode objfpc}{$H+}
-
-interface
-
-{$IF FPC_FULLVERSION<20701}
-uses
-  Classes, SysUtils, db, dbconst, sqldb, trunksqlscript;
-{$ELSE}
-uses
-  Classes, SysUtils, db, sqldb;
-{$ENDIF}
-
-{$IF FPC_FULLVERSION<20701}
-// Only use this customised version for non-trunk FPC
-type
-  { TModCustomSQLQuery }
-    TModCustomSQLQuery = class(TCustomSQLQuery)
-    public
-      //redeclaration from protected to public
-      property ParamCheck;
-      property ParseSQL;
-      property SQL;
-    end;
-
-  { TModSQLScript }
-    TModSQLScript = class (TTrunkCustomSQLScript)
-    private
-      FOnDirective: TSQLScriptDirectiveEvent;
-      FQuery   : TModCustomSQLQuery;
-      FDatabase : TDatabase;
-      FTransaction : TDBTransaction;
-    protected
-      procedure ExecuteStatement (SQLStatement: TStrings; var StopExecution: Boolean); override;
-      procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); override;
-      procedure ExecuteCommit(CommitRetaining: boolean=true); override;
-      Procedure SetDatabase (Value : TDatabase); virtual;
-      Procedure SetTransaction(Value : TDBTransaction); virtual;
-      Procedure CheckDatabase;
-    public
-      constructor Create(AOwner : TComponent); override;
-      destructor Destroy; override;
-      procedure Execute; override;
-      procedure ExecuteScript;
-    published
-      Property DataBase : TDatabase Read FDatabase Write SetDatabase;
-      Property Transaction : TDBTransaction Read FTransaction Write SetTransaction;
-      property OnDirective: TSQLScriptDirectiveEvent read FOnDirective write FOnDirective;
-      property Directives;
-      property Defines;
-      property Script;
-      property Terminator;
-      property CommentsinSQL;
-      property UseSetTerm;
-      property UseCommit;
-      property UseDefines;
-      property OnException;
-    end;
-
-
-implementation
-
-
-{ TModSQLScript }
-
-procedure TModSQLScript.ExecuteStatement(SQLStatement: TStrings;
-  var StopExecution: Boolean);
-begin
-  fquery.SQL.assign(SQLStatement);
-  fquery.ExecSQL;
-end;
-
-procedure TModSQLScript.ExecuteDirective(Directive, Argument: String;
-  var StopExecution: Boolean);
-begin
-  if assigned (FOnDirective) then
-    FOnDirective (Self, Directive, Argument, StopExecution);
-end;
-
-procedure TModSQLScript.ExecuteCommit(CommitRetaining: boolean=true);
-begin
-  if FTransaction is TSQLTransaction then
-    if CommitRetaining then
-      TSQLTransaction(FTransaction).CommitRetaining
-    else
-      begin
-      TSQLTransaction(FTransaction).Commit;
-      TSQLTransaction(FTransaction).StartTransaction;
-      end
-  else
-    begin
-    FTransaction.Active := false;
-    FTransaction.Active := true;
-    end;
-end;
-
-procedure TModSQLScript.SetDatabase(Value: TDatabase);
-begin
-  FDatabase := Value;
-end;
-
-procedure TModSQLScript.SetTransaction(Value: TDBTransaction);
-begin
-  FTransaction := Value;
-end;
-
-procedure TModSQLScript.CheckDatabase;
-begin
-  If (FDatabase=Nil) then
-    DatabaseError(SErrNoDatabaseAvailable,Self)
-end;
-
-constructor TModSQLScript.Create(AOwner: TComponent);
-begin
-  inherited Create(AOwner);
-  FQuery := TModCustomSQLQuery.Create(nil);
-  CommentsInSQL:=false; //don't process comments by default
-  FQuery.ParamCheck := false; // Do not parse for parameters; breaks use of e.g. select bla into :bla in Firebird procedures
-  FQuery.ParseSQL:= false; //added for extra protection against messing with parameters
-end;
-
-destructor TModSQLScript.Destroy;
-begin
-  FQuery.Free;
-  inherited Destroy;
-end;
-
-procedure TModSQLScript.Execute;
-begin
-  FQuery.DataBase := FDatabase;
-  FQuery.Transaction := FTransaction;
-  inherited Execute;
-end;
-
-procedure TModSQLScript.ExecuteScript;
-begin
-  Execute;
-end;
-{$ELSE}
-// In FPC trunk, we can just use existing code
-type
-  TModSQLScript = TSQLScript;
-implementation
-{$ENDIF}
-end.

querywindow.pas

@@ -9,7 +9,7 @@ uses
   Controls, Graphics, Dialogs, ExtCtrls, PairSplitter, StdCtrls, Buttons,
   DBGrids, Menus, ComCtrls, SynEdit, SynHighlighterSQL, Reg,
   SynEditTypes, SynCompletion, Clipbrd, grids, DbCtrls, types, LCLType,
-  modsqlscript, dbugintf, turbocommon, variants, strutils;
+  dbugintf, turbocommon, variants, strutils;
 
 type
 
@@ -176,7 +176,7 @@ type
     FQueryPart: string;
     FTab: TTabSheet;
     FResultMemo: TMemo;
-    FSQLScript: TModSQLScript;
+    FSQLScript: TSQLScript;
     // Text for caption
     FAText: string;
     FModifyCount: Integer;
@@ -214,7 +214,7 @@ type
     // Get query text from GUI/memo into
     // QueryContents
     function GetQuery(QueryContents: tstrings): boolean;
-    function CreateResultTab(QueryType: TQueryTypes; var aSqlQuery: TSQLQuery; var aSQLScript: TModSQLScript;
+    function CreateResultTab(QueryType: TQueryTypes; var aSqlQuery: TSQLQuery; var aSQLScript: TSQLScript;
       var meResult: TMemo; AdditionalTitle: string = ''): TTabSheet;
     // Runs SQL script; returns result
     function ExecuteScript(Script: string): Boolean;
@@ -688,7 +688,7 @@ procedure TfmQueryWindow.tbCommitClick(Sender: TObject);
 var
   meResult: TMemo;
   SqlQuery: TSQLQuery;
-  SqlScript: TModSQLScript;
+  SqlScript: TSQLScript;
   ATab: TTabSheet;
   QT: TQueryThread;
 begin
@@ -812,7 +812,7 @@ procedure TfmQueryWindow.tbRollbackClick(Sender: TObject);
 var
   meResult: TMemo;
   SqlQuery: TSQLQuery;
-  SqlScript: TModSQLScript;
+  SqlScript: TSQLScript;
   ATab: TTabSheet;
   QT: TQueryThread;
 begin
@@ -1010,7 +1010,7 @@ end;
 { Create new result tab depending on query type }
 
 function TfmQueryWindow.CreateResultTab(QueryType: TQueryTypes;
-  var aSqlQuery: TSQLQuery; var aSQLScript: TModSQLScript; var meResult: TMemo;
+  var aSqlQuery: TSQLQuery; var aSQLScript: TSQLScript; var meResult: TMemo;
   AdditionalTitle: string): TTabSheet;
 var
   ATab: TTabSheet;
@@ -1106,7 +1106,7 @@ begin
         // Clean up to avoid memory leak
         if assigned(aSQLScript) then
           aSQLScript.Free;
-        aSQLScript:= TModSQLScript.Create(self);
+        aSQLScript:= TSQLScript.Create(self);
         aSQLScript.DataBase:= FIBConnection;
         aSQLScript.Transaction:= FSQLTrans;
         aSQLScript.CommentsInSQL:= true;
@@ -1411,7 +1411,7 @@ function TfmQueryWindow.ExecuteScript(Script: string): Boolean;
 var
   StartTime: TDateTime;
   SqlQuery: TSQLQuery;
-  SqlScript: TModSQLScript;
+  SqlScript: TSQLScript;
   meResult: TMemo;
   ATab: TTabSheet;
 begin

trunksqlscript.pas

@@ -1,706 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2008 by the Free Pascal development team
-
-    Abstract SQL scripting engine.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program 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.
-
- **********************************************************************}
-{ This is unit sqlscript from FPC trunk/2.7.1}
-unit trunksqlscript;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
-  Classes, SysUtils;
-
-type
-
-  TSQLScriptStatementEvent = procedure(Sender: TObject; Statement: TStrings; var StopExecution: Boolean) of object;
-  TSQLScriptDirectiveEvent = procedure(Sender: TObject; Directive, Argument: AnsiString; var StopExecution: Boolean) of object;
-  TSQLScriptExceptionEvent = procedure(Sender: TObject; Statement: TStrings; TheException: Exception; var Continue: boolean) of object;
-  TSQLSkipMode = (smNone, smIfBranch, smElseBranch, smAll);
-
-  { TTrunkCustomSQLScript }
-
-  TTrunkCustomSQLScript = class(TComponent)
-  private
-    FAutoCommit: Boolean;
-    FLine: Integer;
-    FCol: Integer;
-    FDefines: TStrings;
-    FOnException: TSQLScriptExceptionEvent;
-    FSkipMode: TSQLSkipMode;
-    FIsSkipping: Boolean;
-    FSkipStackIndex: Integer;
-    FSkipModeStack: array[0..255] of TSQLSkipMode;
-    FIsSkippingStack: array[0..255] of Boolean;
-    FAborted: Boolean;
-    FUseSetTerm, FUseDefines, FUseCommit,
-    FCommentsInSQL: Boolean;
-    FTerminator: AnsiString;
-    FSQL: TStrings;
-    FCurrentStripped,
-    FCurrentStatement: TStrings;
-    FDirectives: TStrings;
-    FComment,
-    FEmitLine: Boolean;
-    procedure SetDefines(const Value: TStrings);
-    function FindNextSeparator(sep: array of string): AnsiString;
-    procedure AddToStatement(value: AnsiString; ForceNewLine : boolean);
-    procedure SetDirectives(value: TStrings);
-    procedure SetSQL(value: TStrings);
-    procedure SQLChange(Sender: TObject);
-    function GetLine: Integer;
-  protected
-    procedure ClearStatement; virtual;
-    procedure InternalStatement (Statement: TStrings; var StopExecution: Boolean); virtual;
-    procedure InternalDirective (Directive, Argument: String; var StopExecution: Boolean); virtual;
-    // Runs commit. If ComitRetaining, use CommitRetraining if possible, else stop/starttransaction
-    procedure InternalCommit(CommitRetaining: boolean=true); virtual;
-    Function ProcessConditional(Directive : String; Param : String) : Boolean; virtual;
-    function NextStatement: AnsiString; virtual;
-    procedure ProcessStatement; virtual;
-    function Available: Boolean; virtual;
-    procedure DefaultDirectives; virtual;
-    procedure ExecuteStatement (Statement: TStrings; var StopExecution: Boolean); virtual; abstract;
-    procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); virtual; abstract;
-    // Executes commit. If possible and CommitRetaining, use CommitRetaining, else
-    procedure ExecuteCommit(CommitRetaining: boolean=true); virtual; abstract;
-  public
-    constructor Create (AnOwner: TComponent); override;
-    destructor Destroy; override;
-    procedure Execute; virtual;
-  protected
-    property Aborted: Boolean read FAborted;
-    property Line: Integer read GetLine;
-    property AutoCommit : Boolean Read FAutoCommit Write FAutoCommit;
-    property CommentsInSQL: Boolean read FCommentsInSQL write FCommentsInSQL;
-    property UseSetTerm: Boolean read FUseSetTerm write FUseSetTerm;
-    property UseCommit: Boolean read FUseCommit write FUseCommit;
-    property UseDefines: Boolean read FUseDefines write FUseDefines;
-    property Defines : TStrings Read FDefines Write SetDefines;
-    property Directives: TStrings read FDirectives write SetDirectives;
-    property Script: TStrings read FSQL write SetSQL;  // script to execute
-    property Terminator: AnsiString read FTerminator write FTerminator;
-    property OnException : TSQLScriptExceptionEvent read FOnException write FOnException;
-  end;
-
-  { TEventSQLScript }
-
-  TEventSQLScript = class (TTrunkCustomSQLScript)
-  private
-    FAfterExec: TNotifyEvent;
-    FBeforeExec: TNotifyEvent;
-    FOnCommit: TNotifyEvent;
-    FOnSQLStatement: TSQLScriptStatementEvent;
-    FOnDirective: TSQLScriptDirectiveEvent;
-  protected
-    procedure ExecuteStatement (SQLStatement: TStrings; var StopExecution: Boolean); override;
-    procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); override;
-    procedure ExecuteCommit(CommitRetaining: boolean=true); override;
-  public
-    procedure Execute; override;
-    property Aborted;
-    property Line;
-  published
-    property Directives;
-    property Defines;
-    property Script;
-    property Terminator;
-    property CommentsinSQL;
-    property UseSetTerm;
-    property UseCommit;
-    property UseDefines;
-    property OnException;
-    property OnSQLStatement: TSQLScriptStatementEvent read FOnSQLStatement write FOnSQLStatement;
-    property OnDirective: TSQLScriptDirectiveEvent read FOnDirective write FOnDirective;
-    property OnCommit: TNotifyEvent read FOnCommit write FOnCommit;
-    property BeforeExecute : TNotifyEvent read FBeforeExec write FBeforeExec;
-    property AfterExecute : TNotifyEvent read FAfterExec write FAfterExec;
-  end;
-
-  ESQLScript = Class(Exception);
-
-implementation
-
-Resourcestring
- SErrIfXXXNestingLimitReached = '#IFDEF nesting limit reached';
- SErrInvalidEndif = '#ENDIF without #IFDEF';
- SErrInvalidElse  = '#ELSE without #IFDEF';
-
-{ ---------------------------------------------------------------------
-    Auxiliary Functions
-  ---------------------------------------------------------------------}
-
-function StartsWith(S1, S2: AnsiString): Boolean;
-
-var
-  L1,L2 : Integer;
-
-begin
-  Result:=False;
-  L1:=Length(S1);
-  L2:=Length(S2);
-  if (L2=0) or (L1<L2) then
-    Exit;
-  Result:=(AnsiCompareStr(Copy(s1,1,L2),S2)=0);
-  Result := Result and ((L2 = L1) or (s1[L2+1] = ' '));
-end;
-
-function GetFirstSeparator(S: AnsiString; Sep: array of string): AnsiString;
-
-var
-  i, C, M: Integer;
-
-begin
-  M:=length(S) + 1;
-  Result:='';
-  for i:=0 to high(Sep) do
-    begin
-    C:=Pos(Sep[i],S);
-    if (C<>0) and (C<M) then
-      begin
-      M:=C;
-      Result:=Sep[i];
-      end;
-    end;
-end;
-
-Function ConvertWhiteSpace(S : String) : String;
-
-begin
-  Result:=StringReplace(S,#13,' ',[rfReplaceAll]);
-  Result:=StringReplace(Result,#10,' ',[rfReplaceAll]);
-  Result:=Trim(Result);
-end;
-
-{ ---------------------------------------------------------------------
-    TSQLScript
-  ---------------------------------------------------------------------}
-
-procedure TTrunkCustomSQLScript.SQLChange(Sender: TObject);
-begin
-  FLine:=1;
-  FCol:=1;
-end;
-
-procedure TTrunkCustomSQLScript.SetDirectives(value: TStrings);
-
-var
-  i : Integer;
-  S : AnsiString;
-
-begin
-  FDirectives.Clear();
-  if (Value<>Nil) then
-    begin
-    for i:=0 to value.Count - 1 do
-      begin
-      S:=UpperCase(ConvertWhiteSpace(value[i]));
-      if Length(S)>0 then
-        FDirectives.Add(S);
-      end;
-    end;
-  DefaultDirectives;
-end;
-
-procedure TTrunkCustomSQLScript.SetSQL(value: TStrings);
-begin
-  FSQL.Assign(value);
-  FLine:=1;
-  FCol:=1;
-end;
-
-function TTrunkCustomSQLScript.GetLine: Integer;
-begin
-  Result:=FLine - 1;
-end;
-
-procedure TTrunkCustomSQLScript.AddToStatement(value: AnsiString; ForceNewLine : Boolean);
-  Procedure DA(L : TStrings);
-  begin
-    With L do
-      if ForceNewLine or (Count=0) then
-        Add(value)
-      else
-        Strings[Count-1]:=Strings[Count-1] + value;
-  end;
-begin
- DA(FCurrentStatement);
- if Not FComment then
- 	 DA(FCurrentStripped);
-end;
-
-function TTrunkCustomSQLScript.FindNextSeparator(Sep: array of string): AnsiString;
-
-var
-  S: AnsiString;
-
-begin
-  Result:='';
-  while (FLine<=FSQL.Count) do
-    begin
-    S:=FSQL.Strings[FLine-1];
-    if (FCol>1) then
-      begin
-      S:=Copy(S,FCol,length(S));
-      end;
-    Result:=GetFirstSeparator(S,Sep);
-    if (Result='') then
-      begin
-      if FEmitLine then
-        AddToStatement(S,(FCol=1));
-      FCol:=1;
-      FLine:=FLine+1;
-      end
-    else
-      begin
-      if FEmitLine then
-        AddToStatement(Copy(S,1,Pos(Result,S)-1),(FCol=1));
-      FCol:=(FCol-1)+Pos(Result,S);
-      break;
-      end;
-    end;
-end;
-
-function TTrunkCustomSQLScript.Available: Boolean;
-
-var
-  SCol,
-  SLine: Integer;
-
-begin
-  SCol:=FCol;
-  SLine:=FLine;
-  try
-    Result:=Length(Trim(NextStatement()))>0;
-  Finally
-    FCol:=SCol;
-    FLine:=SLine;
-  end;
-end;
-
-procedure TTrunkCustomSQLScript.InternalStatement(Statement: TStrings;  var StopExecution: Boolean);
-
-var
-  cont : boolean;
-
-begin
-  try
-    ExecuteStatement(Statement, StopExecution);
-  except
-    on E : Exception do
-      begin
-      cont := false;
-      if assigned (FOnException) then
-        FOnException (self, Statement, E, cont);
-      if not cont then
-        Raise;
-      end;
-  end;
-end;
-
-procedure TTrunkCustomSQLScript.InternalDirective(Directive, Argument: String;  var StopExecution: Boolean);
-
-var
-  cont : boolean;
-  l : TStrings;
-
-begin
-  try
-    ExecuteDirective(Directive, Argument, StopExecution);
-  except
-    on E : Exception do
-      begin
-      cont := false;
-      if assigned (FOnException) then
-        begin
-        l := TStringlist.Create;
-        try
-          L.Add(Directive);
-          if Argument <> '' then
-            L.Add(Argument);
-          FOnException (self, l, E, cont);
-        finally
-          L.Free;
-        end;
-        end;
-      if not cont then
-        Raise;
-      end;
-  end;
-end;
-
-procedure TTrunkCustomSQLScript.InternalCommit(CommitRetaining: boolean=true);
-
-var
-  cont : boolean;
-  l : TStrings;
-
-begin
-  try
-    ExecuteCommit(CommitRetaining);
-  except
-    on E : Exception do
-      begin
-      cont := false;
-      if assigned (FOnException) then
-        begin
-        l := TStringlist.Create;
-        try
-          L.Add('COMMIT');
-          FOnException (self, l, E, cont);
-        finally
-          L.Free;
-        end;
-        end;
-      if not cont then
-        Raise;
-      end;
-  end;
-end;
-
-procedure TTrunkCustomSQLScript.ClearStatement;
-begin
-  FCurrentStatement.Clear;
-  FCurrentStripped.Clear;
-end;
-
-procedure TTrunkCustomSQLScript.ProcessStatement;
-
-Var
-  S,
-  Directive : String;
-  I : longint;
-
-begin
-  if (FCurrentStatement.Count=0) then
-    Exit;
-  S:=Trim(FCurrentStripped.Text);
-  I:=0;
-  Directive:='';
-  While (i<FDirectives.Count) and (Directive='') do
-    begin
-    If StartsWith(AnsiUpperCase(S), FDirectives[i]) Then
-      Directive:=FDirectives[i];
-    Inc(I);
-    end;
-  If (Directive<>'') then
-    begin
-    S:=Trim(Copy(S,Length(Directive)+1,length(S)));
-    If (Directive[1]='#') then
-      begin
-      if not FUseDefines or not ProcessConditional(Directive,S) then
-        if Not FIsSkipping then
-          InternalDirective (Directive, S, FAborted);
-      end
-    else If Not FIsSkipping then
-      begin
-      // If AutoCommit, skip any explicit commits.
-      if FUseCommit
-        and ((Directive = 'COMMIT') or (Directive = 'COMMIT WORK' {SQL standard}))
-        and not FAutoCommit then
-        InternalCommit(false) //explicit commit, no commit retaining
-      else if FUseCommit
-        and (Directive = 'COMMIT RETAIN') {at least Firebird syntax}
-        and not FAutoCommit then
-        InternalCommit(true)
-      else if FUseSetTerm
-        and (Directive = 'SET TERM' {Firebird/Interbase only}) then
-        FTerminator:=S
-      else
-        InternalDirective (Directive,S,FAborted)
-      end
-    end
-  else
-    if (not FIsSkipping) then
-      begin
-      InternalStatement(FCurrentStatement,FAborted);
-      If FAutoCommit and not FAborted then
-        InternalCommit;
-      end;
-end;
-
-procedure TTrunkCustomSQLScript.Execute;
-
-begin
-  FSkipMode:=smNone;
-  FIsSkipping:=False;
-  FSkipStackIndex:=0;
-  Faborted:=False;
-  DefaultDirectives;
-  while not FAborted and Available() do
-    begin
-    NextStatement();
-    if Length(Trim(FCurrentStripped.Text))>0 then
-      ProcessStatement;
-    end;
-end;
-
-function TTrunkCustomSQLScript.NextStatement: AnsiString;
-
-var
-  pnt: AnsiString;
-  terminator_found: Boolean;
-
-begin
-  terminator_found:=False;
-  ClearStatement;
-  while FLine <= FSQL.Count do
-    begin
-    pnt:=FindNextSeparator([FTerminator, '/*', '"', '''', '--']);
-    if (pnt=FTerminator) then
-      begin
-      if pnt='' then
-      begin
-        // Empty line, only e.g. a ; present:
-        FEmitLine:=False;
-        end
-        else begin
-        FCol:=FCol + length(pnt);
-        terminator_found:=True;
-        break;
-        end;
-      end
-    else if pnt = '/*' then
-      begin
-      FComment:=True;
-      if FCommentsInSQL then
-        AddToStatement(pnt,false)
-      else
-        FEmitLine:=False;
-      FCol:=FCol + length(pnt);
-      pnt:=FindNextSeparator(['*/']);
-      if FCommentsInSQL then
-        AddToStatement(pnt,false)
-      else
-        FEmitLine:=True;
-      FCol:=FCol + length(pnt);
-      FComment:=False;
-      end
-    else if pnt = '--' then
-      begin
-      FComment:=True;
-      if FCommentsInSQL then
-       AddToStatement(Copy(FSQL[FLine-1],FCol,Length(FSQL[FLine-1])-FCol+1),True);
-      Inc(Fline);
-      FCol:=0;
-      FComment:=False;
-      end
-    else if pnt = '"' then
-      begin
-      AddToStatement(pnt,false);
-      FCol:=FCol + length(pnt);
-      pnt:=FindNextSeparator(['"']);
-      AddToStatement(pnt,false);
-      FCol:=FCol + length(pnt);
-      end
-    else if pnt = '''' then
-      begin
-      AddToStatement(pnt,False);
-      FCol:=FCol + length(pnt);
-      pnt:=FindNextSeparator(['''']);
-      AddToStatement(pnt,false);
-      FCol:=FCol + length(pnt);
-      end;
-    end;
-  if not terminator_found then
-    ClearStatement;
-  while (FCurrentStatement.Count > 0) and (trim(FCurrentStatement.Strings[0]) = '') do
-    FCurrentStatement.Delete(0);
-  while (FCurrentStripped.Count > 0) and (trim(FCurrentStripped.Strings[0]) = '') do
-    FCurrentStripped.Delete(0);
-  Result:=FCurrentStatement.Text;
-end;
-
-Constructor TTrunkCustomSQLScript.Create (AnOwner: TComponent);
-
-Var
-  L : TStringList;
-
-begin
-  inherited;
-  L:=TStringList.Create;
-  With L do
-    begin
-    Sorted:=True;
-    Duplicates:=dupIgnore;
-    end;
-  FDefines:=L;
-  FCommentsInSQL:=True;
-  FTerminator:=';';
-  L:=TStringList.Create();
-  L.OnChange:=@SQLChange;
-  FSQL:=L;
-  FDirectives:=TStringList.Create();
-  FCurrentStripped:=TStringList.Create();
-  FCurrentStatement:=TStringList.Create();
-  FLine:=1;
-  FCol:=1;
-  FEmitLine:=True;
-  FUseCommit := true;
-  FUseDefines := True;
-  FUseSetTerm := True;
-  DefaultDirectives;
-end;
-
-destructor TTrunkCustomSQLScript.Destroy;
-begin
-  FreeAndNil(FCurrentStatement);
-  FreeAndNil(FCurrentStripped);
-  FreeAndNil(FSQL);
-  FreeAndNil(FDirectives);
-  FreeAndNil(FDefines);
-  inherited Destroy;
-end;
-
-procedure TTrunkCustomSQLScript.SetDefines(const Value: TStrings);
-begin
-  FDefines.Assign(Value);
-end;
-
-procedure TTrunkCustomSQLScript.DefaultDirectives;
-begin
-  With FDirectives do
-    begin
-    // Insertion order matters as testing for directives will be done with StartsWith
-    if FUseSetTerm then
-      Add('SET TERM');
-    if FUseCommit then
-    begin
-      Add('COMMIT WORK'); {SQL Standard, equivalent to commit}
-      Add('COMMIT RETAIN'); {Firebird/Interbase; probably won't hurt on other dbs}
-      Add('COMMIT'); {Shorthand used in many dbs, e.g. Firebird}
-    end;
-    if FUseDefines then
-      begin
-      Add('#IFDEF');
-      Add('#IFNDEF');
-      Add('#ELSE');
-      Add('#ENDIF');
-      Add('#DEFINE');
-      Add('#UNDEF');
-      Add('#UNDEFINE');
-      end;
-    end;
-end;
-
-Function TTrunkCustomSQLScript.ProcessConditional(Directive: String; Param : String) : Boolean;
-
-  Procedure PushSkipMode;
-
-  begin
-    if FSkipStackIndex=High(FSkipModeStack) then
-      Raise ESQLScript.Create(SErrIfXXXNestingLimitReached);
-    FSkipModeStack[FSkipStackIndex]:=FSkipMode;
-    FIsSkippingStack[FSkipStackIndex]:=FIsSkipping;
-    Inc(FSkipStackIndex);
-  end;
-
-  Procedure PopSkipMode;
-
-  begin
-    if FSkipStackIndex = 0 then
-      Raise ESQLScript.Create(SErrInvalidEndif);
-    Dec(FSkipStackIndex);
-    FSkipMode := FSkipModeStack[FSkipStackIndex];
-    FIsSkipping := FIsSkippingStack[FSkipStackIndex];
-  end;
-
-Var
-  Index : Integer;
-
-begin
-  Result:=True;
-  if (Directive='#DEFINE') then
-    begin
-    if not FIsSkipping then
-      FDefines.Add(Param);
-    end
-  else if (Directive='#UNDEF') or (Directive='#UNDEFINE') then
-    begin
-    if not FIsSkipping then
-      begin
-      Index:=FDefines.IndexOf(Param);
-      if (Index>=0) then
-        FDefines.Delete(Index);
-      end;
-    end
-  else if (Directive='#IFDEF') or (Directive='#IFNDEF') then
-    begin
-    PushSkipMode;
-    if FIsSkipping then
-      begin
-      FSkipMode:=smAll;
-      FIsSkipping:=true;
-      end
-    else
-      begin
-      Index:=FDefines.IndexOf(Param);
-      if ((Directive='#IFDEF') and (Index<0)) or
-         ((Directive='#IFNDEF') and (Index>=0)) then
-        begin
-        FSkipMode:=smIfBranch;
-        FIsSkipping:=true;
-        end
-      else
-        FSkipMode := smElseBranch;
-      end;
-    end
-  else if (Directive='#ELSE') then
-    begin
-    if (FSkipStackIndex=0) then
-      Raise ESQLScript.Create(SErrInvalidElse);
-    if (FSkipMode=smIfBranch) then
-      FIsSkipping:=false
-    else if (FSkipMode=smElseBranch) then
-      FIsSkipping:=true;
-    end
-  else if (Directive='#ENDIF') then
-    PopSkipMode
-  else
-    Result:=False;
-end;
-
-{ TEventSQLScript }
-
-procedure TEventSQLScript.ExecuteStatement(SQLStatement: TStrings;
-  var StopExecution: Boolean);
-begin
-  if assigned (FOnSQLStatement) then
-    FOnSQLStatement (self, SQLStatement, StopExecution);
-end;
-
-procedure TEventSQLScript.ExecuteDirective(Directive, Argument: String;
-  var StopExecution: Boolean);
-begin
-  if assigned (FOnDirective) then
-    FOnDirective (Self, Directive, Argument, StopExecution);
-end;
-
-procedure TEventSQLScript.ExecuteCommit(CommitRetaining: boolean=true);
-begin
-  if assigned (FOnCommit) then
-    FOnCommit (Self);
-end;
-
-procedure TEventSQLScript.Execute;
-begin
-  if assigned (FBeforeExec) then
-    FBeforeExec (Self);
-  inherited Execute;
-  if assigned (FAfterExec) then
-    FAfterExec (Self);
-end;
-
-end.
-