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 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 60 by tony, Mon Mar 27 15:21:02 2017 UTC

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

Diff Legend

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