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

Diff Legend

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