ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/udr/client/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 287 by tony, Thu Apr 11 08:51:23 2019 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 >   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
165 –  Value := Trim(Value);
740    if Dialect = 1 then
741 <    Value := AnsiUpperCase(Value)
741 >    Value := AnsiUpperCase(Trim(Value))
742    else
743 +    Value := '"' + StringReplace (Value, '""', '"', [rfReplaceAll]) + '"';
744 +  Result := Value;
745 + end;
746 +
747 + const
748 +  ValidSQLIdentifierChars = ['A'..'Z','a'..'z','0'..'9','_','$'];
749 +
750 + {Returns true if the value is a valid SQL Identifier - note lower case accepted}
751 +
752 + function IsSQLIdentifier(Value: AnsiString): boolean;
753 + var i: integer;
754 + begin
755 +  Result := false;
756 +  for i := 1 to Length(Value) do
757 +    if not (Value[i] in ValidSQLIdentifierChars) then Exit;
758 +  Result := true;
759 + end;
760 +
761 + {Extracts the Database Connect string from a Create Database Statement}
762 +
763 + {$IFDEF HASREQEX}
764 + function ExtractConnectString(const CreateSQL: AnsiString;
765 +  var ConnectString: AnsiString): boolean;
766 + var RegexObj: TRegExpr;
767 + begin
768 +  RegexObj := TRegExpr.Create;
769 +  try
770 +    {extact database file spec}
771 +    RegexObj.ModifierG := false; {turn off greedy matches}
772 +    RegexObj.ModifierI := true; {case insensitive match}
773 +    RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''';
774 +    Result := RegexObj.Exec(CreateSQL);
775 +    if Result then
776 +      ConnectString := RegexObj.Match[2];
777 +  finally
778 +    RegexObj.Free;
779 +  end;
780 + end;
781 +
782 + function ParseConnectString(ConnectString: AnsiString; var ServerName,
783 +  DatabaseName: AnsiString; var Protocol: TProtocolAll; var PortNo: AnsiString
784 +  ): boolean;
785 +
786 +  function GetProtocol(scheme: AnsiString): TProtocolAll;
787    begin
788 <    if (Value <> '') and (Value[1] = '"') then
788 >    scheme := AnsiUpperCase(scheme);
789 >    if scheme = 'INET' then
790 >      Result := inet
791 >    else
792 >    if scheme = 'INET4' then
793 >      Result := inet4
794 >    else
795 >    if scheme = 'INET6' then
796 >      Result := inet6
797 >    else
798 >    if scheme = 'XNET' then
799 >      Result := xnet
800 >    else
801 >    if scheme = 'WNET' then
802 >      Result := wnet
803 >  end;
804 >
805 > var RegexObj: TRegExpr;
806 > begin
807 >  ServerName := '';
808 >  DatabaseName := ConnectString;
809 >  PortNo := '';
810 >  Protocol := unknownProtocol;
811 >  RegexObj := TRegExpr.Create;
812 >  try
813 >    {extact database file spec}
814 >    RegexObj.ModifierG := false; {turn off greedy matches}
815 >    RegexObj.Expression := '^([a-zA-Z46]+)://([a-zA-Z0-9\-\.]*)(|:[0-9a-zA-Z\-]+)/(.*)$';
816 >    Result := RegexObj.Exec(ConnectString);
817 >    if Result then
818      begin
819 <      Delete(Value, 1, 1);
820 <      Delete(Value, Length(Value), 1);
821 <      Value := AnsiUpperCase(StringReplace (Value, '""', '"', [rfReplaceAll]));
819 >      {URL type connect string}
820 >      Protocol := GetProtocol(RegexObj.Match[1]);
821 >      ServerName := RegexObj.Match[2];
822 >      if RegexObj.MatchLen[3] > 0 then
823 >        PortNo := system.Copy(ConnectString,RegexObj.MatchPos[3]+1,RegexObj.MatchLen[3]-1);
824 >      DatabaseName := RegexObj.Match[4];
825 >      if ServerName = '' then
826 >        DatabaseName := '/' + DatabaseName;
827      end
828      else
829 <      Value := AnsiUpperCase(Value);
829 >    begin
830 >      {URL type connect string - local loop}
831 >      RegexObj.Expression := '^([a-zA-Z46]+)://(.*)$';
832 >      Result := RegexObj.Exec(ConnectString);
833 >      if Result then
834 >      begin
835 >        Protocol := GetProtocol(RegexObj.Match[1]);
836 >        DatabaseName := RegexObj.Match[2];
837 >      end
838 >      else
839 >      begin
840 >        RegexObj.Expression := '^([a-zA-Z]:\\.*)';
841 >        Result := RegexObj.Exec(ConnectString);
842 >        if Result then
843 >          Protocol := Local {Windows with leading drive ID}
844 >        else
845 >        begin
846 >          RegexObj.Expression := '^([a-zA-Z0-9\-\.]+)(|/[0-9a-zA-Z\-]+):(.*)$';
847 >          Result := RegexObj.Exec(ConnectString);
848 >          if Result then
849 >          begin
850 >            {Legacy TCP Format}
851 >            ServerName := RegexObj.Match[1];
852 >            if RegexObj.MatchLen[2] > 0 then
853 >              PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
854 >            DatabaseName := RegexObj.Match[3];
855 >            Protocol := TCP;
856 >          end
857 >          else
858 >          begin
859 >            RegexObj.Expression := '^\\\\([a-zA-Z0-9\-\.]+)(|@[0-9a-zA-Z\-]+)\\(.*)$';
860 >            Result := RegexObj.Exec(ConnectString);
861 >            if Result then
862 >            begin
863 >              {Netbui}
864 >              ServerName := RegexObj.Match[1];
865 >              if RegexObj.MatchLen[2] > 0 then
866 >                PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
867 >              DatabaseName := RegexObj.Match[3];
868 >              Protocol := NamedPipe
869 >            end
870 >            else
871 >            begin
872 >              Result := true;
873 >              Protocol := Local; {Assume local}
874 >            end;
875 >          end;
876 >        end;
877 >      end;
878 >    end;
879 >  finally
880 >    RegexObj.Free;
881    end;
179 –  Result := Value;
882   end;
883  
884 < function ExtractIdentifier(Dialect: Integer; Value: String): String;
884 > function GetProtocol(ConnectString: AnsiString): TProtocolAll;
885 > var ServerName,
886 >    DatabaseName: AnsiString;
887 >    PortNo: AnsiString;
888   begin
889 <  Value := Trim(Value);
890 <  if Dialect = 1 then
891 <    Value := AnsiUpperCase(Value)
892 <  else
889 >  ParseConnectString(ConnectString,ServerName,DatabaseName,Result,PortNo);
890 > end;
891 >
892 > {$ELSE}
893 > {cruder version of above for Delphi. Older versions lack regular expression
894 > handling.}
895 > function ExtractConnectString(const CreateSQL: AnsiString;
896 >  var ConnectString: AnsiString): boolean;
897 > var i: integer;
898 > begin
899 >  Result := false;
900 >  i := Pos('''',CreateSQL);
901 >  if i > 0 then
902    begin
903 <    if (Value <> '') and (Value[1] = '"') then
903 >    ConnectString := CreateSQL;
904 >    delete(ConnectString,1,i);
905 >    i := Pos('''',ConnectString);
906 >    if i > 0 then
907      begin
908 <      Delete(Value, 1, 1);
909 <      Delete(Value, Length(Value), 1);
910 <      Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
194 <    end
195 <    else
196 <      Value := AnsiUpperCase(Value);
908 >      delete(ConnectString,i,Length(ConnectString)-i+1);
909 >      Result := true;
910 >    end;
911    end;
198 –  Result := Value;
912   end;
913  
914 < function IsReservedWord(w: string): boolean;
202 < var i: integer;
914 > function GetProtocol(ConnectString: AnsiString): TProtocolAll;
915   begin
916 <     Result := true;
205 <     for i := 0 to Length(sqlReservedWords) - 1 do
206 <         if w = sqlReservedWords[i] then
207 <            Exit;
208 <     Result := false;
916 >  Result := unknownProtocol; {not implemented for Delphi}
917   end;
918  
919 < function QuoteIdentifier(Dialect: Integer; Value: String): String;
919 > function ParseConnectString(ConnectString: AnsiString;
920 >              var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
921 >              var PortNo: AnsiString): boolean;
922   begin
923 <  if Dialect = 1 then
214 <    Value := AnsiUpperCase(Trim(Value))
215 <  else
216 <    Value := '"' + Value + '"';
217 <  Result := Value;
923 >  Result := false;
924   end;
925  
926 < function QuoteIdentifierIfNeeded(Dialect: Integer; Value: String): String;
926 > {$ENDIF}
927 >
928 > {Make a connect string in format appropriate protocol}
929 >
930 > function MakeConnectString(ServerName, DatabaseName: AnsiString;
931 >  Protocol: TProtocol; PortNo: AnsiString): AnsiString;
932 >
933 >  function FormatURL: AnsiString;
934 >  begin
935 >    if (ServerName = '') and (Pos('/',DatabaseName) <= 1) then
936 >      Result := DatabaseName
937 >    else
938 >      Result := ServerName + '/' + DatabaseName;
939 >  end;
940 >
941 > begin
942 >  if PortNo <> '' then
943 >    case Protocol of
944 >    NamedPipe:
945 >      ServerName := ServerName + '@' + PortNo;
946 >    Local,
947 >    SPX,
948 >    xnet: {do nothing};
949 >    TCP:
950 >      ServerName := ServerName + '/' + PortNo;
951 >    else
952 >      ServerName := ServerName + ':' + PortNo;
953 >    end;
954 >
955 >  case Protocol of
956 >    TCP:        Result := ServerName + ':' + DatabaseName; {do not localize}
957 >    SPX:        Result := ServerName + '@' + DatabaseName; {do not localize}
958 >    NamedPipe:  Result := '\\' + ServerName + '\' + DatabaseName; {do not localize}
959 >    Local:      Result := DatabaseName; {do not localize}
960 >    inet:       Result := 'inet://' + FormatURL; {do not localize}
961 >    inet4:       Result := 'inet4://' + FormatURL; {do not localize}
962 >    inet6:       Result := 'inet6://' + FormatURL; {do not localize}
963 >    wnet:       Result := 'wnet://' + FormatURL; {do not localize}
964 >    xnet:       Result := 'xnet://' + FormatURL;  {do not localize}
965 >  end;
966 > end;
967 >
968 > {Format an SQL Identifier according to SQL Dialect with encapsulation if necessary}
969 >
970 > function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
971   begin
972    if (Dialect = 3) and
973 <    ((AnsiUpperCase(Value) <> Value) or IsReservedWord(Value)) then
974 <     Result := '"' + Value + '"'
973 >    (IsReservedWord(Value) or not IsSQLIdentifier(Value) or (AnsiUpperCase(Value) <> Value)) then
974 >     Result := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
975    else
976      Result := Value
977   end;
978  
979 < function Space2Underscore(s: string): string;
979 > {Replaces unknown characters in a string with underscores}
980 >
981 > function Space2Underscore(s: AnsiString): AnsiString;
982   var
983     k: integer;
984   begin
985       Result := s;
986       for k := 1 to Length(s) do
987 <         if not (Result[k] in ['0'..'9','A'..'Z','_','$'])  then
987 >         if not (Result[k] in ValidSQLIdentifierChars)  then
988              Result[k] := '_';
989   end;
990  
991 + {Reformats an SQL string with single quotes duplicated.}
992 +
993 + function SQLSafeString(const s: AnsiString): AnsiString;
994 + begin
995 +  Result := StringReplace(s,'''','''''',[rfReplaceAll]);
996 + end;
997 +
998 + { TSQLParamProcessor }
999 +
1000 + function TSQLParamProcessor.DoExecute(GenerateParamNames: boolean;
1001 +  var slNames: TStrings): AnsiString;
1002 + var token: TSQLTokens;
1003 +    iParamSuffix: Integer;
1004 + begin
1005 +  Result := '';
1006 +  iParamSuffix := 0;
1007 +
1008 +  while not EOF do
1009 +  begin
1010 +    token := GetNextToken;
1011 +    case token of
1012 +    sqltParam,
1013 +    sqltQuotedParam:
1014 +      begin
1015 +        Result := Result + '?';
1016 +        slNames.Add(TokenText);
1017 +      end;
1018 +
1019 +    sqltPlaceHolder:
1020 +      if GenerateParamNames then
1021 +      begin
1022 +        Inc(iParamSuffix);
1023 +        slNames.AddObject(sIBXParam + IntToStr(iParamSuffix),self); //Note local convention
1024 +                                            //add pointer to self to mark entry
1025 +        Result := Result + '?';
1026 +      end
1027 +      else
1028 +        IBError(ibxeSQLParseError, [SParamNameExpected]);
1029 +
1030 +    sqltQuotedString:
1031 +      Result := Result + '''' + SQLSafeString(TokenText) + '''';
1032 +
1033 +    sqltIdentifierInDoubleQuotes:
1034 +      Result := Result + '"' + StringReplace(TokenText,'"','""',[rfReplaceAll]) + '"';
1035 +
1036 +    sqltComment:
1037 +      Result := Result + '/*' + TokenText + '*/';
1038 +
1039 +    sqltCommentLine:
1040 +      Result := Result + '--' + TokenText + LineEnding;
1041 +
1042 +    sqltEOL:
1043 +      Result := Result + LineEnding;
1044 +
1045 +    else
1046 +      Result := Result + TokenText;
1047 +    end;
1048 +  end;
1049 + end;
1050 +
1051 + function TSQLParamProcessor.GetChar: AnsiChar;
1052 + begin
1053 +  if FIndex <= Length(FInString) then
1054 +  begin
1055 +    Result := FInString[FIndex];
1056 +    Inc(FIndex);
1057 +  end
1058 +  else
1059 +    Result := #0;
1060 + end;
1061 +
1062 + class function TSQLParamProcessor.Execute(sSQL: AnsiString;
1063 +  GenerateParamNames: boolean; var slNames: TStrings): AnsiString;
1064 + begin
1065 +  with self.Create do
1066 +  try
1067 +    FInString := sSQL;
1068 +    FIndex := 1;
1069 +    Result := DoExecute(GenerateParamNames,slNames);
1070 +  finally
1071 +    Free;
1072 +  end;
1073 + end;
1074 +
1075 + { TSQLwithNamedParamsTokeniser }
1076 +
1077 + procedure TSQLwithNamedParamsTokeniser.Assign(source: TSQLTokeniser);
1078 + begin
1079 +  inherited Assign(source);
1080 +  if source is TSQLwithNamedParamsTokeniser then
1081 +  begin
1082 +    FState := TSQLwithNamedParamsTokeniser(source).FState;
1083 +    FNested := TSQLwithNamedParamsTokeniser(source).FNested;
1084 +  end;
1085 + end;
1086 +
1087 + procedure TSQLwithNamedParamsTokeniser.Reset;
1088 + begin
1089 +  inherited Reset;
1090 +  FState := stInit;
1091 +  FNested := 0;
1092 + end;
1093 +
1094 + function TSQLwithNamedParamsTokeniser.TokenFound(var token: TSQLTokens
1095 +  ): boolean;
1096 + begin
1097 +  Result := inherited TokenFound(token);
1098 +  if not Result then Exit;
1099 +
1100 +  case FState of
1101 +  stInit:
1102 +    begin
1103 +      case token of
1104 +      sqltColon:
1105 +        begin
1106 +          FState := stInParam;
1107 +          ResetQueue(token);
1108 +        end;
1109 +
1110 +      sqltBegin:
1111 +        begin
1112 +          FState := stInBlock;
1113 +          FNested := 1;
1114 +        end;
1115 +
1116 +      sqltOpenSquareBracket:
1117 +          FState := stInArrayDim;
1118 +
1119 +      end;
1120 +    end;
1121 +
1122 +  stInParam:
1123 +    begin
1124 +      case token of
1125 +      sqltIdentifier:
1126 +        token := sqltParam;
1127 +
1128 +      sqltIdentifierInDoubleQuotes:
1129 +        token := sqltQuotedParam;
1130 +
1131 +      else
1132 +        begin
1133 +          QueueToken(token);
1134 +          ReleaseQueue(token);
1135 +        end;
1136 +      end;
1137 +      FState := stInit;
1138 +    end;
1139 +
1140 +  stInBlock:
1141 +    begin
1142 +      case token of
1143 +      sqltBegin:
1144 +          Inc(FNested);
1145 +
1146 +      sqltEnd:
1147 +        begin
1148 +          Dec(FNested);
1149 +          if FNested = 0 then
1150 +            FState := stInit;
1151 +        end;
1152 +      end;
1153 +    end;
1154 +
1155 +    stInArrayDim:
1156 +      begin
1157 +        if token = sqltCloseSquareBracket then
1158 +            FState := stInit;
1159 +      end;
1160 +    end;
1161 +
1162 +  Result := (FState <> stInParam);
1163 + end;
1164 +
1165 + { TSQLTokeniser }
1166 +
1167 + function TSQLTokeniser.GetNext: TSQLTokens;
1168 + var C: AnsiChar;
1169 + begin
1170 +  if EOF then
1171 +    Result := sqltEOF
1172 +  else
1173 +  begin
1174 +    C := GetChar;
1175 +    case C of
1176 +    #0:
1177 +      Result := sqltEOF;
1178 +    ' ',TAB:
1179 +      Result := sqltSpace;
1180 +    '0'..'9':
1181 +      Result := sqltNumberString;
1182 +    ';':
1183 +      Result := sqltSemiColon;
1184 +    '?':
1185 +      Result := sqltPlaceholder;
1186 +    '|':
1187 +      Result := sqltPipe;
1188 +    '"':
1189 +      Result := sqltDoubleQuotes;
1190 +    '''':
1191 +      Result := sqltSingleQuotes;
1192 +    '/':
1193 +      Result := sqltForwardSlash;
1194 +    '\':
1195 +      Result := sqltBackslash;
1196 +    '*':
1197 +      Result := sqltAsterisk;
1198 +    '(':
1199 +      Result := sqltOpenBracket;
1200 +    ')':
1201 +      Result := sqltCloseBracket;
1202 +    ':':
1203 +      Result := sqltColon;
1204 +    ',':
1205 +      Result := sqltComma;
1206 +    '.':
1207 +      Result := sqltPeriod;
1208 +    '=':
1209 +      Result := sqltEquals;
1210 +    '[':
1211 +      Result := sqltOpenSquareBracket;
1212 +    ']':
1213 +      Result := sqltCloseSquareBracket;
1214 +    '-':
1215 +      Result := sqltMinus;
1216 +    '<':
1217 +      Result := sqltLT;
1218 +    '>':
1219 +      Result := sqltGT;
1220 +    CR:
1221 +      Result := sqltCR;
1222 +    LF:
1223 +      Result := sqltEOL;
1224 +    else
1225 +      if C in ValidSQLIdentifierChars then
1226 +        Result := sqltIdentifier
1227 +      else
1228 +        Result := sqltOtherCharacter;
1229 +    end;
1230 +    FLastChar := C
1231 +  end;
1232 +  FNextToken := Result;
1233 + end;
1234 +
1235 + procedure TSQLTokeniser.PopQueue(var token: TSQLTokens);
1236 + begin
1237 +  if FQFirst = FQLast then
1238 +    IBError(ibxeTokenQueueUnderflow,[]);
1239 +  token := FTokenQueue[FQFirst].token;
1240 +  FString := FTokenQueue[FQFirst].text;
1241 +  Inc(FQFirst);
1242 +  if FQFirst = FQLast then
1243 +    FQueueState := tsHold;
1244 + end;
1245 +
1246 + procedure TSQLTokeniser.Assign(source: TSQLTokeniser);
1247 + begin
1248 +  FString := source.FString;
1249 +  FNextToken := source.FNextToken;
1250 +  FTokenQueue := source.FTokenQueue;
1251 +  FQueueState := source.FQueueState;
1252 +  FQFirst := source.FQFirst;
1253 +  FQLast := source.FQLast;
1254 + end;
1255 +
1256 + function TSQLTokeniser.TokenFound(var token: TSQLTokens): boolean;
1257 + begin
1258 +  Result := (FState = stDefault);
1259 +  if Result and (token = sqltIdentifier)  then
1260 +    FindReservedWord(FString,token);
1261 + end;
1262 +
1263 + procedure TSQLTokeniser.QueueToken(token: TSQLTokens; text: AnsiString);
1264 + begin
1265 +  if FQLast > TokenQueueMaxSize then
1266 +    IBError(ibxeTokenQueueOverflow,[]);
1267 +  FTokenQueue[FQLast].token := token;
1268 +  FTokenQueue[FQLast].text := text;
1269 +  Inc(FQLast);
1270 + end;
1271 +
1272 + procedure TSQLTokeniser.QueueToken(token: TSQLTokens);
1273 + begin
1274 +  QueueToken(token,TokenText);
1275 + end;
1276 +
1277 + procedure TSQLTokeniser.ResetQueue;
1278 + begin
1279 +  FQFirst := 0;
1280 +  FQLast := 0;
1281 +  FQueueState := tsHold;
1282 + end;
1283 +
1284 + procedure TSQLTokeniser.ResetQueue(token: TSQLTokens; text: AnsiString);
1285 + begin
1286 +  ResetQueue;
1287 +  QueueToken(token,text);
1288 + end;
1289 +
1290 + procedure TSQLTokeniser.ResetQueue(token: TSQLTokens);
1291 + begin
1292 +  ResetQueue;
1293 +  QueueToken(token);
1294 + end;
1295 +
1296 + procedure TSQLTokeniser.ReleaseQueue(var token: TSQLTokens);
1297 + begin
1298 +  FQueueState := tsRelease;
1299 +  PopQueue(token);
1300 + end;
1301 +
1302 + procedure TSQLTokeniser.ReleaseQueue;
1303 + begin
1304 +  FQueueState := tsRelease;
1305 + end;
1306 +
1307 + function TSQLTokeniser.GetQueuedText: AnsiString;
1308 + var i: integer;
1309 + begin
1310 +  Result := '';
1311 +  for i := FQFirst to FQLast do
1312 +    Result := Result + FTokenQueue[i].text;
1313 + end;
1314 +
1315 + procedure TSQLTokeniser.SetTokenText(text: AnsiString);
1316 + begin
1317 +  FString := text;
1318 + end;
1319 +
1320 + constructor TSQLTokeniser.Create;
1321 + begin
1322 +  inherited Create;
1323 +  Reset;
1324 + end;
1325 +
1326 + destructor TSQLTokeniser.Destroy;
1327 + begin
1328 +  Reset;
1329 +  inherited Destroy;
1330 + end;
1331 +
1332 + procedure TSQLTokeniser.Reset;
1333 + begin
1334 +  FNextToken := sqltInit;
1335 +  FState := stDefault;
1336 +  FString := '';
1337 +  FEOF := false;
1338 +  ResetQueue;
1339 + end;
1340 +
1341 + function TSQLTokeniser.GetNextToken: TSQLTokens;
1342 + begin
1343 +  if FQueueState = tsRelease then
1344 +  repeat
1345 +    PopQueue(Result);
1346 +    FEOF := Result = sqltEOF;
1347 +    if TokenFound(Result) then
1348 +      Exit;
1349 +  until FQueueState <> tsRelease;
1350 +
1351 +  Result := InternalGetNextToken;
1352 + end;
1353 +
1354 + {a simple lookahead one algorithm to extra the next symbol}
1355 +
1356 + function TSQLTokeniser.InternalGetNextToken: TSQLTokens;
1357 + var C: AnsiChar;
1358 + begin
1359 +  Result := sqltEOF;
1360 +
1361 +  if FNextToken = sqltInit then
1362 +    GetNext;
1363 +
1364 +  repeat
1365 +    Result := FNextToken;
1366 +    C := FLastChar;
1367 +    GetNext;
1368 +
1369 +    if FSkipNext then
1370 +    begin
1371 +      FSkipNext := false;
1372 +      continue;
1373 +    end;
1374 +
1375 +    case FState of
1376 +    stInComment:
1377 +      begin
1378 +        if (Result = sqltAsterisk) and (FNextToken = sqltForwardSlash) then
1379 +        begin
1380 +          FState := stDefault;
1381 +          Result := sqltComment;
1382 +          GetNext;
1383 +        end
1384 +        else
1385 +          FString := FString + C;
1386 +      end;
1387 +
1388 +    stInCommentLine:
1389 +      begin
1390 +        case Result of
1391 +        sqltEOL:
1392 +          begin
1393 +            FState := stDefault;
1394 +            Result := sqltCommentLine;
1395 +          end;
1396 +
1397 +        sqltCR: {ignore};
1398 +
1399 +        else
1400 +          FString := FString + C;
1401 +        end;
1402 +      end;
1403 +
1404 +    stSingleQuoted:
1405 +      begin
1406 +        if (Result = sqltSingleQuotes) then
1407 +        begin
1408 +          if (FNextToken = sqltSingleQuotes) then
1409 +          begin
1410 +            FSkipNext := true;
1411 +            FString := FString + C;
1412 +          end
1413 +          else
1414 +          begin
1415 +            Result := sqltQuotedString;
1416 +            FState := stDefault;
1417 +          end;
1418 +        end
1419 +        else
1420 +          FString := FString + C;
1421 +      end;
1422 +
1423 +    stDoubleQuoted:
1424 +      begin
1425 +        if (Result = sqltDoubleQuotes) then
1426 +        begin
1427 +          if (FNextToken = sqltDoubleQuotes) then
1428 +          begin
1429 +            FSkipNext := true;
1430 +            FString := FString + C;
1431 +          end
1432 +          else
1433 +          begin
1434 +            Result := sqltIdentifierInDoubleQuotes;
1435 +            FState := stDefault;
1436 +          end;
1437 +        end
1438 +        else
1439 +          FString := FString + C;
1440 +      end;
1441 +
1442 +    stInIdentifier:
1443 +      begin
1444 +        FString := FString + C;
1445 +        Result := sqltIdentifier;
1446 +        if not (FNextToken in [sqltIdentifier,sqltNumberString]) then
1447 +          FState := stDefault
1448 +      end;
1449 +
1450 +    stInNumeric:
1451 +      begin
1452 +        FString := FString + C;
1453 +        if (Result = sqltPeriod) and (FNextToken = sqltPeriod) then
1454 +        begin
1455 +          {malformed decimal}
1456 +          FState := stInIdentifier;
1457 +          Result := sqltIdentifier
1458 +        end
1459 +        else
1460 +        begin
1461 +          if not (FNextToken in [sqltNumberString,sqltPeriod]) then
1462 +            FState := stDefault;
1463 +          Result := sqltNumberString;
1464 +        end;
1465 +      end;
1466 +
1467 +    else {stDefault}
1468 +      begin
1469 +        FString := C;
1470 +        case Result of
1471 +
1472 +        sqltPipe:
1473 +          if FNextToken = sqltPipe then
1474 +          begin
1475 +            Result := sqltConcatSymbol;
1476 +            FString := C + FLastChar;
1477 +            GetNext;
1478 +          end;
1479 +
1480 +        sqltForwardSlash:
1481 +          begin
1482 +            if FNextToken = sqltAsterisk then
1483 +            begin
1484 +              FString := '';
1485 +              GetNext;
1486 +              FState := stInComment;
1487 +            end
1488 +          end;
1489 +
1490 +        sqltMinus:
1491 +          begin
1492 +            if FNextToken = sqltMinus then
1493 +            begin
1494 +              FString := '';
1495 +              GetNext;
1496 +              FState := stInCommentLine;
1497 +            end;
1498 +          end;
1499 +
1500 +        sqltSingleQuotes:
1501 +          begin
1502 +            FString := '';
1503 +            FState := stSingleQuoted;
1504 +          end;
1505 +
1506 +        sqltDoubleQuotes:
1507 +          begin
1508 +            FString := '';
1509 +            FState := stDoubleQuoted;
1510 +          end;
1511 +
1512 +        sqltIdentifier:
1513 +          if FNextToken in [sqltIdentifier,sqltNumberString] then
1514 +            FState := stInIdentifier;
1515 +
1516 +        sqltNumberString:
1517 +          if FNextToken in [sqltNumberString,sqltPeriod] then
1518 +            FState := stInNumeric;
1519 +        end;
1520 +      end;
1521 +    end;
1522 +
1523 + //    writeln(FString);
1524 +    FEOF := Result = sqltEOF;
1525 +  until TokenFound(Result) or EOF;
1526 + end;
1527  
1528   end.

Diff Legend

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