ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/runtime/ibxscript.pas

Comparing ibx/trunk/runtime/ibxscript.pas (file contents):
Revision 46 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 47 by tony, Mon Jan 9 15:31:51 2017 UTC

#	Line 15 | Line 15
15		*
16		*  The Initial Developer of the Original Code is Tony Whyman.
17		*
18	<	*  The Original Code is (C) 2014 Tony Whyman, MWA Software
18	>	*  The Original Code is (C) 2014-2017 Tony Whyman, MWA Software
19		*  (http://www.mwasoftware.co.uk).
20		*
21		*  All Rights Reserved.
#	Line 31 | Line 31 | unit ibxscript;
31
32		interface
33
34	<	uses Classes, IBDatabase,  IBSQL, IB;
34	>	uses Classes, IBDatabase,  IBSQL, IB, IBDataOutput;
35	>
36	>	const
37	>	ibx_blob = 'IBX_BLOB';
38	>	ibx_array = 'IBX_ARRAY';
39	>
40	>	BlobLineLength = 40;
41	>
42	>	{Non-character symbols}
43	>	sqNone                 = #0;
44	>	sqEnd                  = #1;
45	>	sqBegin                = #2;
46	>	sqString               = #3;
47	>	sqComment              = #4;
48	>	sqCase                 = #5;
49	>	sqDeclare              = #6;
50	>	sqCommentLine          = #7;
51	>	sqEOL                  = #8;
52	>	sqTab                  = #9;
53	>	sqTerminator           = #10;
54	>	sqEOF                  = #11;
55	>	sqTag                  = #12;
56	>	sqEndTag               = #13;
57	>	sqQuotedString         = #14;
58	>	sqDoubleQuotedString   = #15;
59	>
60	>	type
61	>	TSQLSymbol = char;
62	>
63	>	TSQLStates =  (stInit, stError, stInSQL, stNested,  stInDeclaration);
64	>
65	>	TXMLStates =  (stInTag,stAttribute,stAttributeValue,stQuotedAttributeValue,
66	>	stTagged,stEndTag);
67	>
68	>	TXMLTag    =   (xtNone,xtBlob,xtArray,xtElt);
69	>
70	>	TOnNextLine = procedure(Sender: TObject; Line: string) of object;
71	>	TOnProgressEvent = procedure (Sender: TObject; Reset: boolean; value: integer) of object;
72	>
73	>	TXMLTagDef = record
74	>	XMLTag: TXMLTag;
75	>	TagValue: string;
76	>	end;
77	>
78	>	const
79	>	XMLTagDefs: array [0..2] of TXMLTagDef = (
80	>	(XMLTag: xtBlob;   TagValue: 'blob'),
81	>	(XMLTag: xtArray;  TagValue: 'array'),
82	>	(XMLTag: xtElt;    TagValue: 'elt')
83	>	);
84
85		type
86	<	TSQLSymbol = (sqNone,sqSpace,sqSemiColon,sqSingleQuotes,sqDoubleQuotes,
87	<	sqEnd,sqBegin,sqCommit,sqRollback,sqString,sqCommentStart,
88	<	sqCommentEnd,sqCommentLine,sqAsterisk,sqForwardSlash,
89	<	sqDeclare,sqEOL,sqTerminator, sqReconnect,sqCase);
90	<
91	<	TSQLStates =  (stInit, stError, stInSQL, stNested, stInSingleQuotes,
92	<	stInDoubleQuotes, stInComment, stInCommentLine,
93	<	stInDeclaration, stInCommit, stInReconnect);
86	>
87	>	{ TSymbolStream }
88	>
89	>	{A simple lookahead one parser to process a text stream as a stream of symbols.
90	>	This is an abstract object, subclassed for different sources.}
91	>
92	>	TSymbolStream = class
93	>	private
94	>	FNextSymbol: TSQLSymbol;
95	>	FOnNextLine: TOnNextLine;
96	>	FOnProgressEvent: TOnProgressEvent;
97	>	FTerminator: char;
98	>	FLastChar: char;
99	>	FIndex: integer;
100	>	FLine: string;
101	>	FString: string;
102	>	FXMLTag: TXMLTag;
103	>	FXMLMode: integer;
104	>	protected
105	>	FNextStatement: boolean;
106	>	function GetErrorPrefix: string; virtual; abstract;
107	>	function GetNextSymbol(C: char): TSQLSymbol;
108	>	function FindTag(tag: string; var xmlTag: TXMLTag): boolean;
109	>	function GetNextLine(var Line: string):boolean; virtual; abstract;
110	>	public
111	>	constructor Create;
112	>	procedure ShowError(msg: string; params: array of const);
113	>	function GetSymbol: TSQLSymbol; virtual;
114	>	procedure NextStatement;
115	>	property SymbolValue: string read FString;
116	>	property Terminator: char read FTerminator write FTerminator;
117	>	property XMLTag: TXMLTag read FXMLTag;
118	>	property OnNextLine: TOnNextLine read FOnNextLine write FOnNextLine;
119	>	property OnProgressEvent: TOnProgressEvent read FOnProgressEvent write FOnProgressEvent; {Progress Bar Support}
120	>	end;
121	>
122	>	{ TBatchSymbolStream }
123	>
124	>	{This symbol stream supports non-interactive parsing of a text file, stream or
125	>	lines of text.}
126	>
127	>	TBatchSymbolStream = class(TSymbolStream)
128	>	private
129	>	FLines: TStrings;
130	>	FLineIndex: integer;
131	>	protected
132	>	function GetErrorPrefix: string; override;
133	>	function GetNextLine(var Line: string):boolean; override;
134	>	public
135	>	constructor Create;
136	>	destructor Destroy; override;
137	>	procedure SetStreamSource(Lines: TStrings); overload;
138	>	procedure SetStreamSource(S: TStream); overload;
139	>	procedure SetStreamSource(FileName: string); overload;
140	>	end;
141	>
142	>	{ TInteractiveSymbolStream }
143	>
144	>	{This symbol stream supports interactive parsing of commands and
145	>	SQL statements entered at a console}
146	>
147	>	TInteractiveSymbolStream = class(TSymbolStream)
148	>	private
149	>	FPrompt: string;
150	>	FContinuePrompt: string;
151	>	FTerminated: boolean;
152	>	protected
153	>	function GetErrorPrefix: string; override;
154	>	function GetNextLine(var Line: string):boolean; override;
155	>	public
156	>	constructor Create(aPrompt: string='SQL>'; aContinue: string = 'CON>');
157	>	function GetSymbol: TSQLSymbol; override;
158	>	property Terminated: boolean read FTerminated write FTerminated;
159	>	end;
160	>
161	>	TBlobData = record
162	>	BlobIntf: IBlob;
163	>	SubType: cardinal;
164	>	end;
165	>
166	>	TArrayData = record
167	>	ArrayIntf: IArray;
168	>	SQLType: cardinal;
169	>	relationName: string;
170	>	columnName: string;
171	>	dim: cardinal;
172	>	Size: cardinal;
173	>	Scale: integer;
174	>	CharSet: string;
175	>	bounds: TArrayBounds;
176	>	CurrentRow: integer;
177	>	Index: array of integer;
178	>	end;
179	>
180	>	{ TIBXMLProcessor }
181	>
182	>	{This is a simple XML parser that parses the output of a symbol stream as XML
183	>	structured data, recognising tags, attributes and data. The tags are given in
184	>	the table XMLTagDefs. The BlobData and ArrayData properties return blob and
185	>	array data decoded from the XML stream.}
186	>
187	>	TIBXMLProcessor = class
188	>	private
189	>	FDatabase: TIBDatabase;
190	>	FSymbolStream: TSymbolStream;
191	>	FState: TXMLStates;
192	>	FTransaction: TIBTransaction;
193	>	FXMLTagStack: array [1..20] of TXMLTag;
194	>	FXMLTagIndex: integer;
195	>	FAttributeName: string;
196	>	FBlobData: array of TBlobData;
197	>	FCurrentBlob: integer;
198	>	FArrayData: array of TArrayData;
199	>	FCurrentArray: integer;
200	>	FBlobBuffer: PChar;
201	>	procedure EndXMLTag(xmltag: TXMLTag);
202	>	procedure EnterTag;
203	>	function GetArrayData(index: integer): TArrayData;
204	>	function GetArrayDataCount: integer;
205	>	function GetBlobData(index: integer): TBlobData;
206	>	function GetBlobDataCount: integer;
207	>	procedure ProcessTagValue(tagValue: string);
208	>	procedure StartXMLTag(xmltag: TXMLTag);
209	>	procedure ProcessAttributeValue(attrValue: string);
210	>	procedure ProcessBoundsList(boundsList: string);
211	>	public
212	>	constructor Create;
213	>	destructor Destroy; override;
214	>	function AnalyseXML(SymbolStream: TSymbolStream): string;
215	>	procedure NextStatement;
216	>	class function FormatBlob(Field: ISQLData): string;
217	>	class function FormatArray(ar: IArray): string;
218	>	property BlobData[index: integer]: TBlobData read GetBlobData;
219	>	property BlobDataCount: integer read GetBlobDataCount;
220	>	property ArrayData[index: integer]: TArrayData read GetArrayData;
221	>	property ArrayDataCount: integer read GetArrayDataCount;
222	>	property Database: TIBDatabase read FDatabase write FDatabase;
223	>	property Transaction: TIBTransaction read FTransaction write FTransaction;
224	>	end;
225	>
226	>	{ TIBSQLProcessor }
227	>
228	>	{This parses a symbol stream into SQL statements. If embedded XML is found then
229	>	this is processed by the supplied XMLProcessor. The HasBegin property provides
230	>	a simple way to recognised stored procedure DDL, and "Execute As" statements.}
231	>
232	>	TIBSQLProcessor = class
233	>	private
234	>	FSQLText: string;
235	>	FState: TSQLStates;
236	>	FStack: array [0..16] of TSQLStates;
237	>	FStackindex: integer;
238	>	FHasBegin: boolean;
239	>	FInCase: boolean;
240	>	FNested: integer;
241	>	FXMLProcessor: TIBXMLProcessor;
242	>	FSymbolStream: TSymbolStream;
243	>	procedure AddToSQL(const Symbol: string);
244	>	procedure SetState(AState: TSQLStates);
245	>	function PopState: TSQLStates;
246	>	public
247	>	constructor Create(XMLProcessor: TIBXMLProcessor);
248	>	function GetNextStatement(SymbolStream: TSymbolStream; var stmt: string) : boolean;
249	>	property HasBegin: boolean read FHasBegin;
250	>	end;
251
252		TGetParamValue = procedure(Sender: TObject; ParamName: string; var BlobID: TISC_QUAD) of object;
253		TLogEvent = procedure(Sender: TObject; Msg: string) of Object;
48	–	TOnProgressEvent = procedure (Sender: TObject; Reset: boolean; value: integer) of object;
254		TOnSelectSQL = procedure (Sender: TObject; SQLText: string) of object;
255	+	TOnSetStatement = procedure(Sender: TObject; command, aValue, stmt: string; var Done: boolean) of object;
256	+
257	+	{ TCustomIBXScript }
258	+
259	+	{This is the main script processing engine and can be customised by subclassing
260	+	and defining the symbol stream appropriate for use.
261	+
262	+	The RunScript function is used to invoke the processing of a symbol stream. Each
263	+	SQL statement is extracted one by one. If it is recognised as a built in command
264	+	by "ProcessStatement" then it is actioned directly. Otherwise, it is executed
265	+	using the TIBSQL component. Note that SQL validation by this class is only partial
266	+	and is sufficient only to parse the SQL into statements. The Firebird engine does
267	+	the rest when the statement is executed.}
268	+
269	+	TCustomIBXScript = class(TComponent)
270	+	private
271	+	FEcho: boolean;
272	+	FIBXMLProcessor: TIBXMLProcessor;
273	+	FIBSQLProcessor: TIBSQLProcessor;
274	+	FDatabase: TIBDatabase;
275	+	FDataOutputFormatter: TIBCustomDataOutput;
276	+	FIgnoreGrants: boolean;
277	+	FOnErrorLog: TLogEvent;
278	+	FOnSelectSQL: TOnSelectSQL;
279	+	FOnSetStatement: TOnSetStatement;
280	+	FShowAffectedRows: boolean;
281	+	FShowPerformanceStats: boolean;
282	+	FStopOnFirstError: boolean;
283	+	FTransaction: TIBTransaction;
284	+	FInternalTransaction: TIBTransaction;
285	+	FISQL: TIBSQL;
286	+	FGetParamValue: TGetParamValue;
287	+	FOnOutputLog: TLogEvent;
288	+	FAutoDDL: boolean;
289	+	procedure DoCommit;
290	+	procedure DoReconnect;
291	+	procedure ExecSQL(stmt: string);
292	+	function GetOnProgressEvent: TOnProgressEvent;
293	+	function GetTransaction: TIBTransaction;
294	+	procedure SetDatabase(AValue: TIBDatabase);
295	+	procedure SetDataOutputFormatter(AValue: TIBCustomDataOutput);
296	+	procedure SetOnProgressEvent(AValue: TOnProgressEvent);
297	+	procedure SetParamValue(SQLVar: ISQLParam);
298	+	procedure SetShowPerformanceStats(AValue: boolean);
299	+	procedure SetTransaction(AValue: TIBTransaction);
300	+	protected
301	+	FSymbolStream: TSymbolStream;
302	+	procedure Add2Log(const Msg: string; IsError: boolean=true); virtual;
303	+	procedure EchoNextLine(Sender: TObject; Line: string);
304	+	procedure Notification(AComponent: TComponent; Operation: TOperation); override;
305	+	function ProcessStatement(stmt: string): boolean; virtual;
306	+	function ProcessStream: boolean;
307	+	public
308	+	constructor Create(aOwner: TComponent); override;
309	+	destructor Destroy; override;
310	+	procedure DefaultSelectSQLHandler(aSQLText: string);
311	+	published
312	+	property Database: TIBDatabase read FDatabase write SetDatabase;
313	+	property DataOutputFormatter: TIBCustomDataOutput read FDataOutputFormatter
314	+	write SetDataOutputFormatter;
315	+	property AutoDDL: boolean read FAutoDDL write FAutoDDL default true;
316	+	property Echo: boolean read FEcho write FEcho default true;  {Echo Input to Log}
317	+	property IgnoreGrants: boolean read FIgnoreGrants write FIgnoreGrants;
318	+	property Transaction: TIBTransaction read FTransaction write SetTransaction;
319	+	property ShowAffectedRows: boolean read FShowAffectedRows write FShowAffectedRows;
320	+	property ShowPerformanceStats: boolean read FShowPerformanceStats write SetShowPerformanceStats;
321	+	property StopOnFirstError: boolean read FStopOnFirstError write FStopOnFirstError default true;
322	+	property GetParamValue: TGetParamValue read FGetParamValue write FGetParamValue; {resolve parameterized queries}
323	+	property OnOutputLog: TLogEvent read FOnOutputLog write FOnOutputLog; {Log handler}
324	+	property OnErrorLog: TLogEvent read FOnErrorLog write FOnErrorLog;
325	+	property OnProgressEvent: TOnProgressEvent read GetOnProgressEvent write SetOnProgressEvent; {Progress Bar Support}
326	+	property OnSelectSQL: TOnSelectSQL read FOnSelectSQL write FOnSelectSQL; {Handle Select SQL Statements}
327	+	property OnSetStatement: TOnSetStatement read FOnSetStatement write FOnSetStatement;
328	+	end;
329
330		{
331		TIBXScript: runs an SQL script in the specified file or stream. The text is parsed
332		into SQL statements which are executed in turn. The intention is to be ISQL
333		compatible but with extensions:
334
335	<	* SET TERM and Set AutoDDL are both supported
335	>	* All DML and DDL Statements are supported.
336	>
337	>	* CREATE DATABASE, DROP DATABASE, CONNECT and COMMIT are supported.
338	>
339	>	* The following SET statements are supported:
340	>	SET SQL DIALECT
341	>	SET TERM
342	>	SET AUTODDL
343	>	SET BAIL
344	>	SET ECHO
345	>	SET COUNT
346	>	SET STATS
347	>	SET NAMES <character set>
348
349		* New Command: RECONNECT. Performs a commit followed by disconnecting and
350		reconnecting to the database.
#	Line 76 | Line 367 | type
367
368		* Database: Link to TIBDatabase component
369		* Transaction: Link to Transaction. Defaults to internaltransaction (concurrency, wait)
370	+	* AutoDDL: When true DDL statements are automatically committed after execution
371		* Echo: boolean. When true, all SQL statements are echoed to log
372		* StopOnFirstError: boolean. When true the script engine terminates on the first
373		SQL Error.
374		* IgnoreGrants: When true, grant statements are silently discarded. This can be
375		useful when applying a script using the Embedded Server.
376	+	* ShowPerformanceStats: When true, performance statistics (in ISQL format) are
377	+	written to the log after a DML statement is executed
378	+	* DataOutputFormatter: Identifies a Data Output Formatter component used to format
379	+	the results of executing a Select Statement
380
381
382		Events:
#	Line 95 | Line 391 | type
391		value of progress bar. Otherwise called to step progress bar.
392		* OnSelectSQL: handler for select SQL statements. If not present, select SQL
393		statements result in an exception.
394	+	* OnSetStatement: called to process a SET command that has not already been
395	+	handled by TIBXScript.
396
397	<	The PerformUpdate function is used to execute an SQL Script and may be called
397	>	The RunScript function is used to execute an SQL Script and may be called
398		multiple times.
399		}
400
103	–
401		{ TIBXScript }
402
403	<	TIBXScript = class(TComponent)
107	<	private
108	<	FDatabase: TIBDatabase;
109	<	FEcho: boolean;
110	<	FIgnoreGrants: boolean;
111	<	FOnErrorLog: TLogEvent;
112	<	FOnProgressEvent: TOnProgressEvent;
113	<	FOnSelectSQL: TOnSelectSQL;
114	<	FStopOnFirstError: boolean;
115	<	FTransaction: TIBTransaction;
116	<	FInternalTransaction: TIBTransaction;
117	<	FState: TSQLStates;
118	<	FString: string;
119	<	FISQL: TIBSQL;
120	<	FLastSymbol: TSQLSymbol;
121	<	FNested: integer;
122	<	FLastChar: char;
123	<	FSQLText: string;
124	<	FHasBegin: boolean;
125	<	FInCase: boolean;
126	<	FStack: array [0..16] of TSQLStates;
127	<	FStackindex: integer;
128	<	FGetParamValue: TGetParamValue;
129	<	FOnOutputLog: TLogEvent;
130	<	FTerminator: char;
131	<	FAutoDDL: boolean;
132	<	procedure Add2Log(const Msg: string; IsError: boolean=true);
133	<	procedure AddToSQL(const Symbol: string);
134	<	function AnalyseSQL(Lines: TStringList): boolean;
135	<	procedure AnalyseLine(const Line: string);
136	<	procedure DoCommit;
137	<	procedure DoReconnect;
138	<	procedure ExecSQL;
139	<	function GetNextSymbol(C: char): TSQLSymbol;
140	<	function GetSymbol(const Line: string; var index: integer): TSQLSymbol;
141	<	function GetTransaction: TIBTransaction;
142	<	procedure SetDatabase(AValue: TIBDatabase);
143	<	procedure SetParamValue(SQLVar: ISQLParam);
144	<	procedure SetState(AState: TSQLStates);
145	<	procedure ClearStatement;
146	<	function PopState: TSQLStates;
147	<	function ProcessSetStatement(stmt: string): boolean;
403	>	TIBXScript = class(TCustomIBXScript)
404		public
405		constructor Create(aOwner: TComponent); override;
406	<	destructor Destroy; override;
407	<	function PerformUpdate(const SQLFile: string;  AutoDDL: boolean): boolean; overload;
408	<	function PerformUpdate(const SQLStream: TStream;   AutoDDL: boolean): boolean; overload;
409	<	published
410	<	property Database: TIBDatabase read FDatabase write SetDatabase;
411	<	property Echo: boolean read FEcho write FEcho default true;  {Echo Input to Log}
412	<	property IgnoreGrants: boolean read FIgnoreGrants write FIgnoreGrants;
157	<	property Transaction: TIBTransaction read FTransaction write FTransaction;
158	<	property StopOnFirstError: boolean read FStopOnFirstError write FStopOnFirstError default true;
159	<	property GetParamValue: TGetParamValue read FGetParamValue write FGetParamValue; {resolve parameterized queries}
160	<	property OnOutputLog: TLogEvent read FOnOutputLog write FOnOutputLog; {Log handler}
161	<	property OnErrorLog: TLogEvent read FOnErrorLog write FOnErrorLog;
162	<	property OnProgressEvent: TOnProgressEvent read FOnProgressEvent write FOnProgressEvent; {Progress Bar Support}
163	<	property OnSelectSQL: TOnSelectSQL read FOnSelectSQL write FOnSelectSQL; {Handle Select SQL Statements}
406	>	{use RunScript instead of PerformUpdate}
407	>	function PerformUpdate(SQLFile: string; aAutoDDL: boolean): boolean; overload; deprecated;
408	>	function PerformUpdate(SQLStream: TStream;   aAutoDDL: boolean): boolean; overload; deprecated;
409	>	function RunScript(SQLFile: string): boolean; overload;
410	>	function RunScript(SQLStream: TStream): boolean; overload;
411	>	function RunScript(SQLLines: TStrings): boolean; overload;
412	>	function ExecSQLScript(sql: string): boolean;
413		end;
414
415	+	function StringToHex(octetString: string; MaxLineLength: integer=0): string; overload;
416	+	procedure StringToHex(octetString: string; TextOut: TStrings; MaxLineLength: integer=0); overload;
417	+
418	+
419	+	resourcestring
420	+	sInvalidSetStatement = 'Invalid %s Statement - %s';
421	+
422		implementation
423
424		uses Sysutils, RegExpr;
#	Line 173 | Line 429 | resourcestring
429		sUnknownSymbol = 'Unknown Symbol %d';
430		sNoSelectSQL = 'Select SQL Statements are not supported';
431		sStackUnderflow = 'Stack Underflow';
176	–	sInvalidAutoDDL = 'Invalid AUTODDL Statement - %s';
432		sNoParamQueries =  'Parameterised Queries are not supported';
433		sStackOverFlow = 'Stack Overflow';
434		sResolveQueryParam =  'Resolving Query Parameter: %s';
435		sNoCommit =  'Commit not allowed here';
436		sNoReconnect = 'Reconnect not allowed here';
437	+	sXMLStackUnderflow = 'XML Stack Underflow';
438	+	sInvalidEndTag = 'XML End Tag Mismatch - %s';
439	+	sXMLStackOverFlow = 'XML Stack Overflow';
440	+	sErrorState = 'Entered Error State';
441	+	sXMLError = 'Invalid XML (%c)';
442	+	sXMLAttributeError = 'Unexpected attribute - "%s" = "%s"';
443	+	sInvalidBoundsList = 'Invalid array bounds list - "%s"';
444	+	sBinaryBlockMustbeEven = 'Binary block must have an even number of characters';
445	+	sInvalidCharacterSet = 'Unrecognised character set name - "%s"';
446	+	sOnLineError = 'On Line %d Character %d: ';
447	+	sArrayIndexError = 'Array Index Error (%d)';
448	+	sBlobIndexError = 'Blob Index Error (%d)';
449	+	sStatementError = 'Error processing SQL statement: %s %s - for statement "%s"';
450	+
451	+	function StringToHex(octetString: string; MaxLineLength: integer): string; overload;
452	+
453	+	function ToHex(aValue: byte): string;
454	+	const
455	+	HexChars: array [0..15] of char = '0123456789ABCDEF';
456	+	begin
457	+	Result := HexChars[aValue shr 4] +
458	+	HexChars[(aValue and $0F)];
459	+	end;
460	+
461	+	var i, j: integer;
462	+	begin
463	+	i := 1;
464	+	Result := '';
465	+	if MaxLineLength = 0 then
466	+	while i <= Length(octetString) do
467	+	begin
468	+	Result += ToHex(byte(octetString[i]));
469	+	Inc(i);
470	+	end
471	+	else
472	+	while i <= Length(octetString) do
473	+	begin
474	+	for j := 1 to MaxLineLength do
475	+	begin
476	+	if i > Length(octetString) then
477	+	Exit
478	+	else
479	+	Result += ToHex(byte(octetString[i]));
480	+	inc(i);
481	+	end;
482	+	Result += LineEnding;
483	+	end;
484	+	end;
485	+
486	+	procedure StringToHex(octetString: string; TextOut: TStrings; MaxLineLength: integer); overload;
487	+	begin
488	+	TextOut.Add(StringToHex(octetString,MaxLineLength));
489	+	end;
490	+
491	+
492
493		{ TIBXScript }
494
495	<	procedure TIBXScript.Add2Log(const Msg: string; IsError: boolean);
495	>	constructor TIBXScript.Create(aOwner: TComponent);
496	>	begin
497	>	inherited Create(aOwner);
498	>	FSymbolStream := TBatchSymbolStream.Create;
499	>	FSymbolStream.OnNextLine := @EchoNextLine;
500	>	end;
501	>
502	>	function TIBXScript.PerformUpdate(SQLFile: string; aAutoDDL: boolean): boolean;
503	>	begin
504	>	FAutoDDL := aAutoDDL;
505	>	Result := RunScript( SQLFile);
506	>	end;
507	>
508	>	function TIBXScript.PerformUpdate(SQLStream: TStream; aAutoDDL: boolean
509	>	): boolean;
510	>	begin
511	>	FAutoDDL := aAutoDDL;
512	>	Result := RunScript(SQLStream);
513	>	end;
514	>
515	>	function TIBXScript.RunScript(SQLFile: string): boolean;
516	>	begin
517	>	TBatchSymbolStream(FSymbolStream).SetStreamSource(SQLFile);
518	>	Result := ProcessStream;
519	>	end;
520	>
521	>	function TIBXScript.RunScript(SQLStream: TStream): boolean;
522	>	begin
523	>	TBatchSymbolStream(FSymbolStream).SetStreamSource(SQLStream);
524	>	Result := ProcessStream;
525	>	end;
526	>
527	>	function TIBXScript.RunScript(SQLLines: TStrings): boolean;
528	>	begin
529	>	TBatchSymbolStream(FSymbolStream).SetStreamSource(SQLLines);
530	>	Result := ProcessStream;
531	>	end;
532	>
533	>	function TIBXScript.ExecSQLScript(sql: string): boolean;
534	>	var s: TStringList;
535	>	begin
536	>	s := TStringList.Create;
537	>	try
538	>	s.Text := sql;
539	>	TBatchSymbolStream(FSymbolStream).SetStreamSource(s);
540	>	Result := ProcessStream;
541	>	finally
542	>	s.Free;
543	>	end;
544	>	end;
545	>
546	>	{ TCustomIBXScript }
547	>
548	>	procedure TCustomIBXScript.Add2Log(const Msg: string; IsError: boolean);
549		begin
550		if IsError then
551		begin
#	Line 192 | Line 555 | begin
555		if assigned(FOnOutputLog) then FOnOutputLog(self,Msg)
556		end;
557
558	<	procedure TIBXScript.AddToSQL(const Symbol: string);
558	>	procedure TCustomIBXScript.DoCommit;
559	>	begin
560	>	with GetTransaction do
561	>	if InTransaction then Commit;
562	>	GetTransaction.Active := true;
563	>	end;
564	>
565	>	procedure TCustomIBXScript.DoReconnect;
566		begin
567	<	FSQLText := FSQLText +  Symbol
567	>	with GetTransaction do
568	>	if InTransaction then Commit;
569	>	Database.Connected := false;
570	>	Database.Connected := true;
571	>	GetTransaction.Active := true;
572		end;
573
574	<	procedure TIBXScript.AnalyseLine(const Line: string);
575	<	var index: integer;
576	<	Symbol: TSQLSymbol;
574	>	procedure TCustomIBXScript.ExecSQL(stmt: string);
575	>	var DDL: boolean;
576	>	I: integer;
577	>	stats: TPerfCounters;
578	>	begin
579	>	Database.Connected := true;
580	>	FISQL.SQL.Text := stmt;
581	>	FISQL.Transaction := GetTransaction;
582	>	FISQL.Transaction.Active := true;
583	>	FISQL.ParamCheck := not FIBSQLProcessor.HasBegin; {Probably PSQL}
584	>	FISQL.Prepare;
585	>	FISQL.Statement.EnableStatistics(ShowPerformanceStats);
586	>
587	>	if FISQL.SQLStatementType in [SQLInsert, SQLUpdate, SQLDelete] then
588	>	begin
589	>	{Interpret parameters}
590	>	for I := 0 to FISQL.Params.Count - 1 do
591	>	SetParamValue(FISQL.Params[I]);
592	>	end;
593	>
594	>	if FISQL.SQLStatementType = SQLSelect then
595	>	begin
596	>	if assigned(OnSelectSQL) then
597	>	OnSelectSQL(self,stmt)
598	>	else
599	>	DefaultSelectSQLHandler(stmt);
600	>	end
601	>	else
602	>	begin
603	>	DDL := FISQL.SQLStatementType = SQLDDL;
604	>	if not DDL or not FIgnoreGrants or (Pos('GRANT',AnsiUpperCase(Trim(stmt))) <> 1) then
605	>	begin
606	>	FISQL.ExecQuery;
607	>	if ShowAffectedRows and not DDL then
608	>	Add2Log('Rows Affected: ' + IntToStr(FISQL.RowsAffected));
609	>	if not DDL then
610	>	TIBCustomDataOutput.ShowPerfStats(FISQL.Statement,@Add2Log);
611	>	end;
612	>
613	>	if FAutoDDL and DDL then
614	>	FISQL.Transaction.Commit;
615	>	FISQL.Close;
616	>	end;
617	>	FISQL.SQL.Clear;
618	>	end;
619	>
620	>	function TCustomIBXScript.GetOnProgressEvent: TOnProgressEvent;
621	>	begin
622	>	Result := FSymbolStream.OnProgressEvent;
623	>	end;
624	>
625	>	function TCustomIBXScript.GetTransaction: TIBTransaction;
626	>	begin
627	>	if FTransaction = nil then
628	>	Result := FInternalTransaction
629	>	else
630	>	Result := FTransaction;
631	>	end;
632	>
633	>	procedure TCustomIBXScript.EchoNextLine(Sender: TObject; Line: string);
634	>	begin
635	>	if Echo then Add2Log(Line);
636	>	end;
637	>
638	>	procedure TCustomIBXScript.Notification(AComponent: TComponent;
639	>	Operation: TOperation);
640	>	begin
641	>	inherited Notification(AComponent, Operation);
642	>	if (AComponent = FDatabase) and (Operation = opRemove) then
643	>	FDatabase := nil;
644	>	if (AComponent = FTransaction) and (Operation = opRemove) then
645	>	FTransaction := nil;
646	>	if (AComponent = DataOutputFormatter) and (Operation = opRemove) then
647	>	FDataOutputFormatter := nil;
648	>	end;
649	>
650	>	procedure TCustomIBXScript.SetDatabase(AValue: TIBDatabase);
651	>	begin
652	>	if FDatabase = AValue then Exit;
653	>	FDatabase := AValue;
654	>	FISQL.Database := AValue;
655	>	FIBXMLProcessor.Database := AValue;
656	>	FInternalTransaction.DefaultDatabase := AValue;
657	>	end;
658	>
659	>	procedure TCustomIBXScript.SetDataOutputFormatter(AValue: TIBCustomDataOutput);
660	>	begin
661	>	if FDataOutputFormatter = AValue then Exit;
662	>	if (FDataOutputFormatter <> nil) and (AValue <> nil) then
663	>	AValue.Assign(FDataOutputFormatter);
664	>	FDataOutputFormatter := AValue;
665	>	if FDataOutputFormatter <> nil then
666	>	FDataOutputFormatter.Database := Database;
667	>	end;
668	>
669	>	procedure TCustomIBXScript.SetOnProgressEvent(AValue: TOnProgressEvent);
670	>	begin
671	>	FSymbolStream.OnProgressEvent := AValue;
672	>	end;
673	>
674	>	procedure TCustomIBXScript.SetParamValue(SQLVar: ISQLParam);
675	>	var BlobID: TISC_QUAD;
676	>	ix: integer;
677	>	begin
678	>	if (SQLVar.SQLType = SQL_BLOB) and (Pos(ibx_blob,SQLVar.Name) = 1) then
679	>	begin
680	>	ix := StrToInt(system.copy(SQLVar.Name,length(ibx_blob)+1,length(SQLVar.Name)-length(ibx_blob)));
681	>	SQLVar.AsBlob := FIBXMLProcessor.BlobData[ix].BlobIntf;
682	>	Exit;
683	>	end
684	>	else
685	>	if (SQLVar.SQLType = SQL_ARRAY) and (Pos(ibx_array,SQLVar.Name) = 1) then
686	>	begin
687	>	ix := StrToInt(system.copy(SQLVar.Name,length(ibx_array)+1,length(SQLVar.Name)-length(ibx_array)));
688	>	SQLVar.AsArray := FIBXMLProcessor.ArrayData[ix].ArrayIntf;
689	>	Exit;
690	>	end;
691	>
692	>	if assigned(FGetParamValue) and (SQLVar.SQLType = SQL_BLOB) then
693	>	begin
694	>	Add2Log(Format(sResolveQueryParam,[SQLVar.Name]));
695	>	GetParamValue(self,SQLVar.Name,BlobID);
696	>	if (BlobID.gds_quad_high = 0) and (BlobID.gds_quad_low = 0) then
697	>	SQLVar.Clear
698	>	else
699	>	SQLVar.AsQuad := BlobID
700	>	end
701	>	else
702	>	raise Exception.Create(sNoParamQueries);
703	>	end;
704	>
705	>	procedure TCustomIBXScript.SetShowPerformanceStats(AValue: boolean);
706	>	begin
707	>	if FShowPerformanceStats = AValue then Exit;
708	>	FShowPerformanceStats := AValue;
709	>	if assigned(DataOutputFormatter) then
710	>	DataOutputFormatter.ShowPerformanceStats := AValue;
711	>	end;
712	>
713	>	function TCustomIBXScript.ProcessStream: boolean;
714	>	var stmt: string;
715	>	begin
716	>	Result := false;
717	>	while FIBSQLProcessor.GetNextStatement(FSymbolStream,stmt) do
718	>	try
719	>	//    writeln('stmt = ',stmt);
720	>	if trim(stmt) = '' then continue;
721	>	if not ProcessStatement(stmt) then
722	>	ExecSQL(stmt);
723	>
724	>	except on E:Exception do
725	>	begin
726	>	Add2Log(Format(sStatementError,[FSymbolStream.GetErrorPrefix,
727	>	E.Message,stmt]),true);
728	>	if StopOnFirstError then Exit;
729	>	end
730	>	end;
731	>	Result := true;
732	>	end;
733	>
734	>	function TCustomIBXScript.ProcessStatement(stmt: string): boolean;
735	>	var command: string;
736	>	ucStmt: string;
737	>
738	>	function Toggle(aValue: string): boolean;
739	>	begin
740	>	aValue := AnsiUpperCase(aValue);
741	>	if aValue = 'ON' then
742	>	Result := true
743	>	else
744	>	if aValue = 'OFF' then
745	>	Result := false
746	>	else
747	>	raise Exception.CreateFmt(sInvalidSetStatement, [command,stmt]);
748	>	end;
749	>
750	>	procedure ExtractUserInfo;
751	>	var  RegexObj: TRegExpr;
752	>	begin
753	>	RegexObj := TRegExpr.Create;
754	>	try
755	>	RegexObj.ModifierG := false; {turn off greedy matches}
756	>	RegexObj.Expression := ' +USER +''(.+)''';
757	>	if RegexObj.Exec(ucStmt) then
758	>	FDatabase.Params.Values['user_name'] := RegexObj.Match[1];
759	>
760	>	RegexObj.Expression := ' +PASSWORD +''(.+)''';
761	>	if RegexObj.Exec(ucStmt) then
762	>	FDatabase.Params.Values['password'] :=
763	>	system.copy(stmt,RegexObj.MatchPos[1],RegexObj.MatchLen[1]);
764	>	finally
765	>	RegexObj.Free;
766	>	end;
767	>	end;
768	>
769	>	procedure ExtractConnectInfo;
770	>	var  RegexObj: TRegExpr;
771	>	begin
772	>	ExtractUserInfo;
773	>	RegexObj := TRegExpr.Create;
774	>	try
775	>	RegexObj.ModifierG := false; {turn off greedy matches}
776	>	RegexObj.Expression := '^ *CONNECT +''(.*)''';
777	>	if RegexObj.Exec(ucStmt) then
778	>	begin
779	>	FDatabase.DatabaseName := system.copy(stmt,RegexObj.MatchPos[1],RegexObj.MatchLen[1]);
780	>	end;
781	>
782	>	RegexObj.Expression := ' +ROLE +''(.+)''';
783	>	if RegexObj.Exec(ucStmt) then
784	>	FDatabase.Params.Values['sql_role_name'] := RegexObj.Match[1]
785	>	else
786	>	with FDatabase.Params do
787	>	if IndexOfName('sql_role_name') <> -1 then
788	>	Delete(IndexOfName('sql_role_name'));
789	>
790	>	RegexObj.Expression := ' +CACHE +([0-9]+)';
791	>	if RegexObj.Exec(ucStmt) then
792	>	FDatabase.Params.Values['cache_manager'] := RegexObj.Match[1]
793	>	else
794	>	with FDatabase.Params do
795	>	if IndexOfName('cache_manager') <> -1 then
796	>	Delete(IndexOfName('cache_manager'));
797	>	finally
798	>	RegexObj.Free;
799	>	end;
800	>	end;
801	>
802	>	procedure UpdateUserPassword;
803	>	var  RegexObj: TRegExpr;
804	>	begin
805	>	RegexObj := TRegExpr.Create;
806	>	try
807	>	RegexObj.ModifierG := false; {turn off greedy matches}
808	>	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +(''.*'') +USER +''(.+)''';
809	>	if not RegexObj.Exec(ucStmt) and (FDatabase.Params.IndexOfName('user_name') <> -1) then
810	>	begin
811	>	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +(''.*'')';
812	>	if RegexObj.Exec(ucStmt) then
813	>	begin
814	>	system.Insert(' USER ''' + FDatabase.Params.Values['user_name'] +'''',stmt,
815	>	RegexObj.MatchPos[2] + RegexObj.MatchLen[2]);
816	>	ucStmt := AnsiUpperCase(stmt);
817	>	end;
818	>	end;
819	>
820	>	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''.*'' +USER +''.+'' PASSWORD +''(.+)''';
821	>	if not RegexObj.Exec(ucStmt) and (FDatabase.Params.IndexOfName('password') <> -1) then
822	>	begin
823	>	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''.*'' +(USER +''.+'')';
824	>	if RegexObj.Exec(ucStmt) then
825	>	begin
826	>	system.Insert(' PASSWORD ''' + FDatabase.Params.Values['password'] +'''',stmt,
827	>	RegexObj.MatchPos[2] + RegexObj.MatchLen[2]);
828	>	ucStmt := AnsiUpperCase(stmt);
829	>	end;
830	>	end;
831	>	finally
832	>	RegexObj.Free;
833	>	end;
834	>	end;
835	>
836	>	var  RegexObj: TRegExpr;
837	>	n: integer;
838	>	charsetid: integer;
839	>	param: string;
840	>	Terminator: char;
841	>	begin
842	>	Result := false;
843	>	ucStmt := AnsiUpperCase(stmt);
844	>	Terminator := FSymbolStream.Terminator;
845	>	RegexObj := TRegExpr.Create;
846	>	try
847	>	{process create database}
848	>	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +(.*) *(\' + Terminator + '|)';
849	>	if RegexObj.Exec(ucStmt) then
850	>	begin
851	>	UpdateUserPassword;
852	>	FDatabase.Connected := false;
853	>	FDatabase.CreateDatabase(stmt);
854	>	FDatabase.Connected := false;
855	>	ExtractUserInfo;
856	>	DoReconnect;
857	>	Result := true;
858	>	Exit;
859	>	end;
860	>
861	>	{process connect statement}
862	>	RegexObj.Expression := '^ *CONNECT +.*(\' + Terminator + '|)';
863	>	if RegexObj.Exec(ucStmt) then
864	>	begin
865	>	ExtractConnectInfo;
866	>	DoReconnect;
867	>	Result := true;
868	>	Exit;
869	>	end;
870	>
871	>	{Process Drop Database}
872	>	RegexObj.Expression := '^ *DROP +DATABASE *(\' + Terminator + '|)';
873	>	if RegexObj.Exec(ucStmt) then
874	>	begin
875	>	FDatabase.DropDatabase;
876	>	Result := true;
877	>	Exit;
878	>	end;
879	>
880	>	{process commit statement}
881	>	RegexObj.Expression := '^ *COMMIT *(\' + Terminator + '|)';
882	>	if RegexObj.Exec(ucStmt) then
883	>	begin
884	>	DoCommit;
885	>	Result := true;
886	>	Exit;
887	>	end;
888	>
889	>	{process Reconnect statement}
890	>	RegexObj.Expression := '^ *RECONNECT *(\' + Terminator + '|)';
891	>	if RegexObj.Exec(ucStmt) then
892	>	begin
893	>	DoReconnect;
894	>	Result := true;
895	>	Exit;
896	>	end;
897	>
898	>
899	>	{Process Set Term}
900	>	RegexObj.Expression := '^ *SET +TERM +(.) *(\' + Terminator + '|)';
901	>	if RegexObj.Exec(ucStmt) then
902	>	begin
903	>	FSymbolStream.Terminator := RegexObj.Match[1][1];
904	>	Result := true;
905	>	Exit;
906	>	end;
907	>
908	>	{process Set SQL Dialect}
909	>	RegexObj.Expression := '^ *SET +SQL +DIALECT +([0-9]) *(\' + Terminator + '|)';
910	>	if RegexObj.Exec(ucStmt) then
911	>	begin
912	>	n := StrToInt(RegexObj.Match[1]);
913	>	if Database.SQLDialect <> n then
914	>	begin
915	>	Database.SQLDialect := n;
916	>	if Database.Connected then
917	>	DoReconnect;
918	>	end;
919	>	Result := true;
920	>	Exit;
921	>	end;
922	>
923	>	{Process Remaining Set statements}
924	>	RegexObj.Expression := '^ *SET +([A-Z]+)( +[A-Z0-9]+|) *(\' + Terminator + '|)';
925	>	if RegexObj.Exec(ucStmt) then
926	>	begin
927	>	command := AnsiUpperCase(RegexObj.Match[1]);
928	>	param := trim(RegexObj.Match[2]);
929	>	if command = 'AUTODDL' then
930	>	AutoDDL := ((RegexObj.MatchLen[2] = 0) and not AutoDDL) or
931	>	(RegexObj.MatchLen[2] > 0) and Toggle(param)
932	>	else
933	>	if command = 'BAIL' then
934	>	StopOnFirstError := ((RegexObj.MatchLen[2] = 0) and not StopOnFirstError) or
935	>	(RegexObj.MatchLen[2] > 0) and Toggle(param)
936	>	else
937	>	if command = 'ECHO' then
938	>	Echo := ((RegexObj.MatchLen[2] = 0) and not Echo) or
939	>	(RegexObj.MatchLen[2] > 0) and Toggle(param)
940	>	else
941	>	if command = 'COUNT' then
942	>	ShowAffectedRows := ((RegexObj.MatchLen[2] = 0) and not ShowAffectedRows) or
943	>	(RegexObj.MatchLen[2] > 0) and Toggle(param)
944	>	else
945	>	if command = 'STATS' then
946	>	ShowPerformanceStats := ((RegexObj.MatchLen[2] = 0) and not FShowPerformanceStats) or
947	>	(RegexObj.MatchLen[2] > 0) and Toggle(param)
948	>	else
949	>	if command = 'NAMES' then
950	>	begin
951	>	if FirebirdAPI.CharSetName2CharSetID(param,charsetid) then
952	>	begin
953	>	Database.Params.Values['lc_ctype'] := param;
954	>	if Database.Connected then
955	>	DoReconnect;
956	>	end
957	>	else
958	>	raise Exception.CreateFmt(sInvalidCharacterSet, [param,stmt]);
959	>	end
960	>	else
961	>	begin
962	>	if assigned(DataOutputFormatter) then
963	>	DataOutputFormatter.SetCommand(command,param,stmt,Result);
964	>	if not Result and assigned(OnSetStatement) then
965	>	OnSetStatement(self,command,param,stmt,Result)
966	>	else
967	>	raise Exception.CreateFmt(sInvalidSetStatement, [command,stmt]);
968	>	Exit;
969	>	end;
970	>	Result := true;
971	>	Exit;
972	>	end;
973	>
974	>	finally
975	>	RegexObj.Free;
976	>	end;
977	>	end;
978	>
979	>	procedure TCustomIBXScript.SetTransaction(AValue: TIBTransaction);
980	>	begin
981	>	if FTransaction = AValue then Exit;
982	>	FTransaction := AValue;
983	>	FIBXMLProcessor.Transaction := AValue;
984	>	end;
985	>
986	>	constructor TCustomIBXScript.Create(aOwner: TComponent);
987	>	begin
988	>	inherited Create(aOwner);
989	>	FStopOnFirstError := true;
990	>	FEcho := true;
991	>	FAutoDDL := true;
992	>	FISQL := TIBSQL.Create(self);
993	>	FISQL.ParamCheck := true;
994	>	FIBXMLProcessor := TIBXMLProcessor.Create;
995	>	FIBSQLProcessor := TIBSQLProcessor.Create(FIBXMLProcessor);
996	>	FInternalTransaction := TIBTransaction.Create(self);
997	>	FInternalTransaction.Params.Clear;
998	>	FInternalTransaction.Params.Add('concurrency');
999	>	FInternalTransaction.Params.Add('wait');
1000	>	end;
1001	>
1002	>	destructor TCustomIBXScript.Destroy;
1003	>	begin
1004	>	if FIBSQLProcessor <> nil then FIBSQLProcessor.Free;
1005	>	if FIBXMLProcessor <> nil then FIBXMLProcessor.Free;
1006	>	if FSymbolStream <> nil then FSymbolStream.Free;
1007	>	if FISQL <> nil then FISQL.Free;
1008	>	if FInternalTransaction <> nil then FInternalTransaction.Free;
1009	>	inherited Destroy;
1010	>	end;
1011	>
1012	>	procedure TCustomIBXScript.DefaultSelectSQLHandler(aSQLText: string);
1013	>	begin
1014	>	if assigned(DataOutputFormatter) then
1015	>	DataOutputFormatter.DataOut(aSQLText,@Add2Log)
1016	>	else
1017	>	FSymbolStream.ShowError(sNoSelectSQL,[nil]);
1018	>	end;
1019	>
1020	>	{ TIBSQLProcessor }
1021	>
1022	>	procedure TIBSQLProcessor.AddToSQL(const Symbol: string);
1023	>	begin
1024	>	FSQLText := FSQLText +  Symbol;
1025	>	//  writeln('SQL = ',FSQLText);
1026	>	end;
1027	>
1028	>	procedure TIBSQLProcessor.SetState(AState: TSQLStates);
1029	>	begin
1030	>	if FStackIndex > 16 then
1031	>	FSymbolStream.ShowError(sStackOverFlow,[nil]);
1032	>	FStack[FStackIndex] := FState;
1033	>	Inc(FStackIndex);
1034	>	FState := AState
1035	>	end;
1036	>
1037	>	function TIBSQLProcessor.PopState: TSQLStates;
1038	>	begin
1039	>	if FStackIndex = 0 then
1040	>	FSymbolStream.ShowError(sStackUnderflow,[nil]);
1041	>	Dec(FStackIndex);
1042	>	Result := FStack[FStackIndex]
1043	>	end;
1044	>
1045	>	constructor TIBSQLProcessor.Create(XMLProcessor: TIBXMLProcessor);
1046	>	begin
1047	>	inherited Create;
1048	>	FXMLProcessor := XMLProcessor;
1049	>	end;
1050	>
1051	>	function TIBSQLProcessor.GetNextStatement(SymbolStream: TSymbolStream;
1052	>	var stmt: string): boolean;
1053	>	var Symbol: TSQLSymbol;
1054		NonSpace: boolean;
1055	+	Done: boolean;
1056		begin
1057	<	index := 1;
1057	>	FSQLText := '';
1058	>	FState := stInit;
1059	>	FHasBegin := false;
1060	>	FSymbolStream := SymbolStream;
1061	>	FXMLProcessor.NextStatement;
1062	>	SymbolStream.NextStatement;
1063	>
1064	>	Result := true;
1065	>	Done := false;
1066		NonSpace := false;
1067	<	while true do
1067	>	while not Done do
1068	>	with SymbolStream do
1069		begin
1070		if FState = stError then
1071	<	raise Exception.Create('Entered Error State');
1072	<	Symbol := GetSymbol(Line,index);
1073	<	if not (Symbol in [sqSpace,sqEOL]) then
1071	>	ShowError(sErrorState,[nil]);
1072	>	Symbol := GetSymbol;
1073	>	//    writeln('Symbol = ',Symbol,' Value = ',SymbolValue);
1074	>	if not (Symbol in [' ',sqEOL]) then
1075		NonSpace := true;
1076	+
1077		case Symbol of
1078	<	sqSpace:
1079	<	if not (FState in [stInComment,stInCommentLine]) then
1080	<	AddToSQL(' ');
1078	>	sqTag:
1079	>	begin
1080	>	if FState in [stInSQL,stNested] then
1081	>	AddToSQL(FXMLProcessor.AnalyseXML(SymbolStream));
1082	>	end;
1083
1084		sqTerminator:
220	–	if not (FState in [stInComment,stInCommentLine]) then
1085		case FState of
1086		stInit: {ignore empty statement};
1087
1088		stInSQL:
1089	<	ExecSQL;
1089	>	Done := true;
1090
1091	<	stInCommit:
1092	<	DoCommit;
229	<
230	<	stInReconnect:
231	<	DoReconnect;
232	<
233	<	stNested, stInSingleQuotes, stInDoubleQuotes:
234	<	AddToSQL(FTerminator);
1091	>	stNested:
1092	>	AddToSQL(Terminator);
1093
1094		stInDeclaration:
1095		begin
1096		FState := PopState;
1097	<	AddToSQL(FTerminator);
1097	>	AddToSQL(Terminator);
1098		end;
1099
1100		else
1101	<	raise Exception.CreateFmt(sTerminatorUnknownState,[FState]);
1101	>	ShowError(sTerminatorUnknownState,[FState]);
1102		end;
1103
1104	<	sqSemiColon:
1104	>	';':
1105		begin
1106		if FState = stInDeclaration then
1107		FState := PopState;
1108		AddToSQL(';');
1109		end;
1110
1111	<	sqAsterisk:
254	<	if not (FState in [stInComment,stInCommentLine]) then
1111	>	'*':
1112		begin
1113		AddToSQL('*');
1114		if FState =  stInit then
1115		FState := stInSQL
1116		end;
1117
1118	<	sqForwardSlash:
262	<	if not (FState in [stInComment,stInCommentLine]) then
1118	>	'/':
1119		begin
1120		AddToSQL('/');
1121		if FState =  stInit then
1122		FState := stInSQL
1123		end;
1124
1125	<	sqCommentStart:
1126	<	if not (FState in [stInComment,stInCommentLine]) then
1127	<	SetState(stInComment);
1128	<
1129	<	sqCommentEnd:
274	<	if FState = stInComment then
275	<	begin
276	<	AddToSQL('/* ' + Trim(FString) + ' */');
277	<	FState := PopState
278	<	end
279	<	else
280	<	FState := stError;
1125	>	sqComment,
1126	>	sqQuotedString,
1127	>	sqDoubleQuotedString:
1128	>	if FState <> stInit then
1129	>	AddToSQL(SymbolValue);
1130
1131		sqCommentLine:
1132	<	if not (FState in [stInComment,stInCommentLine]) then
1133	<	SetState(stInCommentLine);
285	<
286	<	sqSingleQuotes:
287	<	if not (FState in [stInComment,stInCommentLine]) then
288	<	begin
289	<	case FState of
290	<	stInSingleQuotes:
291	<	FState := PopState;
292	<	stInDoubleQuotes:
293	<	{Ignore};
294	<	else
295	<	SetState(stInSingleQuotes)
296	<	end;
297	<	AddToSQL('''')
298	<	end;
299	<
300	<	sqDoubleQuotes:
301	<	if not (FState in [stInComment,stInCommentLine]) then
302	<	begin
303	<	case FState of
304	<	stInSingleQuotes:
305	<	{Ignore};
306	<	stInDoubleQuotes:
307	<	FState := PopState;
308	<	else
309	<	SetState(stInDoubleQuotes)
310	<	end;
311	<	AddToSQL('"')
312	<	end;
1132	>	if FState <> stInit then
1133	>	AddToSQL(SymbolValue + LineEnding);
1134
1135		sqEnd:
315	–	if not (FState in [stInComment,stInCommentLine]) then
1136		begin
1137	<	AddToSQL(FString);
1137	>	AddToSQL(SymbolValue);
1138		case FState of
319	–	stInSingleQuotes,
320	–	stInDoubleQuotes:
321	–	{Ignore};
1139		stNested:
1140		begin
1141		if FNested = 0 then
#	Line 327 | Line 1144 | begin
1144		if not FInCase then
1145		begin
1146		FState := stInit;
1147	<	ExecSQL
1147	>	Done := true;
1148		end
1149		else
1150		FInCase := false;
#	Line 340 | Line 1157 | begin
1157		end;
1158
1159		sqBegin:
343	–	if not (FState in [stInComment,stInCommentLine]) then
1160		begin
1161		FHasBegin := true;
1162	<	AddToSQL(FString);
1162	>	AddToSQL(SymbolValue);
1163		case FState of
348	–	stInSingleQuotes,
349	–	stInDoubleQuotes:
350	–	{Ignore};
1164		stNested:
1165		Inc(FNested);
1166
#	Line 358 | Line 1171 | begin
1171		end;
1172
1173		sqCase:
361	–	if not (FState in [stInComment,stInCommentLine]) then
1174		begin
1175	<	AddToSQL(FString);
1175	>	AddToSQL(SymbolValue);
1176		case FState of
365	–	stInSingleQuotes,
366	–	stInDoubleQuotes:
367	–	{Ignore};
1177		stNested:
1178		Inc(FNested);
1179
#	Line 378 | Line 1187 | begin
1187		end;
1188
1189		sqDeclare:
381	–	if not (FState in [stInComment,stInCommentLine]) then
1190		begin
1191	<	AddToSQL(FString);
1191	>	AddToSQL(SymbolValue);
1192		if FState in [stInit,stInSQL] then
1193		SetState(stInDeclaration)
1194		end;
1195
388	–	sqCommit:
389	–	if not (FState in [stInComment,stInCommentLine]) then
390	–	begin
391	–	if FState = stInit then
392	–	FState := stInCommit
393	–	else
394	–	AddToSQL(FString);
395	–	end;
396	–
397	–	sqReconnect:
398	–	if not (FState in [stInComment,stInCommentLine]) then
399	–	begin
400	–	if FState = stInit then
401	–	FState := stInReconnect
402	–	else
403	–	raise Exception.Create(sNoReconnect)
404	–	end;
405	–
1196		sqString:
407	–	if not (FState in [stInComment,stInCommentLine]) then
1197		begin
1198	<	AddToSQL(FString);
1198	>	AddToSQL(SymbolValue);
1199		if FState = stInit then
1200		FState := stInSQL
1201		end;
#	Line 414 | Line 1203 | begin
1203		sqEOL:
1204		begin
1205		case FState of
1206	<	stInCommentLine:
1207	<	begin
1208	<	AddToSQL('/* ' + Trim(FString) + ' */');
1209	<	FState := PopState;
421	<	end;
422	<	stInDoubleQuotes,
423	<	stInSingleQuotes:
424	<	raise Exception.Create(sUnterminatedString);
1206	>	stInit:
1207	>	{Do nothing};
1208	>	else
1209	>	if NonSpace then AddToSQL(LineEnding);
1210		end;
426	–	if NonSpace then AddToSQL(#13#10);
427	–	Exit;
1211		end;
1212	+
1213	+	sqEOF:
1214	+	begin
1215	+	Done := true;
1216	+	Result := trim(FSQLText) <> '';
1217	+	end
1218		else
1219	<	raise Exception.CreateFmt(sUnknownSymbol,[Symbol]);
1219	>	if FState <> stInit then
1220	>	AddToSQL(Symbol);
1221		end
1222	<	end
1222	>	end;
1223	>	stmt := FSQLText;
1224	>	//  writeln('stmt = ',stmt);
1225		end;
1226
1227	<	function TIBXScript.AnalyseSQL(Lines: TStringList): boolean;
1228	<	var I: integer;
1227	>	{ TIBXMLProcessor }
1228	>
1229	>	procedure TIBXMLProcessor.EndXMLTag(xmltag: TXMLTag);
1230		begin
1231	<	Result := true;
1232	<	ClearStatement;
1233	<	FLastSymbol := sqNone;
1234	<	for I := 0 to Lines.Count - 1 do
1235	<	begin
1236	<	if Echo then Add2Log(Lines[I],false);
1237	<	if assigned(OnProgressEvent) then
1238	<	OnProgressEvent(self,false,1);
1239	<	try
1240	<	AnalyseLine(Lines[I]);
1241	<	except on E:Exception do
1242	<	begin
1243	<	Add2Log(E.Message);
1244	<	Result := false;
452	<	if StopOnFirstError then Exit;
453	<	ClearStatement;
454	<	FLastSymbol := sqNone;
455	<	end
456	<	end;
1231	>	if FXMLTagIndex = 0 then
1232	>	FSymbolStream.ShowError(sXMLStackUnderflow,[nil]);
1233	>	if xmltag <> FXMLTagStack[FXMLTagIndex] then
1234	>	FSymbolStream.ShowError(sInvalidEndTag,[FSymbolStream.SymbolValue]);
1235	>
1236	>	case FXMLTagStack[FXMLTagIndex] of
1237	>	xtBlob:
1238	>	FBlobData[FCurrentBlob].BlobIntf.Close;
1239	>
1240	>	xtArray:
1241	>	FArrayData[FCurrentArray].ArrayIntf.SaveChanges;
1242	>
1243	>	xtElt:
1244	>	Dec(FArrayData[FCurrentArray].CurrentRow);
1245		end;
1246	<	if FState <> stInit then
459	<	AnalyseLine(';');
460	<	Result := (FStackIndex = 0) and (FState = stInit)
1246	>	Dec(FXMLTagIndex);
1247		end;
1248
1249	<	constructor TIBXScript.Create(aOwner: TComponent);
1249	>	procedure TIBXMLProcessor.EnterTag;
1250	>	var aCharSetID: integer;
1251		begin
1252	<	inherited;
1253	<	FStopOnFirstError := true;
1254	<	FEcho := true;
1255	<	FState := stInit;
1256	<	FISQL := TIBSQL.Create(self);
1257	<	FISQL.ParamCheck := true;
1258	<	FInternalTransaction := TIBTransaction.Create(self);
1259	<	FInternalTransaction.Params.Clear;
1260	<	FInternalTransaction.Params.Add('concurrency');
1261	<	FInternalTransaction.Params.Add('wait');
1262	<	ClearStatement;
1252	>	case FXMLTagStack[FXMLTagIndex] of
1253	>	xtBlob:
1254	>	begin
1255	>	Database.Connected := true;
1256	>	Transaction.Active := true;
1257	>	FBlobData[FCurrentBlob].BlobIntf := Database.Attachment.CreateBlob(
1258	>	Transaction.TransactionIntf,FBlobData[FCurrentBlob].SubType);
1259	>	end;
1260	>
1261	>	xtArray:
1262	>	with FArrayData[FCurrentArray] do
1263	>	begin
1264	>	Database.Connected := true;
1265	>	Transaction.Active := true;
1266	>	FirebirdAPI.CharSetName2CharSetID(CharSet,aCharSetID);
1267	>	SetLength(Index,dim);
1268	>	ArrayIntf := Database.Attachment.CreateArray(
1269	>	Transaction.TransactionIntf,
1270	>	Database.Attachment.CreateArrayMetaData(SQLType,
1271	>	relationName,columnName,Scale,Size,
1272	>	aCharSetID,dim,bounds)
1273	>	);
1274	>	end;
1275	>	end;
1276		end;
1277
1278	<	destructor TIBXScript.Destroy;
1278	>	function TIBXMLProcessor.GetArrayData(index: integer): TArrayData;
1279		begin
1280	<	if FISQL <> nil then FISQL.Free;
1281	<	if FInternalTransaction <> nil then FInternalTransaction.Free;
1282	<	inherited;
1280	>	if (index < 0) or (index > ArrayDataCount) then
1281	>	FSymbolStream.ShowError(sArrayIndexError,[index]);
1282	>	Result := FArrayData[index];
1283		end;
1284
1285	<	procedure TIBXScript.DoCommit;
1285	>	function TIBXMLProcessor.GetArrayDataCount: integer;
1286		begin
1287	<	with GetTransaction do
488	<	if InTransaction then Commit;
489	<	if not GetTransaction.InTransaction then
490	<	GetTransaction.StartTransaction;
491	<	ClearStatement;
1287	>	Result := Length(FArrayData);
1288		end;
1289
1290	<	procedure TIBXScript.DoReconnect;
1290	>	function TIBXMLProcessor.GetBlobData(index: integer): TBlobData;
1291		begin
1292	<	with GetTransaction do
1293	<	if InTransaction then Commit;
1294	<	Database.Connected := false;
499	<	Database.Connected := true;
500	<	if not GetTransaction.InTransaction then
501	<	GetTransaction.StartTransaction;
502	<	ClearStatement;
1292	>	if (index < 0) or (index > BlobDataCount) then
1293	>	FSymbolStream.ShowError(sBlobIndexError,[index]);
1294	>	Result := FBlobData[index];
1295		end;
1296
1297	<	procedure TIBXScript.ExecSQL;
506	<	var DDL: boolean;
507	<	I: integer;
1297	>	function TIBXMLProcessor.GetBlobDataCount: integer;
1298		begin
1299	<	if FSQLText <> '' then
1300	<	begin
511	<	if ProcessSetStatement(FSQLText) then {Handle Set Statement}
512	<	begin
513	<	ClearStatement;
514	<	Exit;
515	<	end;
1299	>	Result := Length(FBlobData);
1300	>	end;
1301
1302	<	FISQL.SQL.Text := FSQLText;
518	<	FISQL.Transaction := GetTransaction;
519	<	with FISQL.Transaction do
520	<	if not InTransaction then StartTransaction;
521	<	FISQL.ParamCheck := not FHasBegin; {Probably PSQL}
522	<	FISQL.Prepare;
523	<	if FISQL.SQLStatementType in [SQLInsert, SQLUpdate, SQLDelete] then
524	<	begin
525	<	{Interpret parameters}
526	<	for I := 0 to FISQL.Params.Count - 1 do
527	<	SetParamValue(FISQL.Params[I]);
528	<	end;
1302	>	procedure TIBXMLProcessor.ProcessTagValue(tagValue: string);
1303
1304	<	if FISQL.SQLStatementType = SQLSelect then
1305	<	begin
1306	<	if assigned(OnSelectSQL) then
1307	<	OnSelectSQL(self,FSQLText)
1308	<	else
1309	<	raise Exception.Create(sNoSelectSQL);
1310	<	end
1311	<	else
1312	<	begin
1313	<	DDL := FISQL.SQLStatementType = SQLDDL;
1314	<	if not DDL or not FIgnoreGrants or (Pos('GRANT',AnsiUpperCase(Trim(FSQLText))) <> 1) then
1315	<	FISQL.ExecQuery;
1316	<	if FAutoDDL and DDL then
1317	<	FISQL.Transaction.Commit;
1318	<	FISQL.Close;
1319	<	end;
1320	<	FISQL.SQL.Clear;
1321	<	ClearStatement;
1322	<	end
1304	>	function nibble(hex: char): byte;
1305	>	begin
1306	>	case hex of
1307	>	'0': Result := 0;
1308	>	'1': Result := 1;
1309	>	'2': Result := 2;
1310	>	'3': Result := 3;
1311	>	'4': Result := 4;
1312	>	'5': Result := 5;
1313	>	'6': Result := 6;
1314	>	'7': Result := 7;
1315	>	'8': Result := 8;
1316	>	'9': Result := 9;
1317	>	'a','A': Result := 10;
1318	>	'b','B': Result := 11;
1319	>	'c','C': Result := 12;
1320	>	'd','D': Result := 13;
1321	>	'e','E': Result := 14;
1322	>	'f','F': Result := 15;
1323	>	end;
1324	>	end;
1325	>
1326	>	procedure RemoveWhiteSpace(var hexData: string);
1327	>	var i: integer;
1328	>	begin
1329	>	{Remove White Space}
1330	>	i := 1;
1331	>	while i <= length(hexData) do
1332	>	begin
1333	>	case hexData[i] of
1334	>	' ',#9,#10,#13:
1335	>	begin
1336	>	if i < Length(hexData) then
1337	>	Move(hexData[i+1],hexData[i],Length(hexData)-i);
1338	>	SetLength(hexData,Length(hexData)-1);
1339	>	end;
1340	>	else
1341	>	Inc(i);
1342	>	end;
1343	>	end;
1344	>	end;
1345	>
1346	>	procedure WriteToBlob(hexData: string);
1347	>	var i,j : integer;
1348	>	blength: integer;
1349	>	P: PChar;
1350	>	begin
1351	>	RemoveWhiteSpace(hexData);
1352	>	if odd(length(hexData)) then
1353	>	FSymbolStream.ShowError(sBinaryBlockMustbeEven,[nil]);
1354	>	blength := Length(hexData) div 2;
1355	>	IBAlloc(FBlobBuffer,0,blength);
1356	>	j := 1;
1357	>	P := FBlobBuffer;
1358	>	for i := 1 to blength do
1359	>	begin
1360	>	P^ := char((nibble(hexData[j]) shl 4) or nibble(hexdata[j+1]));
1361	>	Inc(j,2);
1362	>	Inc(P);
1363	>	end;
1364	>	FBlobData[FCurrentBlob].BlobIntf.Write(FBlobBuffer^,blength);
1365	>	end;
1366	>
1367	>	begin
1368	>	if tagValue = '' then Exit;
1369	>	case FXMLTagStack[FXMLTagIndex] of
1370	>	xtBlob:
1371	>	WriteToBlob(tagValue);
1372	>
1373	>	xtElt:
1374	>	with FArrayData[FCurrentArray] do
1375	>	ArrayIntf.SetAsString(index,tagValue);
1376	>
1377	>	end;
1378		end;
1379
1380	+	procedure TIBXMLProcessor.StartXMLTag(xmltag: TXMLTag);
1381	+	begin
1382	+	if FXMLTagIndex > 19 then
1383	+	FSymbolStream.ShowError(sXMLStackOverFlow,[nil]);
1384	+	Inc(FXMLTagIndex);
1385	+	FXMLTagStack[FXMLTagIndex] := xmltag;
1386	+	case xmltag of
1387	+	xtBlob:
1388	+	begin
1389	+	Inc(FCurrentBlob);
1390	+	SetLength(FBlobData,FCurrentBlob+1);
1391	+	FBlobData[FCurrentBlob].BlobIntf := nil;
1392	+	FBlobData[FCurrentBlob].SubType := 0;
1393	+	end;
1394
1395	+	xtArray:
1396	+	begin
1397	+	Inc(FCurrentArray);
1398	+	SetLength(FArrayData,FCurrentArray+1);
1399	+	with FArrayData[FCurrentArray] do
1400	+	begin
1401	+	ArrayIntf := nil;
1402	+	SQLType := 0;
1403	+	dim := 0;
1404	+	Size := 0;
1405	+	Scale := 0;
1406	+	CharSet := 'NONE';
1407	+	SetLength(Index,0);
1408	+	CurrentRow := -1;
1409	+	end;
1410	+	end;
1411	+
1412	+	xtElt:
1413	+	with FArrayData[FCurrentArray] do
1414	+	Inc(CurrentRow);
1415	+
1416	+	end;
1417	+	end;
1418
1419	<	function TIBXScript.GetNextSymbol(C: char): TSQLSymbol;
1419	>	procedure TIBXMLProcessor.ProcessAttributeValue(attrValue: string);
1420		begin
1421	<	if C = FTerminator then
1422	<	Result := sqTerminator
1421	>	case FXMLTagStack[FXMLTagIndex] of
1422	>	xtBlob:
1423	>	if FAttributeName = 'subtype' then
1424	>	FBlobData[FCurrentBlob].SubType := StrToInt(attrValue)
1425		else
1426	<	case C of
1427	<	' ',#9:
1428	<	Result := sqSpace;
1429	<	';':
1430	<	Result := sqSemiColon;
1431	<	'"':
1432	<	Result := sqDoubleQuotes;
1433	<	'''':
1434	<	Result := sqSingleQuotes;
1435	<	'/':
1436	<	Result := sqForwardSlash;
1437	<	'*':
1438	<	Result := sqAsterisk;
1426	>	FSymbolStream.ShowError(sXMLAttributeError,[FAttributeName,attrValue]);
1427	>
1428	>	xtArray:
1429	>	if FAttributeName = 'sqltype' then
1430	>	FArrayData[FCurrentArray].SQLType := StrToInt(attrValue)
1431	>	else
1432	>	if FAttributeName = 'relation_name' then
1433	>	FArrayData[FCurrentArray].relationName := attrValue
1434	>	else
1435	>	if FAttributeName = 'column_name' then
1436	>	FArrayData[FCurrentArray].columnName := attrValue
1437	>	else
1438	>	if FAttributeName = 'dim' then
1439	>	FArrayData[FCurrentArray].Dim := StrToInt(attrValue)
1440		else
1441	+	if FAttributeName = 'length' then
1442	+	FArrayData[FCurrentArray].Size := StrToInt(attrValue)
1443	+	else
1444	+	if FAttributeName = 'scale' then
1445	+	FArrayData[FCurrentArray].Scale := StrToInt(attrValue)
1446	+	else
1447	+	if FAttributeName = 'charset' then
1448	+	FArrayData[FCurrentArray].CharSet := attrValue
1449	+	else
1450	+	if FAttributeName = 'bounds' then
1451	+	ProcessBoundsList(attrValue)
1452	+	else
1453	+	FSymbolStream.ShowError(sXMLAttributeError,[FAttributeName,attrValue]);
1454	+
1455	+	xtElt:
1456	+	if FAttributeName = 'ix' then
1457	+	with FArrayData[FCurrentArray] do
1458	+	Index[CurrentRow] :=  StrToInt(attrValue)
1459	+	else
1460	+	FSymbolStream.ShowError(sXMLAttributeError,[FAttributeName,attrValue]);
1461	+	end;
1462	+	end;
1463	+
1464	+	procedure TIBXMLProcessor.ProcessBoundsList(boundsList: string);
1465	+	var list: TStringList;
1466	+	i,j: integer;
1467	+	begin
1468	+	list := TStringList.Create;
1469	+	try
1470	+	list.Delimiter := ',';
1471	+	list.DelimitedText := boundsList;
1472	+	with FArrayData[FCurrentArray] do
1473	+	begin
1474	+	if dim <> list.Count then
1475	+	FSymbolStream.ShowError(sInvalidBoundsList,[boundsList]);
1476	+	SetLength(bounds,dim);
1477	+	for i := 0 to list.Count - 1 do
1478		begin
1479	<	Result := sqString;
1480	<	FLastChar := C
1481	<	end
1479	>	j := Pos(':',list[i]);
1480	>	if j = 0 then
1481	>	raise Exception.CreateFmt(sInvalidBoundsList,[boundsList]);
1482	>	bounds[i].LowerBound := StrToInt(system.copy(list[i],1,j-1));
1483	>	bounds[i].UpperBound := StrToInt(system.copy(list[i],j+1,length(list[i])-j));
1484	>	end;
1485		end;
1486	+	finally
1487	+	list.Free;
1488	+	end;
1489		end;
1490
1491	<	function TIBXScript.GetSymbol(const Line: string; var index: integer): TSQLSymbol;
1491	>	constructor TIBXMLProcessor.Create;
1492		begin
1493	<	Result := sqNone;
1494	<	if FLastSymbol <> sqNone then
1495	<	begin
1496	<	Result := FLastSymbol;
1497	<	if Result = sqString then
1498	<	FString := FLastChar;
1499	<	FLastSymbol := sqNone
1500	<	end;
1493	>	inherited Create;
1494	>	NextStatement;
1495	>	end;
1496	>
1497	>	destructor TIBXMLProcessor.Destroy;
1498	>	begin
1499	>	FreeMem(FBlobBuffer);
1500	>	inherited Destroy;
1501	>	end;
1502
1503	<	while (index <= Length(Line)) and (FLastSymbol = sqNone) do
1503	>	function TIBXMLProcessor.AnalyseXML(SymbolStream: TSymbolStream): string;
1504	>	var Symbol: TSQLSymbol;
1505	>	Done: boolean;
1506	>	XMLString: string;
1507	>	begin
1508	>	Result := '';
1509	>	XMLString := '';
1510	>	Done := false;
1511	>	FState := stInTag;
1512	>	FSymbolStream := SymbolStream;
1513	>	with SymbolStream do
1514		begin
1515	<	FLastSymbol := GetNextSymbol(Line[index]);
1516	<	{combine if possible}
1517	<	case Result of
1518	<	sqNone:
1519	<	begin
1520	<	Result := FLastSymbol;
1521	<	if FLastSymbol = sqString then
1522	<	FString := FLastChar;
1523	<	FLastSymbol := sqNone
1515	>	StartXMLTag(XMLTag);
1516	>	while not Done do
1517	>	with SymbolStream do
1518	>	begin
1519	>	Symbol := GetSymbol;
1520	>
1521	>	case Symbol of
1522	>	sqEOL:
1523	>	case FState of
1524	>	stQuotedAttributeValue,
1525	>	stTagged:
1526	>	XMLString += LineEnding;
1527		end;
1528
1529	<	sqForwardSlash:
1530	<	if FLastSymbol = sqAsterisk then
1531	<	begin
1532	<	Result := sqCommentStart;
1533	<	FLastSymbol := sqNone
1534	<	end
1529	>	' ',sqTab:
1530	>	case FState of
1531	>	stQuotedAttributeValue,
1532	>	stTagged:
1533	>	XMLString += ' ';
1534	>	end;
1535	>
1536	>	';':
1537	>	case FState of
1538	>	stQuotedAttributeValue,
1539	>	stTagged:
1540	>	XMLString += ';';
1541	>	else
1542	>	ShowError(sXMLError,[Symbol]);
1543	>	end;
1544	>
1545	>	'''':
1546	>	case FState of
1547	>	stQuotedAttributeValue,
1548	>	stTagged:
1549	>	XMLString += '''';
1550	>	else
1551	>	ShowError(sXMLError,[Symbol]);
1552	>	end;
1553	>
1554	>	'*':
1555	>	case FState of
1556	>	stQuotedAttributeValue,
1557	>	stTagged:
1558	>	XMLString += '*';
1559	>	else
1560	>	ShowError(sXMLError,[Symbol]);
1561	>	end;
1562	>
1563	>	'/':
1564	>	case FState of
1565	>	stQuotedAttributeValue,
1566	>	stTagged:
1567	>	XMLString += '/';
1568	>	else
1569	>	ShowError(sXMLError,[Symbol]);
1570	>	end;
1571	>
1572	>	'>':
1573	>	case FState of
1574	>	stEndTag:
1575	>	case XMLTag of
1576	>	xtBlob:
1577	>	begin
1578	>	Result := ':' + Format(ibx_blob+'%d',[FCurrentBlob]);
1579	>	Done := true;
1580	>	end;
1581	>	xtArray:
1582	>	begin
1583	>	Result := ':' + Format(ibx_array+'%d',[FCurrentArray]);
1584	>	Done := true;
1585	>	end;
1586	>	else
1587	>	FState := stTagged;
1588	>	end;
1589	>
1590	>	stInTag:
1591	>	begin
1592	>	XMLString := '';
1593	>	FState := stTagged;
1594	>	EnterTag;
1595	>	end;
1596	>
1597	>	stQuotedAttributeValue,
1598	>	stTagged:
1599	>	XMLString += '>';
1600	>
1601	>	else
1602	>	ShowError(sXMLError,[Symbol]);
1603	>	end;
1604	>
1605	>	sqTag:
1606	>	if FState = stTagged then
1607	>	begin
1608	>	FState := stInTag;
1609	>	StartXMLTag(XMLTag)
1610	>	end
1611	>	else
1612	>	ShowError(sXMLError,[Symbol]);
1613	>
1614	>	sqEndTag:
1615	>	if FState = stTagged then
1616	>	begin
1617	>	ProcessTagValue(XMLString);
1618	>	EndXMLTag(XMLTag);
1619	>	FState := stEndTag;
1620	>	end
1621	>	else
1622	>	ShowError(sXMLError,[Symbol]);
1623	>
1624	>	'=':
1625	>	case FState of
1626	>	stAttribute:
1627	>	FState := stAttributeValue;
1628	>
1629	>	stQuotedAttributeValue,
1630	>	stTagged:
1631	>	XMLString += '=';
1632	>
1633	>	else
1634	>	ShowError(sXMLError,[Symbol]);
1635	>	end;
1636	>
1637	>	'"':
1638	>	case FState of
1639	>	stAttributeValue:
1640	>	begin
1641	>	XMLString := '';
1642	>	FState := stQuotedAttributeValue;
1643	>	end;
1644	>
1645	>	stQuotedAttributeValue:
1646	>	begin
1647	>	ProcessAttributeValue(XMLString);
1648	>	FState := stInTag;
1649	>	end;
1650	>
1651	>	stTagged:
1652	>	XMLString += '"';
1653	>
1654	>	else
1655	>	ShowError(sXMLError,[Symbol]);
1656	>	end;
1657	>
1658	>	sqString:
1659	>	case FState of
1660	>	stInTag: {attribute name}
1661	>	begin
1662	>	FAttributeName := SymbolValue;
1663	>	FState := stAttribute;
1664	>	end;
1665	>
1666	>	stAttributeValue:
1667	>	begin
1668	>	ProcessAttributeValue(FString);
1669	>	FState := stInTag;
1670	>	end;
1671	>
1672	>	stQuotedAttributeValue,
1673	>	stTagged:
1674	>	XMLString += SymbolValue;
1675	>
1676	>	else
1677	>	ShowError(sXMLError,[Symbol]);
1678	>	end;
1679		else
1680	<	if FLastSymbol = sqForwardSlash then
1681	<	begin
1682	<	Result := sqCommentLine;
1683	<	FLastSymbol := sqNone
1684	<	end;
1680	>	ShowError(sXMLError,[Symbol]);
1681	>	end
1682	>	end;
1683	>	end;
1684	>	end;
1685
1686	<	sqAsterisk:
1687	<	if FLastSymbol = sqForwardSlash then
1688	<	begin
1689	<	Result := sqCommentEnd;
1690	<	FLastSymbol := sqNone
1691	<	end;
1686	>	procedure TIBXMLProcessor.NextStatement;
1687	>	begin
1688	>	FXMLTagIndex := 0;
1689	>	SetLength(FBlobData,0);
1690	>	FCurrentBlob := -1;
1691	>	SetLength(FArrayData,0);
1692	>	FCurrentArray := -1;
1693	>	end;
1694
1695	<	sqString:
1696	<	if FLastSymbol = sqString then
1695	>	class function TIBXMLProcessor.FormatBlob(Field: ISQLData): string;
1696	>	var TextOut: TStrings;
1697	>	begin
1698	>	TextOut := TStringList.Create;
1699	>	try
1700	>	TextOut.Add(Format('<blob subtype="%d">',[Field.getSubtype]));
1701	>	StringToHex(Field.AsString,TextOut,BlobLineLength);
1702	>	TextOut.Add('</blob>');
1703	>	Result := TextOut.Text;
1704	>	finally
1705	>	TextOut.Free;
1706	>	end;
1707	>	end;
1708	>
1709	>	class function TIBXMLProcessor.FormatArray(ar: IArray): string;
1710	>	var index: array of integer;
1711	>	TextOut: TStrings;
1712	>
1713	>	procedure AddElements(dim: integer; indent:string = ' ');
1714	>	var i: integer;
1715	>	recurse: boolean;
1716	>	begin
1717	>	SetLength(index,dim+1);
1718	>	recurse := dim < ar.GetDimensions - 1;
1719	>	with ar.GetBounds[dim] do
1720	>	for i := LowerBound to UpperBound do
1721		begin
1722	<	FString := FString + FLastChar;
1723	<	FLastSymbol := sqNone
1722	>	index[dim] := i;
1723	>	if recurse then
1724	>	begin
1725	>	TextOut.Add(Format('%s<elt id="%d">',[indent,i]));
1726	>	AddElements(dim+1,indent + ' ');
1727	>	TextOut.Add('</elt>');
1728	>	end
1729	>	else
1730	>	if ((ar.GetSQLType = SQL_TEXT) or (ar.GetSQLType = SQL_VARYING)) and
1731	>	(ar.GetCharSetID = 1) then
1732	>	TextOut.Add(Format('%s<elt ix="%d">%s</elt>',[indent,i,StringToHex(ar.GetAsString(index))]))
1733	>	else
1734	>	TextOut.Add(Format('%s<elt ix="%d">%s</elt>',[indent,i,ar.GetAsString(index)]));
1735		end;
1736		end;
1737	<	Inc(index)
1737	>
1738	>	var
1739	>	s: string;
1740	>	bounds: TArrayBounds;
1741	>	i: integer;
1742	>	boundsList: string;
1743	>	begin
1744	>	TextOut := TStringList.Create;
1745	>	try
1746	>	s := Format('<array dim = "%d" sqltype = "%d" length = "%d" relation_name = "%s" column_name = "%s"',
1747	>	[ar.GetDimensions,ar.GetSQLType,ar.GetSize,
1748	>	ar.GetTableName,ar.GetColumnName]);
1749	>	case ar.GetSQLType of
1750	>	SQL_DOUBLE, SQL_FLOAT, SQL_LONG, SQL_SHORT, SQL_D_FLOAT, SQL_INT64:
1751	>	s += Format(' scale = "%d"',[ ar.GetScale]);
1752	>	SQL_TEXT,
1753	>	SQL_VARYING:
1754	>	s += Format(' charset = "%s"',[FirebirdAPI.GetCharsetName(ar.GetCharSetID)]);
1755	>	end;
1756	>	bounds := ar.GetBounds;
1757	>	boundsList := '';
1758	>	for i := 0 to length(bounds) - 1 do
1759	>	begin
1760	>	if i <> 0 then boundsList += ',';
1761	>	boundsList += Format('%d:%d',[bounds[i].LowerBound,bounds[i].UpperBound]);
1762	>	end;
1763	>	s += Format(' bounds="%s"',[boundsList]);
1764	>	s += '>';
1765	>	TextOut.Add(s);
1766	>
1767	>	SetLength(index,0);
1768	>	AddElements(0);
1769	>	TextOut.Add('</array>');
1770	>	Result := TextOut.Text;
1771	>	finally
1772	>	TextOut.Free;
1773		end;
1774	+	end;
1775
1776	<	if (index > Length(Line)) then
634	<	if Result = sqNone then
635	<	Result := sqEOL
636	<	else
637	<	if (FLastSymbol = sqNone) and (Result <> sqEOL) then
638	<	FLastSymbol := sqEOL;
1776	>	{ TInteractiveSymbolStream }
1777
1778	<	if Result = sqString then
1779	<	begin
1780	<	if FString <> '' then
643	<	if CompareText(FString,'begin') = 0 then
644	<	Result := sqBegin
645	<	else
646	<	if CompareText(FString,'end') = 0 then
647	<	Result := sqEnd
648	<	else
649	<	if CompareText(FString,'declare') = 0 then
650	<	Result := sqDeclare
651	<	else
652	<	if CompareText(FString,'commit') = 0 then
653	<	Result := sqCommit
654	<	else
655	<	if CompareText(FString,'reconnect') = 0 then
656	<	Result := sqReconnect
657	<	else
658	<	if CompareText(FString,'case') = 0 then
659	<	Result := sqCase;
660	<	end
1778	>	function TInteractiveSymbolStream.GetErrorPrefix: string;
1779	>	begin
1780	>	Result := '';
1781		end;
1782
1783	<	function TIBXScript.GetTransaction: TIBTransaction;
1783	>	function TInteractiveSymbolStream.GetNextLine(var Line: string): boolean;
1784		begin
1785	<	if FTransaction = nil then
1786	<	Result := FInternalTransaction
1785	>	if FNextStatement then
1786	>	write(FPrompt)
1787		else
1788	<	Result := FTransaction;
1788	>	write(FContinuePrompt);
1789	>	Result := not EOF;
1790	>	if Result then
1791	>	readln(Line);
1792		end;
1793
1794	<	procedure TIBXScript.SetDatabase(AValue: TIBDatabase);
1794	>	constructor TInteractiveSymbolStream.Create(aPrompt: string; aContinue: string);
1795		begin
1796	<	if FDatabase = AValue then Exit;
1797	<	FDatabase := AValue;
1798	<	FISQL.Database := AValue;
676	<	FInternalTransaction.DefaultDatabase := AValue;
1796	>	inherited Create;
1797	>	FPrompt := aPrompt;
1798	>	FContinuePrompt := aContinue;
1799		end;
1800
1801	<	function TIBXScript.PerformUpdate(const SQLFile: string;
680	<	AutoDDL: boolean): boolean;
681	<	var F: TFileStream;
1801	>	function TInteractiveSymbolStream.GetSymbol: TSQLSymbol;
1802		begin
1803	<	F := TFileStream.Create(SQLFile,fmOpenRead or fmShareDenyNone);
1804	<	try
1805	<	Result := PerformUpdate(F,AutoDDL)
1806	<	finally
1807	<	F.Free
1803	>	if Terminated then
1804	>	Result := sqEOF
1805	>	else
1806	>	Result := inherited GetSymbol;
1807	>	end;
1808	>
1809	>	{ TBatchSymbolStream }
1810	>
1811	>	function TBatchSymbolStream.GetErrorPrefix: string;
1812	>	begin
1813	>	Result := Format(sOnLineError,[FLineIndex,FIndex]);
1814	>	end;
1815	>
1816	>	function TBatchSymbolStream.GetNextLine(var Line: string): boolean;
1817	>	begin
1818	>	Result := FLineIndex < FLines.Count;
1819	>	if Result then
1820	>	begin
1821	>	Line := FLines[FLineIndex];
1822	>	//    writeln('Next Line = ',Line);
1823	>	Inc(FLineIndex);
1824	>	if assigned(OnProgressEvent) then
1825	>	OnProgressEvent(self,false,1);
1826		end;
1827		end;
1828
1829	<	function TIBXScript.PerformUpdate(const SQLStream: TStream; AutoDDL: boolean): boolean;
692	<	var Lines: TStringList;
693	<	FNotConnected: boolean;
1829	>	constructor TBatchSymbolStream.Create;
1830		begin
1831	<	FTerminator := ';';
1832	<	FAutoDDL := AutoDDL;
1833	<	FNotConnected := not Database.Connected;
698	<	Database.Connected := true;
699	<	try
700	<	Lines := TStringList.Create;
701	<	Lines.LoadFromStream(SQLStream);
702	<	try
703	<	if assigned(OnProgressEvent) then
704	<	OnProgressEvent(self,true,Lines.Count);
1831	>	inherited Create;
1832	>	FLines := TStringList.Create;
1833	>	end;
1834
1835	<	Result := AnalyseSQL(Lines)
1836	<	finally
1837	<	Lines.Free
1838	<	end;
1839	<	except on E:Exception do
1835	>	destructor TBatchSymbolStream.Destroy;
1836	>	begin
1837	>	if assigned(FLines) then FLines.Free;
1838	>	inherited Destroy;
1839	>	end;
1840	>
1841	>	procedure TBatchSymbolStream.SetStreamSource(Lines: TStrings);
1842	>	begin
1843	>	FLineIndex := 0;
1844	>	FLines.Assign(Lines);
1845	>	if assigned(OnProgressEvent) then
1846	>	OnProgressEvent(self,true,FLines.Count);
1847	>	end;
1848	>
1849	>	procedure TBatchSymbolStream.SetStreamSource(S: TStream);
1850	>	begin
1851	>	FLineIndex := 0;
1852	>	FLines.LoadFromStream(S);
1853	>	if assigned(OnProgressEvent) then
1854	>	OnProgressEvent(self,true,FLines.Count);
1855	>	end;
1856	>
1857	>	procedure TBatchSymbolStream.SetStreamSource(FileName: string);
1858	>	begin
1859	>	FLineIndex := 0;
1860	>	FLines.LoadFromFile(FileName);
1861	>	if assigned(OnProgressEvent) then
1862	>	OnProgressEvent(self,true,FLines.Count);
1863	>	end;
1864	>
1865	>	{ TSymbolStream }
1866	>
1867	>	function TSymbolStream.GetNextSymbol(C: char): TSQLSymbol;
1868	>	begin
1869	>	Result := sqNone;
1870	>	if C = FTerminator then
1871	>	Result := sqTerminator
1872	>	else
1873	>	case C of
1874	>	#0..#8,#10..#31,' ':
1875	>	Result := ' ';
1876	>
1877	>	#9,';','"','''','/',
1878	>	'*','=','>','<',',':
1879	>	Result := C;
1880	>	else
1881		begin
1882	<	Add2Log(E.Message);
1883	<	with GetTransaction do
714	<	if InTransaction then Rollback;
715	<	Result := false
1882	>	Result := sqString;
1883	>	FLastChar := C
1884		end
1885		end;
718	–	with GetTransaction do
719	–	if InTransaction then Commit;
720	–	if FNotConnected then
721	–	Database.Connected := false;
1886		end;
1887
1888	<	function TIBXScript.PopState: TSQLStates;
1888	>	function TSymbolStream.FindTag(tag: string; var xmlTag: TXMLTag): boolean;
1889	>	var i: integer;
1890		begin
1891	<	if FStackIndex = 0 then
1892	<	raise Exception.Create(sStackUnderflow);
1893	<	Dec(FStackIndex);
1894	<	Result := FStack[FStackIndex]
1891	>	Result := false;
1892	>	for i := 0 to Length(XMLTagDefs) - 1 do
1893	>	if XMLTagDefs[i].TagValue = tag then
1894	>	begin
1895	>	xmlTag := XMLTagDefs[i].XMLTag;
1896	>	Result := true;
1897	>	break;
1898	>	end;
1899		end;
1900
1901	<	function TIBXScript.ProcessSetStatement(stmt: string): boolean;
733	<	var  RegexObj: TRegExpr;
1901	>	constructor TSymbolStream.Create;
1902		begin
1903	<	Result := false;
1904	<	RegexObj := TRegExpr.Create;
1905	<	try
1906	<	{Process Set Term}
1907	<	RegexObj.Expression := 'SET +TERM +(.) *(\' + FTerminator + '|)';
1908	<	if RegexObj.Exec(AnsiUpperCase(stmt)) then
1903	>	inherited;
1904	>	FTerminator := ';';
1905	>	NextStatement;
1906	>	end;
1907	>
1908	>	procedure TSymbolStream.ShowError(msg: string; params: array of const);
1909	>	begin
1910	>	raise EIBClientError.CreateFmt(GetErrorPrefix + msg,params);
1911	>	end;
1912	>
1913	>	function TSymbolStream.GetSymbol: TSQLSymbol;
1914	>	var
1915	>	DelimitedText: string;
1916	>	CurState: (gsNone,gsInComment,gsInSingleQuotes,gsInDoubleQuotes);
1917	>	begin
1918	>	Result := sqNone;
1919	>	CurState := gsNone;
1920	>	DelimitedText := '';
1921	>	if FNextSymbol <> sqNone then
1922	>	begin
1923	>	Result := FNextSymbol;
1924	>	if Result = sqString then
1925	>	FString := FLastChar
1926	>	else
1927	>	FString := '';
1928	>	FNextSymbol := sqNone
1929	>	end;
1930	>
1931	>	while FNextSymbol = sqNone do {find the next symbol}
1932	>	begin
1933	>	if FIndex > Length(FLine) then
1934		begin
1935	<	FTerminator := RegexObj.Match[1][1];
1936	<	Result := true;
1937	<	Exit;
1935	>	FNextSymbol := sqEOL;
1936	>	FIndex := 0;
1937	>	end
1938	>	else
1939	>	begin
1940	>	if FIndex = 0 then
1941	>	begin
1942	>	if not GetNextLine(FLine) then
1943	>	begin
1944	>	Result := sqEOF;
1945	>	FNextSymbol := sqNone;
1946	>	Exit;
1947	>	end;
1948	>	FIndex := 1;
1949	>	FNextStatement := false;
1950	>	if assigned(OnNextLine) then
1951	>	OnNextLine(self,FLine);
1952	>	if CurState <> gsNone then
1953	>	DelimitedText += LineEnding;
1954	>	if Length(FLine) = 0 then
1955	>	continue;
1956	>	end;
1957	>	if CurState <> gsNone then
1958	>	DelimitedText += FLine[FIndex];
1959	>	FNextSymbol := GetNextSymbol(FLine[FIndex]);
1960	>	Inc(FIndex);
1961		end;
1962
1963	<	{Process AutoDDL}
1964	<	RegexObj.Expression := 'SET +AUTODDL +([a-zA-Z]+) *(\' + FTerminator + '|)';
1965	<	if RegexObj.Exec(AnsiUpperCase(stmt)) then
1966	<	begin
1967	<	if  AnsiUpperCase(RegexObj.Match[1]) = 'ON' then
1968	<	FAutoDDL := true
1969	<	else
1970	<	if  AnsiUpperCase(RegexObj.Match[1]) = 'OFF' then
1971	<	FAutoDDL := false
1972	<	else
1973	<	raise Exception.CreateFmt(sInvalidAutoDDL, [RegexObj.Match[0]]);
1963	>	case CurState of
1964	>	gsNone:
1965	>	begin
1966	>	{combine if possible}
1967	>	case Result of
1968	>	sqNone:
1969	>	begin
1970	>	Result := FNextSymbol;
1971	>	if FNextSymbol = sqString then
1972	>	FString := FLastChar;
1973	>	FNextSymbol := sqNone
1974	>	end;
1975	>
1976	>	'/':
1977	>	if FXMLMode > 0 then
1978	>	break
1979	>	else
1980	>	if FNextSymbol = '*' then
1981	>	begin
1982	>	CurState := gsInComment;
1983	>	DelimitedText := '/*';
1984	>	Result := sqNone;
1985	>	FNextSymbol := sqNone
1986	>	end
1987	>	else
1988	>	if FNextSymbol = '/' then
1989	>	begin
1990	>	FString := '/*' + system.copy(FLine,FIndex,length(FLine)- FIndex + 1) + ' */';
1991	>	Result := sqCommentLine;
1992	>	FIndex := 0;
1993	>	FNextSymbol := sqNone
1994	>	end;
1995	>
1996	>	'<':
1997	>	if (FXMLMode > 0) and (FNextSymbol = '/') then
1998	>	begin
1999	>	Result := sqEndTag;
2000	>	FString := '';
2001	>	FNextSymbol := sqNone
2002	>	end
2003	>	else
2004	>	if FNextSymbol = sqString then
2005	>	begin
2006	>	Result := sqTag;
2007	>	FString := FLastChar;
2008	>	FNextSymbol := sqNone
2009	>	end;
2010	>
2011	>	'''':
2012	>	if FXMLMode > 0 then
2013	>	break
2014	>	else
2015	>	if FNextSymbol = '''' then
2016	>	begin
2017	>	Result := sqQuotedString;
2018	>	FString := '''''';
2019	>	FNextSymbol := sqNone
2020	>	end
2021	>	else
2022	>	begin
2023	>	CurState := gsInSingleQuotes;
2024	>	DelimitedText := '''';
2025	>	if FNextSymbol = sqEOL then
2026	>	DelimitedText += LineEnding
2027	>	else
2028	>	DelimitedText += FLine[FIndex-1];
2029	>	Result := sqNone;
2030	>	FNextSymbol := sqNone
2031	>	end;
2032	>
2033	>	'"':
2034	>	if FXMLMode > 0 then
2035	>	break
2036	>	else
2037	>	begin
2038	>	CurState := gsInDoubleQuotes;
2039	>	DelimitedText := '"';
2040	>	if FNextSymbol = sqEOL then
2041	>	DelimitedText += LineEnding
2042	>	else
2043	>	DelimitedText += FLine[FIndex-1];
2044	>	Result := sqNone;
2045	>	FNextSymbol := sqNone
2046	>	end;
2047	>
2048	>	sqTag,
2049	>	sqEndTag,
2050	>	sqString:
2051	>	if FNextSymbol = sqString then
2052	>	begin
2053	>	FString := FString + FLastChar;
2054	>	FNextSymbol := sqNone
2055	>	end;
2056	>	end
2057	>	end;
2058	>
2059	>	{Check for state exit condition}
2060	>	gsInSingleQuotes:
2061	>	if Result = '''' then
2062	>	begin
2063	>	CurState := gsNone;
2064	>	if FNextSymbol = sqEOL then
2065	>	FString := DelimitedText
2066	>	else
2067	>	FString := system.copy(DelimitedText,1,Length(DelimitedText)-1);
2068	>	Result := sqQuotedString;
2069	>	end;
2070	>
2071	>	gsInDoubleQuotes:
2072	>	if Result = '"' then
2073	>	begin
2074	>	CurState := gsNone;
2075	>	if FNextSymbol = sqEOL then
2076	>	FString := DelimitedText
2077	>	else
2078	>	FString := system.copy(DelimitedText,1,Length(DelimitedText)-1);
2079	>	Result := sqDoubleQuotedString;
2080	>	end;
2081	>
2082	>	gsInComment:
2083	>	if (Result = '*') and (FNextSymbol = '/') then
2084	>	begin
2085	>	CurState := gsNone;
2086	>	FString := DelimitedText;
2087	>	Result := sqComment;
2088	>	FNextSymbol := sqNone
2089	>	end;
2090
759	–	Result := true;
2091		end;
761	–	finally
762	–	RegexObj.Free;
763	–	end;
764	–	end;
2092
2093	+	if (CurState <> gsNone) and (FNextSymbol <> sqNone) then
2094	+	begin
2095	+	Result := FNextSymbol;
2096	+	FNextSymbol := sqNone;
2097	+	end;
2098	+	end;
2099
2100	<	procedure TIBXScript.SetParamValue(SQLVar: ISQLParam);
768	<	var BlobID: TISC_QUAD;
769	<	begin
770	<	if assigned(FGetParamValue) and (SQLVar.SQLType = SQL_BLOB) then
2100	>	if (Result = sqTag) and (FNextSymbol <> sqNone) then
2101		begin
2102	<	Add2Log(Format(sResolveQueryParam,[SQLVar.Name]));
2103	<	GetParamValue(self,SQLVar.Name,BlobID);
774	<	if (BlobID.gds_quad_high = 0) and (BlobID.gds_quad_low = 0) then
775	<	SQLVar.Clear
2102	>	if FindTag(FString,FXMLTag) then
2103	>	Inc(FXMLMode)
2104		else
2105	<	SQLVar.AsQuad := BlobID
2105	>	Result := sqString;
2106		end
2107		else
2108	<	raise Exception.Create(sNoParamQueries);
2109	<	end;
2108	>	if (Result = sqEndTag) and (FNextSymbol <> sqNone) then
2109	>	begin
2110	>	if FindTag(FString,FXMLTag) then
2111	>	Dec(FXMLMode)
2112	>	else
2113	>	Result := sqString;
2114	>	end;
2115
2116	<	procedure TIBXScript.SetState(AState: TSQLStates);
2117	<	begin
2118	<	if FStackIndex > 16 then
2119	<	raise Exception.Create(sStackOverFlow);
2120	<	FStack[FStackIndex] := FState;
2121	<	Inc(FStackIndex);
2122	<	FState := AState
2116	>	if (FXMLMode = 0) and (Result = sqString) and (FString <> '') then
2117	>	begin
2118	>	if CompareText(FString,'begin') = 0 then
2119	>	Result := sqBegin
2120	>	else
2121	>	if CompareText(FString,'end') = 0 then
2122	>	Result := sqEnd
2123	>	else
2124	>	if CompareText(FString,'declare') = 0 then
2125	>	Result := sqDeclare
2126	>	else
2127	>	if CompareText(FString,'case') = 0 then
2128	>	Result := sqCase
2129	>	end;
2130	>	//  writeln(Result,',',FString);
2131		end;
2132
2133	<	procedure TIBXScript.ClearStatement;
2133	>	procedure TSymbolStream.NextStatement;
2134		begin
2135	<	FSQLText := '';
2136	<	FState := stInit;
796	<	FHasBegin := false;
797	<	FLastChar := ' ';
798	<	FLastSymbol := sqNone;
2135	>	FXMLTag := xtNone;
2136	>	FNextStatement := true;
2137		end;
2138
2139		end.

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines