ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/runtime/nongui/ibxscript.pas

Comparing ibx/trunk/runtime/nongui/ibxscript.pas (file contents):
Revision 229 by tony, Tue Apr 10 13:32:36 2018 UTC vs.
Revision 349 by tony, Mon Oct 18 08:39:40 2021 UTC

#	Line 31 | Line 31 | unit ibxscript;
31
32		interface
33
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	<	DefaultTerminator = ';';
43	<
44	<	{Non-character symbols}
45	<	sqNone                 = #0;
46	<	sqEnd                  = #1;
47	<	sqBegin                = #2;
48	<	sqString               = #3;
49	<	sqComment              = #4;
50	<	sqCase                 = #5;
51	<	sqDeclare              = #6;
52	<	sqCommentLine          = #7;
53	<	sqEOL                  = #8;
54	<	sqTab                  = #9;
55	<	sqTerminator           = #10;
56	<	sqEOF                  = #11;
57	<	sqTag                  = #12;
58	<	sqEndTag               = #13;
59	<	sqQuotedString         = #14;
60	<	sqDoubleQuotedString   = #15;
34	>	uses Classes, IBDatabase,  IBSQL, IB, IBDataOutput, IBUtils;
35
36		type
63	–	TSQLSymbol = char;
64	–
65	–	TSQLStates =  (stInit, stError, stInSQL, stNested,  stInDeclaration);
66	–
67	–	TXMLStates =  (stInTag,stAttribute,stAttributeValue,stQuotedAttributeValue,
68	–	stTagged,stEndTag);
69	–
70	–	TXMLTag    =   (xtNone,xtBlob,xtArray,xtElt);
37
38		TOnNextLine = procedure(Sender: TObject; Line: string) of object;
39		TOnProgressEvent = procedure (Sender: TObject; Reset: boolean; value: integer) of object;
40
41	<	TXMLTagDef = record
76	<	XMLTag: TXMLTag;
77	<	TagValue: string;
78	<	end;
79	<
80	<	const
81	<	XMLTagDefs: array [0..2] of TXMLTagDef = (
82	<	(XMLTag: xtBlob;   TagValue: 'blob'),
83	<	(XMLTag: xtArray;  TagValue: 'array'),
84	<	(XMLTag: xtElt;    TagValue: 'elt')
85	<	);
41	>	{ TSQLXMLReader }
42
43	<	type
43	>	TSQLXMLReader = class(TSQLTokeniser)
44	>	private
45	>	type
46	>	TXMLStates =  (stNoXML, stInTag,stInTagBody,
47	>	stAttribute,stAttributeValue,stQuotedAttributeValue,
48	>	stInEndTag, stInEndTagBody,
49	>	stXMLData);
50	>
51	>	TXMLTag    =   (xtNone,xtBlob,xtArray,xtElt);
52	>
53	>	TXMLTagDef = record
54	>	XMLTag: TXMLTag;
55	>	TagValue: string;
56	>	end;
57	>
58	>	const
59	>	XMLTagDefs: array [xtBlob..xtElt] of TXMLTagDef = (
60	>	(XMLTag: xtBlob;   TagValue: 'blob'),
61	>	(XMLTag: xtArray;  TagValue: 'array'),
62	>	(XMLTag: xtElt;    TagValue: 'elt')
63	>	);
64	>	MaxXMLTags = 20;
65	>	BlobLineLength = 40;
66
67	<	{ TSymbolStream }
67	>	public
68	>	const
69	>	ibx_blob = 'IBX_BLOB';
70	>	ibx_array = 'IBX_ARRAY';
71	>
72	>	type
73	>	TBlobData = record
74	>	BlobIntf: IBlob;
75	>	SubType: cardinal;
76	>	end;
77	>
78	>	TArrayData = record
79	>	ArrayIntf: IArray;
80	>	SQLType: cardinal;
81	>	relationName: string;
82	>	columnName: string;
83	>	dim: cardinal;
84	>	Size: cardinal;
85	>	Scale: integer;
86	>	CharSet: string;
87	>	bounds: TArrayBounds;
88	>	CurrentRow: integer;
89	>	Index: array of integer;
90	>	end;
91	>
92	>	private
93	>	FDatabase: TIBDatabase;
94	>	FOnProgressEvent: TOnProgressEvent;
95	>	FTransaction: TIBTransaction;
96	>	FXMLState: TXMLStates;
97	>	FXMLTagStack: array [1..MaxXMLTags] of TXMLTag;
98	>	FXMLTagIndex: integer;
99	>	FAttributeName: string;
100	>	FXMLData: string;
101	>	FBlobData: array of TBlobData;
102	>	FCurrentBlob: integer;
103	>	FBlobBuffer: PChar;
104	>	FArrayData: array of TArrayData;
105	>	FCurrentArray: integer;
106	>	FXMLString: string;
107	>	function FindTag(tag: string; var xmlTag: TXMLTag): boolean;
108	>	function GetArrayData(index: integer): TArrayData;
109	>	function GetArrayDataCount: integer;
110	>	function GetBlobData(index: integer): TBlobData;
111	>	function GetBlobDataCount: integer;
112	>	function GetTagName(xmltag: TXMLTag): string;
113	>	procedure ProcessAttributeValue(attrValue: string);
114	>	procedure ProcessBoundsList(boundsList: string);
115	>	procedure ProcessTagValue(tagValue: string);
116	>	procedure XMLTagInit(xmltag: TXMLTag);
117	>	function XMLTagEnd(var xmltag: TXMLTag): boolean;
118	>	procedure XMLTagEnter;
119	>	protected
120	>	function GetErrorPrefix: string; virtual; abstract;
121	>	function TokenFound(var token: TSQLTokens): boolean; override;
122	>	procedure Reset; override;
123	>	procedure ShowError(msg: string; params: array of const); virtual; overload;
124	>	procedure ShowError(msg: string); overload;
125	>	public
126	>	constructor Create;
127	>	procedure FreeDataObjects;
128	>	class function FormatBlob(Field: ISQLData): string;
129	>	class function FormatArray(Database: TIBDatabase; ar: IArray): string;
130	>	property BlobData[index: integer]: TBlobData read GetBlobData;
131	>	property BlobDataCount: integer read GetBlobDataCount;
132	>	property ArrayData[index: integer]: TArrayData read GetArrayData;
133	>	property ArrayDataCount: integer read GetArrayDataCount;
134	>	property Database: TIBDatabase read FDatabase write FDatabase;
135	>	property Transaction: TIBTransaction read FTransaction write FTransaction;
136	>	property OnProgressEvent: TOnProgressEvent read FOnProgressEvent write FOnProgressEvent; {Progress Bar Support}
137	>	end;
138
139	<	{A simple lookahead one parser to process a text stream as a stream of symbols.
92	<	This is an abstract object, subclassed for different sources.}
139	>	{ TSQLStatementReader }
140
141	<	TSymbolStream = class
141	>	TSQLStatementReader = class(TSQLXMLReader)
142		private
143	<	FNextSymbol: TSQLSymbol;
143	>	type
144	>	TSQLState = (stDefault, stInStmt, stInBlock, stInArrayDim, stInDeclare);
145	>	private
146	>	FHasBegin: boolean;
147		FOnNextLine: TOnNextLine;
98	–	FOnProgressEvent: TOnProgressEvent;
148		FTerminator: char;
100	–	FLastChar: char;
101	–	FIndex: integer;
102	–	FLine: string;
103	–	FString: string;
104	–	FXMLTag: TXMLTag;
105	–	FXMLMode: integer;
149		protected
150	<	FNextStatement: boolean;
108	<	function GetErrorPrefix: string; virtual; abstract;
109	<	function GetNextSymbol(C: char): TSQLSymbol;
110	<	function FindTag(tag: string; var xmlTag: TXMLTag): boolean;
111	<	function GetNextLine(var Line: string):boolean; virtual; abstract;
150	>	procedure EchoNextLine(aLine: string);
151		public
152		constructor Create;
153	<	procedure ShowError(msg: string; params: array of const);
154	<	function GetSymbol: TSQLSymbol; virtual;
155	<	procedure NextStatement;
117	<	property SymbolValue: string read FString;
118	<	property Terminator: char read FTerminator write FTerminator;
119	<	property XMLTag: TXMLTag read FXMLTag;
153	>	function GetNextStatement(var stmt: string) : boolean; virtual;
154	>	property HasBegin: boolean read FHasBegin;
155	>	property Terminator: char read FTerminator write FTerminator default DefaultTerminator;
156		property OnNextLine: TOnNextLine read FOnNextLine write FOnNextLine;
121	–	property OnProgressEvent: TOnProgressEvent read FOnProgressEvent write FOnProgressEvent; {Progress Bar Support}
157		end;
158
124	–	{ TBatchSymbolStream }
159
160	<	{This symbol stream supports non-interactive parsing of a text file, stream or
160	>	{ TBatchSQLStatementReader }
161	>
162	>	{This SQL Reader supports non-interactive parsing of a text file, stream or
163		lines of text.}
164
165	<	TBatchSymbolStream = class(TSymbolStream)
165	>	TBatchSQLStatementReader = class(TSQLStatementReader)
166		private
167	<	FLines: TStrings;
167	>	FInStream: TStream;
168	>	FOwnsInStream: boolean;
169		FLineIndex: integer;
170	+	FIndex: integer;
171	+	FCurLine: string;
172		protected
173	+	function GetChar: char; override;
174		function GetErrorPrefix: string; override;
135	–	function GetNextLine(var Line: string):boolean; override;
175		public
176	<	constructor Create;
138	<	destructor Destroy; override;
176	>	procedure Reset; override;
177		procedure SetStreamSource(Lines: TStrings); overload;
178		procedure SetStreamSource(S: TStream); overload;
179		procedure SetStreamSource(FileName: string); overload;
180	+	procedure SetStringStreamSource(S: string);
181		end;
182
183	<	{ TInteractiveSymbolStream }
183	>	{ TInteractiveSQLStatementReader }
184
185	<	{This symbol stream supports interactive parsing of commands and
185	>	{This SQL reader supports interactive parsing of commands and
186		SQL statements entered at a console}
187
188	<	TInteractiveSymbolStream = class(TSymbolStream)
188	>	TInteractiveSQLStatementReader = class(TSQLStatementReader)
189		private
190		FPrompt: string;
191		FContinuePrompt: string;
192		FTerminated: boolean;
193	+	FLine: string;
194	+	FLineIndex: integer;
195	+	FNextStatement: boolean;
196	+	function GetNextLine(var Line: string):boolean;
197		protected
198	+	function GetChar: char; override;
199		function GetErrorPrefix: string; override;
156	–	function GetNextLine(var Line: string):boolean; override;
200		public
201		constructor Create(aPrompt: string='SQL>'; aContinue: string = 'CON>');
202	<	function GetSymbol: TSQLSymbol; override;
202	>	function GetNextStatement(var stmt: string) : boolean; override;
203		property Terminated: boolean read FTerminated write FTerminated;
204		end;
205
163	–	TBlobData = record
164	–	BlobIntf: IBlob;
165	–	SubType: cardinal;
166	–	end;
167	–
168	–	TArrayData = record
169	–	ArrayIntf: IArray;
170	–	SQLType: cardinal;
171	–	relationName: string;
172	–	columnName: string;
173	–	dim: cardinal;
174	–	Size: cardinal;
175	–	Scale: integer;
176	–	CharSet: string;
177	–	bounds: TArrayBounds;
178	–	CurrentRow: integer;
179	–	Index: array of integer;
180	–	end;
181	–
182	–	{ TIBXMLProcessor }
183	–
184	–	{This is a simple XML parser that parses the output of a symbol stream as XML
185	–	structured data, recognising tags, attributes and data. The tags are given in
186	–	the table XMLTagDefs. The BlobData and ArrayData properties return blob and
187	–	array data decoded from the XML stream.}
188	–
189	–	TIBXMLProcessor = class
190	–	private
191	–	FDatabase: TIBDatabase;
192	–	FSymbolStream: TSymbolStream;
193	–	FState: TXMLStates;
194	–	FTransaction: TIBTransaction;
195	–	FXMLTagStack: array [1..20] of TXMLTag;
196	–	FXMLTagIndex: integer;
197	–	FAttributeName: string;
198	–	FBlobData: array of TBlobData;
199	–	FCurrentBlob: integer;
200	–	FArrayData: array of TArrayData;
201	–	FCurrentArray: integer;
202	–	FBlobBuffer: PChar;
203	–	procedure EndXMLTag(xmltag: TXMLTag);
204	–	procedure EnterTag;
205	–	function GetArrayData(index: integer): TArrayData;
206	–	function GetArrayDataCount: integer;
207	–	function GetBlobData(index: integer): TBlobData;
208	–	function GetBlobDataCount: integer;
209	–	procedure ProcessTagValue(tagValue: string);
210	–	procedure StartXMLTag(xmltag: TXMLTag);
211	–	procedure ProcessAttributeValue(attrValue: string);
212	–	procedure ProcessBoundsList(boundsList: string);
213	–	public
214	–	constructor Create;
215	–	destructor Destroy; override;
216	–	function AnalyseXML(SymbolStream: TSymbolStream): string;
217	–	procedure NextStatement;
218	–	class function FormatBlob(Field: ISQLData): string;
219	–	class function FormatArray(Database: TIBDatabase; ar: IArray): string;
220	–	property BlobData[index: integer]: TBlobData read GetBlobData;
221	–	property BlobDataCount: integer read GetBlobDataCount;
222	–	property ArrayData[index: integer]: TArrayData read GetArrayData;
223	–	property ArrayDataCount: integer read GetArrayDataCount;
224	–	property Database: TIBDatabase read FDatabase write FDatabase;
225	–	property Transaction: TIBTransaction read FTransaction write FTransaction;
226	–	end;
227	–
228	–	{ TIBSQLProcessor }
229	–
230	–	{This parses a symbol stream into SQL statements. If embedded XML is found then
231	–	this is processed by the supplied XMLProcessor. The HasBegin property provides
232	–	a simple way to recognised stored procedure DDL, and "Execute As" statements.}
233	–
234	–	TIBSQLProcessor = class
235	–	private
236	–	FSQLText: string;
237	–	FState: TSQLStates;
238	–	FStack: array [0..16] of TSQLStates;
239	–	FStackindex: integer;
240	–	FHasBegin: boolean;
241	–	FInCase: boolean;
242	–	FNested: integer;
243	–	FXMLProcessor: TIBXMLProcessor;
244	–	FSymbolStream: TSymbolStream;
245	–	procedure AddToSQL(const Symbol: string);
246	–	procedure SetState(AState: TSQLStates);
247	–	function PopState: TSQLStates;
248	–	public
249	–	constructor Create(XMLProcessor: TIBXMLProcessor);
250	–	function GetNextStatement(SymbolStream: TSymbolStream; var stmt: string) : boolean;
251	–	property HasBegin: boolean read FHasBegin;
252	–	end;
253	–
206		TGetParamValue = procedure(Sender: TObject; ParamName: string; var BlobID: TISC_QUAD) of object;
207		TLogEvent = procedure(Sender: TObject; Msg: string) of Object;
208		TOnSelectSQL = procedure (Sender: TObject; SQLText: string) of object;
#	Line 272 | Line 224 | type
224		TCustomIBXScript = class(TComponent)
225		private
226		FEcho: boolean;
227	<	FIBXMLProcessor: TIBXMLProcessor;
276	<	FIBSQLProcessor: TIBSQLProcessor;
227	>	FSQLReader: TSQLStatementReader;
228		FDatabase: TIBDatabase;
229		FDataOutputFormatter: TIBCustomDataOutput;
230		FIgnoreCreateDatabase: boolean;
#	Line 302 | Line 253 | type
253		procedure SetShowPerformanceStats(AValue: boolean);
254		procedure SetTransaction(AValue: TIBTransaction);
255		protected
305	–	FSymbolStream: TSymbolStream;
256		procedure Add2Log(const Msg: string; IsError: boolean=true); virtual;
257		procedure ExecSQL(stmt: string);
258		procedure EchoNextLine(Sender: TObject; Line: string);
259		procedure Notification(AComponent: TComponent; Operation: TOperation); override;
260		function ProcessStatement(stmt: string): boolean; virtual;
261		function ProcessStream: boolean;
262	+	procedure SetSQLStatementReader(SQLStatementReader: TSQLStatementReader);
263		public
264		constructor Create(aOwner: TComponent); override;
265		destructor Destroy; override;
266		procedure DefaultSelectSQLHandler(aSQLText: string);
267	+	property SQLStatementReader: TSQLStatementReader read FSQLReader;
268		published
269		property Database: TIBDatabase read FDatabase write SetDatabase;
270		property DataOutputFormatter: TIBCustomDataOutput read FDataOutputFormatter
#	Line 431 | Line 383 | implementation
383		uses Sysutils, RegExpr;
384
385		resourcestring
434	–	sTerminatorUnknownState = 'Statement Terminator in unexpected state (%d)';
386		sNoSelectSQL = 'Select SQL Statements are not supported';
436	–	sStackUnderflow = 'Stack Underflow';
387		sNoParamQueries =  'Parameterised Queries are not supported';
438	–	sStackOverFlow = 'Stack Overflow';
388		sResolveQueryParam =  'Resolving Query Parameter: %s';
389		sXMLStackUnderflow = 'XML Stack Underflow';
390		sInvalidEndTag = 'XML End Tag Mismatch - %s';
391	+	sBadEndTagClosing = 'XML End Tag incorrectly closed';
392		sXMLStackOverFlow = 'XML Stack Overflow';
443	–	sErrorState = 'Entered Error State';
444	–	sXMLError = 'Invalid XML (%c)';
393		sXMLAttributeError = 'Unexpected attribute - "%s" = "%s"';
394		sInvalidBoundsList = 'Invalid array bounds list - "%s"';
395		sBinaryBlockMustbeEven = 'Binary block must have an even number of characters';
#	Line 450 | Line 398 | resourcestring
398		sArrayIndexError = 'Array Index Error (%d)';
399		sBlobIndexError = 'Blob Index Error (%d)';
400		sStatementError = 'Error processing SQL statement: %s %s - for statement "%s"';
401	+	sNotInArray = 'elt tag found but not in an XML array tag';
402	+	sNoDatabase = 'Missing database for xml tag import';
403	+	sNoTransaction = 'Missing transaction for xml tag import';
404
405		function StringToHex(octetString: string; MaxLineLength: integer): string; overload;
406
#	Line 491 | Line 442 | begin
442		TextOut.Add(StringToHex(octetString,MaxLineLength));
443		end;
444
445	+	{ TSQLStatementReader }
446	+
447	+	procedure TSQLStatementReader.EchoNextLine(aLine: string);
448	+	begin
449	+	if assigned(FOnNextLine) then
450	+	OnNextLine(self,aLine);
451	+	end;
452	+
453	+	constructor TSQLStatementReader.Create;
454	+	begin
455	+	inherited Create;
456	+	Terminator := DefaultTerminator;
457	+	end;
458	+
459	+	function TSQLStatementReader.GetNextStatement(var stmt: string): boolean;
460	+	var State: TSQLState;
461	+	Nested: integer;
462	+	token: TSQLTokens;
463	+	EndOfStatement: boolean;
464	+	begin
465	+	FHasBegin := false;
466	+	Result := false;
467	+	EndOfStatement := false;
468	+	Nested := 0;
469	+	stmt := '';
470	+	State := stDefault;
471	+	while not EOF and not EndOfStatement do
472	+	begin
473	+	token := GetNextToken;
474	+	//    writeln(token,' ',TokenText,' ',Terminator);
475	+	case State of
476	+	stDefault:
477	+	{ignore everything before a reserved word}
478	+	if (token <= high(TSQLReservedWords)) or (token = sqltIdentifier) then
479	+	begin
480	+	State := stInStmt;
481	+	stmt += TokenText;
482	+	end;
483	+
484	+	stInStmt:
485	+	begin
486	+	case token of
487	+	sqltBegin:
488	+	begin
489	+	FHasBegin := true;
490	+	State := stInBlock;
491	+	Nested := 1;
492	+	stmt += TokenText;
493	+	end;
494	+
495	+	sqltDeclare:
496	+	begin
497	+	State := stInDeclare;
498	+	stmt += TokenText;
499	+	end;
500	+
501	+	sqltOpenSquareBracket:
502	+	begin
503	+	State := stInArrayDim;
504	+	stmt += TokenText;
505	+	end;
506	+
507	+	sqltComment:
508	+	stmt += '/*' + TokenText + '*/';
509	+
510	+	sqltCommentLine:
511	+	stmt += '/*' + TokenText + ' */' + LineEnding;
512	+
513	+	sqltQuotedString:
514	+	stmt += '''' + SQLSafeString(TokenText) + '''';
515	+
516	+	sqltIdentifierInDoubleQuotes:
517	+	stmt += '"' + TokenText + '"';
518	+
519	+	sqltCR: {ignore};
520	+
521	+	sqltEOL:
522	+	stmt += LineEnding;
523	+
524	+	else
525	+	begin
526	+	if (tokentext = Terminator) and (Nested = 0) then
527	+	begin
528	+	EndOfStatement := true;
529	+	State := stDefault;
530	+	end
531	+	else
532	+	stmt += TokenText;
533	+	end;
534	+	end;
535	+	end;
536	+
537	+	{ignore begin..end blocks for Terminator detection }
538	+
539	+	stInBlock:
540	+	begin
541	+	case token of
542	+	sqltBegin:
543	+	begin
544	+	Inc(Nested);
545	+	stmt += TokenText;
546	+	end;
547	+
548	+	sqltEnd:
549	+	begin
550	+	Dec(Nested);
551	+	stmt += TokenText;
552	+	if Nested = 0 then
553	+	begin
554	+	State := stDefault;
555	+	EndOfStatement := true;
556	+	end;
557	+	end;
558	+
559	+	sqltCase:
560	+	{case constructs can appear within select statement in nested blocks.
561	+	We need to match the case constructs END token in order to parse the
562	+	block correctly. This is a simple parser and the only objective is
563	+	to determine the correct end of block. We therefore do not check to
564	+	ensure that the next end properly matches the case. The CASE is thus
565	+	treated the same as BEGIN. The Firebird SQL Parser will flag any errors
566	+	due to mismatched CASE/BEGIN END}
567	+	begin
568	+	Inc(Nested);
569	+	stmt += TokenText;
570	+	end;
571	+
572	+	sqltComment:
573	+	stmt += '/*' + TokenText + '*/';
574	+
575	+	sqltCommentLine:
576	+	stmt += '/* ' + TokenText + ' */' + LineEnding;
577	+
578	+	sqltQuotedString:
579	+	stmt += '''' + SQLSafeString(TokenText) + '''';
580	+
581	+	sqltIdentifierInDoubleQuotes:
582	+	stmt += '"' + TokenText + '"';
583	+
584	+	sqltCR: {ignore};
585	+
586	+	sqltEOL:
587	+	stmt += LineEnding;
588	+
589	+	else
590	+	stmt += TokenText;
591	+	end;
592	+	end;
593	+
594	+	{ignore array dimensions for Terminator detection }
595	+
596	+	stInArrayDim:
597	+	begin
598	+	case token of
599	+
600	+	sqltComment:
601	+	stmt += '/*' + TokenText + '*/';
602	+
603	+	sqltCommentLine:
604	+	stmt += '/* ' + TokenText + ' */' + LineEnding;
605	+
606	+	sqltCloseSquareBracket:
607	+	begin
608	+	stmt += TokenText;
609	+	State := stInStmt;
610	+	end;
611	+
612	+	sqltCR: {ignore};
613	+
614	+	sqltEOL:
615	+	stmt += LineEnding;
616	+
617	+	else
618	+	stmt += TokenText;
619	+	end;
620	+	end;
621	+
622	+	{ignore Declare statement for terminator - semi-colon terminates declaration}
623	+
624	+	stInDeclare:
625	+	begin
626	+	case token of
627	+
628	+	sqltComment:
629	+	stmt += '/*' + TokenText + '*/';
630	+
631	+	sqltCommentLine:
632	+	stmt += '/* ' + TokenText + ' */' + LineEnding;
633	+
634	+	sqltQuotedString:
635	+	stmt += '''' + SQLSafeString(TokenText) + '''';  {exists some DECLARE with cursor having SELECT ...\... rc.rdb$constraint_type = 'PRIMARY KEY');}
636	+
637	+	sqltSemiColon:
638	+	begin
639	+	State := stInStmt;
640	+	stmt += TokenText;
641	+	end;
642	+
643	+	sqltCR: {ignore};
644	+
645	+	sqltEOL:
646	+	stmt += LineEnding;
647	+
648	+	else
649	+	stmt += TokenText;
650	+	end;
651	+	end;
652	+	end;
653	+	end;
654	+	Result := stmt <> '';
655	+	end;
656	+
657	+	{ TSQLXMLReader }
658	+
659	+	function TSQLXMLReader.FindTag(tag: string; var xmlTag: TXMLTag): boolean;
660	+	var i: TXMLTag;
661	+	begin
662	+	Result := false;
663	+	for i := xtBlob to xtElt do
664	+	if XMLTagDefs[i].TagValue = tag then
665	+	begin
666	+	xmlTag := XMLTagDefs[i].XMLTag;
667	+	Result := true;
668	+	break;
669	+	end;
670	+	end;
671	+
672	+	function TSQLXMLReader.GetArrayData(index: integer): TArrayData;
673	+	begin
674	+	if (index < 0) or (index > ArrayDataCount) then
675	+	ShowError(sArrayIndexError,[index]);
676	+	Result := FArrayData[index];
677	+	end;
678	+
679	+	function TSQLXMLReader.GetArrayDataCount: integer;
680	+	begin
681	+	Result := Length(FArrayData);
682	+	end;
683	+
684	+	function TSQLXMLReader.GetBlobData(index: integer): TBlobData;
685	+	begin
686	+	if (index < 0) or (index > BlobDataCount) then
687	+	ShowError(sBlobIndexError,[index]);
688	+	Result := FBlobData[index];
689	+	end;
690	+
691	+	function TSQLXMLReader.GetBlobDataCount: integer;
692	+	begin
693	+	Result := Length(FBlobData);
694	+	end;
695	+
696	+	function TSQLXMLReader.GetTagName(xmltag: TXMLTag): string;
697	+	var i: TXMLTag;
698	+	begin
699	+	Result := 'unknown';
700	+	for i := xtBlob to xtElt do
701	+	if XMLTagDefs[i].XMLTag = xmltag then
702	+	begin
703	+	Result := XMLTagDefs[i].TagValue;
704	+	Exit;
705	+	end;
706	+	end;
707	+
708	+	procedure TSQLXMLReader.ProcessAttributeValue(attrValue: string);
709	+	begin
710	+	case FXMLTagStack[FXMLTagIndex] of
711	+	xtBlob:
712	+	if FAttributeName = 'subtype' then
713	+	FBlobData[FCurrentBlob].SubType := StrToInt(attrValue)
714	+	else
715	+	ShowError(sXMLAttributeError,[FAttributeName,attrValue]);
716	+
717	+	xtArray:
718	+	if FAttributeName = 'sqltype' then
719	+	FArrayData[FCurrentArray].SQLType := StrToInt(attrValue)
720	+	else
721	+	if FAttributeName = 'relation_name' then
722	+	FArrayData[FCurrentArray].relationName := attrValue
723	+	else
724	+	if FAttributeName = 'column_name' then
725	+	FArrayData[FCurrentArray].columnName := attrValue
726	+	else
727	+	if FAttributeName = 'dim' then
728	+	FArrayData[FCurrentArray].Dim := StrToInt(attrValue)
729	+	else
730	+	if FAttributeName = 'length' then
731	+	FArrayData[FCurrentArray].Size := StrToInt(attrValue)
732	+	else
733	+	if FAttributeName = 'scale' then
734	+	FArrayData[FCurrentArray].Scale := StrToInt(attrValue)
735	+	else
736	+	if FAttributeName = 'charset' then
737	+	FArrayData[FCurrentArray].CharSet := attrValue
738	+	else
739	+	if FAttributeName = 'bounds' then
740	+	ProcessBoundsList(attrValue)
741	+	else
742	+	ShowError(sXMLAttributeError,[FAttributeName,attrValue]);
743	+
744	+	xtElt:
745	+	if FAttributeName = 'ix' then
746	+	with FArrayData[FCurrentArray] do
747	+	Index[CurrentRow] :=  StrToInt(attrValue)
748	+	else
749	+	ShowError(sXMLAttributeError,[FAttributeName,attrValue]);
750	+	end;
751	+	end;
752	+
753	+	procedure TSQLXMLReader.ProcessBoundsList(boundsList: string);
754	+	var list: TStringList;
755	+	i,j: integer;
756	+	begin
757	+	list := TStringList.Create;
758	+	try
759	+	list.Delimiter := ',';
760	+	list.DelimitedText := boundsList;
761	+	with FArrayData[FCurrentArray] do
762	+	begin
763	+	if dim <> list.Count then
764	+	ShowError(sInvalidBoundsList,[boundsList]);
765	+	SetLength(bounds,dim);
766	+	for i := 0 to list.Count - 1 do
767	+	begin
768	+	j := Pos(':',list[i]);
769	+	if j = 0 then
770	+	raise Exception.CreateFmt(sInvalidBoundsList,[boundsList]);
771	+	bounds[i].LowerBound := StrToInt(system.copy(list[i],1,j-1));
772	+	bounds[i].UpperBound := StrToInt(system.copy(list[i],j+1,length(list[i])-j));
773	+	end;
774	+	end;
775	+	finally
776	+	list.Free;
777	+	end;
778	+	end;
779	+
780	+	procedure TSQLXMLReader.ProcessTagValue(tagValue: string);
781	+
782	+	function nibble(hex: char): byte;
783	+	begin
784	+	case hex of
785	+	'0': Result := 0;
786	+	'1': Result := 1;
787	+	'2': Result := 2;
788	+	'3': Result := 3;
789	+	'4': Result := 4;
790	+	'5': Result := 5;
791	+	'6': Result := 6;
792	+	'7': Result := 7;
793	+	'8': Result := 8;
794	+	'9': Result := 9;
795	+	'a','A': Result := 10;
796	+	'b','B': Result := 11;
797	+	'c','C': Result := 12;
798	+	'd','D': Result := 13;
799	+	'e','E': Result := 14;
800	+	'f','F': Result := 15;
801	+	end;
802	+	end;
803	+
804	+	procedure RemoveWhiteSpace(var hexData: string);
805	+	var i: integer;
806	+	begin
807	+	{Remove White Space}
808	+	i := 1;
809	+	while i <= length(hexData) do
810	+	begin
811	+	case hexData[i] of
812	+	' ',#9,#10,#13:
813	+	begin
814	+	if i < Length(hexData) then
815	+	Move(hexData[i+1],hexData[i],Length(hexData)-i);
816	+	SetLength(hexData,Length(hexData)-1);
817	+	end;
818	+	else
819	+	Inc(i);
820	+	end;
821	+	end;
822	+	end;
823	+
824	+	procedure WriteToBlob(hexData: string);
825	+	var i,j : integer;
826	+	blength: integer;
827	+	P: PChar;
828	+	begin
829	+	RemoveWhiteSpace(hexData);
830	+	if odd(length(hexData)) then
831	+	ShowError(sBinaryBlockMustbeEven,[nil]);
832	+	blength := Length(hexData) div 2;
833	+	IBAlloc(FBlobBuffer,0,blength);
834	+	j := 1;
835	+	P := FBlobBuffer;
836	+	for i := 1 to blength do
837	+	begin
838	+	P^ := char((nibble(hexData[j]) shl 4) or nibble(hexdata[j+1]));
839	+	Inc(j,2);
840	+	Inc(P);
841	+	end;
842	+	FBlobData[FCurrentBlob].BlobIntf.Write(FBlobBuffer^,blength);
843	+	end;
844	+
845	+	begin
846	+	if tagValue = '' then Exit;
847	+	case FXMLTagStack[FXMLTagIndex] of
848	+	xtBlob:
849	+	WriteToBlob(tagValue);
850	+
851	+	xtElt:
852	+	with FArrayData[FCurrentArray] do
853	+	ArrayIntf.SetAsString(index,tagValue);
854	+
855	+	end;
856	+	end;
857	+
858	+	procedure TSQLXMLReader.XMLTagInit(xmltag: TXMLTag);
859	+	begin
860	+	if FXMLTagIndex > MaxXMLTags then
861	+	ShowError(sXMLStackOverFlow,[nil]);
862	+	Inc(FXMLTagIndex);
863	+	FXMLTagStack[FXMLTagIndex] := xmltag;
864	+	FXMLString := '';
865	+
866	+	case xmltag of
867	+	xtBlob:
868	+	begin
869	+	Inc(FCurrentBlob);
870	+	SetLength(FBlobData,FCurrentBlob+1);
871	+	FBlobData[FCurrentBlob].BlobIntf := nil;
872	+	FBlobData[FCurrentBlob].SubType := 0;
873	+	end;
874	+
875	+	xtArray:
876	+	begin
877	+	Inc(FCurrentArray);
878	+	SetLength(FArrayData,FCurrentArray+1);
879	+	with FArrayData[FCurrentArray] do
880	+	begin
881	+	ArrayIntf := nil;
882	+	SQLType := 0;
883	+	dim := 0;
884	+	Size := 0;
885	+	Scale := 0;
886	+	CharSet := 'NONE';
887	+	SetLength(Index,0);
888	+	CurrentRow := -1;
889	+	end;
890	+	end;
891	+
892	+	xtElt:
893	+	with FArrayData[FCurrentArray] do
894	+	Inc(CurrentRow)
895	+	end;
896	+	end;
897	+
898	+	function TSQLXMLReader.XMLTagEnd(var xmltag: TXMLTag): boolean;
899	+	begin
900	+	if FXMLTagIndex = 0 then
901	+	ShowError(sXMLStackUnderflow,[nil]);
902	+
903	+	xmlTag := FXMLTagStack[FXMLTagIndex];
904	+	case FXMLTagStack[FXMLTagIndex] of
905	+	xtBlob:
906	+	FBlobData[FCurrentBlob].BlobIntf.Close;
907	+
908	+	xtArray:
909	+	FArrayData[FCurrentArray].ArrayIntf.SaveChanges;
910	+
911	+	xtElt:
912	+	Dec(FArrayData[FCurrentArray].CurrentRow);
913	+	end;
914	+	Dec(FXMLTagIndex);
915	+	Result := FXMLTagIndex = 0;
916	+	end;
917	+
918	+	procedure TSQLXMLReader.XMLTagEnter;
919	+	var aCharSetID: integer;
920	+	begin
921	+	if Database = nil then
922	+	ShowError(sNoDatabase);
923	+	if Transaction = nil then
924	+	ShowError(sNoTransaction);
925	+	case FXMLTagStack[FXMLTagIndex] of
926	+	xtBlob:
927	+	begin
928	+	Database.Connected := true;
929	+	Transaction.Active := true;
930	+	FBlobData[FCurrentBlob].BlobIntf := Database.Attachment.CreateBlob(
931	+	Transaction.TransactionIntf,FBlobData[FCurrentBlob].SubType);
932	+	end;
933	+
934	+	xtArray:
935	+	with FArrayData[FCurrentArray] do
936	+	begin
937	+	Database.Connected := true;
938	+	Transaction.Active := true;
939	+	Database.Attachment.CharSetName2CharSetID(CharSet,aCharSetID);
940	+	SetLength(Index,dim);
941	+	ArrayIntf := Database.Attachment.CreateArray(
942	+	Transaction.TransactionIntf,
943	+	Database.Attachment.CreateArrayMetaData(SQLType,
944	+	relationName,columnName,Scale,Size,
945	+	aCharSetID,dim,bounds)
946	+	);
947	+	end;
948	+	end;
949	+	end;
950	+
951	+	{This is where the XML tags are identified and the token stream modified in
952	+	consequence}
953	+
954	+	function TSQLXMLReader.TokenFound(var token: TSQLTokens): boolean;
955	+
956	+	procedure NotAnXMLTag;
957	+	begin
958	+	begin
959	+	if FXMLTagIndex = 0 then
960	+	{nothing to do with XML so go back to processing SQL}
961	+	begin
962	+	QueueToken(token);
963	+	ReleaseQueue(token);
964	+	FXMLState := stNoXML
965	+	end
966	+	else
967	+	begin
968	+	{Not an XML tag, so just push back to XML Data}
969	+	FXMLState := stXMLData;
970	+	FXMLString += GetQueuedText;
971	+	ResetQueue;
972	+	end;
973	+	end;
974	+	end;
975	+
976	+	var XMLTag: TXMLTag;
977	+	begin
978	+	Result := inherited TokenFound(token);
979	+	if not Result then Exit;
980	+
981	+	case FXMLState of
982	+	stNoXML:
983	+	if token = sqltLT then
984	+	begin
985	+	ResetQueue;
986	+	QueueToken(token); {save in case this is not XML}
987	+	FXMLState := stInTag;
988	+	end;
989	+
990	+	stInTag:
991	+	{Opening '<' found, now looking for tag name or end tag marker}
992	+	case token of
993	+	sqltIdentifier:
994	+	begin
995	+	if FindTag(TokenText,XMLTag) then
996	+	begin
997	+	XMLTagInit(XMLTag);
998	+	QueueToken(token);
999	+	FXMLState := stInTagBody;
1000	+	end
1001	+	else
1002	+	NotAnXMLTag;
1003	+	end;
1004	+
1005	+	sqltForwardSlash:
1006	+	FXMLState := stInEndTag;
1007	+
1008	+	else
1009	+	NotAnXMLTag;
1010	+	end {case token};
1011	+
1012	+	stInTagBody:
1013	+	{Tag name found. Now looking for attribute or closing '>'}
1014	+	case token of
1015	+	sqltIdentifier:
1016	+	begin
1017	+	FAttributeName := TokenText;
1018	+	QueueToken(token);
1019	+	FXMLState := stAttribute;
1020	+	end;
1021	+
1022	+	sqltGT:
1023	+	begin
1024	+	ResetQueue;
1025	+	XMLTagEnter;
1026	+	FXMLState := stXMLData;
1027	+	end;
1028	+
1029	+	sqltSpace,
1030	+	sqltCR, sqltEOL:
1031	+	QueueToken(token);
1032	+
1033	+	else
1034	+	NotAnXMLTag;
1035	+	end {case token};
1036	+
1037	+	stAttribute:
1038	+	{Attribute name found. Must be followed by an '=', a '>' or another tag name}
1039	+	case token of
1040	+	sqltEquals:
1041	+	begin
1042	+	QueueToken(token);
1043	+	FXMLState := stAttributeValue;
1044	+	end;
1045	+
1046	+	sqltSpace,
1047	+	sqltCR, sqltEOL:
1048	+	QueueToken(token);
1049	+
1050	+	sqltIdentifier:
1051	+	begin
1052	+	ProcessAttributeValue('');
1053	+	FAttributeName := TokenText;
1054	+	QueueToken(token);
1055	+	FXMLState := stAttribute;
1056	+	end;
1057	+
1058	+	sqltGT:
1059	+	begin
1060	+	ProcessAttributeValue('');
1061	+	ResetQueue;
1062	+	XMLTagEnter;
1063	+	FXMLState := stXMLData;
1064	+	end;
1065	+
1066	+	else
1067	+	NotAnXMLTag;
1068	+	end; {case token}
1069	+
1070	+	stAttributeValue:
1071	+	{Looking for attribute value as a single identifier or a double quoted value}
1072	+	case token of
1073	+	sqltIdentifier,sqltIdentifierInDoubleQuotes:
1074	+	begin
1075	+	ProcessAttributeValue(TokenText);
1076	+	QueueToken(token);
1077	+	FXMLState := stInTagBody;
1078	+	end;
1079	+
1080	+	sqltSpace,
1081	+	sqltCR, sqltEOL:
1082	+	QueueToken(token);
1083	+
1084	+	else
1085	+	NotAnXMLTag;
1086	+	end; {case token}
1087	+
1088	+	stXMLData:
1089	+	if token = sqltLT then
1090	+	begin
1091	+	QueueToken(token); {save in case this is not XML}
1092	+	FXMLState := stInTag;
1093	+	end
1094	+	else
1095	+	FXMLString += TokenText;
1096	+
1097	+	stInEndTag:
1098	+	{Opening '</' found, now looking for tag name}
1099	+	case token of
1100	+	sqltIdentifier:
1101	+	begin
1102	+	if FindTag(TokenText,XMLTag) and (XMLTag = FXMLTagStack[FXMLTagIndex]) then
1103	+	begin
1104	+	QueueToken(token);
1105	+	FXMLState := stInEndTagBody;
1106	+	end
1107	+	else
1108	+	ShowError(sInvalidEndTag,[TokenText]);
1109	+	end;
1110	+	else
1111	+	NotAnXMLTag;
1112	+	end {case token};
1113	+
1114	+	stInEndTagBody:
1115	+	{End tag name found, now looping for closing '>'}
1116	+	case Token of
1117	+	sqltGT:
1118	+	begin
1119	+	ProcessTagValue(FXMLString);
1120	+	if XMLTagEnd(XMLTag) then
1121	+	begin
1122	+	ResetQueue;
1123	+	QueueToken(sqltColon,':');
1124	+	case XMLTag of
1125	+	xtBlob:
1126	+	QueueToken(sqltIdentifier,Format(ibx_blob+'%d',[FCurrentBlob]));
1127	+
1128	+	xtArray:
1129	+	QueueToken(sqltIdentifier, Format(ibx_array+'%d',[FCurrentArray]));
1130	+	end;
1131	+	ReleaseQueue(token);
1132	+	FXMLState := stNoXML;
1133	+	end
1134	+	else
1135	+	FXMLState := stXMLData;
1136	+	end;
1137	+
1138	+	sqltSpace,
1139	+	sqltCR, sqltEOL:
1140	+	QueueToken(token);
1141	+
1142	+	else
1143	+	ShowError(sBadEndTagClosing);
1144	+	end; {case token}
1145	+
1146	+	end {Case FState};
1147	+
1148	+	{Only allow token to be returned if not processing an XML tag}
1149	+
1150	+	Result := FXMLState = stNoXML;
1151	+	end;
1152	+
1153	+	procedure TSQLXMLReader.ShowError(msg: string; params: array of const);
1154	+	begin
1155	+	raise EIBClientError.CreateFmt(GetErrorPrefix + msg,params);
1156	+	end;
1157	+
1158	+	procedure TSQLXMLReader.ShowError(msg: string);
1159	+	begin
1160	+	ShowError(msg,[nil]);
1161	+	end;
1162	+
1163	+	constructor TSQLXMLReader.Create;
1164	+	begin
1165	+	inherited;
1166	+	FXMLState := stNoXML;
1167	+	end;
1168	+
1169	+	procedure TSQLXMLReader.FreeDataObjects;
1170	+	begin
1171	+	FXMLTagIndex := 0;
1172	+	SetLength(FBlobData,0);
1173	+	FCurrentBlob := -1;
1174	+	SetLength(FArrayData,0);
1175	+	FCurrentArray := -1;
1176	+	end;
1177	+
1178	+	class function TSQLXMLReader.FormatBlob(Field: ISQLData): string;
1179	+	var TextOut: TStrings;
1180	+	begin
1181	+	TextOut := TStringList.Create;
1182	+	try
1183	+	TextOut.Add(Format('<blob subtype="%d">',[Field.getSubtype]));
1184	+	StringToHex(Field.AsString,TextOut,BlobLineLength);
1185	+	TextOut.Add('</blob>');
1186	+	Result := TextOut.Text;
1187	+	finally
1188	+	TextOut.Free;
1189	+	end;
1190	+	end;
1191	+
1192	+	class function TSQLXMLReader.FormatArray(Database: TIBDatabase; ar: IArray
1193	+	): string;
1194	+	var index: array of integer;
1195	+	TextOut: TStrings;
1196	+
1197	+	procedure AddElements(dim: integer; indent:string = ' ');
1198	+	var i: integer;
1199	+	recurse: boolean;
1200	+	begin
1201	+	SetLength(index,dim+1);
1202	+	recurse := dim < ar.GetDimensions - 1;
1203	+	with ar.GetBounds[dim] do
1204	+	for i := LowerBound to UpperBound do
1205	+	begin
1206	+	index[dim] := i;
1207	+	if recurse then
1208	+	begin
1209	+	TextOut.Add(Format('%s<elt id="%d">',[indent,i]));
1210	+	AddElements(dim+1,indent + ' ');
1211	+	TextOut.Add('</elt>');
1212	+	end
1213	+	else
1214	+	if ((ar.GetSQLType = SQL_TEXT) or (ar.GetSQLType = SQL_VARYING)) and
1215	+	(ar.GetCharSetID = 1) then
1216	+	TextOut.Add(Format('%s<elt ix="%d">%s</elt>',[indent,i,StringToHex(ar.GetAsString(index))]))
1217	+	else
1218	+	TextOut.Add(Format('%s<elt ix="%d">%s</elt>',[indent,i,ar.GetAsString(index)]));
1219	+	end;
1220	+	end;
1221	+
1222	+	var
1223	+	s: string;
1224	+	bounds: TArrayBounds;
1225	+	i: integer;
1226	+	boundsList: string;
1227	+	begin
1228	+	TextOut := TStringList.Create;
1229	+	try
1230	+	if ar.GetCharSetWidth = 0 then
1231	+	s := Format('<array dim = "%d" sqltype = "%d" length = "%d" relation_name = "%s" column_name = "%s"',
1232	+	[ar.GetDimensions,ar.GetSQLType,ar.GetSize,
1233	+	ar.GetTableName,ar.GetColumnName])
1234	+	else
1235	+	s := Format('<array dim = "%d" sqltype = "%d" length = "%d" relation_name = "%s" column_name = "%s"',
1236	+	[ar.GetDimensions,ar.GetSQLType,ar.GetSize div ar.GetCharSetWidth,
1237	+	ar.GetTableName,ar.GetColumnName]);
1238	+	case ar.GetSQLType of
1239	+	SQL_DOUBLE, SQL_FLOAT, SQL_LONG, SQL_SHORT, SQL_D_FLOAT, SQL_INT64:
1240	+	s += Format(' scale = "%d"',[ ar.GetScale]);
1241	+	SQL_TEXT,
1242	+	SQL_VARYING:
1243	+	s += Format(' charset = "%s"',[Database.Attachment.GetCharsetName(ar.GetCharSetID)]);
1244	+	end;
1245	+	bounds := ar.GetBounds;
1246	+	boundsList := '';
1247	+	for i := 0 to length(bounds) - 1 do
1248	+	begin
1249	+	if i <> 0 then boundsList += ',';
1250	+	boundsList += Format('%d:%d',[bounds[i].LowerBound,bounds[i].UpperBound]);
1251	+	end;
1252	+	s += Format(' bounds="%s"',[boundsList]);
1253	+	s += '>';
1254	+	TextOut.Add(s);
1255	+
1256	+	SetLength(index,0);
1257	+	AddElements(0);
1258	+	TextOut.Add('</array>');
1259	+	Result := TextOut.Text;
1260	+	finally
1261	+	TextOut.Free;
1262	+	end;       end;
1263	+
1264	+	procedure TSQLXMLReader.Reset;
1265	+	begin
1266	+	inherited Reset;
1267	+	FreeDataObjects;
1268	+	FXMLString := '';
1269	+	FreeMem(FBlobBuffer);
1270	+	end;
1271	+
1272
1273
1274		{ TIBXScript }
#	Line 498 | Line 1276 | end;
1276		constructor TIBXScript.Create(aOwner: TComponent);
1277		begin
1278		inherited Create(aOwner);
1279	<	FSymbolStream := TBatchSymbolStream.Create;
502	<	FSymbolStream.OnNextLine := @EchoNextLine;
1279	>	SetSQLStatementReader(TBatchSQLStatementReader.Create);
1280		end;
1281
1282		function TIBXScript.PerformUpdate(SQLFile: string; aAutoDDL: boolean): boolean;
#	Line 517 | Line 1294 | end;
1294
1295		function TIBXScript.RunScript(SQLFile: string): boolean;
1296		begin
1297	<	TBatchSymbolStream(FSymbolStream).SetStreamSource(SQLFile);
1297	>	TBatchSQLStatementReader(FSQLReader).SetStreamSource(SQLFile);
1298		Result := ProcessStream;
1299		end;
1300
1301		function TIBXScript.RunScript(SQLStream: TStream): boolean;
1302		begin
1303	<	TBatchSymbolStream(FSymbolStream).SetStreamSource(SQLStream);
1303	>	TBatchSQLStatementReader(FSQLReader).SetStreamSource(SQLStream);
1304		Result := ProcessStream;
1305		end;
1306
1307		function TIBXScript.RunScript(SQLLines: TStrings): boolean;
1308		begin
1309	<	TBatchSymbolStream(FSymbolStream).SetStreamSource(SQLLines);
1309	>	TBatchSQLStatementReader(FSQLReader).SetStreamSource(SQLLines);
1310		Result := ProcessStream;
1311		end;
1312
1313		function TIBXScript.ExecSQLScript(sql: string): boolean;
537	–	var s: TStringList;
1314		begin
1315	<	s := TStringList.Create;
1316	<	try
541	<	s.Text := sql;
542	<	TBatchSymbolStream(FSymbolStream).SetStreamSource(s);
543	<	Result := ProcessStream;
544	<	finally
545	<	s.Free;
546	<	end;
1315	>	TBatchSQLStatementReader(FSQLReader).SetStringStreamSource(sql);
1316	>	Result := ProcessStream;
1317		end;
1318
1319		{ TCustomIBXScript }
#	Line 579 | Line 1349 | begin
1349		FISQL.SQL.Text := stmt;
1350		FISQL.Transaction := GetTransaction;
1351		FISQL.Transaction.Active := true;
1352	<	FISQL.ParamCheck := not FIBSQLProcessor.HasBegin; {Probably PSQL}
1352	>	//   FISQL.ParamCheck := not FSQLReader.HasBegin; {Probably PSQL}
1353		FISQL.Prepare;
1354		FISQL.Statement.EnableStatistics(ShowPerformanceStats);
1355
#	Line 618 | Line 1388 | end;
1388
1389		function TCustomIBXScript.GetOnProgressEvent: TOnProgressEvent;
1390		begin
1391	<	Result := FSymbolStream.OnProgressEvent;
1391	>	Result := FSQLReader.OnProgressEvent;
1392		end;
1393
1394		function TCustomIBXScript.GetTransaction: TIBTransaction;
#	Line 651 | Line 1421 | begin
1421		if not (csLoading in ComponentState) and (FDatabase = AValue) then Exit;
1422		FDatabase := AValue;
1423		FISQL.Database := AValue;
1424	<	FIBXMLProcessor.Database := AValue;
1424	>	FSQLReader.Database := AValue;
1425		FInternalTransaction.Active := false;
1426		FInternalTransaction.DefaultDatabase := AValue;
1427		end;
#	Line 668 | Line 1438 | end;
1438
1439		procedure TCustomIBXScript.SetOnProgressEvent(AValue: TOnProgressEvent);
1440		begin
1441	<	FSymbolStream.OnProgressEvent := AValue;
1441	>	FSQLReader.OnProgressEvent := AValue;
1442		end;
1443
1444		procedure TCustomIBXScript.SetParamValue(SQLVar: ISQLParam);
1445		var BlobID: TISC_QUAD;
1446		ix: integer;
1447		begin
1448	<	if (SQLVar.SQLType = SQL_BLOB) and (Pos(ibx_blob,SQLVar.Name) = 1) then
1448	>	if (SQLVar.SQLType = SQL_BLOB) and (Pos(TSQLXMLReader.ibx_blob,SQLVar.Name) = 1) then
1449		begin
1450	<	ix := StrToInt(system.copy(SQLVar.Name,length(ibx_blob)+1,length(SQLVar.Name)-length(ibx_blob)));
1451	<	SQLVar.AsBlob := FIBXMLProcessor.BlobData[ix].BlobIntf;
1450	>	ix := StrToInt(system.copy(SQLVar.Name,length(TSQLXMLReader.ibx_blob)+1,length(SQLVar.Name)-length(TSQLXMLReader.ibx_blob)));
1451	>	SQLVar.AsBlob := FSQLReader.BlobData[ix].BlobIntf;
1452		Exit;
1453		end
1454		else
1455	<	if (SQLVar.SQLType = SQL_ARRAY) and (Pos(ibx_array,SQLVar.Name) = 1) then
1455	>	if (SQLVar.SQLType = SQL_ARRAY) and (Pos(TSQLXMLReader.ibx_array,SQLVar.Name) = 1) then
1456		begin
1457	<	ix := StrToInt(system.copy(SQLVar.Name,length(ibx_array)+1,length(SQLVar.Name)-length(ibx_array)));
1458	<	SQLVar.AsArray := FIBXMLProcessor.ArrayData[ix].ArrayIntf;
1457	>	ix := StrToInt(system.copy(SQLVar.Name,length(TSQLXMLReader.ibx_array)+1,length(SQLVar.Name)-length(TSQLXMLReader.ibx_array)));
1458	>	SQLVar.AsArray := FSQLReader.ArrayData[ix].ArrayIntf;
1459		Exit;
1460		end;
1461
#	Line 714 | Line 1484 | function TCustomIBXScript.ProcessStream:
1484		var stmt: string;
1485		begin
1486		Result := false;
1487	<	while FIBSQLProcessor.GetNextStatement(FSymbolStream,stmt) do
1487	>	while FSQLReader.GetNextStatement(stmt) do
1488		try
1489	<	//    writeln('stmt = ',stmt);
1490	<	if trim(stmt) = '' then continue;
1489	>	stmt := trim(stmt);
1490	>	//    writeln('stmt = "',stmt,'"');
1491	>	if stmt = '' then continue;
1492		if not ProcessStatement(stmt) then
1493		ExecSQL(stmt);
1494
#	Line 725 | Line 1496 | begin
1496		begin
1497		with GetTransaction do
1498		if InTransaction then Rollback;
1499	<	FSymbolStream.Terminator := DefaultTerminator;
1499	>	FSQLReader.Terminator := TSQLStatementReader.DefaultTerminator;
1500		if assigned(OnErrorLog) then
1501		begin
1502	<	Add2Log(Format(sStatementError,[FSymbolStream.GetErrorPrefix,
1502	>	Add2Log(Format(sStatementError,[FSQLReader.GetErrorPrefix,
1503		E.Message,stmt]),true);
1504		if StopOnFirstError then Exit;
1505		end
#	Line 739 | Line 1510 | begin
1510		Result := true;
1511		end;
1512
1513	+	procedure TCustomIBXScript.SetSQLStatementReader(
1514	+	SQLStatementReader: TSQLStatementReader);
1515	+	begin
1516	+	FSQLReader := SQLStatementReader;
1517	+	FSQLReader.OnNextLine := @EchoNextLine;
1518	+	FSQLReader.Transaction := FInternalTransaction;
1519	+	end;
1520	+
1521		function TCustomIBXScript.ProcessStatement(stmt: string): boolean;
1522		var command: string;
1523
#	Line 850 | Line 1629 | var  RegexObj: TRegExpr;
1629		LoginPrompt: boolean;
1630		begin
1631		Result := false;
1632	<	Terminator := FSymbolStream.Terminator;
1632	>	Terminator := FSQLReader.Terminator;
1633		RegexObj := TRegExpr.Create;
1634		try
1635		{process create database}
#	Line 868 | Line 1647 | begin
1647		OnCreateDatabase(self,FileName);
1648		stmt := 'CREATE DATABASE ''' + FileName + '''' + system.copy(stmt,RegexObj.MatchPos[3], RegexObj.MatchLen[3]);
1649		UpdateUserPassword;
1650	<	FDatabase.Connected := false;
1650	>	if FDatabase.Connected then
1651	>	FDatabase.Dropdatabase;
1652		FDatabase.CreateDatabase(stmt);
873	–	FDatabase.Connected := false;
874	–	ExtractUserInfo;
875	–	FDatabase.Connected := true;
1653		Result := true;
1654		Exit;
1655		end;
#	Line 920 | Line 1697 | begin
1697		RegexObj.Expression := '^ *SET +TERM +(.) *(\' + Terminator + '|)';
1698		if RegexObj.Exec(stmt) then
1699		begin
1700	<	FSymbolStream.Terminator := RegexObj.Match[1][1];
1700	>	FSQLReader.Terminator := RegexObj.Match[1][1];
1701		Result := true;
1702		Exit;
1703		end;
#	Line 946 | Line 1723 | begin
1723		begin
1724		command := AnsiUpperCase(RegexObj.Match[1]);
1725		param := trim(RegexObj.Match[2]);
1726	+	if command = 'GENERATOR' then
1727	+	begin
1728	+	Result := false;
1729	+	Exit;
1730	+	end;
1731		if command = 'AUTODDL' then
1732		AutoDDL := ((RegexObj.MatchLen[2] = 0) and not AutoDDL) or
1733		(RegexObj.MatchLen[2] > 0) and Toggle(param)
#	Line 985 | Line 1767 | begin
1767		begin
1768		if assigned(DataOutputFormatter) then
1769		DataOutputFormatter.SetCommand(command,param,stmt,Result);
1770	<	if not Result and assigned(OnSetStatement) then
1771	<	OnSetStatement(self,command,param,stmt,Result)
1772	<	else
1773	<	raise Exception.CreateFmt(sInvalidSetStatement, [command,stmt]);
1770	>	if not Result then
1771	>	begin
1772	>	if assigned(OnSetStatement) then
1773	>	OnSetStatement(self,command,param,stmt,Result)
1774	>	else
1775	>	raise Exception.CreateFmt(sInvalidSetStatement, [command,stmt]);
1776	>	end;
1777		Exit;
1778		end;
1779		Result := true;
#	Line 1004 | Line 1789 | procedure TCustomIBXScript.SetTransactio
1789		begin
1790		if FTransaction = AValue then Exit;
1791		FTransaction := AValue;
1792	<	FIBXMLProcessor.Transaction := AValue;
1792	>	if FTransaction = nil then
1793	>	FSQLReader.Transaction := FInternalTransaction
1794	>	else
1795	>	FSQLReader.Transaction := FTransaction;
1796		end;
1797
1798		constructor TCustomIBXScript.Create(aOwner: TComponent);
#	Line 1015 | Line 1803 | begin
1803		FAutoDDL := true;
1804		FISQL := TIBSQL.Create(self);
1805		FISQL.ParamCheck := true;
1018	–	FIBXMLProcessor := TIBXMLProcessor.Create;
1019	–	FIBSQLProcessor := TIBSQLProcessor.Create(FIBXMLProcessor);
1806		FInternalTransaction := TIBTransaction.Create(self);
1807		FInternalTransaction.Params.Clear;
1808		FInternalTransaction.Params.Add('concurrency');
#	Line 1025 | Line 1811 | end;
1811
1812		destructor TCustomIBXScript.Destroy;
1813		begin
1814	<	if FIBSQLProcessor <> nil then FIBSQLProcessor.Free;
1029	<	if FIBXMLProcessor <> nil then FIBXMLProcessor.Free;
1030	<	if FSymbolStream <> nil then FSymbolStream.Free;
1814	>	if FSQLReader <> nil then FSQLReader.Free;
1815		if FISQL <> nil then FISQL.Free;
1816		if FInternalTransaction <> nil then FInternalTransaction.Free;
1817		inherited Destroy;
#	Line 1038 | Line 1822 | begin
1822		if assigned(DataOutputFormatter) then
1823		DataOutputFormatter.DataOut(aSQLText,@Add2Log)
1824		else
1825	<	FSymbolStream.ShowError(sNoSelectSQL,[nil]);
1825	>	FSQLReader.ShowError(sNoSelectSQL);
1826		end;
1827
1828	<	{ TIBSQLProcessor }
1828	>	{ TInteractiveSQLStatementReader }
1829
1830	<	procedure TIBSQLProcessor.AddToSQL(const Symbol: string);
1830	>	function TInteractiveSQLStatementReader.GetErrorPrefix: string;
1831		begin
1832	<	FSQLText := FSQLText +  Symbol;
1049	<	//  writeln('SQL = ',FSQLText);
1050	<	end;
1051	<
1052	<	procedure TIBSQLProcessor.SetState(AState: TSQLStates);
1053	<	begin
1054	<	if FStackIndex > 16 then
1055	<	FSymbolStream.ShowError(sStackOverFlow,[nil]);
1056	<	FStack[FStackIndex] := FState;
1057	<	Inc(FStackIndex);
1058	<	FState := AState
1059	<	end;
1060	<
1061	<	function TIBSQLProcessor.PopState: TSQLStates;
1062	<	begin
1063	<	if FStackIndex = 0 then
1064	<	FSymbolStream.ShowError(sStackUnderflow,[nil]);
1065	<	Dec(FStackIndex);
1066	<	Result := FStack[FStackIndex]
1067	<	end;
1068	<
1069	<	constructor TIBSQLProcessor.Create(XMLProcessor: TIBXMLProcessor);
1070	<	begin
1071	<	inherited Create;
1072	<	FXMLProcessor := XMLProcessor;
1832	>	Result := '';
1833		end;
1834
1835	<	function TIBSQLProcessor.GetNextStatement(SymbolStream: TSymbolStream;
1076	<	var stmt: string): boolean;
1077	<	var Symbol: TSQLSymbol;
1078	<	NonSpace: boolean;
1079	<	Done: boolean;
1835	>	function TInteractiveSQLStatementReader.GetNextLine(var Line: string): boolean;
1836		begin
1837	<	FSQLText := '';
1838	<	FState := stInit;
1839	<	FHasBegin := false;
1840	<	FSymbolStream := SymbolStream;
1841	<	FXMLProcessor.NextStatement;
1842	<	SymbolStream.NextStatement;
1087	<
1088	<	Result := true;
1089	<	Done := false;
1090	<	NonSpace := false;
1091	<	while not Done do
1092	<	with SymbolStream do
1837	>	if FNextStatement then
1838	>	write(FPrompt)
1839	>	else
1840	>	write(FContinuePrompt);
1841	>	Result := not system.EOF;
1842	>	if Result then
1843		begin
1844	<	if FState = stError then
1845	<	ShowError(sErrorState,[nil]);
1096	<	Symbol := GetSymbol;
1097	<	//    writeln('Symbol = ',Symbol,' Value = ',SymbolValue);
1098	<	if not (Symbol in [' ',sqEOL]) then
1099	<	NonSpace := true;
1100	<
1101	<	case Symbol of
1102	<	sqTag:
1103	<	begin
1104	<	if FState in [stInSQL,stNested] then
1105	<	AddToSQL(FXMLProcessor.AnalyseXML(SymbolStream));
1106	<	end;
1107	<
1108	<	sqTerminator:
1109	<	case FState of
1110	<	stInit: {ignore empty statement};
1111	<
1112	<	stInSQL:
1113	<	Done := true;
1114	<
1115	<	stNested:
1116	<	AddToSQL(Terminator);
1117	<
1118	<	stInDeclaration:
1119	<	begin
1120	<	FState := PopState;
1121	<	AddToSQL(Terminator);
1122	<	end;
1123	<
1124	<	else
1125	<	ShowError(sTerminatorUnknownState,[FState]);
1126	<	end;
1127	<
1128	<	';':
1129	<	begin
1130	<	if FState = stInDeclaration then
1131	<	FState := PopState;
1132	<	AddToSQL(';');
1133	<	end;
1134	<
1135	<	'*':
1136	<	begin
1137	<	AddToSQL('*');
1138	<	if FState =  stInit then
1139	<	FState := stInSQL
1140	<	end;
1141	<
1142	<	'/':
1143	<	begin
1144	<	AddToSQL('/');
1145	<	if FState =  stInit then
1146	<	FState := stInSQL
1147	<	end;
1148	<
1149	<	sqComment,
1150	<	sqQuotedString,
1151	<	sqDoubleQuotedString:
1152	<	if FState <> stInit then
1153	<	AddToSQL(SymbolValue);
1154	<
1155	<	sqCommentLine:
1156	<	if FState <> stInit then
1157	<	AddToSQL(SymbolValue + LineEnding);
1158	<
1159	<	sqEnd:
1160	<	begin
1161	<	AddToSQL(SymbolValue);
1162	<	case FState of
1163	<	stNested:
1164	<	begin
1165	<	if FNested = 0 then
1166	<	begin
1167	<	FState := PopState;
1168	<	if not FInCase then
1169	<	begin
1170	<	FState := stInit;
1171	<	Done := true;
1172	<	end
1173	<	else
1174	<	FInCase := false;
1175	<	end
1176	<	else
1177	<	Dec(FNested)
1178	<	end;
1179	<	{Otherwise ignore}
1180	<	end
1181	<	end;
1182	<
1183	<	sqBegin:
1184	<	begin
1185	<	FHasBegin := true;
1186	<	AddToSQL(SymbolValue);
1187	<	case FState of
1188	<	stNested:
1189	<	Inc(FNested);
1190	<
1191	<	stInSQL,
1192	<	stInit:
1193	<	SetState(stNested);
1194	<	end
1195	<	end;
1196	<
1197	<	sqCase:
1198	<	begin
1199	<	AddToSQL(SymbolValue);
1200	<	case FState of
1201	<	stNested:
1202	<	Inc(FNested);
1203	<
1204	<	stInSQL,
1205	<	stInit:
1206	<	begin
1207	<	FInCase := true;
1208	<	SetState(stNested);
1209	<	end;
1210	<	end
1211	<	end;
1212	<
1213	<	sqDeclare:
1214	<	begin
1215	<	AddToSQL(SymbolValue);
1216	<	if FState in [stInit,stInSQL] then
1217	<	SetState(stInDeclaration)
1218	<	end;
1219	<
1220	<	sqString:
1221	<	begin
1222	<	AddToSQL(SymbolValue);
1223	<	if FState = stInit then
1224	<	FState := stInSQL
1225	<	end;
1226	<
1227	<	sqEOL:
1228	<	begin
1229	<	case FState of
1230	<	stInit:
1231	<	{Do nothing};
1232	<	else
1233	<	if NonSpace then AddToSQL(LineEnding);
1234	<	end;
1235	<	end;
1236	<
1237	<	sqEOF:
1238	<	begin
1239	<	Done := true;
1240	<	Result := trim(FSQLText) <> '';
1241	<	end
1242	<	else
1243	<	if FState <> stInit then
1244	<	AddToSQL(Symbol);
1245	<	end
1246	<	end;
1247	<	stmt := FSQLText;
1248	<	//  writeln('stmt = ',stmt);
1249	<	end;
1250	<
1251	<	{ TIBXMLProcessor }
1252	<
1253	<	procedure TIBXMLProcessor.EndXMLTag(xmltag: TXMLTag);
1254	<	begin
1255	<	if FXMLTagIndex = 0 then
1256	<	FSymbolStream.ShowError(sXMLStackUnderflow,[nil]);
1257	<	if xmltag <> FXMLTagStack[FXMLTagIndex] then
1258	<	FSymbolStream.ShowError(sInvalidEndTag,[FSymbolStream.SymbolValue]);
1259	<
1260	<	case FXMLTagStack[FXMLTagIndex] of
1261	<	xtBlob:
1262	<	FBlobData[FCurrentBlob].BlobIntf.Close;
1263	<
1264	<	xtArray:
1265	<	FArrayData[FCurrentArray].ArrayIntf.SaveChanges;
1266	<
1267	<	xtElt:
1268	<	Dec(FArrayData[FCurrentArray].CurrentRow);
1269	<	end;
1270	<	Dec(FXMLTagIndex);
1271	<	end;
1272	<
1273	<	procedure TIBXMLProcessor.EnterTag;
1274	<	var aCharSetID: integer;
1275	<	begin
1276	<	case FXMLTagStack[FXMLTagIndex] of
1277	<	xtBlob:
1278	<	begin
1279	<	Database.Connected := true;
1280	<	Transaction.Active := true;
1281	<	FBlobData[FCurrentBlob].BlobIntf := Database.Attachment.CreateBlob(
1282	<	Transaction.TransactionIntf,FBlobData[FCurrentBlob].SubType);
1283	<	end;
1284	<
1285	<	xtArray:
1286	<	with FArrayData[FCurrentArray] do
1287	<	begin
1288	<	Database.Connected := true;
1289	<	Transaction.Active := true;
1290	<	Database.Attachment.CharSetName2CharSetID(CharSet,aCharSetID);
1291	<	SetLength(Index,dim);
1292	<	ArrayIntf := Database.Attachment.CreateArray(
1293	<	Transaction.TransactionIntf,
1294	<	Database.Attachment.CreateArrayMetaData(SQLType,
1295	<	relationName,columnName,Scale,Size,
1296	<	aCharSetID,dim,bounds)
1297	<	);
1298	<	end;
1844	>	readln(Line);
1845	>	EchoNextLine(Line);
1846		end;
1847		end;
1848
1849	<	function TIBXMLProcessor.GetArrayData(index: integer): TArrayData;
1303	<	begin
1304	<	if (index < 0) or (index > ArrayDataCount) then
1305	<	FSymbolStream.ShowError(sArrayIndexError,[index]);
1306	<	Result := FArrayData[index];
1307	<	end;
1308	<
1309	<	function TIBXMLProcessor.GetArrayDataCount: integer;
1310	<	begin
1311	<	Result := Length(FArrayData);
1312	<	end;
1313	<
1314	<	function TIBXMLProcessor.GetBlobData(index: integer): TBlobData;
1849	>	function TInteractiveSQLStatementReader.GetChar: char;
1850		begin
1851	<	if (index < 0) or (index > BlobDataCount) then
1852	<	FSymbolStream.ShowError(sBlobIndexError,[index]);
1853	<	Result := FBlobData[index];
1854	<	end;
1320	<
1321	<	function TIBXMLProcessor.GetBlobDataCount: integer;
1322	<	begin
1323	<	Result := Length(FBlobData);
1324	<	end;
1325	<
1326	<	procedure TIBXMLProcessor.ProcessTagValue(tagValue: string);
1327	<
1328	<	function nibble(hex: char): byte;
1329	<	begin
1330	<	case hex of
1331	<	'0': Result := 0;
1332	<	'1': Result := 1;
1333	<	'2': Result := 2;
1334	<	'3': Result := 3;
1335	<	'4': Result := 4;
1336	<	'5': Result := 5;
1337	<	'6': Result := 6;
1338	<	'7': Result := 7;
1339	<	'8': Result := 8;
1340	<	'9': Result := 9;
1341	<	'a','A': Result := 10;
1342	<	'b','B': Result := 11;
1343	<	'c','C': Result := 12;
1344	<	'd','D': Result := 13;
1345	<	'e','E': Result := 14;
1346	<	'f','F': Result := 15;
1347	<	end;
1348	<	end;
1349	<
1350	<	procedure RemoveWhiteSpace(var hexData: string);
1351	<	var i: integer;
1851	>	if Terminated then
1852	>	Result := #0
1853	>	else
1854	>	if FLineIndex > Length(FLine) then
1855		begin
1856	<	{Remove White Space}
1857	<	i := 1;
1858	<	while i <= length(hexData) do
1859	<	begin
1860	<	case hexData[i] of
1358	<	' ',#9,#10,#13:
1359	<	begin
1360	<	if i < Length(hexData) then
1361	<	Move(hexData[i+1],hexData[i],Length(hexData)-i);
1362	<	SetLength(hexData,Length(hexData)-1);
1363	<	end;
1364	<	else
1365	<	Inc(i);
1366	<	end;
1367	<	end;
1368	<	end;
1369	<
1370	<	procedure WriteToBlob(hexData: string);
1371	<	var i,j : integer;
1372	<	blength: integer;
1373	<	P: PChar;
1856	>	Result := LF;
1857	>	FLineIndex := 0;
1858	>	end
1859	>	else
1860	>	if FLineIndex = 0 then
1861		begin
1862	<	RemoveWhiteSpace(hexData);
1863	<	if odd(length(hexData)) then
1377	<	FSymbolStream.ShowError(sBinaryBlockMustbeEven,[nil]);
1378	<	blength := Length(hexData) div 2;
1379	<	IBAlloc(FBlobBuffer,0,blength);
1380	<	j := 1;
1381	<	P := FBlobBuffer;
1382	<	for i := 1 to blength do
1383	<	begin
1384	<	P^ := char((nibble(hexData[j]) shl 4) or nibble(hexdata[j+1]));
1385	<	Inc(j,2);
1386	<	Inc(P);
1387	<	end;
1388	<	FBlobData[FCurrentBlob].BlobIntf.Write(FBlobBuffer^,blength);
1389	<	end;
1390	<
1391	<	begin
1392	<	if tagValue = '' then Exit;
1393	<	case FXMLTagStack[FXMLTagIndex] of
1394	<	xtBlob:
1395	<	WriteToBlob(tagValue);
1396	<
1397	<	xtElt:
1398	<	with FArrayData[FCurrentArray] do
1399	<	ArrayIntf.SetAsString(index,tagValue);
1400	<
1401	<	end;
1402	<	end;
1403	<
1404	<	procedure TIBXMLProcessor.StartXMLTag(xmltag: TXMLTag);
1405	<	begin
1406	<	if FXMLTagIndex > 19 then
1407	<	FSymbolStream.ShowError(sXMLStackOverFlow,[nil]);
1408	<	Inc(FXMLTagIndex);
1409	<	FXMLTagStack[FXMLTagIndex] := xmltag;
1410	<	case xmltag of
1411	<	xtBlob:
1412	<	begin
1413	<	Inc(FCurrentBlob);
1414	<	SetLength(FBlobData,FCurrentBlob+1);
1415	<	FBlobData[FCurrentBlob].BlobIntf := nil;
1416	<	FBlobData[FCurrentBlob].SubType := 0;
1417	<	end;
1418	<
1419	<	xtArray:
1420	<	begin
1421	<	Inc(FCurrentArray);
1422	<	SetLength(FArrayData,FCurrentArray+1);
1423	<	with FArrayData[FCurrentArray] do
1424	<	begin
1425	<	ArrayIntf := nil;
1426	<	SQLType := 0;
1427	<	dim := 0;
1428	<	Size := 0;
1429	<	Scale := 0;
1430	<	CharSet := 'NONE';
1431	<	SetLength(Index,0);
1432	<	CurrentRow := -1;
1433	<	end;
1434	<	end;
1435	<
1436	<	xtElt:
1437	<	with FArrayData[FCurrentArray] do
1438	<	Inc(CurrentRow);
1439	<
1440	<	end;
1441	<	end;
1442	<
1443	<	procedure TIBXMLProcessor.ProcessAttributeValue(attrValue: string);
1444	<	begin
1445	<	case FXMLTagStack[FXMLTagIndex] of
1446	<	xtBlob:
1447	<	if FAttributeName = 'subtype' then
1448	<	FBlobData[FCurrentBlob].SubType := StrToInt(attrValue)
1449	<	else
1450	<	FSymbolStream.ShowError(sXMLAttributeError,[FAttributeName,attrValue]);
1451	<
1452	<	xtArray:
1453	<	if FAttributeName = 'sqltype' then
1454	<	FArrayData[FCurrentArray].SQLType := StrToInt(attrValue)
1455	<	else
1456	<	if FAttributeName = 'relation_name' then
1457	<	FArrayData[FCurrentArray].relationName := attrValue
1458	<	else
1459	<	if FAttributeName = 'column_name' then
1460	<	FArrayData[FCurrentArray].columnName := attrValue
1461	<	else
1462	<	if FAttributeName = 'dim' then
1463	<	FArrayData[FCurrentArray].Dim := StrToInt(attrValue)
1464	<	else
1465	<	if FAttributeName = 'length' then
1466	<	FArrayData[FCurrentArray].Size := StrToInt(attrValue)
1467	<	else
1468	<	if FAttributeName = 'scale' then
1469	<	FArrayData[FCurrentArray].Scale := StrToInt(attrValue)
1470	<	else
1471	<	if FAttributeName = 'charset' then
1472	<	FArrayData[FCurrentArray].CharSet := attrValue
1862	>	if not GetNextLine(FLine) then
1863	>	Result := #0
1864		else
1865	<	if FAttributeName = 'bounds' then
1866	<	ProcessBoundsList(attrValue)
1865	>	if Length(FLine) = 0 then
1866	>	Result := LF
1867		else
1477	–	FSymbolStream.ShowError(sXMLAttributeError,[FAttributeName,attrValue]);
1478	–
1479	–	xtElt:
1480	–	if FAttributeName = 'ix' then
1481	–	with FArrayData[FCurrentArray] do
1482	–	Index[CurrentRow] :=  StrToInt(attrValue)
1483	–	else
1484	–	FSymbolStream.ShowError(sXMLAttributeError,[FAttributeName,attrValue]);
1485	–	end;
1486	–	end;
1487	–
1488	–	procedure TIBXMLProcessor.ProcessBoundsList(boundsList: string);
1489	–	var list: TStringList;
1490	–	i,j: integer;
1491	–	begin
1492	–	list := TStringList.Create;
1493	–	try
1494	–	list.Delimiter := ',';
1495	–	list.DelimitedText := boundsList;
1496	–	with FArrayData[FCurrentArray] do
1868		begin
1869	<	if dim <> list.Count then
1870	<	FSymbolStream.ShowError(sInvalidBoundsList,[boundsList]);
1871	<	SetLength(bounds,dim);
1872	<	for i := 0 to list.Count - 1 do
1873	<	begin
1874	<	j := Pos(':',list[i]);
1875	<	if j = 0 then
1876	<	raise Exception.CreateFmt(sInvalidBoundsList,[boundsList]);
1506	<	bounds[i].LowerBound := StrToInt(system.copy(list[i],1,j-1));
1507	<	bounds[i].UpperBound := StrToInt(system.copy(list[i],j+1,length(list[i])-j));
1508	<	end;
1509	<	end;
1510	<	finally
1511	<	list.Free;
1869	>	Result := FLine[1];
1870	>	FLineIndex := 2;
1871	>	end
1872	>	end
1873	>	else
1874	>	begin
1875	>	Result := FLine[FLineIndex];
1876	>	Inc(FLineIndex);
1877		end;
1878		end;
1879
1880	<	constructor TIBXMLProcessor.Create;
1880	>	constructor TInteractiveSQLStatementReader.Create(aPrompt: string; aContinue: string);
1881		begin
1882		inherited Create;
1883	<	NextStatement;
1884	<	end;
1885	<
1886	<	destructor TIBXMLProcessor.Destroy;
1522	<	begin
1523	<	FreeMem(FBlobBuffer);
1524	<	inherited Destroy;
1883	>	FPrompt := aPrompt;
1884	>	FLineIndex := 0;
1885	>	FNextStatement := true;
1886	>	FContinuePrompt := aContinue;
1887		end;
1888
1889	<	function TIBXMLProcessor.AnalyseXML(SymbolStream: TSymbolStream): string;
1890	<	var Symbol: TSQLSymbol;
1529	<	Done: boolean;
1530	<	XMLString: string;
1889	>	function TInteractiveSQLStatementReader.GetNextStatement(var stmt: string
1890	>	): boolean;
1891		begin
1892	<	Result := '';
1893	<	XMLString := '';
1534	<	Done := false;
1535	<	FState := stInTag;
1536	<	FSymbolStream := SymbolStream;
1537	<	with SymbolStream do
1538	<	begin
1539	<	StartXMLTag(XMLTag);
1540	<	while not Done do
1541	<	with SymbolStream do
1542	<	begin
1543	<	Symbol := GetSymbol;
1544	<
1545	<	case Symbol of
1546	<	sqEOL:
1547	<	case FState of
1548	<	stQuotedAttributeValue,
1549	<	stTagged:
1550	<	XMLString += LineEnding;
1551	<	end;
1552	<
1553	<	' ',sqTab:
1554	<	case FState of
1555	<	stQuotedAttributeValue,
1556	<	stTagged:
1557	<	XMLString += ' ';
1558	<	end;
1559	<
1560	<	';':
1561	<	case FState of
1562	<	stQuotedAttributeValue,
1563	<	stTagged:
1564	<	XMLString += ';';
1565	<	else
1566	<	ShowError(sXMLError,[Symbol]);
1567	<	end;
1568	<
1569	<	'''':
1570	<	case FState of
1571	<	stQuotedAttributeValue,
1572	<	stTagged:
1573	<	XMLString += '''';
1574	<	else
1575	<	ShowError(sXMLError,[Symbol]);
1576	<	end;
1577	<
1578	<	'*':
1579	<	case FState of
1580	<	stQuotedAttributeValue,
1581	<	stTagged:
1582	<	XMLString += '*';
1583	<	else
1584	<	ShowError(sXMLError,[Symbol]);
1585	<	end;
1586	<
1587	<	'/':
1588	<	case FState of
1589	<	stQuotedAttributeValue,
1590	<	stTagged:
1591	<	XMLString += '/';
1592	<	else
1593	<	ShowError(sXMLError,[Symbol]);
1594	<	end;
1595	<
1596	<	'>':
1597	<	case FState of
1598	<	stEndTag:
1599	<	case XMLTag of
1600	<	xtBlob:
1601	<	begin
1602	<	Result := ':' + Format(ibx_blob+'%d',[FCurrentBlob]);
1603	<	Done := true;
1604	<	end;
1605	<	xtArray:
1606	<	begin
1607	<	Result := ':' + Format(ibx_array+'%d',[FCurrentArray]);
1608	<	Done := true;
1609	<	end;
1610	<	else
1611	<	FState := stTagged;
1612	<	end;
1613	<
1614	<	stInTag:
1615	<	begin
1616	<	XMLString := '';
1617	<	FState := stTagged;
1618	<	EnterTag;
1619	<	end;
1620	<
1621	<	stQuotedAttributeValue,
1622	<	stTagged:
1623	<	XMLString += '>';
1624	<
1625	<	else
1626	<	ShowError(sXMLError,[Symbol]);
1627	<	end;
1628	<
1629	<	sqTag:
1630	<	if FState = stTagged then
1631	<	begin
1632	<	FState := stInTag;
1633	<	StartXMLTag(XMLTag)
1634	<	end
1635	<	else
1636	<	ShowError(sXMLError,[Symbol]);
1637	<
1638	<	sqEndTag:
1639	<	if FState = stTagged then
1640	<	begin
1641	<	ProcessTagValue(XMLString);
1642	<	EndXMLTag(XMLTag);
1643	<	FState := stEndTag;
1644	<	end
1645	<	else
1646	<	ShowError(sXMLError,[Symbol]);
1647	<
1648	<	'=':
1649	<	case FState of
1650	<	stAttribute:
1651	<	FState := stAttributeValue;
1652	<
1653	<	stQuotedAttributeValue,
1654	<	stTagged:
1655	<	XMLString += '=';
1656	<
1657	<	else
1658	<	ShowError(sXMLError,[Symbol]);
1659	<	end;
1660	<
1661	<	'"':
1662	<	case FState of
1663	<	stAttributeValue:
1664	<	begin
1665	<	XMLString := '';
1666	<	FState := stQuotedAttributeValue;
1667	<	end;
1668	<
1669	<	stQuotedAttributeValue:
1670	<	begin
1671	<	ProcessAttributeValue(XMLString);
1672	<	FState := stInTag;
1673	<	end;
1674	<
1675	<	stTagged:
1676	<	XMLString += '"';
1677	<
1678	<	else
1679	<	ShowError(sXMLError,[Symbol]);
1680	<	end;
1681	<
1682	<	sqString:
1683	<	case FState of
1684	<	stInTag: {attribute name}
1685	<	begin
1686	<	FAttributeName := SymbolValue;
1687	<	FState := stAttribute;
1688	<	end;
1689	<
1690	<	stAttributeValue:
1691	<	begin
1692	<	ProcessAttributeValue(FString);
1693	<	FState := stInTag;
1694	<	end;
1695	<
1696	<	stQuotedAttributeValue,
1697	<	stTagged:
1698	<	XMLString += SymbolValue;
1699	<
1700	<	else
1701	<	ShowError(sXMLError,[Symbol]);
1702	<	end;
1703	<	else
1704	<	ShowError(sXMLError,[Symbol]);
1705	<	end
1706	<	end;
1707	<	end;
1892	>	Result := inherited GetNextStatement(stmt);
1893	>	FNextStatement := Result;
1894		end;
1895
1896	<	procedure TIBXMLProcessor.NextStatement;
1711	<	begin
1712	<	FXMLTagIndex := 0;
1713	<	SetLength(FBlobData,0);
1714	<	FCurrentBlob := -1;
1715	<	SetLength(FArrayData,0);
1716	<	FCurrentArray := -1;
1717	<	end;
1896	>	{ TBatchSQLStatementReader }
1897
1898	<	class function TIBXMLProcessor.FormatBlob(Field: ISQLData): string;
1720	<	var TextOut: TStrings;
1898	>	function TBatchSQLStatementReader.GetChar: char;
1899		begin
1900	<	TextOut := TStringList.Create;
1901	<	try
1902	<	TextOut.Add(Format('<blob subtype="%d">',[Field.getSubtype]));
1903	<	StringToHex(Field.AsString,TextOut,BlobLineLength);
1726	<	TextOut.Add('</blob>');
1727	<	Result := TextOut.Text;
1728	<	finally
1729	<	TextOut.Free;
1730	<	end;
1731	<	end;
1732	<
1733	<	class function TIBXMLProcessor.FormatArray(Database: TIBDatabase; ar: IArray
1734	<	): string;
1735	<	var index: array of integer;
1736	<	TextOut: TStrings;
1737	<
1738	<	procedure AddElements(dim: integer; indent:string = ' ');
1739	<	var i: integer;
1740	<	recurse: boolean;
1900	>	if not EOF and assigned(FInStream) and not (FInStream.Position = FInStream.Size) then
1901	>	begin
1902	>	Result := char(FInStream.ReadByte);
1903	>	if Result = LF then
1904		begin
1905	<	SetLength(index,dim+1);
1906	<	recurse := dim < ar.GetDimensions - 1;
1907	<	with ar.GetBounds[dim] do
1908	<	for i := LowerBound to UpperBound do
1909	<	begin
1910	<	index[dim] := i;
1911	<	if recurse then
1912	<	begin
1750	<	TextOut.Add(Format('%s<elt id="%d">',[indent,i]));
1751	<	AddElements(dim+1,indent + ' ');
1752	<	TextOut.Add('</elt>');
1753	<	end
1754	<	else
1755	<	if ((ar.GetSQLType = SQL_TEXT) or (ar.GetSQLType = SQL_VARYING)) and
1756	<	(ar.GetCharSetID = 1) then
1757	<	TextOut.Add(Format('%s<elt ix="%d">%s</elt>',[indent,i,StringToHex(ar.GetAsString(index))]))
1758	<	else
1759	<	TextOut.Add(Format('%s<elt ix="%d">%s</elt>',[indent,i,ar.GetAsString(index)]));
1760	<	end;
1761	<	end;
1762	<
1763	<	var
1764	<	s: string;
1765	<	bounds: TArrayBounds;
1766	<	i: integer;
1767	<	boundsList: string;
1768	<	begin
1769	<	TextOut := TStringList.Create;
1770	<	try
1771	<	s := Format('<array dim = "%d" sqltype = "%d" length = "%d" relation_name = "%s" column_name = "%s"',
1772	<	[ar.GetDimensions,ar.GetSQLType,ar.GetSize,
1773	<	ar.GetTableName,ar.GetColumnName]);
1774	<	case ar.GetSQLType of
1775	<	SQL_DOUBLE, SQL_FLOAT, SQL_LONG, SQL_SHORT, SQL_D_FLOAT, SQL_INT64:
1776	<	s += Format(' scale = "%d"',[ ar.GetScale]);
1777	<	SQL_TEXT,
1778	<	SQL_VARYING:
1779	<	s += Format(' charset = "%s"',[Database.Attachment.GetCharsetName(ar.GetCharSetID)]);
1780	<	end;
1781	<	bounds := ar.GetBounds;
1782	<	boundsList := '';
1783	<	for i := 0 to length(bounds) - 1 do
1905	>	EchoNextLine(FCurLine);
1906	>	FCurLine := '';
1907	>	if assigned(OnProgressEvent) then
1908	>	OnProgressEvent(self,false,FIndex+1);
1909	>	Inc(FLineIndex);
1910	>	FIndex := 1;
1911	>	end
1912	>	else
1913		begin
1914	<	if i <> 0 then boundsList += ',';
1915	<	boundsList += Format('%d:%d',[bounds[i].LowerBound,bounds[i].UpperBound]);
1914	>	FCurLine += Result;
1915	>	Inc(FIndex);
1916		end;
1917	<	s += Format(' bounds="%s"',[boundsList]);
1789	<	s += '>';
1790	<	TextOut.Add(s);
1791	<
1792	<	SetLength(index,0);
1793	<	AddElements(0);
1794	<	TextOut.Add('</array>');
1795	<	Result := TextOut.Text;
1796	<	finally
1797	<	TextOut.Free;
1798	<	end;
1799	<	end;
1800	<
1801	<	{ TInteractiveSymbolStream }
1802	<
1803	<	function TInteractiveSymbolStream.GetErrorPrefix: string;
1804	<	begin
1805	<	Result := '';
1806	<	end;
1807	<
1808	<	function TInteractiveSymbolStream.GetNextLine(var Line: string): boolean;
1809	<	begin
1810	<	if FNextStatement then
1811	<	write(FPrompt)
1812	<	else
1813	<	write(FContinuePrompt);
1814	<	Result := not EOF;
1815	<	if Result then
1816	<	readln(Line);
1817	<	end;
1818	<
1819	<	constructor TInteractiveSymbolStream.Create(aPrompt: string; aContinue: string);
1820	<	begin
1821	<	inherited Create;
1822	<	FPrompt := aPrompt;
1823	<	FContinuePrompt := aContinue;
1824	<	end;
1825	<
1826	<	function TInteractiveSymbolStream.GetSymbol: TSQLSymbol;
1827	<	begin
1828	<	if Terminated then
1829	<	Result := sqEOF
1917	>	end
1918		else
1919	<	Result := inherited GetSymbol;
1919	>	Result := #0;
1920		end;
1921
1922	<	{ TBatchSymbolStream }
1835	<
1836	<	function TBatchSymbolStream.GetErrorPrefix: string;
1922	>	function TBatchSQLStatementReader.GetErrorPrefix: string;
1923		begin
1924		Result := Format(sOnLineError,[FLineIndex,FIndex]);
1925		end;
1926
1927	<	function TBatchSymbolStream.GetNextLine(var Line: string): boolean;
1842	<	begin
1843	<	Result := FLineIndex < FLines.Count;
1844	<	if Result then
1845	<	begin
1846	<	Line := FLines[FLineIndex];
1847	<	//    writeln('Next Line = ',Line);
1848	<	Inc(FLineIndex);
1849	<	if assigned(OnProgressEvent) then
1850	<	OnProgressEvent(self,false,1);
1851	<	end;
1852	<	end;
1853	<
1854	<	constructor TBatchSymbolStream.Create;
1927	>	procedure TBatchSQLStatementReader.Reset;
1928		begin
1929	<	inherited Create;
1930	<	FLines := TStringList.Create;
1931	<	end;
1932	<
1933	<	destructor TBatchSymbolStream.Destroy;
1934	<	begin
1935	<	if assigned(FLines) then FLines.Free;
1936	<	inherited Destroy;
1937	<	end;
1938	<
1939	<	procedure TBatchSymbolStream.SetStreamSource(Lines: TStrings);
1940	<	begin
1941	<	FLineIndex := 0;
1942	<	FLines.Assign(Lines);
1929	>	inherited Reset;
1930	>	if FOwnsInStream and assigned(FInStream) then
1931	>	FInStream.Free;
1932	>	FInStream := nil;
1933	>	FOwnsInStream := false;
1934	>	FLineIndex := 1;
1935	>	FIndex := 1;
1936	>	FCurLine := '';
1937	>	end;
1938	>
1939	>	procedure TBatchSQLStatementReader.SetStreamSource(Lines: TStrings);
1940	>	begin
1941	>	Reset;
1942	>	FInStream := TMemoryStream.Create;
1943	>	FOwnsInStream := true;
1944	>	Lines.SaveToStream(FInStream);
1945	>	FInStream.Position := 0;
1946		if assigned(OnProgressEvent) then
1947	<	OnProgressEvent(self,true,FLines.Count);
1947	>	OnProgressEvent(self,true,FInStream.Size);
1948		end;
1949
1950	<	procedure TBatchSymbolStream.SetStreamSource(S: TStream);
1950	>	procedure TBatchSQLStatementReader.SetStreamSource(S: TStream);
1951		begin
1952	<	FLineIndex := 0;
1953	<	FLines.LoadFromStream(S);
1952	>	Reset;
1953	>	FInStream := S;
1954		if assigned(OnProgressEvent) then
1955	<	OnProgressEvent(self,true,FLines.Count);
1955	>	OnProgressEvent(self,true,S.Size - S.Position);
1956		end;
1957
1958	<	procedure TBatchSymbolStream.SetStreamSource(FileName: string);
1958	>	procedure TBatchSQLStatementReader.SetStreamSource(FileName: string);
1959		begin
1960	<	FLineIndex := 0;
1961	<	FLines.LoadFromFile(FileName);
1960	>	Reset;
1961	>	FInStream := TFileStream.Create(FileName,fmShareCompat);
1962	>	FOwnsInStream := true;
1963		if assigned(OnProgressEvent) then
1964	<	OnProgressEvent(self,true,FLines.Count);
1888	<	end;
1889	<
1890	<	{ TSymbolStream }
1891	<
1892	<	function TSymbolStream.GetNextSymbol(C: char): TSQLSymbol;
1893	<	begin
1894	<	Result := sqNone;
1895	<	if C = FTerminator then
1896	<	Result := sqTerminator
1897	<	else
1898	<	case C of
1899	<	#0..#8,#10..#31,' ':
1900	<	Result := ' ';
1901	<
1902	<	#9,';','"','''','/','-',
1903	<	'*','=','>','<',',':
1904	<	Result := C;
1905	<	else
1906	<	begin
1907	<	Result := sqString;
1908	<	FLastChar := C
1909	<	end
1910	<	end;
1911	<	end;
1912	<
1913	<	function TSymbolStream.FindTag(tag: string; var xmlTag: TXMLTag): boolean;
1914	<	var i: integer;
1915	<	begin
1916	<	Result := false;
1917	<	for i := 0 to Length(XMLTagDefs) - 1 do
1918	<	if XMLTagDefs[i].TagValue = tag then
1919	<	begin
1920	<	xmlTag := XMLTagDefs[i].XMLTag;
1921	<	Result := true;
1922	<	break;
1923	<	end;
1924	<	end;
1925	<
1926	<	constructor TSymbolStream.Create;
1927	<	begin
1928	<	inherited;
1929	<	FTerminator := DefaultTerminator;
1930	<	NextStatement;
1931	<	end;
1932	<
1933	<	procedure TSymbolStream.ShowError(msg: string; params: array of const);
1934	<	begin
1935	<	raise EIBClientError.CreateFmt(GetErrorPrefix + msg,params);
1936	<	end;
1937	<
1938	<	function TSymbolStream.GetSymbol: TSQLSymbol;
1939	<	var
1940	<	DelimitedText: string;
1941	<	CurState: (gsNone,gsInComment,gsInSingleQuotes,gsInDoubleQuotes);
1942	<	begin
1943	<	Result := sqNone;
1944	<	CurState := gsNone;
1945	<	DelimitedText := '';
1946	<	if FNextSymbol <> sqNone then
1947	<	begin
1948	<	Result := FNextSymbol;
1949	<	if Result = sqString then
1950	<	FString := FLastChar
1951	<	else
1952	<	FString := '';
1953	<	FNextSymbol := sqNone
1954	<	end;
1955	<
1956	<	while FNextSymbol = sqNone do {find the next symbol}
1957	<	begin
1958	<	if FIndex > Length(FLine) then
1959	<	begin
1960	<	FNextSymbol := sqEOL;
1961	<	FIndex := 0;
1962	<	end
1963	<	else
1964	<	begin
1965	<	if FIndex = 0 then
1966	<	begin
1967	<	if not GetNextLine(FLine) then
1968	<	begin
1969	<	Result := sqEOF;
1970	<	FNextSymbol := sqNone;
1971	<	Exit;
1972	<	end;
1973	<	FIndex := 1;
1974	<	FNextStatement := false;
1975	<	if assigned(OnNextLine) then
1976	<	OnNextLine(self,FLine);
1977	<	if CurState <> gsNone then
1978	<	DelimitedText += LineEnding;
1979	<	if Length(FLine) = 0 then
1980	<	continue;
1981	<	end;
1982	<	if CurState <> gsNone then
1983	<	DelimitedText += FLine[FIndex];
1984	<	FNextSymbol := GetNextSymbol(FLine[FIndex]);
1985	<	Inc(FIndex);
1986	<	end;
1987	<
1988	<	case CurState of
1989	<	gsNone:
1990	<	begin
1991	<	{combine if possible}
1992	<	case Result of
1993	<	sqNone:
1994	<	begin
1995	<	Result := FNextSymbol;
1996	<	if FNextSymbol = sqString then
1997	<	FString := FLastChar;
1998	<	FNextSymbol := sqNone
1999	<	end;
2000	<
2001	<	'/':
2002	<	if FXMLMode > 0 then
2003	<	break
2004	<	else
2005	<	if FNextSymbol = '*' then
2006	<	begin
2007	<	CurState := gsInComment;
2008	<	DelimitedText := '/*';
2009	<	Result := sqNone;
2010	<	FNextSymbol := sqNone
2011	<	end
2012	<	else
2013	<	if FNextSymbol = '/' then
2014	<	begin
2015	<	FString := '/*' + system.copy(FLine,FIndex,length(FLine)- FIndex + 1) + ' */';
2016	<	Result := sqCommentLine;
2017	<	FIndex := 0;
2018	<	FNextSymbol := sqNone
2019	<	end;
2020	<
2021	<	'-':
2022	<	if FXMLMode > 0 then
2023	<	break
2024	<	else
2025	<	if FNextSymbol = '-' then
2026	<	begin
2027	<	FString := '--' + system.copy(FLine,FIndex,length(FLine)- FIndex + 1) ;
2028	<	Result := sqCommentLine;
2029	<	FIndex := 0;
2030	<	FNextSymbol := sqNone
2031	<	end;
2032	<
2033	<	'<':
2034	<	if (FXMLMode > 0) and (FNextSymbol = '/') then
2035	<	begin
2036	<	Result := sqEndTag;
2037	<	FString := '';
2038	<	FNextSymbol := sqNone
2039	<	end
2040	<	else
2041	<	if FNextSymbol = sqString then
2042	<	begin
2043	<	Result := sqTag;
2044	<	FString := FLastChar;
2045	<	FNextSymbol := sqNone
2046	<	end;
2047	<
2048	<	'''':
2049	<	if FXMLMode > 0 then
2050	<	break
2051	<	else
2052	<	if FNextSymbol = '''' then
2053	<	begin
2054	<	Result := sqQuotedString;
2055	<	FString := '''''';
2056	<	FNextSymbol := sqNone
2057	<	end
2058	<	else
2059	<	begin
2060	<	CurState := gsInSingleQuotes;
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	<	'"':
2071	<	if FXMLMode > 0 then
2072	<	break
2073	<	else
2074	<	begin
2075	<	CurState := gsInDoubleQuotes;
2076	<	DelimitedText := '"';
2077	<	if FNextSymbol = sqEOL then
2078	<	DelimitedText += LineEnding
2079	<	else
2080	<	DelimitedText += FLine[FIndex-1];
2081	<	Result := sqNone;
2082	<	FNextSymbol := sqNone
2083	<	end;
2084	<
2085	<	sqTag,
2086	<	sqEndTag,
2087	<	sqString:
2088	<	if FNextSymbol = sqString then
2089	<	begin
2090	<	FString := FString + FLastChar;
2091	<	FNextSymbol := sqNone
2092	<	end;
2093	<	end
2094	<	end;
2095	<
2096	<	{Check for state exit condition}
2097	<	gsInSingleQuotes:
2098	<	if Result = '''' then
2099	<	begin
2100	<	CurState := gsNone;
2101	<	if FNextSymbol = sqEOL then
2102	<	FString := DelimitedText
2103	<	else
2104	<	FString := system.copy(DelimitedText,1,Length(DelimitedText)-1);
2105	<	Result := sqQuotedString;
2106	<	end;
2107	<
2108	<	gsInDoubleQuotes:
2109	<	if Result = '"' then
2110	<	begin
2111	<	CurState := gsNone;
2112	<	if FNextSymbol = sqEOL then
2113	<	FString := DelimitedText
2114	<	else
2115	<	FString := system.copy(DelimitedText,1,Length(DelimitedText)-1);
2116	<	Result := sqDoubleQuotedString;
2117	<	end;
2118	<
2119	<	gsInComment:
2120	<	if (Result = '*') and (FNextSymbol = '/') then
2121	<	begin
2122	<	CurState := gsNone;
2123	<	FString := DelimitedText;
2124	<	Result := sqComment;
2125	<	FNextSymbol := sqNone
2126	<	end;
2127	<
2128	<	end;
2129	<
2130	<	if (CurState <> gsNone) and (FNextSymbol <> sqNone) then
2131	<	begin
2132	<	Result := FNextSymbol;
2133	<	FNextSymbol := sqNone;
2134	<	end;
2135	<	end;
2136	<
2137	<	if (Result = sqTag) and (FNextSymbol <> sqNone) then
2138	<	begin
2139	<	if FindTag(FString,FXMLTag) then
2140	<	Inc(FXMLMode)
2141	<	else
2142	<	Result := sqString;
2143	<	end
2144	<	else
2145	<	if (Result = sqEndTag) and (FNextSymbol <> sqNone) then
2146	<	begin
2147	<	if FindTag(FString,FXMLTag) then
2148	<	Dec(FXMLMode)
2149	<	else
2150	<	Result := sqString;
2151	<	end;
2152	<
2153	<	if (FXMLMode = 0) and (Result = sqString) and (FString <> '') then
2154	<	begin
2155	<	if CompareText(FString,'begin') = 0 then
2156	<	Result := sqBegin
2157	<	else
2158	<	if CompareText(FString,'end') = 0 then
2159	<	Result := sqEnd
2160	<	else
2161	<	if CompareText(FString,'declare') = 0 then
2162	<	Result := sqDeclare
2163	<	else
2164	<	if CompareText(FString,'case') = 0 then
2165	<	Result := sqCase
2166	<	end;
2167	<	//  writeln(Result,',',FString);
1964	>	OnProgressEvent(self,true,FInStream.Size);
1965		end;
1966
1967	<	procedure TSymbolStream.NextStatement;
1967	>	procedure TBatchSQLStatementReader.SetStringStreamSource(S: string);
1968		begin
1969	<	FXMLTag := xtNone;
1970	<	FNextStatement := true;
1969	>	Reset;
1970	>	FInStream := TStringStream.Create(S);
1971	>	FOwnsInStream := true;
1972	>	if assigned(OnProgressEvent) then
1973	>	OnProgressEvent(self,true,FInStream.Size);
1974		end;
1975
1976		end.

Diff Legend

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