unit SQLExec;

interface

uses
  Windows, Classes, SysUtils, DB, ADODB;

type
  TSQLExec = class;

  TSQLExecEvent = procedure(Sender: TSQLExec) of object;
  TSQLExecFailEvent = procedure(Sender: TSQLExec; const EM: String) of object;
  TSQLBlockEvent = procedure(Sender: TSQLExec; const Block, Line: Integer;
    const SQL: String) of object;
  TSQLBlockFailEvent = procedure(Sender: TSQLExec; const Block, Line: Integer;
    const SQL, EM: String) of object;
  TSQLPrintEvent = procedure(Sender: TSQLExec;const Block, Line: Integer;
    const S: String) of object;

  TSQLExec = class(TObject)
  private
    FScript: TStringList;
    FDB: TADOConnection;
    FQry: TADOQuery;
    FCurLine: Integer;
    FCurBlock: Integer;
    FOnExecSuccess: TSQLExecEvent;
    FOnExecStart: TSQLExecEvent;
    FOnExecFail: TSQLExecFailEvent;
    FOnBlockSuccess: TSQLBlockEvent;
    FOnBlockStart: TSQLBlockEvent;
    FOnBlockFail: TSQLBlockFailEvent;
    FOnPrint: TSQLPrintEvent;
    procedure Print(const Block, Line: Integer; const S: String);
  public
    constructor Create;
    destructor Destroy; override;
    procedure ExecSQL(const Filename: String; const ConnStr: String;
      const UseDB: String = '');
    property OnExecStart: TSQLExecEvent read FOnExecStart write FOnExecStart;
    property OnExecSuccess: TSQLExecEvent read FOnExecSuccess write FOnExecSuccess;
    property OnExecFail: TSQLExecFailEvent read FOnExecFail write FOnExecFail;
    property OnBlockStart: TSQLBlockEvent read FOnBlockStart write FOnBlockStart;
    property OnBlockSuccess: TSQLBlockEvent read FOnBlockSuccess write FOnBlockSuccess;
    property OnBlockFail: TSQLBlockFailEvent read FOnBlockFail write FOnBlockFail;
    property OnPrint: TSQLPrintEvent read FOnPrint write FOnPrint;
  end;

implementation

{ TSQLExec }

constructor TSQLExec.Create;
begin
  FScript:= TStringList.Create;
  FDB:= TADOConnection.Create(nil);
  FDB.LoginPrompt:= False;
  FQry:= TADOQuery.Create(nil);
  FQry.Connection:= FDB;
  FQry.ParamCheck:= False;
end;

destructor TSQLExec.Destroy;
begin
  FDB.Connected:= False;
  FQry.Free;
  FDB.Free;
  FScript.Free;
  inherited;
end;

procedure TSQLExec.ExecSQL(const Filename, ConnStr, UseDB: String);
var
  S: String;
  X: Integer;
  function ExecBlock: Boolean;
  var
    R: Integer;
  begin
    Inc(FCurBlock);
    if Assigned(FOnBlockStart) then
      FOnBlockStart(Self, FCurBlock, FCurLine, FQry.SQL.Text);
    try
      if FQry.SQL.Count > 0 then begin
        R:= FQry.ExecSQL;
        if Assigned(FOnBlockSuccess) then
          FOnBlockSuccess(Self, FCurBlock, FCurLine, FQry.SQL.Text);
      end;
    except
      on e: exception do begin
        if Assigned(FOnBlockFail) then
          FOnBlockFail(Self, FCurBlock, FCurLine, FQry.SQL.Text, e.Message);
        raise Exception.Create('Block failure: '+e.Message);
      end;
    end;
    FQry.SQL.Clear;
  end;
  procedure DoPrint;
  var
    P: Integer;
  begin
    P:= Pos('''', S);
    Delete(S, 1, P-1);
    P:= Pos('''', S);
    Delete(S, P, Length(S));
    Print(FCurBlock, FCurLine, S);
    //Not sure if this follows the syntax rules...?
  end;
begin
  FCurLine:= 0;
  FCurBlock:= 0;
  FQry.SQL.Clear;
  FDB.ConnectionString:= ConnStr;
  try
    try
      if Assigned(FOnExecStart) then
        FOnExecStart(Self);
      if FileExists(Filename) then begin      
        FScript.LoadFromFile(Filename);
        FDB.Connected:= True;
        FDB.BeginTrans;
        try
          for X := 0 to FScript.Count-1 do begin
            FCurLine:= X;
            S:= FScript[X];
            if (Pos('use ', Trim(S)) = 1) and (UseDB <> '') then begin
              FScript[X]:= 'use '+UseDB;
            end else
            if Pos('print ', Trim(S))=1 then begin
              //This is not working as intended... Necessary to keep?
              DoPrint;
            end else
            if SameText('go', Trim(S)) then begin
              ExecBlock;  //Actual execution
            end else begin
              if Trim(S) <> '' then
                FQry.SQL.Append(S);
            end;
          end;
          //Execute last bit, in case it didn't end with GO
          ExecBlock;
          FDB.CommitTrans;
          if Assigned(FOnExecSuccess) then
            FOnExecSuccess(Self);
        except
          on e: exception do begin
            FDB.RollbackTrans;
            raise Exception.Create(e.Message);
          end;
        end;
      end else begin
        raise Exception.Create('File does not exist');
      end;
    except
      on e: exception do begin
        FOnExecFail(Self, e.Message);
      end;
    end;
  finally
    FQry.Close;
    FDB.Connected:= False;
  end;
end;

procedure TSQLExec.Print(const Block, Line: Integer; const S: String);
begin
  if Assigned(FOnPrint) then
    FOnPrint(Self, Block, Line, S);
end;

end.