How to execute a SQL script using dbExpress?

cytrinox picture cytrinox · Mar 1, 2012 · Viewed 10k times · Source

I'm migrating an old Delphi application (using ZeosDB) to Delphi XE2. I want to use dbExpress as a ZeosDB replacement for database access to Firebird 2.5 or MS-SQL. There are a lot of sql scripts for creating tables, view and stored procedures I need to run. The Firebird script commands are seperated with ^, MS-SQL script commands with "GO".

How can I run these scripts on the database using a dbexpress connection? ZeosDB provides a TZSqlProcessor, but I can't find any equivalent component for dbExpress.

Answer

Tom Hagen picture Tom Hagen · Mar 5, 2012

I do not use DBExpress but as far as I am aware, you can execute (either by Execute or ExecuteDirect) only one SQL command at a time. In other words you cannot put the whole script into the Execute method.

This is not related to different command syntax used by FireBird and MS SQL (^ vs. GO). You have to understand the '^' sign or 'GO' command is not a "TSQL Command"! Both are specific command delimiters used by respective application used to execute commands against the SQL engines. Instead it is difference between "Firebird Manager" (or how it's called) and "SQL Query Profiler" (or "SQL Server Management Studio").

The solution is to use some kind of parser, split the script into a list of single commands, and TSQLConnection.Execute these commands one-by-one.

Something like this pseudocode:

var
  DelimiterPos: Integer;
  S: String;
  Command: String;
begin
  S:= ScriptFile; // ScriptFile: String - your whole script
  While True Do
  begin
    DelimiterPos:= Pos('^', ScriptFile);
    if DelimiterPos = 0 then DelimiterPos:= Length(S);
    Command:= Copy(S, 1, DelimiterPos - 1);
    SQLConnection.Execute(Command);
    Delete(S, 1, DelimiterPos);
    if Lengh(S) = 0 Then Exit;
  end;
end;

Please note that the sample above will work correctly only in cases that the '^' sign is not used anywhere in the script but a command separator.

As a sidenote, I am sure there are some already built components that will do that for you (like TZSQLProcessor). I am not aware of any to point you to.

Sidenote 2: I am pretty sure, that you'll have to modify your scripts to be fully compatible with MS SQL. Eventhough Firebird and MS SQL are both SQL servers there is always difference in DML/DDL syntax.

Edit:

  1. If you can "rewrite" the SQL script into the code, you could use Jedi VCL jvStringHolder component. Put each separate command as one item (of type TStrings) in jvStringHolder.

  2. Creating the parser is rather complicated, but not undoable. With the inspiration from SynEdit i made these clases to exactly what you need: Load the script with TSQLScript.ParseScript, then iterate through Command[index: integer] property. The SQLLexer is not full SQL Lexer, but implements keywords separation with respec to comments, brackets, code folding etc. I've also added a special syntax into comments ($ sign in comment block) that helps me put titles into the script. This is full copy-paste from one of my projects. I'm not giving any more explanation, but I hope you can get the idea and make it running in your project.

unit SQLParser;

interface

type

  TTokenKind = (tkUknown, tkEOF, tkComment, tkKeyword, tkIdentifier,
                tkCommentParam, tkCommentParamValue, tkCommandEnd, tkCRLF);

  TBlockKind = (bkNone, bkLineComment, bkBlockComment);

  TSQLLexer = class
  private
    FBlockKind: TBlockKind;
    FParseString: String;
    FPosition: PChar;
    FTokenKind: TTokenKind;
    FTokenPosition: PChar;
    function GetToken: String;
    procedure Reset;
    procedure SetParseString(Value: String);
  protected
    procedure ReadComment;
    procedure ReadCommentParam;
    procedure ReadCommentParamValue;
    procedure ReadCRLF;
    procedure ReadIdentifier;
    procedure ReadSpace;
  public
    constructor Create(ParseString: String);
    function NextToken: TTokenKind;

    property Position: PChar read FPosition;
    property SQLText: String read FParseString write SetParseString;
    property Token: String read GetToken;
    property TokenKind: TTokenKind read FTokenKind;
    property TokenPosition: PChar read FTokenPosition;
  end;



implementation

uses SysUtils;

{ TSQLLexer }

constructor TSQLLexer.Create(ParseString: string);
begin
  inherited Create;
  FParseString:= ParseString;
  Reset;
end;

function TSQLLexer.GetToken;
begin
  SetString(Result, FTokenPosition, FPosition - FTokenPosition);
end;

function TSQLLexer.NextToken: TTokenKind;
begin
  case FBlockKind of
    bkLineComment, bkBlockComment: ReadComment;
    else
      case FPosition^ of
      #0: FTokenKind:= tkEOF;
      #1..#9, #11, #12, #14..#32:
        begin
          ReadSpace;
          NextToken;
        end;
      #10, #13: ReadCRLF;
      '-':
        if PChar(FPosition +1)^ = '-' then
          ReadComment
        else
          Inc(FPosition);
      '/':
        if PChar(FPosition +1)^ = '*' then
          ReadComment
        else
          Inc(FPosition);
      'a'..'z', 'A'..'Z': ReadIdentifier;
      ';':
        begin
          FTokenPosition:= FPosition;
          Inc(FPosition);
          FTokenKind:= tkCommandEnd;
        end
      else
        Inc(FPosition);
      end;
  end;
  Result:= FTokenKind;
end;


procedure TSQLLexer.ReadComment;
begin
  FTokenPosition:= FPosition;
  if not (FBlockKind in [bkLineComment, bkBlockComment])  then
  begin
    if FPosition^ = '/' then
      FBlockKind:= bkBlockComment
    else
      FBlockKind:= bkLineComment;
    Inc(FPosition, 2);
  end;
  case FPosition^ of
    '$': ReadCommentParam;
    ':': ReadCommentParamValue;
  else
    while not CharInSet(FPosition^, [#0, '$']) do
    begin
      if FBlockKind = bkBlockComment then
      begin
        if (FPosition^ = '*') And (PChar(FPosition + 1)^ = '/') then
        begin
          Inc(FPosition, 2);
          FBlockKind:= bkNone;
          Break;
        end;
      end
      else
      begin
        if CharInSet(Fposition^, [#10, #13]) then
        begin
          ReadCRLF;
          FBlockKind:= bkNone;
          Break;
        end;
      end;
      Inc(FPosition);
    end;
    FTokenKind:= tkComment;
  end;
end;

procedure TSQLLexer.ReadCommentParam;
begin
  Inc(FPosition);
  ReadIdentifier;
  FTokenKind:= tkCommentParam;
end;

procedure TSQLLexer.ReadCommentParamValue;
begin
  Inc(FPosition);
  ReadSpace;
  FTokenPosition:= FPosition;
  while not CharInSet(FPosition^, [#0, #10, #13]) do
    Inc(FPosition);
  FTokenKind:= tkCommentParamValue;
end;

procedure TSQLLexer.ReadCRLF;
begin
  while CharInSet(FPosition^, [#10, #13]) do
    Inc(FPosition);
  FTokenKind:= tkCRLF;
end;

procedure TSQLLexer.ReadIdentifier;
begin
  FTokenPosition:= FPosition;
  while CharInSet(FPosition^, ['a'..'z', 'A'..'Z', '_']) do
    Inc(FPosition);

  FTokenKind:= tkIdentifier;

  if Token = 'GO' then
    FTokenKind:= tkKeyword;
end;

procedure TSQLLexer.ReadSpace;
begin
  while CharInSet(FPosition^, [#1..#9, #11, #12, #14..#32]) do
  Inc(FPosition);
end;

procedure TSQLLexer.Reset;
begin
  FTokenPosition:= PChar(FParseString);
  FPosition:= FTokenPosition;
  FTokenKind:= tkUknown;
  FBlockKind:= bkNone;
end;

procedure TSQLLexer.SetParseString(Value: String);
begin
  FParseString:= Value;
  Reset;
end;

end.

The parser:

type
  TScriptCommand = class
  private
    FCommandText: String;
  public
    constructor Create(ACommand: String);
    property CommandText: String read FCommandText write FCommandText;
  end;

  TSQLScript = class
  private
    FCommands: TStringList;
    function GetCount: Integer;
    function GetCommandList: TStrings;
    function GetCommand(index: Integer): TScriptCommand;
  protected
    procedure AddCommand(AName: String; ACommand: String);
  public
    Constructor Create;
    Destructor Destroy; override;
    procedure ParseScript(Script: TStrings);

    property Count: Integer read GetCount;
    property CommandList: TStrings read GetCommandList;
    property Command[index: integer]: TScriptCommand read GetCommand;
  end;

{ TSQLScriptCommand }

constructor TScriptCommand.Create(ACommand: string);
begin
  inherited Create;
  FCommandText:= ACommand;
end;

{ TSQLSCript }

constructor TSQLScript.Create;
begin
  inherited;
  FCommands:= TStringList.Create(True);
  FCommands.Duplicates:= dupIgnore;
  FCommands.Sorted:= False;
end;

destructor TSQLScript.Destroy;
begin
  FCommands.Free;
  inherited;
end;

procedure TSQLScript.AddCommand(AName, ACommand: String);
var
  ScriptCommand: TScriptCommand;
  S: String;
begin
  if AName = '' then
    S:= SUnnamedCommand
  else
    S:= AName;
  ScriptCommand:= TScriptCommand.Create(ACommand);
  FCommands.AddObject(S, ScriptCommand);
end;

function TSQLScript.GetCommand(index: Integer): TScriptCommand;
begin
  Result:= TScriptCommand(FCommands.Objects[index]);
end;

function TSQLScript.GetCommandList: TStrings;
begin
  Result:= FCommands;
end;

function TSQLScript.GetCount: Integer;
begin
  Result:= FCommands.Count;
end;

procedure TSQLScript.ParseScript(Script: TStrings);
var
  Title: String;
  Command: String;
  LastParam: String;
  LineParser: TSQLLexer;
  IsNewLine: Boolean;
  LastPos: PChar;

  procedure AppendCommand;
  var
    S: String;
  begin
    SetString(S, LastPos, LineParser.Position - LastPos);
    Command:= Command + S;
    LastPos:= LineParser.Position;
  end;

  procedure FinishCommand;
  begin
    if Command <> '' then
      AddCommand(Title, Command);
    Title:= '';
    Command:= '';
    LastPos:= LineParser.Position;
    if LastPos^ = ';' then Inc(LastPos);
  end;

begin
  LineParser:= TSQLLexer.Create(Script.Text);
  try
    LastPos:= LineParser.Position;
    IsNewLine:= True;
    repeat
      LineParser.NextToken;
      case LineParser.TokenKind of
        tkComment: LastPos:= LineParser.Position;
        tkCommentParam:
          begin
            LastParam:= UpperCase(LineParser.Token);
            LastPos:= LineParser.Position;
          end;
        tkCommentParamValue:
          if LastParam = 'TITLE' then
          begin
            Title:= LineParser.Token;
            LastParam:= '';
            LastPos:= LineParser.Position;
          end;
        tkKeyword:
            if (LineParser.Token = 'GO') and IsNewLine then FinishCommand
            else
              AppendCommand;
        tkEOF:
          FinishCommand;
        else
          AppendCommand;
      end;
      IsNewLine:= LineParser.TokenKind in [tkCRLF, tkCommandEnd];
    until LineParser.TokenKind = tkEOF;
  finally
    LineParser.Free;
  end;
end;