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

Diff Legend

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