23
\$\begingroup\$

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.
\$\endgroup\$
  • \$\begingroup\$ Component TZSQLProcessor from the ZeosLib open source, mature (~9 years of development), reasonably light weight, multi platform (multiple database engines and connection libraries) library - solves the same problem. You can compare your solution with their source code to find missing/different points \$\endgroup\$ – xmojmr Jul 20 '14 at 4:00
  • \$\begingroup\$ Note: Committed to Google Code: code.google.com/p/sql-executer/source/browse \$\endgroup\$ – Jerry Dodge Jul 20 '14 at 16:14
  • 7
    \$\begingroup\$ It depends entirely upon how your code 'splitter' works. I have the impresssion that you parse by line. If you have a proper parser that parses by character and recognizes begin/end comments, then it would just maintain state "I'm in a comment now" and ignore everything. \$\endgroup\$ – Jan Doggen Jul 27 '14 at 18:52
  • \$\begingroup\$ @JanDoggen Indeed, but I'm afraid a complete parse would slow it down dramatically. This actually seems to execute about 5 times faster than Microsoft's OSQL tool. I've also updated it to support comment blocks: code.google.com/p/sql-executer/source/browse/SQLExec.pas \$\endgroup\$ – Jerry Dodge Sep 11 '14 at 15:09
  • \$\begingroup\$ I have this on GitHub now with tons of changes, as well as a complete demo application which could be used for production: github.com/djjd47130/sql-executer/tree/SQL-Exec-V2 \$\endgroup\$ – Jerry Dodge Apr 8 '16 at 17:04
15
+100
\$\begingroup\$

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 :)

\$\endgroup\$
  • \$\begingroup\$ As for the spacing inconsistency in :=, I prefer no space, but the IDE automatically adds a space in code completion. \$\endgroup\$ – Jerry Dodge Sep 17 '14 at 0:25

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.