|
@@ -19,7 +19,10 @@ unit sqlscript;
|
|
|
interface
|
|
|
|
|
|
uses
|
|
|
- Classes, SysUtils;
|
|
|
+ Classes, SysUtils;
|
|
|
+
|
|
|
+Const
|
|
|
+ MinSQLSeps = 5; // Default, minimum number of standard SQL separators.
|
|
|
|
|
|
type
|
|
|
|
|
@@ -33,6 +36,7 @@ type
|
|
|
TCustomSQLScript = class(TComponent)
|
|
|
private
|
|
|
FAutoCommit: Boolean;
|
|
|
+ FDollarStrings: Tstrings;
|
|
|
FLine: Integer;
|
|
|
FCol: Integer;
|
|
|
FDefines: TStrings;
|
|
@@ -43,6 +47,7 @@ type
|
|
|
FSkipModeStack: array[0..255] of TSQLSkipMode;
|
|
|
FIsSkippingStack: array[0..255] of Boolean;
|
|
|
FAborted: Boolean;
|
|
|
+ FUseDollarString: Boolean;
|
|
|
FUseSetTerm, FUseDefines, FUseCommit,
|
|
|
FCommentsInSQL: Boolean;
|
|
|
FTerminator: AnsiString;
|
|
@@ -52,12 +57,18 @@ type
|
|
|
FDirectives: TStrings;
|
|
|
FComment,
|
|
|
FEmitLine: Boolean;
|
|
|
+ FSeps : Array of string;
|
|
|
procedure SetDefines(const Value: TStrings);
|
|
|
- function FindNextSeparator(sep: array of string): AnsiString;
|
|
|
+ function FindNextSeparator(ASeps: Array of string; Out IsExtended : Boolean): AnsiString;
|
|
|
procedure AddToStatement(value: AnsiString; ForceNewLine : boolean);
|
|
|
procedure SetDirectives(value: TStrings);
|
|
|
+ procedure SetDollarStrings(AValue: TStrings);
|
|
|
procedure SetSQL(value: TStrings);
|
|
|
+ procedure SetTerminator(AValue: AnsiString);
|
|
|
+ procedure SetUseDollarString(AValue: Boolean);
|
|
|
procedure SQLChange(Sender: TObject);
|
|
|
+ procedure DollarStringsChange(Sender : TObject);
|
|
|
+ Procedure RecalcSeps;
|
|
|
function GetLine: Integer;
|
|
|
protected
|
|
|
procedure ClearStatement; virtual;
|
|
@@ -86,10 +97,12 @@ type
|
|
|
property UseSetTerm: Boolean read FUseSetTerm write FUseSetTerm;
|
|
|
property UseCommit: Boolean read FUseCommit write FUseCommit;
|
|
|
property UseDefines: Boolean read FUseDefines write FUseDefines;
|
|
|
+ Property UseDollarString : Boolean Read FUseDollarString Write SetUseDollarString;
|
|
|
+ Property DollarStrings : TStrings Read FDollarStrings Write SetDollarStrings;
|
|
|
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 Terminator: AnsiString read FTerminator write SetTerminator;
|
|
|
property OnException : TSQLScriptExceptionEvent read FOnException write FOnException;
|
|
|
end;
|
|
|
|
|
@@ -155,21 +168,21 @@ begin
|
|
|
Result := Result and ((L2 = L1) or (s1[L2+1] = ' '));
|
|
|
end;
|
|
|
|
|
|
-function GetFirstSeparator(S: AnsiString; Sep: array of string): AnsiString;
|
|
|
+function GetFirstSeparator(S: AnsiString; Sep: array of string): integer;
|
|
|
|
|
|
var
|
|
|
i, C, M: Integer;
|
|
|
|
|
|
begin
|
|
|
M:=length(S) + 1;
|
|
|
- Result:='';
|
|
|
+ Result:=-1;
|
|
|
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];
|
|
|
+ Result:=i;
|
|
|
end;
|
|
|
end;
|
|
|
end;
|
|
@@ -192,6 +205,34 @@ begin
|
|
|
FCol:=1;
|
|
|
end;
|
|
|
|
|
|
+procedure TCustomSQLScript.DollarStringsChange(Sender: TObject);
|
|
|
+begin
|
|
|
+ RecalcSeps;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TCustomSQLScript.RecalcSeps;
|
|
|
+
|
|
|
+Var
|
|
|
+ L : Integer;
|
|
|
+
|
|
|
+begin
|
|
|
+ L:=MinSQLSeps;
|
|
|
+ If UseDollarString then
|
|
|
+ L:=L+1+DollarStrings.Count;
|
|
|
+ SetLength(FSeps,L);
|
|
|
+ FSeps[0]:=FTerminator;
|
|
|
+ FSeps[1]:='/*';
|
|
|
+ FSeps[2]:='"';
|
|
|
+ FSeps[3]:='''';
|
|
|
+ FSeps[4]:='--';
|
|
|
+ If UseDollarString then
|
|
|
+ begin
|
|
|
+ FSeps[MinSQLSeps]:='$$';
|
|
|
+ For L:=0 to FDollarStrings.Count-1 do
|
|
|
+ FSeps[MinSQLSeps+1+L]:='$'+FDollarStrings[L]+'$';
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
procedure TCustomSQLScript.SetDirectives(value: TStrings);
|
|
|
|
|
|
var
|
|
@@ -212,6 +253,14 @@ begin
|
|
|
DefaultDirectives;
|
|
|
end;
|
|
|
|
|
|
+procedure TCustomSQLScript.SetDollarStrings(AValue: TStrings);
|
|
|
+begin
|
|
|
+ if FDollarStrings=AValue then Exit;
|
|
|
+ FDollarStrings.Assign(AValue);
|
|
|
+ If FUseDollarString then
|
|
|
+ RecalcSeps;
|
|
|
+end;
|
|
|
+
|
|
|
procedure TCustomSQLScript.SetSQL(value: TStrings);
|
|
|
begin
|
|
|
FSQL.Assign(value);
|
|
@@ -219,12 +268,27 @@ begin
|
|
|
FCol:=1;
|
|
|
end;
|
|
|
|
|
|
+procedure TCustomSQLScript.SetTerminator(AValue: AnsiString);
|
|
|
+begin
|
|
|
+ if FTerminator=AValue then Exit;
|
|
|
+ FTerminator:=AValue;
|
|
|
+ if Length(FSeps)>0 then
|
|
|
+ FSeps[0]:=FTerminator;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TCustomSQLScript.SetUseDollarString(AValue: Boolean);
|
|
|
+begin
|
|
|
+ if FUseDollarString=AValue then Exit;
|
|
|
+ FUseDollarString:=AValue;
|
|
|
+ RecalcSeps;
|
|
|
+end;
|
|
|
function TCustomSQLScript.GetLine: Integer;
|
|
|
begin
|
|
|
Result:=FLine - 1;
|
|
|
end;
|
|
|
|
|
|
-procedure TCustomSQLScript.AddToStatement(value: AnsiString; ForceNewLine : Boolean);
|
|
|
+procedure TCustomSQLScript.AddToStatement(value: AnsiString;
|
|
|
+ ForceNewLine: boolean);
|
|
|
|
|
|
Procedure DA(L : TStrings);
|
|
|
|
|
@@ -242,10 +306,12 @@ begin
|
|
|
DA(FCurrentStripped);
|
|
|
end;
|
|
|
|
|
|
-function TCustomSQLScript.FindNextSeparator(Sep: array of string): AnsiString;
|
|
|
+function TCustomSQLScript.FindNextSeparator(ASeps: array of string; out
|
|
|
+ IsExtended: Boolean): AnsiString;
|
|
|
|
|
|
var
|
|
|
S: AnsiString;
|
|
|
+ I : Integer;
|
|
|
|
|
|
begin
|
|
|
Result:='';
|
|
@@ -256,8 +322,8 @@ begin
|
|
|
begin
|
|
|
S:=Copy(S,FCol,length(S));
|
|
|
end;
|
|
|
- Result:=GetFirstSeparator(S,Sep);
|
|
|
- if (Result='') then
|
|
|
+ I:=GetFirstSeparator(S,ASeps);
|
|
|
+ if (I=-1) then
|
|
|
begin
|
|
|
if FEmitLine then
|
|
|
AddToStatement(S,(FCol<=1));
|
|
@@ -266,6 +332,8 @@ begin
|
|
|
end
|
|
|
else
|
|
|
begin
|
|
|
+ Result:=ASeps[i];
|
|
|
+ IsExtended:=I>=MinSQLSeps;
|
|
|
if FEmitLine then
|
|
|
AddToStatement(Copy(S,1,Pos(Result,S)-1),(FCol=1));
|
|
|
FCol:=(FCol-1)+Pos(Result,S);
|
|
@@ -413,7 +481,10 @@ begin
|
|
|
InternalCommit(true)
|
|
|
else if FUseSetTerm
|
|
|
and (Directive = 'SET TERM' {Firebird/Interbase only}) then
|
|
|
- FTerminator:=S
|
|
|
+ begin
|
|
|
+ FTerminator:=S;
|
|
|
+ RecalcSeps;
|
|
|
+ end
|
|
|
else
|
|
|
InternalDirective (Directive,S,FAborted)
|
|
|
end
|
|
@@ -446,14 +517,14 @@ function TCustomSQLScript.NextStatement: AnsiString;
|
|
|
|
|
|
var
|
|
|
pnt: AnsiString;
|
|
|
- terminator_found: Boolean;
|
|
|
+ b,isExtra,terminator_found: Boolean;
|
|
|
|
|
|
begin
|
|
|
terminator_found:=False;
|
|
|
ClearStatement;
|
|
|
while FLine <= FSQL.Count do
|
|
|
begin
|
|
|
- pnt:=FindNextSeparator([FTerminator, '/*', '"', '''', '--']);
|
|
|
+ pnt:=FindNextSeparator(FSeps,isExtra);
|
|
|
if (pnt=FTerminator) then
|
|
|
begin
|
|
|
FCol:=FCol + length(pnt);
|
|
@@ -468,7 +539,7 @@ begin
|
|
|
else
|
|
|
FEmitLine:=False;
|
|
|
FCol:=FCol + length(pnt);
|
|
|
- pnt:=FindNextSeparator(['*/']);
|
|
|
+ pnt:=FindNextSeparator(['*/'],b);
|
|
|
if FCommentsInSQL then
|
|
|
AddToStatement(pnt,false)
|
|
|
else
|
|
@@ -489,7 +560,7 @@ begin
|
|
|
begin
|
|
|
AddToStatement(pnt,false);
|
|
|
FCol:=FCol + length(pnt);
|
|
|
- pnt:=FindNextSeparator(['"']);
|
|
|
+ pnt:=FindNextSeparator(['"'],b);
|
|
|
AddToStatement(pnt,false);
|
|
|
FCol:=FCol + length(pnt);
|
|
|
end
|
|
@@ -497,9 +568,17 @@ begin
|
|
|
begin
|
|
|
AddToStatement(pnt,False);
|
|
|
FCol:=FCol + length(pnt);
|
|
|
- pnt:=FindNextSeparator(['''']);
|
|
|
+ pnt:=FindNextSeparator([''''],b);
|
|
|
AddToStatement(pnt,false);
|
|
|
FCol:=FCol + length(pnt);
|
|
|
+ end
|
|
|
+ else if IsExtra then
|
|
|
+ begin
|
|
|
+ AddToStatement(pnt,false);
|
|
|
+ FCol:=FCol + length(pnt);
|
|
|
+ pnt:=FindNextSeparator([pnt],b);
|
|
|
+ AddToStatement(pnt,false);
|
|
|
+ FCol:=FCol + length(pnt);
|
|
|
end;
|
|
|
end;
|
|
|
if not terminator_found then
|
|
@@ -511,7 +590,7 @@ begin
|
|
|
Result:=FCurrentStatement.Text;
|
|
|
end;
|
|
|
|
|
|
-Constructor TCustomSQLScript.Create (AnOwner: TComponent);
|
|
|
+constructor TCustomSQLScript.Create(AnOwner: TComponent);
|
|
|
|
|
|
Var
|
|
|
L : TStringList;
|
|
@@ -530,6 +609,10 @@ begin
|
|
|
L:=TStringList.Create();
|
|
|
L.OnChange:=@SQLChange;
|
|
|
FSQL:=L;
|
|
|
+ L:=TStringList.Create();
|
|
|
+ L.OnChange:=@DollarStringsChange;
|
|
|
+ FDollarStrings:=L;
|
|
|
+ ReCalcSeps;
|
|
|
FDirectives:=TStringList.Create();
|
|
|
FCurrentStripped:=TStringList.Create();
|
|
|
FCurrentStatement:=TStringList.Create();
|
|
@@ -562,6 +645,7 @@ procedure TCustomSQLScript.DefaultDirectives;
|
|
|
begin
|
|
|
With FDirectives do
|
|
|
begin
|
|
|
+ FreeAndNil(FDollarStrings);
|
|
|
// Insertion order matters as testing for directives will be done with StartsWith
|
|
|
if FUseSetTerm then
|
|
|
Add('SET TERM');
|
|
@@ -584,7 +668,8 @@ begin
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
-Function TCustomSQLScript.ProcessConditional(Directive: String; Param : String) : Boolean;
|
|
|
+function TCustomSQLScript.ProcessConditional(Directive: String; Param: String
|
|
|
+ ): Boolean;
|
|
|
|
|
|
Procedure PushSkipMode;
|
|
|
|