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

Diff Legend

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