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 108 by tony, Thu Jan 18 14:37:46 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)';
#	Line 174 | Line 432 | resourcestring
432		sUnknownSymbol = 'Unknown Symbol %d';
433		sNoSelectSQL = 'Select SQL Statements are not supported';
434		sStackUnderflow = 'Stack Underflow';
177	–	sInvalidAutoDDL = 'Invalid AUTODDL Statement - %s';
435		sNoParamQueries =  'Parameterised Queries are not supported';
436		sStackOverFlow = 'Stack Overflow';
437		sResolveQueryParam =  'Resolving Query Parameter: %s';
438		sNoCommit =  'Commit not allowed here';
439		sNoReconnect = 'Reconnect not allowed here';
440	+	sXMLStackUnderflow = 'XML Stack Underflow';
441	+	sInvalidEndTag = 'XML End Tag Mismatch - %s';
442	+	sXMLStackOverFlow = 'XML Stack Overflow';
443	+	sErrorState = 'Entered Error State';
444	+	sXMLError = 'Invalid XML (%c)';
445	+	sXMLAttributeError = 'Unexpected attribute - "%s" = "%s"';
446	+	sInvalidBoundsList = 'Invalid array bounds list - "%s"';
447	+	sBinaryBlockMustbeEven = 'Binary block must have an even number of characters';
448	+	sInvalidCharacterSet = 'Unrecognised character set name - "%s"';
449	+	sOnLineError = 'On Line %d Character %d: ';
450	+	sArrayIndexError = 'Array Index Error (%d)';
451	+	sBlobIndexError = 'Blob Index Error (%d)';
452	+	sStatementError = 'Error processing SQL statement: %s %s - for statement "%s"';
453	+
454	+	function StringToHex(octetString: string; MaxLineLength: integer): string; overload;
455	+
456	+	function ToHex(aValue: byte): string;
457	+	const
458	+	HexChars: array [0..15] of char = '0123456789ABCDEF';
459	+	begin
460	+	Result := HexChars[aValue shr 4] +
461	+	HexChars[(aValue and $0F)];
462	+	end;
463	+
464	+	var i, j: integer;
465	+	begin
466	+	i := 1;
467	+	Result := '';
468	+	if MaxLineLength = 0 then
469	+	while i <= Length(octetString) do
470	+	begin
471	+	Result += ToHex(byte(octetString[i]));
472	+	Inc(i);
473	+	end
474	+	else
475	+	while i <= Length(octetString) do
476	+	begin
477	+	for j := 1 to MaxLineLength do
478	+	begin
479	+	if i > Length(octetString) then
480	+	Exit
481	+	else
482	+	Result += ToHex(byte(octetString[i]));
483	+	inc(i);
484	+	end;
485	+	Result += LineEnding;
486	+	end;
487	+	end;
488	+
489	+	procedure StringToHex(octetString: string; TextOut: TStrings; MaxLineLength: integer); overload;
490	+	begin
491	+	TextOut.Add(StringToHex(octetString,MaxLineLength));
492	+	end;
493	+
494	+
495
496		{ TIBXScript }
497
498	<	procedure TIBXScript.Add2Log(const Msg: string; IsError: boolean);
498	>	constructor TIBXScript.Create(aOwner: TComponent);
499	>	begin
500	>	inherited Create(aOwner);
501	>	FSymbolStream := TBatchSymbolStream.Create;
502	>	FSymbolStream.OnNextLine := @EchoNextLine;
503	>	end;
504	>
505	>	function TIBXScript.PerformUpdate(SQLFile: string; aAutoDDL: boolean): boolean;
506	>	begin
507	>	FAutoDDL := aAutoDDL;
508	>	Result := RunScript( SQLFile);
509	>	end;
510	>
511	>	function TIBXScript.PerformUpdate(SQLStream: TStream; aAutoDDL: boolean
512	>	): boolean;
513	>	begin
514	>	FAutoDDL := aAutoDDL;
515	>	Result := RunScript(SQLStream);
516	>	end;
517	>
518	>	function TIBXScript.RunScript(SQLFile: string): boolean;
519	>	begin
520	>	TBatchSymbolStream(FSymbolStream).SetStreamSource(SQLFile);
521	>	Result := ProcessStream;
522	>	end;
523	>
524	>	function TIBXScript.RunScript(SQLStream: TStream): boolean;
525	>	begin
526	>	TBatchSymbolStream(FSymbolStream).SetStreamSource(SQLStream);
527	>	Result := ProcessStream;
528	>	end;
529	>
530	>	function TIBXScript.RunScript(SQLLines: TStrings): boolean;
531	>	begin
532	>	TBatchSymbolStream(FSymbolStream).SetStreamSource(SQLLines);
533	>	Result := ProcessStream;
534	>	end;
535	>
536	>	function TIBXScript.ExecSQLScript(sql: string): boolean;
537	>	var s: TStringList;
538	>	begin
539	>	s := TStringList.Create;
540	>	try
541	>	s.Text := sql;
542	>	TBatchSymbolStream(FSymbolStream).SetStreamSource(s);
543	>	Result := ProcessStream;
544	>	finally
545	>	s.Free;
546	>	end;
547	>	end;
548	>
549	>	{ TCustomIBXScript }
550	>
551	>	procedure TCustomIBXScript.Add2Log(const Msg: string; IsError: boolean);
552		begin
553		if IsError then
554		begin
#	Line 193 | Line 558 | begin
558		if assigned(FOnOutputLog) then FOnOutputLog(self,Msg)
559		end;
560
561	<	procedure TIBXScript.AddToSQL(const Symbol: string);
561	>	procedure TCustomIBXScript.DoCommit;
562	>	begin
563	>	with GetTransaction do
564	>	if InTransaction then Commit;
565	>	GetTransaction.Active := true;
566	>	end;
567	>
568	>	procedure TCustomIBXScript.DoReconnect;
569	>	begin
570	>	with GetTransaction do
571	>	if InTransaction then Commit;
572	>	Database.Connected := false;
573	>	Database.Connected := true;
574	>	GetTransaction.Active := true;
575	>	end;
576	>
577	>	procedure TCustomIBXScript.ExecSQL(stmt: string);
578	>	var DDL: boolean;
579	>	I: integer;
580	>	stats: TPerfCounters;
581	>	begin
582	>	Database.Connected := true;
583	>	FISQL.SQL.Text := stmt;
584	>	FISQL.Transaction := GetTransaction;
585	>	FISQL.Transaction.Active := true;
586	>	FISQL.ParamCheck := not FIBSQLProcessor.HasBegin; {Probably PSQL}
587	>	FISQL.Prepare;
588	>	FISQL.Statement.EnableStatistics(ShowPerformanceStats);
589	>
590	>	if FISQL.SQLStatementType in [SQLInsert, SQLUpdate, SQLDelete] then
591	>	begin
592	>	{Interpret parameters}
593	>	for I := 0 to FISQL.Params.Count - 1 do
594	>	SetParamValue(FISQL.Params[I]);
595	>	end;
596	>
597	>	if FISQL.SQLStatementType = SQLSelect then
598	>	begin
599	>	if assigned(OnSelectSQL) then
600	>	OnSelectSQL(self,stmt)
601	>	else
602	>	DefaultSelectSQLHandler(stmt);
603	>	end
604	>	else
605	>	begin
606	>	DDL := FISQL.SQLStatementType = SQLDDL;
607	>	if not DDL or not FIgnoreGrants or (Pos('GRANT',AnsiUpperCase(Trim(stmt))) <> 1) then
608	>	begin
609	>	FISQL.ExecQuery;
610	>	if ShowAffectedRows and not DDL then
611	>	Add2Log('Rows Affected: ' + IntToStr(FISQL.RowsAffected));
612	>	if not DDL then
613	>	TIBCustomDataOutput.ShowPerfStats(FISQL.Statement,@Add2Log);
614	>	end;
615	>
616	>	if FAutoDDL and DDL then
617	>	FISQL.Transaction.Commit;
618	>	FISQL.Close;
619	>	end;
620	>	FISQL.SQL.Clear;
621	>	end;
622	>
623	>	function TCustomIBXScript.GetOnProgressEvent: TOnProgressEvent;
624	>	begin
625	>	Result := FSymbolStream.OnProgressEvent;
626	>	end;
627	>
628	>	function TCustomIBXScript.GetTransaction: TIBTransaction;
629	>	begin
630	>	if FTransaction = nil then
631	>	Result := FInternalTransaction
632	>	else
633	>	Result := FTransaction;
634	>	end;
635	>
636	>	procedure TCustomIBXScript.EchoNextLine(Sender: TObject; Line: string);
637	>	begin
638	>	if Echo then Add2Log(Line);
639	>	end;
640	>
641	>	procedure TCustomIBXScript.Notification(AComponent: TComponent;
642	>	Operation: TOperation);
643	>	begin
644	>	inherited Notification(AComponent, Operation);
645	>	if (AComponent = FDatabase) and (Operation = opRemove) then
646	>	FDatabase := nil;
647	>	if (AComponent = FTransaction) and (Operation = opRemove) then
648	>	FTransaction := nil;
649	>	if (AComponent = DataOutputFormatter) and (Operation = opRemove) then
650	>	FDataOutputFormatter := nil;
651	>	end;
652	>
653	>	procedure TCustomIBXScript.SetDatabase(AValue: TIBDatabase);
654	>	begin
655	>	if not (csLoading in ComponentState) and (FDatabase = AValue) then Exit;
656	>	FDatabase := AValue;
657	>	FISQL.Database := AValue;
658	>	FIBXMLProcessor.Database := AValue;
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	>	begin
853	>	Result := false;
854	>	ucStmt := AnsiUpperCase(stmt);
855	>	Terminator := FSymbolStream.Terminator;
856	>	RegexObj := TRegExpr.Create;
857	>	try
858	>	{process create database}
859	>	RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''(.*)(\' + Terminator + '|)';
860	>	if RegexObj.Exec(ucStmt) then
861	>	begin
862	>	FileName := system.copy(stmt,RegexObj.MatchPos[2], RegexObj.MatchLen[2]);
863	>	if assigned(FOnCreateDatabase) then
864	>	OnCreateDatabase(self,FileName);
865	>	stmt := 'CREATE DATABASE ''' + FileName + '''' + system.copy(stmt,RegexObj.MatchPos[3], RegexObj.MatchLen[3]);
866	>	ucStmt := AnsiUpperCase(stmt);
867	>	UpdateUserPassword;
868	>	FDatabase.Connected := false;
869	>	FDatabase.CreateDatabase(stmt);
870	>	FDatabase.Connected := false;
871	>	ExtractUserInfo;
872	>	DoReconnect;
873	>	Result := true;
874	>	Exit;
875	>	end;
876	>
877	>	{process connect statement}
878	>	RegexObj.Expression := '^ *CONNECT +.*(\' + Terminator + '|)';
879	>	if RegexObj.Exec(ucStmt) then
880	>	begin
881	>	ExtractConnectInfo;
882	>	DoReconnect;
883	>	Result := true;
884	>	Exit;
885	>	end;
886	>
887	>	{Process Drop Database}
888	>	RegexObj.Expression := '^ *DROP +DATABASE *(\' + Terminator + '|)';
889	>	if RegexObj.Exec(ucStmt) then
890	>	begin
891	>	FDatabase.DropDatabase;
892	>	Result := true;
893	>	Exit;
894	>	end;
895	>
896	>	{process commit statement}
897	>	RegexObj.Expression := '^ *COMMIT *(\' + Terminator + '|)';
898	>	if RegexObj.Exec(ucStmt) then
899	>	begin
900	>	DoCommit;
901	>	Result := true;
902	>	Exit;
903	>	end;
904	>
905	>	{process Reconnect statement}
906	>	RegexObj.Expression := '^ *RECONNECT *(\' + Terminator + '|)';
907	>	if RegexObj.Exec(ucStmt) then
908	>	begin
909	>	DoReconnect;
910	>	Result := true;
911	>	Exit;
912	>	end;
913	>
914	>
915	>	{Process Set Term}
916	>	RegexObj.Expression := '^ *SET +TERM +(.) *(\' + Terminator + '|)';
917	>	if RegexObj.Exec(ucStmt) then
918	>	begin
919	>	FSymbolStream.Terminator := RegexObj.Match[1][1];
920	>	Result := true;
921	>	Exit;
922	>	end;
923	>
924	>	{process Set SQL Dialect}
925	>	RegexObj.Expression := '^ *SET +SQL +DIALECT +([0-9]) *(\' + Terminator + '|)';
926	>	if RegexObj.Exec(ucStmt) then
927	>	begin
928	>	n := StrToInt(RegexObj.Match[1]);
929	>	if Database.SQLDialect <> n then
930	>	begin
931	>	Database.SQLDialect := n;
932	>	if Database.Connected then
933	>	DoReconnect;
934	>	end;
935	>	Result := true;
936	>	Exit;
937	>	end;
938	>
939	>	{Process Remaining Set statements}
940	>	RegexObj.Expression := '^ *SET +([A-Z]+)( +[A-Z0-9]+|) *(\' + Terminator + '|)';
941	>	if RegexObj.Exec(ucStmt) then
942	>	begin
943	>	command := AnsiUpperCase(RegexObj.Match[1]);
944	>	param := trim(RegexObj.Match[2]);
945	>	if command = 'AUTODDL' then
946	>	AutoDDL := ((RegexObj.MatchLen[2] = 0) and not AutoDDL) or
947	>	(RegexObj.MatchLen[2] > 0) and Toggle(param)
948	>	else
949	>	if command = 'BAIL' then
950	>	StopOnFirstError := ((RegexObj.MatchLen[2] = 0) and not StopOnFirstError) or
951	>	(RegexObj.MatchLen[2] > 0) and Toggle(param)
952	>	else
953	>	if command = 'ECHO' then
954	>	Echo := ((RegexObj.MatchLen[2] = 0) and not Echo) or
955	>	(RegexObj.MatchLen[2] > 0) and Toggle(param)
956	>	else
957	>	if command = 'COUNT' then
958	>	ShowAffectedRows := ((RegexObj.MatchLen[2] = 0) and not ShowAffectedRows) or
959	>	(RegexObj.MatchLen[2] > 0) and Toggle(param)
960	>	else
961	>	if command = 'STATS' then
962	>	ShowPerformanceStats := ((RegexObj.MatchLen[2] = 0) and not FShowPerformanceStats) or
963	>	(RegexObj.MatchLen[2] > 0) and Toggle(param)
964	>	else
965	>	if command = 'NAMES' then
966	>	begin
967	>	if Database.Attachment.CharSetName2CharSetID(param,charsetid) then
968	>	begin
969	>	Database.Params.Values['lc_ctype'] := param;
970	>	if Database.Connected then
971	>	DoReconnect;
972	>	end
973	>	else
974	>	raise Exception.CreateFmt(sInvalidCharacterSet, [param,stmt]);
975	>	end
976	>	else
977	>	begin
978	>	if assigned(DataOutputFormatter) then
979	>	DataOutputFormatter.SetCommand(command,param,stmt,Result);
980	>	if not Result and assigned(OnSetStatement) then
981	>	OnSetStatement(self,command,param,stmt,Result)
982	>	else
983	>	raise Exception.CreateFmt(sInvalidSetStatement, [command,stmt]);
984	>	Exit;
985	>	end;
986	>	Result := true;
987	>	Exit;
988	>	end;
989	>
990	>	finally
991	>	RegexObj.Free;
992	>	end;
993	>	end;
994	>
995	>	procedure TCustomIBXScript.SetTransaction(AValue: TIBTransaction);
996	>	begin
997	>	if FTransaction = AValue then Exit;
998	>	FTransaction := AValue;
999	>	FIBXMLProcessor.Transaction := AValue;
1000	>	end;
1001	>
1002	>	constructor TCustomIBXScript.Create(aOwner: TComponent);
1003	>	begin
1004	>	inherited Create(aOwner);
1005	>	FStopOnFirstError := true;
1006	>	FEcho := true;
1007	>	FAutoDDL := true;
1008	>	FISQL := TIBSQL.Create(self);
1009	>	FISQL.ParamCheck := true;
1010	>	FIBXMLProcessor := TIBXMLProcessor.Create;
1011	>	FIBSQLProcessor := TIBSQLProcessor.Create(FIBXMLProcessor);
1012	>	FInternalTransaction := TIBTransaction.Create(self);
1013	>	FInternalTransaction.Params.Clear;
1014	>	FInternalTransaction.Params.Add('concurrency');
1015	>	FInternalTransaction.Params.Add('wait');
1016	>	end;
1017	>
1018	>	destructor TCustomIBXScript.Destroy;
1019	>	begin
1020	>	if FIBSQLProcessor <> nil then FIBSQLProcessor.Free;
1021	>	if FIBXMLProcessor <> nil then FIBXMLProcessor.Free;
1022	>	if FSymbolStream <> nil then FSymbolStream.Free;
1023	>	if FISQL <> nil then FISQL.Free;
1024	>	if FInternalTransaction <> nil then FInternalTransaction.Free;
1025	>	inherited Destroy;
1026	>	end;
1027	>
1028	>	procedure TCustomIBXScript.DefaultSelectSQLHandler(aSQLText: string);
1029	>	begin
1030	>	if assigned(DataOutputFormatter) then
1031	>	DataOutputFormatter.DataOut(aSQLText,@Add2Log)
1032	>	else
1033	>	FSymbolStream.ShowError(sNoSelectSQL,[nil]);
1034	>	end;
1035	>
1036	>	{ TIBSQLProcessor }
1037	>
1038	>	procedure TIBSQLProcessor.AddToSQL(const Symbol: string);
1039		begin
1040	<	FSQLText := FSQLText +  Symbol
1040	>	FSQLText := FSQLText +  Symbol;
1041	>	//  writeln('SQL = ',FSQLText);
1042		end;
1043
1044	<	procedure TIBXScript.AnalyseLine(const Line: string);
1045	<	var index: integer;
1046	<	Symbol: TSQLSymbol;
1044	>	procedure TIBSQLProcessor.SetState(AState: TSQLStates);
1045	>	begin
1046	>	if FStackIndex > 16 then
1047	>	FSymbolStream.ShowError(sStackOverFlow,[nil]);
1048	>	FStack[FStackIndex] := FState;
1049	>	Inc(FStackIndex);
1050	>	FState := AState
1051	>	end;
1052	>
1053	>	function TIBSQLProcessor.PopState: TSQLStates;
1054	>	begin
1055	>	if FStackIndex = 0 then
1056	>	FSymbolStream.ShowError(sStackUnderflow,[nil]);
1057	>	Dec(FStackIndex);
1058	>	Result := FStack[FStackIndex]
1059	>	end;
1060	>
1061	>	constructor TIBSQLProcessor.Create(XMLProcessor: TIBXMLProcessor);
1062	>	begin
1063	>	inherited Create;
1064	>	FXMLProcessor := XMLProcessor;
1065	>	end;
1066	>
1067	>	function TIBSQLProcessor.GetNextStatement(SymbolStream: TSymbolStream;
1068	>	var stmt: string): boolean;
1069	>	var Symbol: TSQLSymbol;
1070		NonSpace: boolean;
1071	+	Done: boolean;
1072		begin
1073	<	index := 1;
1073	>	FSQLText := '';
1074	>	FState := stInit;
1075	>	FHasBegin := false;
1076	>	FSymbolStream := SymbolStream;
1077	>	FXMLProcessor.NextStatement;
1078	>	SymbolStream.NextStatement;
1079	>
1080	>	Result := true;
1081	>	Done := false;
1082		NonSpace := false;
1083	<	while true do
1083	>	while not Done do
1084	>	with SymbolStream do
1085		begin
1086		if FState = stError then
1087	<	raise Exception.Create('Entered Error State');
1088	<	Symbol := GetSymbol(Line,index);
1089	<	if not (Symbol in [sqSpace,sqEOL]) then
1087	>	ShowError(sErrorState,[nil]);
1088	>	Symbol := GetSymbol;
1089	>	//    writeln('Symbol = ',Symbol,' Value = ',SymbolValue);
1090	>	if not (Symbol in [' ',sqEOL]) then
1091		NonSpace := true;
1092	+
1093		case Symbol of
1094	<	sqSpace:
1095	<	if not (FState in [stInComment,stInCommentLine]) then
1096	<	AddToSQL(' ');
1094	>	sqTag:
1095	>	begin
1096	>	if FState in [stInSQL,stNested] then
1097	>	AddToSQL(FXMLProcessor.AnalyseXML(SymbolStream));
1098	>	end;
1099
1100		sqTerminator:
221	–	if not (FState in [stInComment,stInCommentLine]) then
1101		case FState of
1102		stInit: {ignore empty statement};
1103
1104		stInSQL:
1105	<	ExecSQL;
227	<
228	<	stInCommit:
229	<	DoCommit;
230	<
231	<	stInReconnect:
232	<	DoReconnect;
1105	>	Done := true;
1106
1107	<	stNested, stInSingleQuotes, stInDoubleQuotes:
1108	<	AddToSQL(FTerminator);
1107	>	stNested:
1108	>	AddToSQL(Terminator);
1109
1110		stInDeclaration:
1111		begin
1112		FState := PopState;
1113	<	AddToSQL(FTerminator);
1113	>	AddToSQL(Terminator);
1114		end;
1115
1116		else
1117	<	raise Exception.CreateFmt(sTerminatorUnknownState,[FState]);
1117	>	ShowError(sTerminatorUnknownState,[FState]);
1118		end;
1119
1120	<	sqSemiColon:
1120	>	';':
1121		begin
1122		if FState = stInDeclaration then
1123		FState := PopState;
1124		AddToSQL(';');
1125		end;
1126
1127	<	sqAsterisk:
255	<	if not (FState in [stInComment,stInCommentLine]) then
1127	>	'*':
1128		begin
1129		AddToSQL('*');
1130		if FState =  stInit then
1131		FState := stInSQL
1132		end;
1133
1134	<	sqForwardSlash:
263	<	if not (FState in [stInComment,stInCommentLine]) then
1134	>	'/':
1135		begin
1136		AddToSQL('/');
1137		if FState =  stInit then
1138		FState := stInSQL
1139		end;
1140
1141	<	sqCommentStart:
1142	<	if not (FState in [stInComment,stInCommentLine]) then
1143	<	SetState(stInComment);
1144	<
1145	<	sqCommentEnd:
275	<	if FState = stInComment then
276	<	begin
277	<	AddToSQL('/* ' + Trim(FString) + ' */');
278	<	FState := PopState
279	<	end
280	<	else
281	<	FState := stError;
1141	>	sqComment,
1142	>	sqQuotedString,
1143	>	sqDoubleQuotedString:
1144	>	if FState <> stInit then
1145	>	AddToSQL(SymbolValue);
1146
1147		sqCommentLine:
1148	<	if not (FState in [stInComment,stInCommentLine]) then
1149	<	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;
1148	>	if FState <> stInit then
1149	>	AddToSQL(SymbolValue + LineEnding);
1150
1151		sqEnd:
316	–	if not (FState in [stInComment,stInCommentLine]) then
1152		begin
1153	<	AddToSQL(FString);
1153	>	AddToSQL(SymbolValue);
1154		case FState of
320	–	stInSingleQuotes,
321	–	stInDoubleQuotes:
322	–	{Ignore};
1155		stNested:
1156		begin
1157		if FNested = 0 then
1158		begin
1159	<	PopState;
1160	<	FState := stInit;
1161	<	ExecSQL
1159	>	FState := PopState;
1160	>	if not FInCase then
1161	>	begin
1162	>	FState := stInit;
1163	>	Done := true;
1164	>	end
1165	>	else
1166	>	FInCase := false;
1167		end
1168		else
1169		Dec(FNested)
#	Line 336 | Line 1173 | begin
1173		end;
1174
1175		sqBegin:
339	–	if not (FState in [stInComment,stInCommentLine]) then
1176		begin
1177		FHasBegin := true;
1178	<	AddToSQL(FString);
1178	>	AddToSQL(SymbolValue);
1179		case FState of
344	–	stInSingleQuotes,
345	–	stInDoubleQuotes:
346	–	{Ignore};
1180		stNested:
1181		Inc(FNested);
1182
#	Line 353 | Line 1186 | begin
1186		end
1187		end;
1188
1189	+	sqCase:
1190	+	begin
1191	+	AddToSQL(SymbolValue);
1192	+	case FState of
1193	+	stNested:
1194	+	Inc(FNested);
1195	+
1196	+	stInSQL,
1197	+	stInit:
1198	+	begin
1199	+	FInCase := true;
1200	+	SetState(stNested);
1201	+	end;
1202	+	end
1203	+	end;
1204	+
1205		sqDeclare:
357	–	if not (FState in [stInComment,stInCommentLine]) then
1206		begin
1207	<	AddToSQL(FString);
1207	>	AddToSQL(SymbolValue);
1208		if FState in [stInit,stInSQL] then
1209		SetState(stInDeclaration)
1210		end;
1211
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	–
1212		sqString:
383	–	if not (FState in [stInComment,stInCommentLine]) then
1213		begin
1214	<	AddToSQL(FString);
1214	>	AddToSQL(SymbolValue);
1215		if FState = stInit then
1216		FState := stInSQL
1217		end;
#	Line 390 | Line 1219 | begin
1219		sqEOL:
1220		begin
1221		case FState of
1222	<	stInCommentLine:
1223	<	begin
1224	<	AddToSQL('/* ' + Trim(FString) + ' */');
1225	<	FState := PopState;
397	<	end;
398	<	stInDoubleQuotes,
399	<	stInSingleQuotes:
400	<	raise Exception.Create(sUnterminatedString);
1222	>	stInit:
1223	>	{Do nothing};
1224	>	else
1225	>	if NonSpace then AddToSQL(LineEnding);
1226		end;
402	–	if NonSpace then AddToSQL(#13#10);
403	–	Exit;
1227		end;
1228	+
1229	+	sqEOF:
1230	+	begin
1231	+	Done := true;
1232	+	Result := trim(FSQLText) <> '';
1233	+	end
1234		else
1235	<	raise Exception.CreateFmt(sUnknownSymbol,[Symbol]);
1235	>	if FState <> stInit then
1236	>	AddToSQL(Symbol);
1237		end
1238	<	end
1238	>	end;
1239	>	stmt := FSQLText;
1240	>	//  writeln('stmt = ',stmt);
1241		end;
1242
1243	<	function TIBXScript.AnalyseSQL(Lines: TStringList): boolean;
1244	<	var I: integer;
1243	>	{ TIBXMLProcessor }
1244	>
1245	>	procedure TIBXMLProcessor.EndXMLTag(xmltag: TXMLTag);
1246		begin
1247	<	Result := true;
1248	<	ClearStatement;
1249	<	FLastSymbol := sqNone;
1250	<	for I := 0 to Lines.Count - 1 do
1251	<	begin
1252	<	if Echo then Add2Log(Lines[I],false);
1253	<	if assigned(OnProgressEvent) then
1254	<	OnProgressEvent(self,false,1);
1255	<	try
1256	<	AnalyseLine(Lines[I]);
1257	<	except on E:Exception do
1258	<	begin
1259	<	Add2Log(E.Message);
1260	<	Result := false;
428	<	if StopOnFirstError then Exit;
429	<	ClearStatement;
430	<	FLastSymbol := sqNone;
431	<	end
432	<	end;
1247	>	if FXMLTagIndex = 0 then
1248	>	FSymbolStream.ShowError(sXMLStackUnderflow,[nil]);
1249	>	if xmltag <> FXMLTagStack[FXMLTagIndex] then
1250	>	FSymbolStream.ShowError(sInvalidEndTag,[FSymbolStream.SymbolValue]);
1251	>
1252	>	case FXMLTagStack[FXMLTagIndex] of
1253	>	xtBlob:
1254	>	FBlobData[FCurrentBlob].BlobIntf.Close;
1255	>
1256	>	xtArray:
1257	>	FArrayData[FCurrentArray].ArrayIntf.SaveChanges;
1258	>
1259	>	xtElt:
1260	>	Dec(FArrayData[FCurrentArray].CurrentRow);
1261		end;
1262	<	if FState <> stInit then
435	<	AnalyseLine(';');
436	<	Result := (FStackIndex = 0) and (FState = stInit)
1262	>	Dec(FXMLTagIndex);
1263		end;
1264
1265	<	constructor TIBXScript.Create(aOwner: TComponent);
1265	>	procedure TIBXMLProcessor.EnterTag;
1266	>	var aCharSetID: integer;
1267		begin
1268	<	inherited;
1269	<	FStopOnFirstError := true;
1270	<	FEcho := true;
1271	<	FState := stInit;
1272	<	FISQL := TIBSQL.Create(self);
1273	<	FISQL.ParamCheck := true;
1274	<	FInternalTransaction := TIBTransaction.Create(self);
1275	<	FInternalTransaction.Params.Clear;
1276	<	FInternalTransaction.Params.Add('concurrency');
1277	<	FInternalTransaction.Params.Add('wait');
1278	<	ClearStatement;
1268	>	case FXMLTagStack[FXMLTagIndex] of
1269	>	xtBlob:
1270	>	begin
1271	>	Database.Connected := true;
1272	>	Transaction.Active := true;
1273	>	FBlobData[FCurrentBlob].BlobIntf := Database.Attachment.CreateBlob(
1274	>	Transaction.TransactionIntf,FBlobData[FCurrentBlob].SubType);
1275	>	end;
1276	>
1277	>	xtArray:
1278	>	with FArrayData[FCurrentArray] do
1279	>	begin
1280	>	Database.Connected := true;
1281	>	Transaction.Active := true;
1282	>	Database.Attachment.CharSetName2CharSetID(CharSet,aCharSetID);
1283	>	SetLength(Index,dim);
1284	>	ArrayIntf := Database.Attachment.CreateArray(
1285	>	Transaction.TransactionIntf,
1286	>	Database.Attachment.CreateArrayMetaData(SQLType,
1287	>	relationName,columnName,Scale,Size,
1288	>	aCharSetID,dim,bounds)
1289	>	);
1290	>	end;
1291	>	end;
1292		end;
1293
1294	<	destructor TIBXScript.Destroy;
1294	>	function TIBXMLProcessor.GetArrayData(index: integer): TArrayData;
1295		begin
1296	<	if FISQL <> nil then FISQL.Free;
1297	<	if FInternalTransaction <> nil then FInternalTransaction.Free;
1298	<	inherited;
1296	>	if (index < 0) or (index > ArrayDataCount) then
1297	>	FSymbolStream.ShowError(sArrayIndexError,[index]);
1298	>	Result := FArrayData[index];
1299		end;
1300
1301	<	procedure TIBXScript.DoCommit;
1301	>	function TIBXMLProcessor.GetArrayDataCount: integer;
1302		begin
1303	<	with GetTransaction do
464	<	if InTransaction then Commit;
465	<	if not GetTransaction.InTransaction then
466	<	GetTransaction.StartTransaction;
467	<	ClearStatement;
1303	>	Result := Length(FArrayData);
1304		end;
1305
1306	<	procedure TIBXScript.DoReconnect;
1306	>	function TIBXMLProcessor.GetBlobData(index: integer): TBlobData;
1307		begin
1308	<	with GetTransaction do
1309	<	if InTransaction then Commit;
1310	<	Database.Connected := false;
475	<	Database.Connected := true;
476	<	if not GetTransaction.InTransaction then
477	<	GetTransaction.StartTransaction;
478	<	ClearStatement;
1308	>	if (index < 0) or (index > BlobDataCount) then
1309	>	FSymbolStream.ShowError(sBlobIndexError,[index]);
1310	>	Result := FBlobData[index];
1311		end;
1312
1313	<	procedure TIBXScript.ExecSQL;
482	<	var DDL: boolean;
483	<	I: integer;
1313	>	function TIBXMLProcessor.GetBlobDataCount: integer;
1314		begin
1315	<	if FSQLText <> '' then
1316	<	begin
487	<	if ProcessSetStatement(FSQLText) then {Handle Set Statement}
488	<	begin
489	<	ClearStatement;
490	<	Exit;
491	<	end;
1315	>	Result := Length(FBlobData);
1316	>	end;
1317
1318	<	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;
1318	>	procedure TIBXMLProcessor.ProcessTagValue(tagValue: string);
1319
1320	<	if FISQL.SQLType = SQLSelect then
1321	<	begin
1322	<	if assigned(OnSelectSQL) then
1323	<	OnSelectSQL(self,FSQLText)
1324	<	else
1325	<	raise Exception.Create(sNoSelectSQL);
1326	<	end
1327	<	else
1328	<	begin
1329	<	DDL := FISQL.SQLType = SQLDDL;
1330	<	if not DDL or not FIgnoreGrants or (Pos('GRANT',AnsiUpperCase(Trim(FSQLText))) <> 1) then
1331	<	FISQL.ExecQuery;
1332	<	if FAutoDDL and DDL then
1333	<	FISQL.Transaction.Commit;
1334	<	FISQL.Close;
1335	<	end;
1336	<	FISQL.SQL.Clear;
1337	<	ClearStatement;
1338	<	end
1320	>	function nibble(hex: char): byte;
1321	>	begin
1322	>	case hex of
1323	>	'0': Result := 0;
1324	>	'1': Result := 1;
1325	>	'2': Result := 2;
1326	>	'3': Result := 3;
1327	>	'4': Result := 4;
1328	>	'5': Result := 5;
1329	>	'6': Result := 6;
1330	>	'7': Result := 7;
1331	>	'8': Result := 8;
1332	>	'9': Result := 9;
1333	>	'a','A': Result := 10;
1334	>	'b','B': Result := 11;
1335	>	'c','C': Result := 12;
1336	>	'd','D': Result := 13;
1337	>	'e','E': Result := 14;
1338	>	'f','F': Result := 15;
1339	>	end;
1340	>	end;
1341	>
1342	>	procedure RemoveWhiteSpace(var hexData: string);
1343	>	var i: integer;
1344	>	begin
1345	>	{Remove White Space}
1346	>	i := 1;
1347	>	while i <= length(hexData) do
1348	>	begin
1349	>	case hexData[i] of
1350	>	' ',#9,#10,#13:
1351	>	begin
1352	>	if i < Length(hexData) then
1353	>	Move(hexData[i+1],hexData[i],Length(hexData)-i);
1354	>	SetLength(hexData,Length(hexData)-1);
1355	>	end;
1356	>	else
1357	>	Inc(i);
1358	>	end;
1359	>	end;
1360	>	end;
1361	>
1362	>	procedure WriteToBlob(hexData: string);
1363	>	var i,j : integer;
1364	>	blength: integer;
1365	>	P: PChar;
1366	>	begin
1367	>	RemoveWhiteSpace(hexData);
1368	>	if odd(length(hexData)) then
1369	>	FSymbolStream.ShowError(sBinaryBlockMustbeEven,[nil]);
1370	>	blength := Length(hexData) div 2;
1371	>	IBAlloc(FBlobBuffer,0,blength);
1372	>	j := 1;
1373	>	P := FBlobBuffer;
1374	>	for i := 1 to blength do
1375	>	begin
1376	>	P^ := char((nibble(hexData[j]) shl 4) or nibble(hexdata[j+1]));
1377	>	Inc(j,2);
1378	>	Inc(P);
1379	>	end;
1380	>	FBlobData[FCurrentBlob].BlobIntf.Write(FBlobBuffer^,blength);
1381	>	end;
1382	>
1383	>	begin
1384	>	if tagValue = '' then Exit;
1385	>	case FXMLTagStack[FXMLTagIndex] of
1386	>	xtBlob:
1387	>	WriteToBlob(tagValue);
1388	>
1389	>	xtElt:
1390	>	with FArrayData[FCurrentArray] do
1391	>	ArrayIntf.SetAsString(index,tagValue);
1392	>
1393	>	end;
1394		end;
1395
1396	+	procedure TIBXMLProcessor.StartXMLTag(xmltag: TXMLTag);
1397	+	begin
1398	+	if FXMLTagIndex > 19 then
1399	+	FSymbolStream.ShowError(sXMLStackOverFlow,[nil]);
1400	+	Inc(FXMLTagIndex);
1401	+	FXMLTagStack[FXMLTagIndex] := xmltag;
1402	+	case xmltag of
1403	+	xtBlob:
1404	+	begin
1405	+	Inc(FCurrentBlob);
1406	+	SetLength(FBlobData,FCurrentBlob+1);
1407	+	FBlobData[FCurrentBlob].BlobIntf := nil;
1408	+	FBlobData[FCurrentBlob].SubType := 0;
1409	+	end;
1410	+
1411	+	xtArray:
1412	+	begin
1413	+	Inc(FCurrentArray);
1414	+	SetLength(FArrayData,FCurrentArray+1);
1415	+	with FArrayData[FCurrentArray] do
1416	+	begin
1417	+	ArrayIntf := nil;
1418	+	SQLType := 0;
1419	+	dim := 0;
1420	+	Size := 0;
1421	+	Scale := 0;
1422	+	CharSet := 'NONE';
1423	+	SetLength(Index,0);
1424	+	CurrentRow := -1;
1425	+	end;
1426	+	end;
1427
1428	+	xtElt:
1429	+	with FArrayData[FCurrentArray] do
1430	+	Inc(CurrentRow);
1431
1432	<	function TIBXScript.GetNextSymbol(C: char): TSQLSymbol;
1432	>	end;
1433	>	end;
1434	>
1435	>	procedure TIBXMLProcessor.ProcessAttributeValue(attrValue: string);
1436		begin
1437	<	if C = FTerminator then
1438	<	Result := sqTerminator
1437	>	case FXMLTagStack[FXMLTagIndex] of
1438	>	xtBlob:
1439	>	if FAttributeName = 'subtype' then
1440	>	FBlobData[FCurrentBlob].SubType := StrToInt(attrValue)
1441		else
1442	<	case C of
1443	<	' ',#9:
1444	<	Result := sqSpace;
1445	<	';':
1446	<	Result := sqSemiColon;
539	<	'"':
540	<	Result := sqDoubleQuotes;
541	<	'''':
542	<	Result := sqSingleQuotes;
543	<	'/':
544	<	Result := sqForwardSlash;
545	<	'*':
546	<	Result := sqAsterisk;
1442	>	FSymbolStream.ShowError(sXMLAttributeError,[FAttributeName,attrValue]);
1443	>
1444	>	xtArray:
1445	>	if FAttributeName = 'sqltype' then
1446	>	FArrayData[FCurrentArray].SQLType := StrToInt(attrValue)
1447		else
1448	+	if FAttributeName = 'relation_name' then
1449	+	FArrayData[FCurrentArray].relationName := attrValue
1450	+	else
1451	+	if FAttributeName = 'column_name' then
1452	+	FArrayData[FCurrentArray].columnName := attrValue
1453	+	else
1454	+	if FAttributeName = 'dim' then
1455	+	FArrayData[FCurrentArray].Dim := StrToInt(attrValue)
1456	+	else
1457	+	if FAttributeName = 'length' then
1458	+	FArrayData[FCurrentArray].Size := StrToInt(attrValue)
1459	+	else
1460	+	if FAttributeName = 'scale' then
1461	+	FArrayData[FCurrentArray].Scale := StrToInt(attrValue)
1462	+	else
1463	+	if FAttributeName = 'charset' then
1464	+	FArrayData[FCurrentArray].CharSet := attrValue
1465	+	else
1466	+	if FAttributeName = 'bounds' then
1467	+	ProcessBoundsList(attrValue)
1468	+	else
1469	+	FSymbolStream.ShowError(sXMLAttributeError,[FAttributeName,attrValue]);
1470	+
1471	+	xtElt:
1472	+	if FAttributeName = 'ix' then
1473	+	with FArrayData[FCurrentArray] do
1474	+	Index[CurrentRow] :=  StrToInt(attrValue)
1475	+	else
1476	+	FSymbolStream.ShowError(sXMLAttributeError,[FAttributeName,attrValue]);
1477	+	end;
1478	+	end;
1479	+
1480	+	procedure TIBXMLProcessor.ProcessBoundsList(boundsList: string);
1481	+	var list: TStringList;
1482	+	i,j: integer;
1483	+	begin
1484	+	list := TStringList.Create;
1485	+	try
1486	+	list.Delimiter := ',';
1487	+	list.DelimitedText := boundsList;
1488	+	with FArrayData[FCurrentArray] do
1489	+	begin
1490	+	if dim <> list.Count then
1491	+	FSymbolStream.ShowError(sInvalidBoundsList,[boundsList]);
1492	+	SetLength(bounds,dim);
1493	+	for i := 0 to list.Count - 1 do
1494		begin
1495	<	Result := sqString;
1496	<	FLastChar := C
1497	<	end
1495	>	j := Pos(':',list[i]);
1496	>	if j = 0 then
1497	>	raise Exception.CreateFmt(sInvalidBoundsList,[boundsList]);
1498	>	bounds[i].LowerBound := StrToInt(system.copy(list[i],1,j-1));
1499	>	bounds[i].UpperBound := StrToInt(system.copy(list[i],j+1,length(list[i])-j));
1500	>	end;
1501		end;
1502	+	finally
1503	+	list.Free;
1504	+	end;
1505		end;
1506
1507	<	function TIBXScript.GetSymbol(const Line: string; var index: integer): TSQLSymbol;
1507	>	constructor TIBXMLProcessor.Create;
1508		begin
1509	<	Result := sqNone;
1510	<	if FLastSymbol <> sqNone then
1511	<	begin
1512	<	Result := FLastSymbol;
1513	<	if Result = sqString then
1514	<	FString := FLastChar;
1515	<	FLastSymbol := sqNone
1516	<	end;
1509	>	inherited Create;
1510	>	NextStatement;
1511	>	end;
1512	>
1513	>	destructor TIBXMLProcessor.Destroy;
1514	>	begin
1515	>	FreeMem(FBlobBuffer);
1516	>	inherited Destroy;
1517	>	end;
1518
1519	<	while (index <= Length(Line)) and (FLastSymbol = sqNone) do
1519	>	function TIBXMLProcessor.AnalyseXML(SymbolStream: TSymbolStream): string;
1520	>	var Symbol: TSQLSymbol;
1521	>	Done: boolean;
1522	>	XMLString: string;
1523	>	begin
1524	>	Result := '';
1525	>	XMLString := '';
1526	>	Done := false;
1527	>	FState := stInTag;
1528	>	FSymbolStream := SymbolStream;
1529	>	with SymbolStream do
1530		begin
1531	<	FLastSymbol := GetNextSymbol(Line[index]);
1532	<	{combine if possible}
1533	<	case Result of
1534	<	sqNone:
1535	<	begin
1536	<	Result := FLastSymbol;
1537	<	if FLastSymbol = sqString then
1538	<	FString := FLastChar;
1539	<	FLastSymbol := sqNone
1531	>	StartXMLTag(XMLTag);
1532	>	while not Done do
1533	>	with SymbolStream do
1534	>	begin
1535	>	Symbol := GetSymbol;
1536	>
1537	>	case Symbol of
1538	>	sqEOL:
1539	>	case FState of
1540	>	stQuotedAttributeValue,
1541	>	stTagged:
1542	>	XMLString += LineEnding;
1543		end;
1544
1545	<	sqForwardSlash:
1546	<	if FLastSymbol = sqAsterisk then
1547	<	begin
1548	<	Result := sqCommentStart;
1549	<	FLastSymbol := sqNone
1550	<	end
1545	>	' ',sqTab:
1546	>	case FState of
1547	>	stQuotedAttributeValue,
1548	>	stTagged:
1549	>	XMLString += ' ';
1550	>	end;
1551	>
1552	>	';':
1553	>	case FState of
1554	>	stQuotedAttributeValue,
1555	>	stTagged:
1556	>	XMLString += ';';
1557	>	else
1558	>	ShowError(sXMLError,[Symbol]);
1559	>	end;
1560	>
1561	>	'''':
1562	>	case FState of
1563	>	stQuotedAttributeValue,
1564	>	stTagged:
1565	>	XMLString += '''';
1566	>	else
1567	>	ShowError(sXMLError,[Symbol]);
1568	>	end;
1569	>
1570	>	'*':
1571	>	case FState of
1572	>	stQuotedAttributeValue,
1573	>	stTagged:
1574	>	XMLString += '*';
1575	>	else
1576	>	ShowError(sXMLError,[Symbol]);
1577	>	end;
1578	>
1579	>	'/':
1580	>	case FState of
1581	>	stQuotedAttributeValue,
1582	>	stTagged:
1583	>	XMLString += '/';
1584	>	else
1585	>	ShowError(sXMLError,[Symbol]);
1586	>	end;
1587	>
1588	>	'>':
1589	>	case FState of
1590	>	stEndTag:
1591	>	case XMLTag of
1592	>	xtBlob:
1593	>	begin
1594	>	Result := ':' + Format(ibx_blob+'%d',[FCurrentBlob]);
1595	>	Done := true;
1596	>	end;
1597	>	xtArray:
1598	>	begin
1599	>	Result := ':' + Format(ibx_array+'%d',[FCurrentArray]);
1600	>	Done := true;
1601	>	end;
1602	>	else
1603	>	FState := stTagged;
1604	>	end;
1605	>
1606	>	stInTag:
1607	>	begin
1608	>	XMLString := '';
1609	>	FState := stTagged;
1610	>	EnterTag;
1611	>	end;
1612	>
1613	>	stQuotedAttributeValue,
1614	>	stTagged:
1615	>	XMLString += '>';
1616	>
1617	>	else
1618	>	ShowError(sXMLError,[Symbol]);
1619	>	end;
1620	>
1621	>	sqTag:
1622	>	if FState = stTagged then
1623	>	begin
1624	>	FState := stInTag;
1625	>	StartXMLTag(XMLTag)
1626	>	end
1627	>	else
1628	>	ShowError(sXMLError,[Symbol]);
1629	>
1630	>	sqEndTag:
1631	>	if FState = stTagged then
1632	>	begin
1633	>	ProcessTagValue(XMLString);
1634	>	EndXMLTag(XMLTag);
1635	>	FState := stEndTag;
1636	>	end
1637	>	else
1638	>	ShowError(sXMLError,[Symbol]);
1639	>
1640	>	'=':
1641	>	case FState of
1642	>	stAttribute:
1643	>	FState := stAttributeValue;
1644	>
1645	>	stQuotedAttributeValue,
1646	>	stTagged:
1647	>	XMLString += '=';
1648	>
1649	>	else
1650	>	ShowError(sXMLError,[Symbol]);
1651	>	end;
1652	>
1653	>	'"':
1654	>	case FState of
1655	>	stAttributeValue:
1656	>	begin
1657	>	XMLString := '';
1658	>	FState := stQuotedAttributeValue;
1659	>	end;
1660	>
1661	>	stQuotedAttributeValue:
1662	>	begin
1663	>	ProcessAttributeValue(XMLString);
1664	>	FState := stInTag;
1665	>	end;
1666	>
1667	>	stTagged:
1668	>	XMLString += '"';
1669	>
1670	>	else
1671	>	ShowError(sXMLError,[Symbol]);
1672	>	end;
1673	>
1674	>	sqString:
1675	>	case FState of
1676	>	stInTag: {attribute name}
1677	>	begin
1678	>	FAttributeName := SymbolValue;
1679	>	FState := stAttribute;
1680	>	end;
1681	>
1682	>	stAttributeValue:
1683	>	begin
1684	>	ProcessAttributeValue(FString);
1685	>	FState := stInTag;
1686	>	end;
1687	>
1688	>	stQuotedAttributeValue,
1689	>	stTagged:
1690	>	XMLString += SymbolValue;
1691	>
1692	>	else
1693	>	ShowError(sXMLError,[Symbol]);
1694	>	end;
1695		else
1696	<	if FLastSymbol = sqForwardSlash then
1697	<	begin
1698	<	Result := sqCommentLine;
1699	<	FLastSymbol := sqNone
1700	<	end;
1696	>	ShowError(sXMLError,[Symbol]);
1697	>	end
1698	>	end;
1699	>	end;
1700	>	end;
1701
1702	<	sqAsterisk:
1703	<	if FLastSymbol = sqForwardSlash then
1704	<	begin
1705	<	Result := sqCommentEnd;
1706	<	FLastSymbol := sqNone
1707	<	end;
1702	>	procedure TIBXMLProcessor.NextStatement;
1703	>	begin
1704	>	FXMLTagIndex := 0;
1705	>	SetLength(FBlobData,0);
1706	>	FCurrentBlob := -1;
1707	>	SetLength(FArrayData,0);
1708	>	FCurrentArray := -1;
1709	>	end;
1710
1711	<	sqString:
1712	<	if FLastSymbol = sqString then
1711	>	class function TIBXMLProcessor.FormatBlob(Field: ISQLData): string;
1712	>	var TextOut: TStrings;
1713	>	begin
1714	>	TextOut := TStringList.Create;
1715	>	try
1716	>	TextOut.Add(Format('<blob subtype="%d">',[Field.getSubtype]));
1717	>	StringToHex(Field.AsString,TextOut,BlobLineLength);
1718	>	TextOut.Add('</blob>');
1719	>	Result := TextOut.Text;
1720	>	finally
1721	>	TextOut.Free;
1722	>	end;
1723	>	end;
1724	>
1725	>	class function TIBXMLProcessor.FormatArray(Database: TIBDatabase; ar: IArray
1726	>	): string;
1727	>	var index: array of integer;
1728	>	TextOut: TStrings;
1729	>
1730	>	procedure AddElements(dim: integer; indent:string = ' ');
1731	>	var i: integer;
1732	>	recurse: boolean;
1733	>	begin
1734	>	SetLength(index,dim+1);
1735	>	recurse := dim < ar.GetDimensions - 1;
1736	>	with ar.GetBounds[dim] do
1737	>	for i := LowerBound to UpperBound do
1738		begin
1739	<	FString := FString + FLastChar;
1740	<	FLastSymbol := sqNone
1739	>	index[dim] := i;
1740	>	if recurse then
1741	>	begin
1742	>	TextOut.Add(Format('%s<elt id="%d">',[indent,i]));
1743	>	AddElements(dim+1,indent + ' ');
1744	>	TextOut.Add('</elt>');
1745	>	end
1746	>	else
1747	>	if ((ar.GetSQLType = SQL_TEXT) or (ar.GetSQLType = SQL_VARYING)) and
1748	>	(ar.GetCharSetID = 1) then
1749	>	TextOut.Add(Format('%s<elt ix="%d">%s</elt>',[indent,i,StringToHex(ar.GetAsString(index))]))
1750	>	else
1751	>	TextOut.Add(Format('%s<elt ix="%d">%s</elt>',[indent,i,ar.GetAsString(index)]));
1752		end;
1753		end;
1754	<	Inc(index)
1754	>
1755	>	var
1756	>	s: string;
1757	>	bounds: TArrayBounds;
1758	>	i: integer;
1759	>	boundsList: string;
1760	>	begin
1761	>	TextOut := TStringList.Create;
1762	>	try
1763	>	s := Format('<array dim = "%d" sqltype = "%d" length = "%d" relation_name = "%s" column_name = "%s"',
1764	>	[ar.GetDimensions,ar.GetSQLType,ar.GetSize,
1765	>	ar.GetTableName,ar.GetColumnName]);
1766	>	case ar.GetSQLType of
1767	>	SQL_DOUBLE, SQL_FLOAT, SQL_LONG, SQL_SHORT, SQL_D_FLOAT, SQL_INT64:
1768	>	s += Format(' scale = "%d"',[ ar.GetScale]);
1769	>	SQL_TEXT,
1770	>	SQL_VARYING:
1771	>	s += Format(' charset = "%s"',[Database.Attachment.GetCharsetName(ar.GetCharSetID)]);
1772	>	end;
1773	>	bounds := ar.GetBounds;
1774	>	boundsList := '';
1775	>	for i := 0 to length(bounds) - 1 do
1776	>	begin
1777	>	if i <> 0 then boundsList += ',';
1778	>	boundsList += Format('%d:%d',[bounds[i].LowerBound,bounds[i].UpperBound]);
1779	>	end;
1780	>	s += Format(' bounds="%s"',[boundsList]);
1781	>	s += '>';
1782	>	TextOut.Add(s);
1783	>
1784	>	SetLength(index,0);
1785	>	AddElements(0);
1786	>	TextOut.Add('</array>');
1787	>	Result := TextOut.Text;
1788	>	finally
1789	>	TextOut.Free;
1790		end;
1791	+	end;
1792
1793	<	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;
1793	>	{ TInteractiveSymbolStream }
1794
1795	<	if Result = sqString then
1796	<	begin
1797	<	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
1795	>	function TInteractiveSymbolStream.GetErrorPrefix: string;
1796	>	begin
1797	>	Result := '';
1798		end;
1799
1800	<	function TIBXScript.GetTransaction: TIBTransaction;
1800	>	function TInteractiveSymbolStream.GetNextLine(var Line: string): boolean;
1801		begin
1802	<	if FTransaction = nil then
1803	<	Result := FInternalTransaction
1802	>	if FNextStatement then
1803	>	write(FPrompt)
1804		else
1805	<	Result := FTransaction;
1805	>	write(FContinuePrompt);
1806	>	Result := not EOF;
1807	>	if Result then
1808	>	readln(Line);
1809		end;
1810
1811	<	procedure TIBXScript.SetDatabase(AValue: TIBDatabase);
1811	>	constructor TInteractiveSymbolStream.Create(aPrompt: string; aContinue: string);
1812		begin
1813	<	if FDatabase = AValue then Exit;
1814	<	FDatabase := AValue;
1815	<	FISQL.Database := AValue;
649	<	FInternalTransaction.DefaultDatabase := AValue;
1813	>	inherited Create;
1814	>	FPrompt := aPrompt;
1815	>	FContinuePrompt := aContinue;
1816		end;
1817
1818	<	function TIBXScript.PerformUpdate(const SQLFile: string;
653	<	AutoDDL: boolean): boolean;
654	<	var F: TFileStream;
1818	>	function TInteractiveSymbolStream.GetSymbol: TSQLSymbol;
1819		begin
1820	<	F := TFileStream.Create(SQLFile,fmOpenRead or fmShareDenyNone);
1821	<	try
1822	<	Result := PerformUpdate(F,AutoDDL)
1823	<	finally
1824	<	F.Free
1820	>	if Terminated then
1821	>	Result := sqEOF
1822	>	else
1823	>	Result := inherited GetSymbol;
1824	>	end;
1825	>
1826	>	{ TBatchSymbolStream }
1827	>
1828	>	function TBatchSymbolStream.GetErrorPrefix: string;
1829	>	begin
1830	>	Result := Format(sOnLineError,[FLineIndex,FIndex]);
1831	>	end;
1832	>
1833	>	function TBatchSymbolStream.GetNextLine(var Line: string): boolean;
1834	>	begin
1835	>	Result := FLineIndex < FLines.Count;
1836	>	if Result then
1837	>	begin
1838	>	Line := FLines[FLineIndex];
1839	>	//    writeln('Next Line = ',Line);
1840	>	Inc(FLineIndex);
1841	>	if assigned(OnProgressEvent) then
1842	>	OnProgressEvent(self,false,1);
1843		end;
1844		end;
1845
1846	<	function TIBXScript.PerformUpdate(const SQLStream: TStream; AutoDDL: boolean): boolean;
665	<	var Lines: TStringList;
666	<	FNotConnected: boolean;
1846	>	constructor TBatchSymbolStream.Create;
1847		begin
1848	<	FTerminator := ';';
1849	<	FAutoDDL := AutoDDL;
1850	<	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);
1848	>	inherited Create;
1849	>	FLines := TStringList.Create;
1850	>	end;
1851
1852	<	Result := AnalyseSQL(Lines)
1853	<	finally
1854	<	Lines.Free
1855	<	end;
1856	<	except on E:Exception do
1852	>	destructor TBatchSymbolStream.Destroy;
1853	>	begin
1854	>	if assigned(FLines) then FLines.Free;
1855	>	inherited Destroy;
1856	>	end;
1857	>
1858	>	procedure TBatchSymbolStream.SetStreamSource(Lines: TStrings);
1859	>	begin
1860	>	FLineIndex := 0;
1861	>	FLines.Assign(Lines);
1862	>	if assigned(OnProgressEvent) then
1863	>	OnProgressEvent(self,true,FLines.Count);
1864	>	end;
1865	>
1866	>	procedure TBatchSymbolStream.SetStreamSource(S: TStream);
1867	>	begin
1868	>	FLineIndex := 0;
1869	>	FLines.LoadFromStream(S);
1870	>	if assigned(OnProgressEvent) then
1871	>	OnProgressEvent(self,true,FLines.Count);
1872	>	end;
1873	>
1874	>	procedure TBatchSymbolStream.SetStreamSource(FileName: string);
1875	>	begin
1876	>	FLineIndex := 0;
1877	>	FLines.LoadFromFile(FileName);
1878	>	if assigned(OnProgressEvent) then
1879	>	OnProgressEvent(self,true,FLines.Count);
1880	>	end;
1881	>
1882	>	{ TSymbolStream }
1883	>
1884	>	function TSymbolStream.GetNextSymbol(C: char): TSQLSymbol;
1885	>	begin
1886	>	Result := sqNone;
1887	>	if C = FTerminator then
1888	>	Result := sqTerminator
1889	>	else
1890	>	case C of
1891	>	#0..#8,#10..#31,' ':
1892	>	Result := ' ';
1893	>
1894	>	#9,';','"','''','/',
1895	>	'*','=','>','<',',':
1896	>	Result := C;
1897	>	else
1898		begin
1899	<	Add2Log(E.Message);
1900	<	with GetTransaction do
687	<	if InTransaction then Rollback;
688	<	Result := false
1899	>	Result := sqString;
1900	>	FLastChar := C
1901		end
1902		end;
691	–	with GetTransaction do
692	–	if InTransaction then Commit;
693	–	if FNotConnected then
694	–	Database.Connected := false;
1903		end;
1904
1905	<	function TIBXScript.PopState: TSQLStates;
1905	>	function TSymbolStream.FindTag(tag: string; var xmlTag: TXMLTag): boolean;
1906	>	var i: integer;
1907		begin
1908	<	if FStackIndex = 0 then
1909	<	raise Exception.Create(sStackUnderflow);
1910	<	Dec(FStackIndex);
1911	<	Result := FStack[FStackIndex]
1908	>	Result := false;
1909	>	for i := 0 to Length(XMLTagDefs) - 1 do
1910	>	if XMLTagDefs[i].TagValue = tag then
1911	>	begin
1912	>	xmlTag := XMLTagDefs[i].XMLTag;
1913	>	Result := true;
1914	>	break;
1915	>	end;
1916		end;
1917
1918	<	function TIBXScript.ProcessSetStatement(stmt: string): boolean;
706	<	var  RegexObj: TRegExpr;
1918	>	constructor TSymbolStream.Create;
1919		begin
1920	<	Result := false;
1921	<	RegexObj := TRegExpr.Create;
1922	<	try
1923	<	{Process Set Term}
1924	<	RegexObj.Expression := 'SET +TERM +(.) *(\' + FTerminator + '|)';
1925	<	if RegexObj.Exec(AnsiUpperCase(stmt)) then
1920	>	inherited;
1921	>	FTerminator := ';';
1922	>	NextStatement;
1923	>	end;
1924	>
1925	>	procedure TSymbolStream.ShowError(msg: string; params: array of const);
1926	>	begin
1927	>	raise EIBClientError.CreateFmt(GetErrorPrefix + msg,params);
1928	>	end;
1929	>
1930	>	function TSymbolStream.GetSymbol: TSQLSymbol;
1931	>	var
1932	>	DelimitedText: string;
1933	>	CurState: (gsNone,gsInComment,gsInSingleQuotes,gsInDoubleQuotes);
1934	>	begin
1935	>	Result := sqNone;
1936	>	CurState := gsNone;
1937	>	DelimitedText := '';
1938	>	if FNextSymbol <> sqNone then
1939	>	begin
1940	>	Result := FNextSymbol;
1941	>	if Result = sqString then
1942	>	FString := FLastChar
1943	>	else
1944	>	FString := '';
1945	>	FNextSymbol := sqNone
1946	>	end;
1947	>
1948	>	while FNextSymbol = sqNone do {find the next symbol}
1949	>	begin
1950	>	if FIndex > Length(FLine) then
1951		begin
1952	<	FTerminator := RegexObj.Match[1][1];
1953	<	Result := true;
1954	<	Exit;
1952	>	FNextSymbol := sqEOL;
1953	>	FIndex := 0;
1954	>	end
1955	>	else
1956	>	begin
1957	>	if FIndex = 0 then
1958	>	begin
1959	>	if not GetNextLine(FLine) then
1960	>	begin
1961	>	Result := sqEOF;
1962	>	FNextSymbol := sqNone;
1963	>	Exit;
1964	>	end;
1965	>	FIndex := 1;
1966	>	FNextStatement := false;
1967	>	if assigned(OnNextLine) then
1968	>	OnNextLine(self,FLine);
1969	>	if CurState <> gsNone then
1970	>	DelimitedText += LineEnding;
1971	>	if Length(FLine) = 0 then
1972	>	continue;
1973	>	end;
1974	>	if CurState <> gsNone then
1975	>	DelimitedText += FLine[FIndex];
1976	>	FNextSymbol := GetNextSymbol(FLine[FIndex]);
1977	>	Inc(FIndex);
1978		end;
1979
1980	<	{Process AutoDDL}
1981	<	RegexObj.Expression := 'SET +AUTODDL +([a-zA-Z]+) *(\' + FTerminator + '|)';
1982	<	if RegexObj.Exec(AnsiUpperCase(stmt)) then
1983	<	begin
1984	<	if  AnsiUpperCase(RegexObj.Match[1]) = 'ON' then
1985	<	FAutoDDL := true
1986	<	else
1987	<	if  AnsiUpperCase(RegexObj.Match[1]) = 'OFF' then
1988	<	FAutoDDL := false
1989	<	else
1990	<	raise Exception.CreateFmt(sInvalidAutoDDL, [RegexObj.Match[0]]);
1980	>	case CurState of
1981	>	gsNone:
1982	>	begin
1983	>	{combine if possible}
1984	>	case Result of
1985	>	sqNone:
1986	>	begin
1987	>	Result := FNextSymbol;
1988	>	if FNextSymbol = sqString then
1989	>	FString := FLastChar;
1990	>	FNextSymbol := sqNone
1991	>	end;
1992	>
1993	>	'/':
1994	>	if FXMLMode > 0 then
1995	>	break
1996	>	else
1997	>	if FNextSymbol = '*' then
1998	>	begin
1999	>	CurState := gsInComment;
2000	>	DelimitedText := '/*';
2001	>	Result := sqNone;
2002	>	FNextSymbol := sqNone
2003	>	end
2004	>	else
2005	>	if FNextSymbol = '/' then
2006	>	begin
2007	>	FString := '/*' + system.copy(FLine,FIndex,length(FLine)- FIndex + 1) + ' */';
2008	>	Result := sqCommentLine;
2009	>	FIndex := 0;
2010	>	FNextSymbol := sqNone
2011	>	end;
2012	>
2013	>	'<':
2014	>	if (FXMLMode > 0) and (FNextSymbol = '/') then
2015	>	begin
2016	>	Result := sqEndTag;
2017	>	FString := '';
2018	>	FNextSymbol := sqNone
2019	>	end
2020	>	else
2021	>	if FNextSymbol = sqString then
2022	>	begin
2023	>	Result := sqTag;
2024	>	FString := FLastChar;
2025	>	FNextSymbol := sqNone
2026	>	end;
2027	>
2028	>	'''':
2029	>	if FXMLMode > 0 then
2030	>	break
2031	>	else
2032	>	if FNextSymbol = '''' then
2033	>	begin
2034	>	Result := sqQuotedString;
2035	>	FString := '''''';
2036	>	FNextSymbol := sqNone
2037	>	end
2038	>	else
2039	>	begin
2040	>	CurState := gsInSingleQuotes;
2041	>	DelimitedText := '''';
2042	>	if FNextSymbol = sqEOL then
2043	>	DelimitedText += LineEnding
2044	>	else
2045	>	DelimitedText += FLine[FIndex-1];
2046	>	Result := sqNone;
2047	>	FNextSymbol := sqNone
2048	>	end;
2049	>
2050	>	'"':
2051	>	if FXMLMode > 0 then
2052	>	break
2053	>	else
2054	>	begin
2055	>	CurState := gsInDoubleQuotes;
2056	>	DelimitedText := '"';
2057	>	if FNextSymbol = sqEOL then
2058	>	DelimitedText += LineEnding
2059	>	else
2060	>	DelimitedText += FLine[FIndex-1];
2061	>	Result := sqNone;
2062	>	FNextSymbol := sqNone
2063	>	end;
2064	>
2065	>	sqTag,
2066	>	sqEndTag,
2067	>	sqString:
2068	>	if FNextSymbol = sqString then
2069	>	begin
2070	>	FString := FString + FLastChar;
2071	>	FNextSymbol := sqNone
2072	>	end;
2073	>	end
2074	>	end;
2075	>
2076	>	{Check for state exit condition}
2077	>	gsInSingleQuotes:
2078	>	if Result = '''' then
2079	>	begin
2080	>	CurState := gsNone;
2081	>	if FNextSymbol = sqEOL then
2082	>	FString := DelimitedText
2083	>	else
2084	>	FString := system.copy(DelimitedText,1,Length(DelimitedText)-1);
2085	>	Result := sqQuotedString;
2086	>	end;
2087	>
2088	>	gsInDoubleQuotes:
2089	>	if Result = '"' then
2090	>	begin
2091	>	CurState := gsNone;
2092	>	if FNextSymbol = sqEOL then
2093	>	FString := DelimitedText
2094	>	else
2095	>	FString := system.copy(DelimitedText,1,Length(DelimitedText)-1);
2096	>	Result := sqDoubleQuotedString;
2097	>	end;
2098	>
2099	>	gsInComment:
2100	>	if (Result = '*') and (FNextSymbol = '/') then
2101	>	begin
2102	>	CurState := gsNone;
2103	>	FString := DelimitedText;
2104	>	Result := sqComment;
2105	>	FNextSymbol := sqNone
2106	>	end;
2107
732	–	Result := true;
2108		end;
734	–	finally
735	–	RegexObj.Free;
736	–	end;
737	–	end;
2109
2110	+	if (CurState <> gsNone) and (FNextSymbol <> sqNone) then
2111	+	begin
2112	+	Result := FNextSymbol;
2113	+	FNextSymbol := sqNone;
2114	+	end;
2115	+	end;
2116
2117	<	procedure TIBXScript.SetParamValue(SQLVar: TIBXSQLVAR);
741	<	var BlobID: TISC_QUAD;
742	<	begin
743	<	if assigned(FGetParamValue) and (SQLVar.SQLType = SQL_BLOB) then
2117	>	if (Result = sqTag) and (FNextSymbol <> sqNone) then
2118		begin
2119	<	Add2Log(Format(sResolveQueryParam,[SQLVar.Name]));
2120	<	GetParamValue(self,SQLVar.Name,BlobID);
747	<	if (BlobID.gds_quad_high = 0) and (BlobID.gds_quad_low = 0) then
748	<	SQLVar.Clear
2119	>	if FindTag(FString,FXMLTag) then
2120	>	Inc(FXMLMode)
2121		else
2122	<	SQLVar.AsQuad := BlobID
2122	>	Result := sqString;
2123		end
2124		else
2125	<	raise Exception.Create(sNoParamQueries);
2126	<	end;
2125	>	if (Result = sqEndTag) and (FNextSymbol <> sqNone) then
2126	>	begin
2127	>	if FindTag(FString,FXMLTag) then
2128	>	Dec(FXMLMode)
2129	>	else
2130	>	Result := sqString;
2131	>	end;
2132
2133	<	procedure TIBXScript.SetState(AState: TSQLStates);
2134	<	begin
2135	<	if FStackIndex > 16 then
2136	<	raise Exception.Create(sStackOverFlow);
2137	<	FStack[FStackIndex] := FState;
2138	<	Inc(FStackIndex);
2139	<	FState := AState
2133	>	if (FXMLMode = 0) and (Result = sqString) and (FString <> '') then
2134	>	begin
2135	>	if CompareText(FString,'begin') = 0 then
2136	>	Result := sqBegin
2137	>	else
2138	>	if CompareText(FString,'end') = 0 then
2139	>	Result := sqEnd
2140	>	else
2141	>	if CompareText(FString,'declare') = 0 then
2142	>	Result := sqDeclare
2143	>	else
2144	>	if CompareText(FString,'case') = 0 then
2145	>	Result := sqCase
2146	>	end;
2147	>	//  writeln(Result,',',FString);
2148		end;
2149
2150	<	procedure TIBXScript.ClearStatement;
2150	>	procedure TSymbolStream.NextStatement;
2151		begin
2152	<	FSQLText := '';
2153	<	FState := stInit;
769	<	FHasBegin := false;
770	<	FLastChar := ' ';
771	<	FLastSymbol := sqNone;
2152	>	FXMLTag := xtNone;
2153	>	FNextStatement := true;
2154		end;
2155
2156		end.

Diff Legend

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