Executing large SQL script file with GO statements using ADO

Question

I wrote a small component (still in the works but working) which takes a large SQL script file, splits it into different "blocks" based on GO statements, and executes them one by one.

The only major flaw I know of is not being able to detect when a GO statement is inside of a comment block, for example...

/*
GO
*/

...which would of course generate a SQL syntax error on both the prior and following block. I know that will take a lot more parsing to fix, but I'm not concerned about that flaw at the moment - our scripts (over 34,000 lines) avoid such occasions.

Is there anything else wrong with how this works?

NOTE: execution is done by A) Assigning a TADOConnection to the Connection property, B) Loading script into the SQL property, and C) Calling the Execute function.

unit SQLExec;

interface

uses
  Windows, Classes, SysUtils, DB, ADODB,
  Dialogs;

const
  SE_ERR_NONE = 0;
  SE_ERR_UNKNOWN = 1;
  SE_ERR_CONNECTION_FAIL = 2;
  SE_ERR_INVALID_CONNECTION = 3;
  SE_ERR_PARSE = 4;
  SE_ERR_EXECUTE = 5;

type
  ESQLExecScriptException = class;
  TSQLExecBlock = class;
  TSQLExecBlocks = class;
  TSQLExec = class;


  ESQLExecScriptException = class(Exception)
  private
    FErrorCode: Integer;
    FBlock: TSQLExecBlock;
  public
    constructor Create(const Msg: string; const ErrCode: Integer;
      ABlock: TSQLExecBlock);
    property ErrorCode: Integer read FErrorCode write FErrorCode;
    property Block: TSQLExecBlock read FBlock;
  end;


  TSQLExecStatus = (sePending, seExecuting, seSuccess, seFail);
  TSQLExecResult = (srSuccess, srConnFail, srSQLFail);

  TSQLExecOption = (soUseTransactions, soAbortOnFail, soForceParse);
  TSQLExecOptions = set of TSQLExecOption;

  TSQLBlockEvent = procedure(Sender: TSQLExec; Block: TSQLExecBlock) of object;

  TSQLExecBlock = class(TObject)
  private
    FOwner: TSQLExecBlocks;
    FSQL: TStringList;
    FStatus: TSQLExecStatus;
    FLine: Integer;
    FMessage: String;
    function GetSQL: TStrings;
    procedure SetSQL(const Value: TStrings);
    function GetIndex: Integer;
  public
    constructor Create(AOwner: TSQLExecBlocks);
    destructor Destroy; override;
    property Index: Integer read GetIndex;
    property Status: TSQLExecStatus read FStatus;
    property SQL: TStrings read GetSQL write SetSQL;
    property Line: Integer read FLine;
    property Message: String read FMessage;
  end;

  TSQLExecBlocks = class(TObject)
  private
    FOwner: TSQLExec;
    FItems: TList;
    function GetItem(Index: Integer): TSQLExecBlock;
  public
    constructor Create(AOwner: TSQLExec);
    destructor Destroy; override;
    function Add: TSQLExecBlock;
    procedure Delete(const Index: Integer);
    function Count: Integer;
    function IndexOf(ABlock: TSQLExecBlock): Integer;
    procedure Clear;
    property Items[Index: Integer]: TSQLExecBlock read GetItem; default;
  end;

  TSQLExec = class(TComponent)
  private
    FSQL: TStringList;
    FBlocks: TSQLExecBlocks;
    FConnection: TADOConnection;
    FOptions: TSQLExecOptions;
    FParsed: Boolean;
    FOnBlockStart: TSQLBlockEvent;
    FOnBlockFinish: TSQLBlockEvent;
    FSplitWord: String;
    function GetSQL: TStrings;
    procedure SetSQL(const Value: TStrings);
    procedure SetConnection(const Value: TADOConnection);
    procedure SQLChanged(Sender: TObject);
    procedure Invalidate;
    procedure SetSplitWord(const Value: String);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ParseSQL;
    function Execute: TSQLExecResult;
    function LineCount: Integer;
    function BlockCount: Integer;
    property Parsed: Boolean read FParsed;
    property Blocks: TSQLExecBlocks read FBlocks;
  published
    property SQL: TStrings read GetSQL write SetSQL;
    property Connection: TADOConnection read FConnection write SetConnection;
    property Options: TSQLExecOptions read FOptions write FOptions;
    property SplitWord: String read FSplitWord write SetSplitWord;
    property OnBlockStart: TSQLBlockEvent read FOnBlockStart write FOnBlockStart;
    property OnBlockFinish: TSQLBlockEvent read FOnBlockFinish write FOnBlockFinish;
  end;


implementation

{ ESQLExecScriptError }

constructor ESQLExecScriptException.Create(const Msg: string;
  const ErrCode: Integer; ABlock: TSQLExecBlock);
begin
  inherited Create(Msg);
  ErrorCode := ErrCode;
  FBlock:= ABlock;
end;

{ TSQLExecBlock }

constructor TSQLExecBlock.Create(AOwner: TSQLExecBlocks);
begin
  FOwner:= AOwner;
  FSQL:= TStringList.Create;
  FStatus:= sePending;
  FMessage:= '';
end;

destructor TSQLExecBlock.Destroy;
begin
  FSQL.Free;
  inherited;
end;

function TSQLExecBlock.GetIndex: Integer;
begin
  Result:= FOwner.FItems.IndexOf(Self);
end;

function TSQLExecBlock.GetSQL: TStrings;
begin
  Result:= TStrings(FSQL);
end;

procedure TSQLExecBlock.SetSQL(const Value: TStrings);
begin
  FSQL.Assign(Value);
end;

{ TSQLExecBlocks }

constructor TSQLExecBlocks.Create(AOwner: TSQLExec);
begin
  FOwner:= AOwner;
  FItems:= TList.Create;
end;

destructor TSQLExecBlocks.Destroy;
begin
  Clear;
  FItems.Free;
  inherited;
end;

function TSQLExecBlocks.Add: TSQLExecBlock;
begin
  Result:= TSQLExecBlock.Create(Self);
  FItems.Add(Result);
end;

procedure TSQLExecBlocks.Clear;
begin
  while Count > 0 do
    Delete(0);
end;

function TSQLExecBlocks.Count: Integer;
begin
  Result:= FItems.Count;
end;

procedure TSQLExecBlocks.Delete(const Index: Integer);
begin
  TSQLExecBlock(FItems[Index]).Free;
  FItems.Delete(Index);
end;

function TSQLExecBlocks.GetItem(Index: Integer): TSQLExecBlock;
begin
  Result:= TSQLExecBlock(FItems[Index]);
end;

function TSQLExecBlocks.IndexOf(ABlock: TSQLExecBlock): Integer;
begin
  Result:= FItems.IndexOf(ABlock);
end;

{ TSQLExec }

constructor TSQLExec.Create(AOwner: TComponent);
begin
  inherited;
  FSQL:= TStringList.Create;
  FSQL.OnChange:= SQLChanged;
  FBlocks:= TSQLExecBlocks.Create(Self);
  FConnection:= nil;
  FOptions:= [soUseTransactions,soAbortOnFail];
  FSplitWord:= 'go';
end;

destructor TSQLExec.Destroy;
begin
  FBlocks.Free;
  FSQL.Free;
  inherited;
end;

procedure TSQLExec.ParseSQL;
var
  X: Integer;
  S: String;
  B: TSQLExecBlock;
begin
  FBlocks.Clear;
  B:= FBlocks.Add;        //Add first block
  B.FLine:= 0;            //Assign the starting line # of block
  try
    for X := 0 to FSQL.Count - 1 do begin
      S:= FSQL[X];          //Get copy of line to string
      if Pos('use ', LowerCase(Trim(S))) = 1 then begin
        //FSQL[X]:= '';       //Temporarily disabled
      end else
      if SameText(FSplitWord, Trim(S)) then begin
        B:= FBlocks.Add;    //Add a new block
        B.FLine:= X;        //Assign the starting line # of block
      end else begin
        B.SQL.Append(S);    //Add SQL script to current block
      end;
    end;
    FParsed:= True;
  except
    on e: Exception do begin
      raise ESQLExecScriptException.Create(e.Message, SE_ERR_PARSE, B);
    end;
  end;
end;

function TSQLExec.Execute: TSQLExecResult;
var
  B: TSQLExecBlock;
  X: Integer;
  R: Integer;
  EM: String;
begin
  Result:= srSuccess;
  if (soForceParse in FOptions) or (not FParsed) then
    ParseSQL;
  //Begin transaction if configured
  if soUseTransactions in FOptions then
    FConnection.BeginTrans;
  try
    if not FConnection.Connected then begin
      try
        FConnection.Connected:= True;
      except
        on e: Exception do begin
          Result:= srConnFail;
          EM:= 'Error connecting to database: '+e.Message;
          raise ESQLExecScriptException.Create(EM, SE_ERR_CONNECTION_FAIL, nil);
        end;
      end;
    end;
    for X := 0 to FBlocks.Count-1 do begin
      B:= FBlocks[X];
      B.FStatus:= seExecuting;
      if Assigned(FOnBlockStart) then
        FOnBlockStart(Self, B);
      try
        if Trim(B.SQL.Text) <> '' then begin
          FConnection.Execute(B.SQL.Text);
        end;
        B.FStatus:= seSuccess;
      except
        on e: Exception do begin
          B.FStatus:= seFail;
          Result:= srSQLFail;
          if soAbortOnFail in FOptions then begin
            EM:= 'Error on Line '+IntToStr(B.Line)+': '+e.Message;
            raise ESQLExecScriptException.Create(EM, SE_ERR_EXECUTE, B);
          end;
        end;
      end;
      if Assigned(FOnBlockFinish) then
        FOnBlockFinish(Self, B);
    end; //of for loop
    //Commit transaction if configured
    if soUseTransactions in FOptions then
      FConnection.CommitTrans;
    //Everything succeeded
    Result:= srSuccess;
  except
    on e: Exception do begin
      Result:= srSQLFail;
      //Rollback transaction if configured
      if soUseTransactions in FOptions then
        if soAbortOnFail in FOptions then
          FConnection.RollbackTrans;
      raise e; //Re-raise exception
    end;
  end;
end;

procedure TSQLExec.Invalidate;
begin
  FParsed:= False;
  FBlocks.Clear;
end;

function TSQLExec.LineCount: Integer;
begin
  Result:= FSQL.Count;
end;

function TSQLExec.BlockCount: Integer;
begin
  if not FParsed then
    ParseSQL;
  Result:= FBlocks.Count;
end;

function TSQLExec.GetSQL: TStrings;
begin
  Result:= TStrings(FSQL);
end;

procedure TSQLExec.SetConnection(const Value: TADOConnection);
begin
  FConnection := Value;
end;

procedure TSQLExec.SetSplitWord(const Value: String);
begin
  FSplitWord := Value;
  Invalidate;
end;

procedure TSQLExec.SetSQL(const Value: TStrings);
begin
  FSQL.Assign(Value);
  Invalidate;
end;

procedure TSQLExec.SQLChanged(Sender: TObject);
begin
  Invalidate;
end;

end.

Answer 1

I am unfortunately not able to test your code, but I am able to read your code. Very well. Your code is overall very well written and you seem to adhere to most of the Delphi coding conventions that I know of. (Yes, non-Delphi users, using F for field name, T for a type, and a few letters before each enum constant is Delphi conventions)

It's been a while since I used Delphi but I believe that most of the things I will say here are useful for you either way.

---

Enum constant naming

Speaking of enum conventions conventions, I do believe the convention is to use the capital letters of the type and prefix to all the constants.

TSQLExecStatus = (sePending, seExecuting, seSuccess, seFail);
TSQLExecResult = (srSuccess, srConnFail, srSQLFail);

TSQLExecOption = (soUseTransactions, soAbortOnFail, soForceParse);

I don't really see how TSQLExecStatus becomes se, I can understand that TSQLExecResult becomes sr and that TSQLExecOption becomes so, but TSQLExecStatus I don't understand, I would have expected sec or ss.

---

Spacing Inconsistency

Starting of with a nitpick, here's some inconsistency:

ErrorCode := ErrCode;
FBlock:= ABlock;

I'd recommend sticking to Variable := Value; (There was a time when I used Variable:=Value; but I have totally dropped that)

I would also increase spacing on this line:

EM:= 'Error on Line '+IntToStr(B.Line)+': '+e.Message;

to:

EM := 'Error on Line ' + IntToStr(B.Line) + ': ' + e.Message;

---

Private member of private member

function TSQLExecBlock.GetIndex: Integer;
begin
  Result:= FOwner.FItems.IndexOf(Self);
end;

Accessing FOwner.FItems.IndexOf I would not recommend. You have created a TSQLExecBlocks.IndexOf method, use that instead.

Result := FOwner.IndexOf(Self);

---

The biggest mess

The biggest mess in your code is clearly in TSQLExec.ParseSQL and TSQLExec.Execute.

First of all, the variable names...

var
  B: TSQLExecBlock;
  X: Integer;
  R: Integer;
  EM: String;

I would name B as CurrentBlock, X as I (because it's a for-loop variable) or LineIndex, R I would remove entirely as it does not seem to be used. Finally I would either name EM as ErrorMessage or I would remove it as it is only a temporary variable for holding the message when the message might as well be specified directly when raising the error.

---

I also find some comments just... overkill. Especially here:

  if Pos('use ', LowerCase(Trim(S))) = 1 then begin
    //FSQL[X]:= '';       //Temporarily disabled
  end else
  if SameText(FSplitWord, Trim(S)) then begin
    B:= FBlocks.Add;    //Add a new block
    B.FLine:= X;        //Assign the starting line # of block
  end else begin
    B.SQL.Append(S);    //Add SQL script to current block
  end;

First:

//FSQL[X]:= '';       //Temporarily disabled

Yes, it's temporarily disabled, I can see that because the line is remmed. Why is it disabled? What would happen if it gets re-enabled?

The other comments:

B:= FBlocks.Add;    //Add a new block
B.FLine:= X;        //Assign the starting line # of block

end else begin B.SQL.Append(S); //Add SQL script to current block

Does not give any extra information at all besides what the code already says. If you would change the variable names to what I suggested above, they would be even more self-documenting.

---

If-then-if

if soUseTransactions in FOptions then
  if soAbortOnFail in FOptions then
    FConnection.RollbackTrans;

Why not write this as the following?

if soUseTransactions in FOptions 
  and soAbortOnFail in FOptions then
    FConnection.RollbackTrans;

---

Consider method extraction

This part of your code:

for X := 0 to FBlocks.Count-1 do begin
  B:= FBlocks[X];
  B.FStatus:= seExecuting;
  if Assigned(FOnBlockStart) then
    FOnBlockStart(Self, B);
  try
    if Trim(B.SQL.Text) <> '' then begin
      FConnection.Execute(B.SQL.Text);
    end;
    B.FStatus:= seSuccess;
  except
    on e: Exception do begin
      B.FStatus:= seFail;
      Result:= srSQLFail;
      if soAbortOnFail in FOptions then begin
        EM:= 'Error on Line '+IntToStr(B.Line)+': '+e.Message;
        raise ESQLExecScriptException.Create(EM, SE_ERR_EXECUTE, B);
      end;
    end;
  end;
  if Assigned(FOnBlockFinish) then
    FOnBlockFinish(Self, B);
end; //of for loop

Can use a method extraction so that the code in that method will look more like:

for X := 0 to FBlocks.Count-1 do begin
  B:= FBlocks[X];
  ExecuteBlock(B);
end; //of for loop

Which, as you can see, removes the need for the //of for loop comment

---

Summary

Well-written code, most of the things here are formatting issues and some refactoring stuff :)