ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/fbintf/IBUtils.pas
(Generate patch)

Comparing ibx/trunk/fbintf/IBUtils.pas (file contents):
Revision 45 by tony, Tue Dec 6 10:33:46 2016 UTC vs.
Revision 311 by tony, Mon Aug 24 09:32:58 2020 UTC

# Line 32 | Line 32
32   {************************************************************************}
33  
34   unit IBUtils;
35 + {$IFDEF MSWINDOWS}
36 + {$DEFINE WINDOWS}
37 + {$ENDIF}
38  
39   {$IFDEF FPC}
40   {$Mode Delphi}
41   {$codepage UTF8}
42 + {$define HASREQEX}
43   {$ENDIF}
44  
45 +
46   interface
47  
48 < uses
49 < {$IFDEF WINDOWS }
50 <  Windows,
51 < {$ELSE}
52 <  unix,
53 < {$ENDIF}
54 <  Classes, SysUtils;
48 > uses Classes, SysUtils, IB;
49 >
50 > type
51 >  TSQLTokens = (
52 >
53 >  {Reserved Words}
54 >
55 >  sqltAdd,
56 >  sqltAdmin,
57 >  sqltAll,
58 >  sqltAlter,
59 >  sqltAnd,
60 >  sqltAny,
61 >  sqltAs,
62 >  sqltAt,
63 >  sqltAvg,
64 >  sqltBegin,
65 >  sqltBetween,
66 >  sqltBigint,
67 >  sqltBit_Length,
68 >  sqltBlob,
69 >  sqltBoolean,
70 >  sqltBoth,
71 >  sqltBy,
72 >  sqltCase,
73 >  sqltCast,
74 >  sqltChar,
75 >  sqltChar_Length,
76 >  sqltCharacter,
77 >  sqltCharacter_Length,
78 >  sqltCheck,
79 >  sqltClose,
80 >  sqltCollate,
81 >  sqltColumn,
82 >  sqltCommit,
83 >  sqltConnect,
84 >  sqltConstraint,
85 >  sqltCorr,
86 >  sqltCount,
87 >  sqltCovar_Pop,
88 >  sqltCovar_Samp,
89 >  sqltCreate,
90 >  sqltCross,
91 >  sqltCurrent,
92 >  sqltCurrent_Connection,
93 >  sqltCurrent_Date,
94 >  sqltCurrent_Role,
95 >  sqltCurrent_Time,
96 >  sqltCurrent_Timestamp,
97 >  sqltCurrent_Transaction,
98 >  sqltCurrent_User,
99 >  sqltCursor,
100 >  sqltDate,
101 >  sqltDay,
102 >  sqltDec,
103 >  sqltDecimal,
104 >  sqltDeclare,
105 >  sqltDefault,
106 >  sqltDelete,
107 >  sqltDeleting,
108 >  sqltDeterministic,
109 >  sqltDisconnect,
110 >  sqltDistinct,
111 >  sqltDouble,
112 >  sqltDrop,
113 >  sqltElse,
114 >  sqltEnd,
115 >  sqltEscape,
116 >  sqltExecute,
117 >  sqltExists,
118 >  sqltExternal,
119 >  sqltExtract,
120 >  sqltFalse,
121 >  sqltFetch,
122 >  sqltFilter,
123 >  sqltFloat,
124 >  sqltFor,
125 >  sqltForeign,
126 >  sqltFrom,
127 >  sqltFull,
128 >  sqltFunction,
129 >  sqltGdscode,
130 >  sqltGlobal,
131 >  sqltGrant,
132 >  sqltGroup,
133 >  sqltHaving,
134 >  sqltHour,
135 >  sqltIn,
136 >  sqltIndex,
137 >  sqltInner,
138 >  sqltInsensitive,
139 >  sqltInsert,
140 >  sqltInserting,
141 >  sqltInt,
142 >  sqltInteger,
143 >  sqltInto,
144 >  sqltIs,
145 >  sqltJoin,
146 >  sqltKey,
147 >  sqltLeading,
148 >  sqltLeft,
149 >  sqltLike,
150 >  sqltLong,
151 >  sqltLower,
152 >  sqltMax,
153 >  sqltMaximum_Segment,
154 >  sqltMerge,
155 >  sqltMin,
156 >  sqltMinute,
157 >  sqltMonth,
158 >  sqltNational,
159 >  sqltNatural,
160 >  sqltNchar,
161 >  sqltNo,
162 >  sqltNot,
163 >  sqltNull,
164 >  sqltNumeric,
165 >  sqltOctet_Length,
166 >  sqltOf,
167 >  sqltOffset,
168 >  sqltOn,
169 >  sqltOnly,
170 >  sqltOpen,
171 >  sqltOr,
172 >  sqltOrder,
173 >  sqltOuter,
174 >  sqltOver,
175 >  sqltParameter,
176 >  sqltPlan,
177 >  sqltPosition,
178 >  sqltPost_Event,
179 >  sqltPrecision,
180 >  sqltPrimary,
181 >  sqltProcedure,
182 >  sqltRdbDb_Key,
183 >  sqltRdbRecord_Version,
184 >  sqltReal,
185 >  sqltRecord_Version,
186 >  sqltRecreate,
187 >  sqltRecursive,
188 >  sqltReferences,
189 >  sqltRegr_Avgx,
190 >  sqltRegr_Avgy,
191 >  sqltRegr_Count,
192 >  sqltRegr_Intercept,
193 >  sqltRegr_R2,
194 >  sqltRegr_Slope,
195 >  sqltRegr_Sxx,
196 >  sqltRegr_Sxy,
197 >  sqltRegr_Syy,
198 >  sqltRelease,
199 >  sqltReturn,
200 >  sqltReturning_Values,
201 >  sqltReturns,
202 >  sqltRevoke,
203 >  sqltRight,
204 >  sqltRollback,
205 >  sqltRow,
206 >  sqltRows,
207 >  sqltRow_Count,
208 >  sqltSavepoint,
209 >  sqltScroll,
210 >  sqltSecond,
211 >  sqltSelect,
212 >  sqltSensitive,
213 >  sqltSet,
214 >  sqltSimilar,
215 >  sqltSmallint,
216 >  sqltSome,
217 >  sqltSqlcode,
218 >  sqltSqlstate,
219 >  sqltStart,
220 >  sqltStddev_Pop,
221 >  sqltStddev_Samp,
222 >  sqltSum,
223 >  sqltTable,
224 >  sqltThen,
225 >  sqltTime,
226 >  sqltTimestamp,
227 >  sqltTo,
228 >  sqltTrailing,
229 >  sqltTrigger,
230 >  sqltTrim,
231 >  sqltTrue,
232 >  sqltUnion,
233 >  sqltUnique,
234 >  sqltUnknown,
235 >  sqltUpdate,
236 >  sqltUpdating,
237 >  sqltUpper,
238 >  sqltUser,
239 >  sqltUsing,
240 >  sqltValue,
241 >  sqltValues,
242 >  sqltVar_Pop,
243 >  sqltVar_Samp,
244 >  sqltVarchar,
245 >  sqltVariable,
246 >  sqltVarying,
247 >  sqltView,
248 >  sqltWhen,
249 >  sqltWhere,
250 >  sqltWhile,
251 >  sqltWith,
252 >  sqltYear,
253 >
254 >  {symbols}
255 >
256 >  sqltSpace,
257 >  sqltSemiColon,
258 >  sqltPlaceholder,
259 >  sqltSingleQuotes,
260 >  sqltDoubleQuotes,
261 >  sqltBackslash,
262 >  sqltComma,
263 >  sqltPeriod,
264 >  sqltEquals,
265 >  sqltOtherCharacter,
266 >  sqltIdentifier,
267 >  sqltIdentifierInDoubleQuotes,
268 >  sqltNumberString,
269 >  sqltString,
270 >  sqltParam,
271 >  sqltQuotedParam,
272 >  sqltColon,
273 >  sqltComment,
274 >  sqltCommentLine,
275 >  sqltQuotedString,
276 >  sqltAsterisk,
277 >  sqltForwardSlash,
278 >  sqltOpenSquareBracket,
279 >  sqltCloseSquareBracket,
280 >  sqltOpenBracket,
281 >  sqltCloseBracket,
282 >  sqltPipe,
283 >  sqltMinus,
284 >  sqltConcatSymbol,
285 >  sqltLT,
286 >  sqltGT,
287 >  sqltCR,
288 >  sqltEOL,
289 >  sqltEOF,
290 >  sqltInit
291 >  );
292 >
293 >  TSQLReservedWords = sqltAdd..sqltYear;
294  
295   const
296    CRLF = #13 + #10;
# Line 55 | Line 299 | const
299    TAB  = #9;
300    NULL_TERMINATOR = #0;
301  
302 <  sqlReservedWords: array [0..166] of string = (
303 <  'ADD','ADMIN','ALL','ALTER','AND','ANY','AS','AT','AVG','BEGIN','BETWEEN','BIGINT','BIT_LENGTH','BLOB','BOTH',
304 < 'BY','CASE','CAST','CHAR','CHAR_LENGTH','CHARACTER','CHARACTER_LENGTH','CHECK','CLOSE','COLLATE','COLUMN',
305 < 'COMMIT','CONNECT','CONSTRAINT','COUNT','CREATE','CROSS','CURRENT','CURRENT_CONNECTION','CURRENT_DATE',
306 < 'CURRENT_ROLE','CURRENT_TIME','CURRENT_TIMESTAMP','CURRENT_TRANSACTION','CURRENT_USER','CURSOR','DATE',
307 < 'DAY','DEC','DECIMAL','DECLARE','DEFAULT','DELETE','DISCONNECT','DISTINCT','DOUBLE','DROP','ELSE','END',
308 < 'ESCAPE','EXECUTE','EXISTS','EXTERNAL','EXTRACT','FETCH','FILTER','FLOAT','FOR','FOREIGN','FROM','FULL',
309 < 'FUNCTION','GDSCODE','GLOBAL','GRANT','GROUP','HAVING','HOUR','IN','INDEX','INNER','INSENSITIVE','INSERT',
310 < 'INT','INTEGER','INTO','IS','JOIN','LEADING','LEFT','LIKE','LONG','LOWER','MAX','MAXIMUM_SEGMENT','MERGE',
311 < 'MIN','MINUTE','MONTH','NATIONAL','NATURAL','NCHAR','NO','NOT','NULL','NUMERIC','OCTET_LENGTH','OF','ON',
312 < 'ONLY','OPEN','OR','ORDER','OUTER','PARAMETER','PLAN','POSITION','POST_EVENT','PRECISION','PRIMARY',
313 < 'PROCEDURE','RDB$DB_KEY','REAL','RECORD_VERSION','RECREATE','RECURSIVE','REFERENCES','RELEASE','RETURNING_VALUES',
314 < 'RETURNS','REVOKE','RIGHT','ROLLBACK','ROW_COUNT','ROWS','SAVEPOINT','SECOND','SELECT','SENSITIVE',
315 < 'SET','SIMILAR','SMALLINT','SOME','SQLCODE','SQLSTATE','START','SUM','TABLE','THEN','TIME',
316 < 'TIMESTAMP','TO','TRAILING','TRIGGER','TRIM','UNION','UNIQUE','UPDATE','UPPER','USER','USING',
317 < 'VALUE','VALUES','VARCHAR','VARIABLE','VARYING','VIEW','WHEN','WHERE','WHILE','WITH','YEAR');
302 >  {$IFNDEF FPC}
303 >  LineEnding = CRLF;
304 >  {$ENDIF}
305 >
306 >  {SQL Reserved words in alphabetical order}
307 >
308 >  sqlReservedWords: array [TSQLReservedWords] of string = (
309 >  'ADD',
310 >  'ADMIN',
311 >  'ALL',
312 >  'ALTER',
313 >  'AND',
314 >  'ANY',
315 >  'AS',
316 >  'AT',
317 >  'AVG',
318 >  'BEGIN',
319 >  'BETWEEN',
320 >  'BIGINT',
321 >  'BIT_LENGTH',
322 >  'BLOB',
323 >  'BOOLEAN',
324 >  'BOTH',
325 >  'BY',
326 >  'CASE',
327 >  'CAST',
328 >  'CHAR',
329 >  'CHAR_LENGTH',
330 >  'CHARACTER',
331 >  'CHARACTER_LENGTH',
332 >  'CHECK',
333 >  'CLOSE',
334 >  'COLLATE',
335 >  'COLUMN',
336 >  'COMMIT',
337 >  'CONNECT',
338 >  'CONSTRAINT',
339 >  'CORR',
340 >  'COUNT',
341 >  'COVAR_POP',
342 >  'COVAR_SAMP',
343 >  'CREATE',
344 >  'CROSS',
345 >  'CURRENT',
346 >  'CURRENT_CONNECTION',
347 >  'CURRENT_DATE',
348 >  'CURRENT_ROLE',
349 >  'CURRENT_TIME',
350 >  'CURRENT_TIMESTAMP',
351 >  'CURRENT_TRANSACTION',
352 >  'CURRENT_USER',
353 >  'CURSOR',
354 >  'DATE',
355 >  'DAY',
356 >  'DEC',
357 >  'DECIMAL',
358 >  'DECLARE',
359 >  'DEFAULT',
360 >  'DELETE',
361 >  'DELETING',
362 >  'DETERMINISTIC',
363 >  'DISCONNECT',
364 >  'DISTINCT',
365 >  'DOUBLE',
366 >  'DROP',
367 >  'ELSE',
368 >  'END',
369 >  'ESCAPE',
370 >  'EXECUTE',
371 >  'EXISTS',
372 >  'EXTERNAL',
373 >  'EXTRACT',
374 >  'FALSE',
375 >  'FETCH',
376 >  'FILTER',
377 >  'FLOAT',
378 >  'FOR',
379 >  'FOREIGN',
380 >  'FROM',
381 >  'FULL',
382 >  'FUNCTION',
383 >  'GDSCODE',
384 >  'GLOBAL',
385 >  'GRANT',
386 >  'GROUP',
387 >  'HAVING',
388 >  'HOUR',
389 >  'IN',
390 >  'INDEX',
391 >  'INNER',
392 >  'INSENSITIVE',
393 >  'INSERT',
394 >  'INSERTING',
395 >  'INT',
396 >  'INTEGER',
397 >  'INTO',
398 >  'IS',
399 >  'JOIN',
400 >  'KEY',
401 >  'LEADING',
402 >  'LEFT',
403 >  'LIKE',
404 >  'LONG',
405 >  'LOWER',
406 >  'MAX',
407 >  'MAXIMUM_SEGMENT',
408 >  'MERGE',
409 >  'MIN',
410 >  'MINUTE',
411 >  'MONTH',
412 >  'NATIONAL',
413 >  'NATURAL',
414 >  'NCHAR',
415 >  'NO',
416 >  'NOT',
417 >  'NULL',
418 >  'NUMERIC',
419 >  'OCTET_LENGTH',
420 >  'OF',
421 >  'OFFSET',
422 >  'ON',
423 >  'ONLY',
424 >  'OPEN',
425 >  'OR',
426 >  'ORDER',
427 >  'OUTER',
428 >  'OVER',
429 >  'PARAMETER',
430 >  'PLAN',
431 >  'POSITION',
432 >  'POST_EVENT',
433 >  'PRECISION',
434 >  'PRIMARY',
435 >  'PROCEDURE',
436 >  'RDB$DB_KEY',
437 >  'RDB$RECORD_VERSION',
438 >  'REAL',
439 >  'RECORD_VERSION',
440 >  'RECREATE',
441 >  'RECURSIVE',
442 >  'REFERENCES',
443 >  'REGR_AVGX',
444 >  'REGR_AVGY',
445 >  'REGR_COUNT',
446 >  'REGR_INTERCEPT',
447 >  'REGR_R2',
448 >  'REGR_SLOPE',
449 >  'REGR_SXX',
450 >  'REGR_SXY',
451 >  'REGR_SYY',
452 >  'RELEASE',
453 >  'RETURN',
454 >  'RETURNING_VALUES',
455 >  'RETURNS',
456 >  'REVOKE',
457 >  'RIGHT',
458 >  'ROLLBACK',
459 >  'ROW',
460 >  'ROWS',
461 >  'ROW_COUNT',
462 >  'SAVEPOINT',
463 >  'SCROLL',
464 >  'SECOND',
465 >  'SELECT',
466 >  'SENSITIVE',
467 >  'SET',
468 >  'SIMILAR',
469 >  'SMALLINT',
470 >  'SOME',
471 >  'SQLCODE',
472 >  'SQLSTATE',
473 >  'START',
474 >  'STDDEV_POP',
475 >  'STDDEV_SAMP',
476 >  'SUM',
477 >  'TABLE',
478 >  'THEN',
479 >  'TIME',
480 >  'TIMESTAMP',
481 >  'TO',
482 >  'TRAILING',
483 >  'TRIGGER',
484 >  'TRIM',
485 >  'TRUE',
486 >  'UNION',
487 >  'UNIQUE',
488 >  'UNKNOWN',
489 >  'UPDATE',
490 >  'UPDATING',
491 >  'UPPER',
492 >  'USER',
493 >  'USING',
494 >  'VALUE',
495 >  'VALUES',
496 >  'VAR_POP',
497 >  'VAR_SAMP',
498 >  'VARCHAR',
499 >  'VARIABLE',
500 >  'VARYING',
501 >  'VIEW',
502 >  'WHEN',
503 >  'WHERE',
504 >  'WHILE',
505 >  'WITH',
506 >  'YEAR'
507 >  );
508 >
509 > type
510 >  {The TSQLTokeniser class provides a common means to parse an SQL statement, or
511 >   even a stream of SQL Statements. The TSQLStringTokeniser class is instantiated
512 >   with a single SQL statement or a set of concatenated statements. The TSQLStreamTokeniser
513 >   is instantiated with a stream from which the SQL statements are read.
514 >
515 >   Successive calls to GetNextToken then return each SQL token. The TokenText contains
516 >   either the single character, the identifier or reserved word, the string or comment.}
517 >
518 >  { TSQLTokeniser }
519 >
520 >  TSQLTokeniser = class
521 >  private
522 >    const
523 >      TokenQueueMaxSize = 64;
524 >    type
525 >      TLexState = (stDefault, stInCommentLine, stInComment, stSingleQuoted, stDoubleQuoted,
526 >                   stInIdentifier, stInNumeric);
527 >
528 >      TTokenQueueItem = record
529 >                          token: TSQLTokens;
530 >                          text: AnsiString;
531 >                        end;
532 >      TTokenQueueState = (tsHold, tsRelease);
533 >
534 >  private
535 >    FLastChar: AnsiChar;
536 >    FState: TLexState;
537 >    FSkipNext: boolean;
538 >    function GetNext: TSQLTokens;
539 >
540 >    {The token Queue is available for use by descendents so that they can
541 >     hold back tokens in order to lookahead by token rather than just a single
542 >     character}
543 >
544 >  private
545 >    FTokenQueue: array[0..TokenQueueMaxSize] of TTokenQueueItem;
546 >    FQueueState: TTokenQueueState;
547 >    FQFirst: integer;  {first and last pointers first=last => queue empty}
548 >    FQLast: integer;
549 >    FEOF: boolean;
550 >    procedure PopQueue(var token: TSQLTokens);
551 >  protected
552 >    FString: AnsiString;
553 >    FNextToken: TSQLTokens;
554 >    procedure Assign(source: TSQLTokeniser); virtual;
555 >    function GetChar: AnsiChar; virtual; abstract;
556 >    function TokenFound(var token: TSQLTokens): boolean; virtual;
557 >    function InternalGetNextToken: TSQLTokens; virtual;
558 >    procedure Reset; virtual;
559 >
560 >    {Token stack}
561 >    procedure QueueToken(token: TSQLTokens; text:AnsiString); overload;
562 >    procedure QueueToken(token: TSQLTokens); overload;
563 >    procedure ResetQueue; overload;
564 >    procedure ResetQueue(token: TSQLTokens; text:AnsiString); overload;
565 >    procedure ResetQueue(token: TSQLTokens); overload;
566 >    procedure ReleaseQueue(var token: TSQLTokens); overload;
567 >    procedure ReleaseQueue; overload;
568 >    function GetQueuedText: AnsiString;
569 >    procedure SetTokenText(text: AnsiString);
570 >
571 >  public
572 >    const
573 >        DefaultTerminator = ';';
574 >  public
575 >    constructor Create;
576 >    destructor Destroy; override;
577 >    function GetNextToken: TSQLTokens;
578 >    property EOF: boolean read FEOF;
579 >    property TokenText: AnsiString read FString;
580 >  end;
581 >
582 >  { TSQLwithNamedParamsTokeniser }
583 >
584 >  TSQLwithNamedParamsTokeniser = class(TSQLTokeniser)
585 >  private
586 >    type
587 >      TSQLState = (stInit,stInParam,stInBlock, stInArrayDim);
588 >  private
589 >    FState: TSQLState;
590 >    FNested: integer;
591 >  protected
592 >    procedure Assign(source: TSQLTokeniser); override;
593 >    procedure Reset; override;
594 >    function TokenFound(var token: TSQLTokens): boolean; override;
595 >  end;
596 >
597 >    { TSQLParamProcessor }
598 >
599 >  TSQLParamProcessor = class(TSQLwithNamedParamsTokeniser)
600 >  private
601 >  const
602 >    sIBXParam = 'IBXParam';  {do not localize}
603 >  private
604 >    FInString: AnsiString;
605 >    FIndex: integer;
606 >    function DoExecute(GenerateParamNames: boolean;
607 >        var slNames: TStrings): AnsiString;
608 >  protected
609 >    function GetChar: AnsiChar; override;
610 >  public
611 >    class function Execute(sSQL: AnsiString; GenerateParamNames: boolean;
612 >        var slNames: TStrings): AnsiString;
613 >  end;
614 >
615  
616   function Max(n1, n2: Integer): Integer;
617   function Min(n1, n2: Integer): Integer;
618 < function RandomString(iLength: Integer): String;
618 > function RandomString(iLength: Integer): AnsiString;
619   function RandomInteger(iLow, iHigh: Integer): Integer;
620 < function StripString(st: String; CharsToStrip: String): String;
621 < function FormatIdentifier(Dialect: Integer; Value: String): String;
622 < function FormatIdentifierValue(Dialect: Integer; Value: String): String;
623 < function FormatIdentifierValueNC(Dialect: Integer; Value: String): String;
624 < function ExtractIdentifier(Dialect: Integer; Value: String): String;
625 < function QuoteIdentifier(Dialect: Integer; Value: String): String;
626 < function QuoteIdentifierIfNeeded(Dialect: Integer; Value: String): String;
627 < function Space2Underscore(s: string): string;
620 > function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
621 > function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
622 > function FindReservedWord(w: AnsiString; var token: TSQLTokens): boolean;
623 > function IsReservedWord(w: AnsiString): boolean;
624 > function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
625 > function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
626 > function Space2Underscore(s: AnsiString): AnsiString;
627 > function SQLSafeString(const s: AnsiString): AnsiString;
628 > function IsSQLIdentifier(Value: AnsiString): boolean;
629 > function ExtractConnectString(const CreateSQL: AnsiString; var ConnectString: AnsiString): boolean;
630 > function MakeConnectString(ServerName, DatabaseName: AnsiString; Protocol: TProtocol;
631 >              PortNo: AnsiString = ''): AnsiString;
632 > function ParseConnectString(ConnectString: AnsiString;
633 >              var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
634 >              var PortNo: AnsiString): boolean;
635 > function GetProtocol(ConnectString: AnsiString): TProtocolAll;
636  
637   implementation
638  
639 + uses FBMessages
640 +
641 + {$IFDEF HASREQEX}
642 + ,RegExpr
643 + {$ENDIF};
644 +
645   function Max(n1, n2: Integer): Integer;
646   begin
647    if (n1 > n2) then
# Line 103 | Line 658 | begin
658      result := n2;
659   end;
660  
661 < function RandomString(iLength: Integer): String;
661 > function RandomString(iLength: Integer): AnsiString;
662   begin
663    result := '';
664    while Length(result) < iLength do
# Line 117 | Line 672 | begin
672    result := Trunc(Random(iHigh - iLow)) + iLow;
673   end;
674  
675 < function StripString(st: String; CharsToStrip: String): String;
675 > function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
676   var
677    i: Integer;
678   begin
# Line 128 | Line 683 | begin
683    end;
684   end;
685  
686 < function FormatIdentifier(Dialect: Integer; Value: String): String;
132 < begin
133 <  Value := Trim(Value);
134 <  if Dialect = 1 then
135 <    Value := AnsiUpperCase(Value)
136 <  else
137 <    if (Value <> '') and (Value[1] = '"') then
138 <      Value := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
139 <    else
140 <      Value := AnsiUpperCase(Value);
141 <  Result := Value;
142 < end;
686 > {Extracts SQL Identifier typically from a  Dialect 3 encoding}
687  
688 < function FormatIdentifierValue(Dialect: Integer; Value: String): String;
688 > function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
689   begin
690    Value := Trim(Value);
691    if Dialect = 1 then
# Line 160 | Line 704 | begin
704    Result := Value;
705   end;
706  
707 < function FormatIdentifierValueNC(Dialect: Integer; Value: String): String;
707 > {Returns true if "w" is a Firebird SQL reserved word, and the
708 > corresponding TSQLTokens value.}
709 >
710 > function FindReservedWord(w: AnsiString; var token: TSQLTokens): boolean;
711 > var i: TSQLTokens;
712   begin
713 <  Value := Trim(Value);
713 >   Result := true;
714 >   w := AnsiUpperCase(Trim(w));
715 >   for i := Low(TSQLReservedWords) to High(TSQLReservedWords) do
716 >   begin
717 >       if w = sqlReservedWords[i] then
718 >       begin
719 >         token := i;
720 >         Exit;
721 >       end;
722 >       if w <  sqlReservedWords[i] then
723 >         break;
724 >   end;
725 >   Result := false;
726 > end;
727 >
728 > {Returns true if "w" is a Firebird SQL reserved word}
729 >
730 > function IsReservedWord(w: AnsiString): boolean;
731 > var token: TSQLTokens;
732 > begin
733 >  Result := FindReservedWord(w,token);
734 > end;
735 >
736 > {Format an SQL Identifier according to SQL Dialect}
737 >
738 > function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
739 > begin
740 >  Value := TrimRight(Value);
741    if Dialect = 1 then
742      Value := AnsiUpperCase(Value)
743    else
744 +    Value := '"' + StringReplace (Value, '""', '"', [rfReplaceAll]) + '"';
745 +  Result := Value;
746 + end;
747 +
748 + const
749 +  ValidSQLIdentifierChars = ['A'..'Z','a'..'z','0'..'9','_','$'];
750 +
751 + {Returns true if the value is a valid SQL Identifier - note lower case accepted}
752 +
753 + function IsSQLIdentifier(Value: AnsiString): boolean;
754 + var i: integer;
755 + begin
756 +  Result := false;
757 +  for i := 1 to Length(Value) do
758 +    if not (Value[i] in ValidSQLIdentifierChars) then Exit;
759 +  Result := true;
760 + end;
761 +
762 + {Extracts the Database Connect string from a Create Database Statement}
763 +
764 + {$IFDEF HASREQEX}
765 + function ExtractConnectString(const CreateSQL: AnsiString;
766 +  var ConnectString: AnsiString): boolean;
767 + var RegexObj: TRegExpr;
768 + begin
769 +  RegexObj := TRegExpr.Create;
770 +  try
771 +    {extact database file spec}
772 +    RegexObj.ModifierG := false; {turn off greedy matches}
773 +    RegexObj.ModifierI := true; {case insensitive match}
774 +    RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''';
775 +    Result := RegexObj.Exec(CreateSQL);
776 +    if Result then
777 +      ConnectString := RegexObj.Match[2];
778 +  finally
779 +    RegexObj.Free;
780 +  end;
781 + end;
782 +
783 + function ParseConnectString(ConnectString: AnsiString; var ServerName,
784 +  DatabaseName: AnsiString; var Protocol: TProtocolAll; var PortNo: AnsiString
785 +  ): boolean;
786 +
787 +  function GetProtocol(scheme: AnsiString): TProtocolAll;
788    begin
789 <    if (Value <> '') and (Value[1] = '"') then
789 >    scheme := AnsiUpperCase(scheme);
790 >    if scheme = 'INET' then
791 >      Result := inet
792 >    else
793 >    if scheme = 'INET4' then
794 >      Result := inet4
795 >    else
796 >    if scheme = 'INET6' then
797 >      Result := inet6
798 >    else
799 >    if scheme = 'XNET' then
800 >      Result := xnet
801 >    else
802 >    if scheme = 'WNET' then
803 >      Result := wnet
804 >  end;
805 >
806 > var RegexObj: TRegExpr;
807 > begin
808 >  ServerName := '';
809 >  DatabaseName := ConnectString;
810 >  PortNo := '';
811 >  Protocol := unknownProtocol;
812 >  RegexObj := TRegExpr.Create;
813 >  try
814 >    {extact database file spec}
815 >    RegexObj.ModifierG := false; {turn off greedy matches}
816 >    RegexObj.Expression := '^([a-zA-Z46]+)://([a-zA-Z0-9\-\.]*)(|:[0-9a-zA-Z\-]+)/(.*)$';
817 >    Result := RegexObj.Exec(ConnectString);
818 >    if Result then
819      begin
820 <      Delete(Value, 1, 1);
821 <      Delete(Value, Length(Value), 1);
822 <      Value := AnsiUpperCase(StringReplace (Value, '""', '"', [rfReplaceAll]));
820 >      {URL type connect string}
821 >      Protocol := GetProtocol(RegexObj.Match[1]);
822 >      ServerName := RegexObj.Match[2];
823 >      if RegexObj.MatchLen[3] > 0 then
824 >        PortNo := system.Copy(ConnectString,RegexObj.MatchPos[3]+1,RegexObj.MatchLen[3]-1);
825 >      DatabaseName := RegexObj.Match[4];
826 >      if ServerName = '' then
827 >        DatabaseName := '/' + DatabaseName;
828      end
829      else
830 <      Value := AnsiUpperCase(Value);
830 >    begin
831 >      {URL type connect string - local loop}
832 >      RegexObj.Expression := '^([a-zA-Z46]+)://(.*)$';
833 >      Result := RegexObj.Exec(ConnectString);
834 >      if Result then
835 >      begin
836 >        Protocol := GetProtocol(RegexObj.Match[1]);
837 >        DatabaseName := RegexObj.Match[2];
838 >      end
839 >      else
840 >      begin
841 >        RegexObj.Expression := '^([a-zA-Z]:\\.*)';
842 >        Result := RegexObj.Exec(ConnectString);
843 >        if Result then
844 >          Protocol := Local {Windows with leading drive ID}
845 >        else
846 >        begin
847 >          RegexObj.Expression := '^([a-zA-Z0-9\-\.]+)(|/[0-9a-zA-Z\-]+):(.*)$';
848 >          Result := RegexObj.Exec(ConnectString);
849 >          if Result then
850 >          begin
851 >            {Legacy TCP Format}
852 >            ServerName := RegexObj.Match[1];
853 >            if RegexObj.MatchLen[2] > 0 then
854 >              PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
855 >            DatabaseName := RegexObj.Match[3];
856 >            Protocol := TCP;
857 >          end
858 >          else
859 >          begin
860 >            RegexObj.Expression := '^\\\\([a-zA-Z0-9\-\.]+)(|@[0-9a-zA-Z\-]+)\\(.*)$';
861 >            Result := RegexObj.Exec(ConnectString);
862 >            if Result then
863 >            begin
864 >              {Netbui}
865 >              ServerName := RegexObj.Match[1];
866 >              if RegexObj.MatchLen[2] > 0 then
867 >                PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
868 >              DatabaseName := RegexObj.Match[3];
869 >              Protocol := NamedPipe
870 >            end
871 >            else
872 >            begin
873 >              Result := true;
874 >              Protocol := Local; {Assume local}
875 >            end;
876 >          end;
877 >        end;
878 >      end;
879 >    end;
880 >  finally
881 >    RegexObj.Free;
882    end;
179 –  Result := Value;
883   end;
884  
885 < function ExtractIdentifier(Dialect: Integer; Value: String): String;
885 > function GetProtocol(ConnectString: AnsiString): TProtocolAll;
886 > var ServerName,
887 >    DatabaseName: AnsiString;
888 >    PortNo: AnsiString;
889   begin
890 <  Value := Trim(Value);
891 <  if Dialect = 1 then
892 <    Value := AnsiUpperCase(Value)
893 <  else
890 >  ParseConnectString(ConnectString,ServerName,DatabaseName,Result,PortNo);
891 > end;
892 >
893 > {$ELSE}
894 > {cruder version of above for Delphi. Older versions lack regular expression
895 > handling.}
896 > function ExtractConnectString(const CreateSQL: AnsiString;
897 >  var ConnectString: AnsiString): boolean;
898 > var i: integer;
899 > begin
900 >  Result := false;
901 >  i := Pos('''',CreateSQL);
902 >  if i > 0 then
903    begin
904 <    if (Value <> '') and (Value[1] = '"') then
904 >    ConnectString := CreateSQL;
905 >    delete(ConnectString,1,i);
906 >    i := Pos('''',ConnectString);
907 >    if i > 0 then
908      begin
909 <      Delete(Value, 1, 1);
910 <      Delete(Value, Length(Value), 1);
911 <      Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
194 <    end
195 <    else
196 <      Value := AnsiUpperCase(Value);
909 >      delete(ConnectString,i,Length(ConnectString)-i+1);
910 >      Result := true;
911 >    end;
912    end;
198 –  Result := Value;
913   end;
914  
915 < function IsReservedWord(w: string): boolean;
202 < var i: integer;
915 > function GetProtocol(ConnectString: AnsiString): TProtocolAll;
916   begin
917 <     Result := true;
205 <     for i := 0 to Length(sqlReservedWords) - 1 do
206 <         if w = sqlReservedWords[i] then
207 <            Exit;
208 <     Result := false;
917 >  Result := unknownProtocol; {not implemented for Delphi}
918   end;
919  
920 < function QuoteIdentifier(Dialect: Integer; Value: String): String;
920 > function ParseConnectString(ConnectString: AnsiString;
921 >              var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
922 >              var PortNo: AnsiString): boolean;
923   begin
924 <  if Dialect = 1 then
214 <    Value := AnsiUpperCase(Trim(Value))
215 <  else
216 <    Value := '"' + Value + '"';
217 <  Result := Value;
924 >  Result := false;
925   end;
926  
927 < function QuoteIdentifierIfNeeded(Dialect: Integer; Value: String): String;
927 > {$ENDIF}
928 >
929 > {Make a connect string in format appropriate protocol}
930 >
931 > function MakeConnectString(ServerName, DatabaseName: AnsiString;
932 >  Protocol: TProtocol; PortNo: AnsiString): AnsiString;
933 >
934 >  function FormatURL: AnsiString;
935 >  begin
936 >    if (ServerName = '') and (Pos('/',DatabaseName) <= 1) then
937 >      Result := DatabaseName
938 >    else
939 >      Result := ServerName + '/' + DatabaseName;
940 >  end;
941 >
942   begin
943 +  if PortNo <> '' then
944 +    case Protocol of
945 +    NamedPipe:
946 +      ServerName := ServerName + '@' + PortNo;
947 +    Local,
948 +    SPX,
949 +    xnet: {do nothing};
950 +    TCP:
951 +      ServerName := ServerName + '/' + PortNo;
952 +    else
953 +      ServerName := ServerName + ':' + PortNo;
954 +    end;
955 +
956 +  case Protocol of
957 +    TCP:        Result := ServerName + ':' + DatabaseName; {do not localize}
958 +    SPX:        Result := ServerName + '@' + DatabaseName; {do not localize}
959 +    NamedPipe:  Result := '\\' + ServerName + '\' + DatabaseName; {do not localize}
960 +    Local:      Result := DatabaseName; {do not localize}
961 +    inet:       Result := 'inet://' + FormatURL; {do not localize}
962 +    inet4:       Result := 'inet4://' + FormatURL; {do not localize}
963 +    inet6:       Result := 'inet6://' + FormatURL; {do not localize}
964 +    wnet:       Result := 'wnet://' + FormatURL; {do not localize}
965 +    xnet:       Result := 'xnet://' + FormatURL;  {do not localize}
966 +  end;
967 + end;
968 +
969 + {Format an SQL Identifier according to SQL Dialect with encapsulation if necessary}
970 +
971 + function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
972 + begin
973 +  Value := TrimRight(Value);
974    if (Dialect = 3) and
975 <    ((AnsiUpperCase(Value) <> Value) or IsReservedWord(Value)) then
976 <     Result := '"' + Value + '"'
975 >    (IsReservedWord(Value) or not IsSQLIdentifier(Value) or (AnsiUpperCase(Value) <> Value)) then
976 >     Result := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
977    else
978      Result := Value
979   end;
980  
981 < function Space2Underscore(s: string): string;
981 > {Replaces unknown characters in a string with underscores}
982 >
983 > function Space2Underscore(s: AnsiString): AnsiString;
984   var
985     k: integer;
986   begin
987       Result := s;
988       for k := 1 to Length(s) do
989 <         if not (Result[k] in ['0'..'9','A'..'Z','_','$'])  then
989 >         if not (Result[k] in ValidSQLIdentifierChars)  then
990              Result[k] := '_';
991   end;
992  
993 + {Reformats an SQL string with single quotes duplicated.}
994 +
995 + function SQLSafeString(const s: AnsiString): AnsiString;
996 + begin
997 +  Result := StringReplace(s,'''','''''',[rfReplaceAll]);
998 + end;
999 +
1000 + { TSQLParamProcessor }
1001 +
1002 + function TSQLParamProcessor.DoExecute(GenerateParamNames: boolean;
1003 +  var slNames: TStrings): AnsiString;
1004 + var token: TSQLTokens;
1005 +    iParamSuffix: Integer;
1006 + begin
1007 +  Result := '';
1008 +  iParamSuffix := 0;
1009 +
1010 +  while not EOF do
1011 +  begin
1012 +    token := GetNextToken;
1013 +    case token of
1014 +    sqltParam,
1015 +    sqltQuotedParam:
1016 +      begin
1017 +        Result := Result + '?';
1018 +        slNames.Add(TokenText);
1019 +      end;
1020 +
1021 +    sqltPlaceHolder:
1022 +      if GenerateParamNames then
1023 +      begin
1024 +        Inc(iParamSuffix);
1025 +        slNames.AddObject(sIBXParam + IntToStr(iParamSuffix),self); //Note local convention
1026 +                                            //add pointer to self to mark entry
1027 +        Result := Result + '?';
1028 +      end
1029 +      else
1030 +        IBError(ibxeSQLParseError, [SParamNameExpected]);
1031 +
1032 +    sqltQuotedString:
1033 +      Result := Result + '''' + SQLSafeString(TokenText) + '''';
1034 +
1035 +    sqltIdentifierInDoubleQuotes:
1036 +      Result := Result + '"' + StringReplace(TokenText,'"','""',[rfReplaceAll]) + '"';
1037 +
1038 +    sqltComment:
1039 +      Result := Result + '/*' + TokenText + '*/';
1040 +
1041 +    sqltCommentLine:
1042 +      Result := Result + '--' + TokenText + LineEnding;
1043 +
1044 +    sqltEOL:
1045 +      Result := Result + LineEnding;
1046 +
1047 +    else
1048 +      Result := Result + TokenText;
1049 +    end;
1050 +  end;
1051 + end;
1052 +
1053 + function TSQLParamProcessor.GetChar: AnsiChar;
1054 + begin
1055 +  if FIndex <= Length(FInString) then
1056 +  begin
1057 +    Result := FInString[FIndex];
1058 +    Inc(FIndex);
1059 +  end
1060 +  else
1061 +    Result := #0;
1062 + end;
1063 +
1064 + class function TSQLParamProcessor.Execute(sSQL: AnsiString;
1065 +  GenerateParamNames: boolean; var slNames: TStrings): AnsiString;
1066 + begin
1067 +  with self.Create do
1068 +  try
1069 +    FInString := sSQL;
1070 +    FIndex := 1;
1071 +    Result := DoExecute(GenerateParamNames,slNames);
1072 +  finally
1073 +    Free;
1074 +  end;
1075 + end;
1076 +
1077 + { TSQLwithNamedParamsTokeniser }
1078 +
1079 + procedure TSQLwithNamedParamsTokeniser.Assign(source: TSQLTokeniser);
1080 + begin
1081 +  inherited Assign(source);
1082 +  if source is TSQLwithNamedParamsTokeniser then
1083 +  begin
1084 +    FState := TSQLwithNamedParamsTokeniser(source).FState;
1085 +    FNested := TSQLwithNamedParamsTokeniser(source).FNested;
1086 +  end;
1087 + end;
1088 +
1089 + procedure TSQLwithNamedParamsTokeniser.Reset;
1090 + begin
1091 +  inherited Reset;
1092 +  FState := stInit;
1093 +  FNested := 0;
1094 + end;
1095 +
1096 + function TSQLwithNamedParamsTokeniser.TokenFound(var token: TSQLTokens
1097 +  ): boolean;
1098 + begin
1099 +  Result := inherited TokenFound(token);
1100 +  if not Result then Exit;
1101 +
1102 +  case FState of
1103 +  stInit:
1104 +    begin
1105 +      case token of
1106 +      sqltColon:
1107 +        begin
1108 +          FState := stInParam;
1109 +          ResetQueue(token);
1110 +        end;
1111 +
1112 +      sqltBegin:
1113 +        begin
1114 +          FState := stInBlock;
1115 +          FNested := 1;
1116 +        end;
1117 +
1118 +      sqltOpenSquareBracket:
1119 +          FState := stInArrayDim;
1120 +
1121 +      end;
1122 +    end;
1123 +
1124 +  stInParam:
1125 +    begin
1126 +      case token of
1127 +      sqltIdentifier:
1128 +        token := sqltParam;
1129 +
1130 +      sqltIdentifierInDoubleQuotes:
1131 +        token := sqltQuotedParam;
1132 +
1133 +      else
1134 +        begin
1135 +          QueueToken(token);
1136 +          ReleaseQueue(token);
1137 +        end;
1138 +      end;
1139 +      FState := stInit;
1140 +    end;
1141 +
1142 +  stInBlock:
1143 +    begin
1144 +      case token of
1145 +      sqltBegin:
1146 +          Inc(FNested);
1147 +
1148 +      sqltEnd:
1149 +        begin
1150 +          Dec(FNested);
1151 +          if FNested = 0 then
1152 +            FState := stInit;
1153 +        end;
1154 +      end;
1155 +    end;
1156 +
1157 +    stInArrayDim:
1158 +      begin
1159 +        if token = sqltCloseSquareBracket then
1160 +            FState := stInit;
1161 +      end;
1162 +    end;
1163 +
1164 +  Result := (FState <> stInParam);
1165 + end;
1166 +
1167 + { TSQLTokeniser }
1168 +
1169 + function TSQLTokeniser.GetNext: TSQLTokens;
1170 + var C: AnsiChar;
1171 + begin
1172 +  if EOF then
1173 +    Result := sqltEOF
1174 +  else
1175 +  begin
1176 +    C := GetChar;
1177 +    case C of
1178 +    #0:
1179 +      Result := sqltEOF;
1180 +    ' ',TAB:
1181 +      Result := sqltSpace;
1182 +    '0'..'9':
1183 +      Result := sqltNumberString;
1184 +    ';':
1185 +      Result := sqltSemiColon;
1186 +    '?':
1187 +      Result := sqltPlaceholder;
1188 +    '|':
1189 +      Result := sqltPipe;
1190 +    '"':
1191 +      Result := sqltDoubleQuotes;
1192 +    '''':
1193 +      Result := sqltSingleQuotes;
1194 +    '/':
1195 +      Result := sqltForwardSlash;
1196 +    '\':
1197 +      Result := sqltBackslash;
1198 +    '*':
1199 +      Result := sqltAsterisk;
1200 +    '(':
1201 +      Result := sqltOpenBracket;
1202 +    ')':
1203 +      Result := sqltCloseBracket;
1204 +    ':':
1205 +      Result := sqltColon;
1206 +    ',':
1207 +      Result := sqltComma;
1208 +    '.':
1209 +      Result := sqltPeriod;
1210 +    '=':
1211 +      Result := sqltEquals;
1212 +    '[':
1213 +      Result := sqltOpenSquareBracket;
1214 +    ']':
1215 +      Result := sqltCloseSquareBracket;
1216 +    '-':
1217 +      Result := sqltMinus;
1218 +    '<':
1219 +      Result := sqltLT;
1220 +    '>':
1221 +      Result := sqltGT;
1222 +    CR:
1223 +      Result := sqltCR;
1224 +    LF:
1225 +      Result := sqltEOL;
1226 +    else
1227 +      if C in ValidSQLIdentifierChars then
1228 +        Result := sqltIdentifier
1229 +      else
1230 +        Result := sqltOtherCharacter;
1231 +    end;
1232 +    FLastChar := C
1233 +  end;
1234 +  FNextToken := Result;
1235 + end;
1236 +
1237 + procedure TSQLTokeniser.PopQueue(var token: TSQLTokens);
1238 + begin
1239 +  if FQFirst = FQLast then
1240 +    IBError(ibxeTokenQueueUnderflow,[]);
1241 +  token := FTokenQueue[FQFirst].token;
1242 +  FString := FTokenQueue[FQFirst].text;
1243 +  Inc(FQFirst);
1244 +  if FQFirst = FQLast then
1245 +    FQueueState := tsHold;
1246 + end;
1247 +
1248 + procedure TSQLTokeniser.Assign(source: TSQLTokeniser);
1249 + begin
1250 +  FString := source.FString;
1251 +  FNextToken := source.FNextToken;
1252 +  FTokenQueue := source.FTokenQueue;
1253 +  FQueueState := source.FQueueState;
1254 +  FQFirst := source.FQFirst;
1255 +  FQLast := source.FQLast;
1256 + end;
1257 +
1258 + function TSQLTokeniser.TokenFound(var token: TSQLTokens): boolean;
1259 + begin
1260 +  Result := (FState = stDefault);
1261 +  if Result and (token = sqltIdentifier)  then
1262 +    FindReservedWord(FString,token);
1263 + end;
1264 +
1265 + procedure TSQLTokeniser.QueueToken(token: TSQLTokens; text: AnsiString);
1266 + begin
1267 +  if FQLast > TokenQueueMaxSize then
1268 +    IBError(ibxeTokenQueueOverflow,[]);
1269 +  FTokenQueue[FQLast].token := token;
1270 +  FTokenQueue[FQLast].text := text;
1271 +  Inc(FQLast);
1272 + end;
1273 +
1274 + procedure TSQLTokeniser.QueueToken(token: TSQLTokens);
1275 + begin
1276 +  QueueToken(token,TokenText);
1277 + end;
1278 +
1279 + procedure TSQLTokeniser.ResetQueue;
1280 + begin
1281 +  FQFirst := 0;
1282 +  FQLast := 0;
1283 +  FQueueState := tsHold;
1284 + end;
1285 +
1286 + procedure TSQLTokeniser.ResetQueue(token: TSQLTokens; text: AnsiString);
1287 + begin
1288 +  ResetQueue;
1289 +  QueueToken(token,text);
1290 + end;
1291 +
1292 + procedure TSQLTokeniser.ResetQueue(token: TSQLTokens);
1293 + begin
1294 +  ResetQueue;
1295 +  QueueToken(token);
1296 + end;
1297 +
1298 + procedure TSQLTokeniser.ReleaseQueue(var token: TSQLTokens);
1299 + begin
1300 +  FQueueState := tsRelease;
1301 +  PopQueue(token);
1302 + end;
1303 +
1304 + procedure TSQLTokeniser.ReleaseQueue;
1305 + begin
1306 +  FQueueState := tsRelease;
1307 + end;
1308 +
1309 + function TSQLTokeniser.GetQueuedText: AnsiString;
1310 + var i: integer;
1311 + begin
1312 +  Result := '';
1313 +  for i := FQFirst to FQLast do
1314 +    Result := Result + FTokenQueue[i].text;
1315 + end;
1316 +
1317 + procedure TSQLTokeniser.SetTokenText(text: AnsiString);
1318 + begin
1319 +  FString := text;
1320 + end;
1321 +
1322 + constructor TSQLTokeniser.Create;
1323 + begin
1324 +  inherited Create;
1325 +  Reset;
1326 + end;
1327 +
1328 + destructor TSQLTokeniser.Destroy;
1329 + begin
1330 +  Reset;
1331 +  inherited Destroy;
1332 + end;
1333 +
1334 + procedure TSQLTokeniser.Reset;
1335 + begin
1336 +  FNextToken := sqltInit;
1337 +  FState := stDefault;
1338 +  FString := '';
1339 +  FEOF := false;
1340 +  ResetQueue;
1341 + end;
1342 +
1343 + function TSQLTokeniser.GetNextToken: TSQLTokens;
1344 + begin
1345 +  if FQueueState = tsRelease then
1346 +  repeat
1347 +    PopQueue(Result);
1348 +    FEOF := Result = sqltEOF;
1349 +    if TokenFound(Result) then
1350 +      Exit;
1351 +  until FQueueState <> tsRelease;
1352 +
1353 +  Result := InternalGetNextToken;
1354 + end;
1355 +
1356 + {a simple lookahead one algorithm to extra the next symbol}
1357 +
1358 + function TSQLTokeniser.InternalGetNextToken: TSQLTokens;
1359 + var C: AnsiChar;
1360 + begin
1361 +  Result := sqltEOF;
1362 +
1363 +  if FNextToken = sqltInit then
1364 +    GetNext;
1365 +
1366 +  repeat
1367 +    Result := FNextToken;
1368 +    C := FLastChar;
1369 +    GetNext;
1370 +
1371 +    if FSkipNext then
1372 +    begin
1373 +      FSkipNext := false;
1374 +      continue;
1375 +    end;
1376 +
1377 +    case FState of
1378 +    stInComment:
1379 +      begin
1380 +        if (Result = sqltAsterisk) and (FNextToken = sqltForwardSlash) then
1381 +        begin
1382 +          FState := stDefault;
1383 +          Result := sqltComment;
1384 +          GetNext;
1385 +        end
1386 +        else
1387 +          FString := FString + C;
1388 +      end;
1389 +
1390 +    stInCommentLine:
1391 +      begin
1392 +        case Result of
1393 +        sqltEOL:
1394 +          begin
1395 +            FState := stDefault;
1396 +            Result := sqltCommentLine;
1397 +          end;
1398 +
1399 +        sqltCR: {ignore};
1400 +
1401 +        else
1402 +          FString := FString + C;
1403 +        end;
1404 +      end;
1405 +
1406 +    stSingleQuoted:
1407 +      begin
1408 +        if (Result = sqltSingleQuotes) then
1409 +        begin
1410 +          if (FNextToken = sqltSingleQuotes) then
1411 +          begin
1412 +            FSkipNext := true;
1413 +            FString := FString + C;
1414 +          end
1415 +          else
1416 +          begin
1417 +            Result := sqltQuotedString;
1418 +            FState := stDefault;
1419 +          end;
1420 +        end
1421 +        else
1422 +          FString := FString + C;
1423 +      end;
1424 +
1425 +    stDoubleQuoted:
1426 +      begin
1427 +        if (Result = sqltDoubleQuotes) then
1428 +        begin
1429 +          if (FNextToken = sqltDoubleQuotes) then
1430 +          begin
1431 +            FSkipNext := true;
1432 +            FString := FString + C;
1433 +          end
1434 +          else
1435 +          begin
1436 +            Result := sqltIdentifierInDoubleQuotes;
1437 +            FState := stDefault;
1438 +          end;
1439 +        end
1440 +        else
1441 +          FString := FString + C;
1442 +      end;
1443 +
1444 +    stInIdentifier:
1445 +      begin
1446 +        FString := FString + C;
1447 +        Result := sqltIdentifier;
1448 +        if not (FNextToken in [sqltIdentifier,sqltNumberString]) then
1449 +          FState := stDefault
1450 +      end;
1451 +
1452 +    stInNumeric:
1453 +      begin
1454 +        FString := FString + C;
1455 +        if (Result = sqltPeriod) and (FNextToken = sqltPeriod) then
1456 +        begin
1457 +          {malformed decimal}
1458 +          FState := stInIdentifier;
1459 +          Result := sqltIdentifier
1460 +        end
1461 +        else
1462 +        begin
1463 +          if not (FNextToken in [sqltNumberString,sqltPeriod]) then
1464 +            FState := stDefault;
1465 +          Result := sqltNumberString;
1466 +        end;
1467 +      end;
1468 +
1469 +    else {stDefault}
1470 +      begin
1471 +        FString := C;
1472 +        case Result of
1473 +
1474 +        sqltPipe:
1475 +          if FNextToken = sqltPipe then
1476 +          begin
1477 +            Result := sqltConcatSymbol;
1478 +            FString := C + FLastChar;
1479 +            GetNext;
1480 +          end;
1481 +
1482 +        sqltForwardSlash:
1483 +          begin
1484 +            if FNextToken = sqltAsterisk then
1485 +            begin
1486 +              FString := '';
1487 +              GetNext;
1488 +              FState := stInComment;
1489 +            end
1490 +          end;
1491 +
1492 +        sqltMinus:
1493 +          begin
1494 +            if FNextToken = sqltMinus then
1495 +            begin
1496 +              FString := '';
1497 +              GetNext;
1498 +              FState := stInCommentLine;
1499 +            end;
1500 +          end;
1501 +
1502 +        sqltSingleQuotes:
1503 +          begin
1504 +            FString := '';
1505 +            FState := stSingleQuoted;
1506 +          end;
1507 +
1508 +        sqltDoubleQuotes:
1509 +          begin
1510 +            FString := '';
1511 +            FState := stDoubleQuoted;
1512 +          end;
1513 +
1514 +        sqltIdentifier:
1515 +          if FNextToken in [sqltIdentifier,sqltNumberString] then
1516 +            FState := stInIdentifier;
1517 +
1518 +        sqltNumberString:
1519 +          if FNextToken in [sqltNumberString,sqltPeriod] then
1520 +            FState := stInNumeric;
1521 +        end;
1522 +      end;
1523 +    end;
1524 +
1525 + //    writeln(FString);
1526 +    FEOF := Result = sqltEOF;
1527 +  until TokenFound(Result) or EOF;
1528 + end;
1529  
1530   end.

Diff Legend

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