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 262 by tony, Mon Apr 16 08:32:21 2018 UTC vs.
Revision 263 by tony, Thu Dec 6 15:55:01 2018 UTC

# Line 47 | Line 47 | interface
47  
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 +  sqltComma,
262 +  sqltPeriod,
263 +  sqltEquals,
264 +  sqltOtherCharacter,
265 +  sqltIdentifier,
266 +  sqltIdentifierInDoubleQuotes,
267 +  sqltNumberString,
268 +  sqltString,
269 +  sqltParam,
270 +  sqltQuotedParam,
271 +  sqltColon,
272 +  sqltComment,
273 +  sqltCommentLine,
274 +  sqltQuotedString,
275 +  sqltAsterisk,
276 +  sqltForwardSlash,
277 +  sqltOpenSquareBracket,
278 +  sqltCloseSquareBracket,
279 +  sqltOpenBracket,
280 +  sqltCloseBracket,
281 +  sqltPipe,
282 +  sqltConcatSymbol,
283 +  sqltLT,
284 +  sqltGT,
285 +  sqltCR,
286 +  sqltEOL,
287 +  sqltEOF,
288 +  sqltInit
289 +  );
290 +
291 +  TSQLReservedWords = sqltAdd..sqltYear;
292 +
293   const
294    CRLF = #13 + #10;
295    CR   = #13;
# Line 54 | Line 297 | const
297    TAB  = #9;
298    NULL_TERMINATOR = #0;
299  
300 <  sqlReservedWords: array [0..198] of string = (
300 >  {$IFNDEF FPC}
301 >  LineEnding = CRLF;
302 >  {$ENDIF}
303 >
304 >  {SQL Reserved words in alphabetical order}
305 >
306 >  sqlReservedWords: array [TSQLReservedWords] of string = (
307    'ADD',
308    'ADMIN',
309    'ALL',
# Line 206 | Line 455 | const
455    'RIGHT',
456    'ROLLBACK',
457    'ROW',
209  'ROW_COUNT',
458    'ROWS',
459 +  'ROW_COUNT',
460    'SAVEPOINT',
461    'SCROLL',
462    'SECOND',
# Line 219 | Line 468 | const
468    'SOME',
469    'SQLCODE',
470    'SQLSTATE',
222  'SQLSTATE',
471    'START',
472    'STDDEV_POP',
473    'STDDEV_SAMP',
# Line 256 | Line 504 | const
504    'YEAR'
505    );
506  
507 + type
508 +  {The TSQLTokeniser class provides a common means to parse an SQL statement, or
509 +   even a stream of SQL Statements. The TSQLStringTokeniser class is instantiated
510 +   with a single SQL statement or a set of concatenated statements. The TSQLStreamTokeniser
511 +   is instantiated with a stream from which the SQL statements are read.
512 +
513 +   Successive calls to GetNextToken then return each SQL token. The TokenText contains
514 +   either the single character, the identifier or reserved word, the string or comment.}
515 +
516 +  { TSQLTokeniser }
517 +
518 +  TSQLTokeniser = class
519 +  private
520 +    const
521 +      TokenQueueMaxSize = 64;
522 +    type
523 +      TLexState = (stDefault, stInCommentLine, stInComment, stSingleQuoted, stDoubleQuoted,
524 +                   stInIdentifier, stInNumeric);
525 +
526 +      TTokenQueueItem = record
527 +                          token: TSQLTokens;
528 +                          text: AnsiString;
529 +                        end;
530 +      TTokenQueueState = (tsHold, tsRelease);
531 +
532 +  private
533 +    FLastChar: AnsiChar;
534 +    FState: TLexState;
535 +    FSkipNext: boolean;
536 +    function GetNext: TSQLTokens;
537 +
538 +    {The token Queue is available for use by descendents so that they can
539 +     hold back tokens in order to lookahead by token rather than just a single
540 +     character}
541 +
542 +  private
543 +    FTokenQueue: array[0..TokenQueueMaxSize] of TTokenQueueItem;
544 +    FQueueState: TTokenQueueState;
545 +    FQFirst: integer;  {first and last pointers first=last => queue empty}
546 +    FQLast: integer;
547 +    FEOF: boolean;
548 +    procedure PopQueue(var token: TSQLTokens);
549 +  protected
550 +    FString: AnsiString;
551 +    FNextToken: TSQLTokens;
552 +    procedure Assign(source: TSQLTokeniser); virtual;
553 +    function GetChar: AnsiChar; virtual; abstract;
554 +    function TokenFound(var token: TSQLTokens): boolean; virtual;
555 +    function InternalGetNextToken: TSQLTokens; virtual;
556 +    procedure Reset; virtual;
557 +
558 +    {Token stack}
559 +    procedure QueueToken(token: TSQLTokens; text:AnsiString); overload;
560 +    procedure QueueToken(token: TSQLTokens); overload;
561 +    procedure ResetQueue; overload;
562 +    procedure ResetQueue(token: TSQLTokens; text:AnsiString); overload;
563 +    procedure ResetQueue(token: TSQLTokens); overload;
564 +    procedure ReleaseQueue(var token: TSQLTokens); overload;
565 +    procedure ReleaseQueue; overload;
566 +    function GetQueuedText: AnsiString;
567 +    procedure SetTokenText(text: AnsiString);
568 +
569 +  public
570 +    const
571 +        DefaultTerminator = ';';
572 +  public
573 +    constructor Create;
574 +    destructor Destroy; override;
575 +    function GetNextToken: TSQLTokens;
576 +    property EOF: boolean read FEOF;
577 +    property TokenText: AnsiString read FString;
578 +  end;
579 +
580 +  { TSQLwithNamedParamsTokeniser }
581 +
582 +  TSQLwithNamedParamsTokeniser = class(TSQLTokeniser)
583 +  private
584 +    type
585 +      TSQLState = (stInit,stInParam,stInBlock, stInArrayDim);
586 +  private
587 +    FState: TSQLState;
588 +    FNested: integer;
589 +  protected
590 +    procedure Assign(source: TSQLTokeniser); override;
591 +    procedure Reset; override;
592 +    function TokenFound(var token: TSQLTokens): boolean; override;
593 +  end;
594 +
595   function Max(n1, n2: Integer): Integer;
596   function Min(n1, n2: Integer): Integer;
597   function RandomString(iLength: Integer): AnsiString;
598   function RandomInteger(iLow, iHigh: Integer): Integer;
599   function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
600   function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
601 + function FindReservedWord(w: AnsiString; var token: TSQLTokens): boolean;
602 + function IsReservedWord(w: AnsiString): boolean;
603   function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
604   function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
605   function Space2Underscore(s: AnsiString): AnsiString;
# Line 277 | Line 615 | function GetProtocol(ConnectString: Ansi
615  
616   implementation
617  
618 + uses FBMessages
619 +
620   {$IFDEF HASREQEX}
621 < uses RegExpr;
622 < {$ENDIF}
621 > ,RegExpr
622 > {$ENDIF};
623  
624   function Max(n1, n2: Integer): Integer;
625   begin
# Line 343 | Line 683 | begin
683    Result := Value;
684   end;
685  
686 + {Returns true if "w" is a Firebird SQL reserved word, and the
687 + corresponding TSQLTokens value.}
688 +
689 + function FindReservedWord(w: AnsiString; var token: TSQLTokens): boolean;
690 + var i: TSQLTokens;
691 + begin
692 +   Result := true;
693 +   w := AnsiUpperCase(Trim(w));
694 +   for i := Low(TSQLReservedWords) to High(TSQLReservedWords) do
695 +   begin
696 +       if w = sqlReservedWords[i] then
697 +       begin
698 +         token := i;
699 +         Exit;
700 +       end;
701 +       if w <  sqlReservedWords[i] then
702 +         break;
703 +   end;
704 +   Result := false;
705 + end;
706 +
707   {Returns true if "w" is a Firebird SQL reserved word}
708  
709   function IsReservedWord(w: AnsiString): boolean;
710 < var i: integer;
710 > var token: TSQLTokens;
711   begin
712 <     Result := true;
352 <     for i := 0 to Length(sqlReservedWords) - 1 do
353 <         if w = sqlReservedWords[i] then
354 <            Exit;
355 <     Result := false;
712 >  Result := FindReservedWord(w,token);
713   end;
714  
715   {Format an SQL Identifier according to SQL Dialect}
# Line 617 | Line 974 | begin
974    Result := StringReplace(s,'''','''''',[rfReplaceAll]);
975   end;
976  
977 + { TSQLwithNamedParamsTokeniser }
978 +
979 + procedure TSQLwithNamedParamsTokeniser.Assign(source: TSQLTokeniser);
980 + begin
981 +  inherited Assign(source);
982 +  if source is TSQLwithNamedParamsTokeniser then
983 +  begin
984 +    FState := TSQLwithNamedParamsTokeniser(source).FState;
985 +    FNested := TSQLwithNamedParamsTokeniser(source).FNested;
986 +  end;
987 + end;
988 +
989 + procedure TSQLwithNamedParamsTokeniser.Reset;
990 + begin
991 +  inherited Reset;
992 +  FState := stInit;
993 +  FNested := 0;
994 + end;
995 +
996 + function TSQLwithNamedParamsTokeniser.TokenFound(var token: TSQLTokens
997 +  ): boolean;
998 + begin
999 +  Result := inherited TokenFound(token);
1000 +  if not Result then Exit;
1001 +
1002 +  case FState of
1003 +  stInit:
1004 +    begin
1005 +      case token of
1006 +      sqltColon:
1007 +        begin
1008 +          FState := stInParam;
1009 +          ResetQueue(token);
1010 +        end;
1011 +
1012 +      sqltBegin:
1013 +        begin
1014 +          FState := stInBlock;
1015 +          FNested := 1;
1016 +        end;
1017 +
1018 +      sqltOpenSquareBracket:
1019 +          FState := stInArrayDim;
1020 +
1021 +      end;
1022 +    end;
1023 +
1024 +  stInParam:
1025 +    begin
1026 +      case token of
1027 +      sqltIdentifier:
1028 +        token := sqltParam;
1029 +
1030 +      sqltIdentifierInDoubleQuotes:
1031 +        token := sqltQuotedParam;
1032 +
1033 +      else
1034 +        begin
1035 +          QueueToken(token);
1036 +          ReleaseQueue(token);
1037 +        end;
1038 +      end;
1039 +      FState := stInit;
1040 +    end;
1041 +
1042 +  stInBlock:
1043 +    begin
1044 +      case token of
1045 +      sqltBegin:
1046 +          Inc(FNested);
1047 +
1048 +      sqltEnd:
1049 +        begin
1050 +          Dec(FNested);
1051 +          if FNested = 0 then
1052 +            FState := stInit;
1053 +        end;
1054 +      end;
1055 +    end;
1056 +
1057 +    stInArrayDim:
1058 +      begin
1059 +        if token = sqltCloseSquareBracket then
1060 +            FState := stInit;
1061 +      end;
1062 +    end;
1063 +
1064 +  Result := (FState <> stInParam);
1065 + end;
1066 +
1067 + { TSQLTokeniser }
1068 +
1069 + function TSQLTokeniser.GetNext: TSQLTokens;
1070 + var C: AnsiChar;
1071 + begin
1072 +  if EOF then
1073 +    Result := sqltEOF
1074 +  else
1075 +  begin
1076 +    C := GetChar;
1077 +    case C of
1078 +    #0:
1079 +      Result := sqltEOF;
1080 +    ' ',TAB:
1081 +      Result := sqltSpace;
1082 +    '0'..'9':
1083 +      Result := sqltNumberString;
1084 +    ';':
1085 +      Result := sqltSemiColon;
1086 +    '?':
1087 +      Result := sqltPlaceholder;
1088 +    '|':
1089 +      Result := sqltPipe;
1090 +    '"':
1091 +      Result := sqltDoubleQuotes;
1092 +    '''':
1093 +      Result := sqltSingleQuotes;
1094 +    '/':
1095 +      Result := sqltForwardSlash;
1096 +    '*':
1097 +      Result := sqltAsterisk;
1098 +    '(':
1099 +      Result := sqltOpenBracket;
1100 +    ')':
1101 +      Result := sqltCloseBracket;
1102 +    ':':
1103 +      Result := sqltColon;
1104 +    ',':
1105 +      Result := sqltComma;
1106 +    '.':
1107 +      Result := sqltPeriod;
1108 +    '=':
1109 +      Result := sqltEquals;
1110 +    '[':
1111 +      Result := sqltOpenSquareBracket;
1112 +    ']':
1113 +      Result := sqltCloseSquareBracket;
1114 +    '<':
1115 +      Result := sqltLT;
1116 +    '>':
1117 +      Result := sqltGT;
1118 +    CR:
1119 +      Result := sqltCR;
1120 +    LF:
1121 +      Result := sqltEOL;
1122 +    else
1123 +      if C in ValidSQLIdentifierChars then
1124 +        Result := sqltIdentifier
1125 +      else
1126 +        Result := sqltOtherCharacter;
1127 +    end;
1128 +    FLastChar := C
1129 +  end;
1130 +  FNextToken := Result;
1131 + end;
1132 +
1133 + procedure TSQLTokeniser.PopQueue(var token: TSQLTokens);
1134 + begin
1135 +  if FQFirst = FQLast then
1136 +    IBError(ibxeTokenQueueUnderflow,[]);
1137 +  token := FTokenQueue[FQFirst].token;
1138 +  FString := FTokenQueue[FQFirst].text;
1139 +  Inc(FQFirst);
1140 +  if FQFirst = FQLast then
1141 +    FQueueState := tsHold;
1142 + end;
1143 +
1144 + procedure TSQLTokeniser.Assign(source: TSQLTokeniser);
1145 + begin
1146 +  FString := source.FString;
1147 +  FNextToken := source.FNextToken;
1148 +  FTokenQueue := source.FTokenQueue;
1149 +  FQueueState := source.FQueueState;
1150 +  FQFirst := source.FQFirst;
1151 +  FQLast := source.FQLast;
1152 + end;
1153 +
1154 + function TSQLTokeniser.TokenFound(var token: TSQLTokens): boolean;
1155 + begin
1156 +  Result := (FState = stDefault);
1157 +  if Result and (token = sqltIdentifier)  then
1158 +    FindReservedWord(FString,token);
1159 + end;
1160 +
1161 + procedure TSQLTokeniser.QueueToken(token: TSQLTokens; text: AnsiString);
1162 + begin
1163 +  if FQLast > TokenQueueMaxSize then
1164 +    IBError(ibxeTokenQueueOverflow,[]);
1165 +  FTokenQueue[FQLast].token := token;
1166 +  FTokenQueue[FQLast].text := text;
1167 +  Inc(FQLast);
1168 + end;
1169 +
1170 + procedure TSQLTokeniser.QueueToken(token: TSQLTokens);
1171 + begin
1172 +  QueueToken(token,TokenText);
1173 + end;
1174 +
1175 + procedure TSQLTokeniser.ResetQueue;
1176 + begin
1177 +  FQFirst := 0;
1178 +  FQLast := 0;
1179 +  FQueueState := tsHold;
1180 + end;
1181 +
1182 + procedure TSQLTokeniser.ResetQueue(token: TSQLTokens; text: AnsiString);
1183 + begin
1184 +  ResetQueue;
1185 +  QueueToken(token,text);
1186 + end;
1187 +
1188 + procedure TSQLTokeniser.ResetQueue(token: TSQLTokens);
1189 + begin
1190 +  ResetQueue;
1191 +  QueueToken(token);
1192 + end;
1193 +
1194 + procedure TSQLTokeniser.ReleaseQueue(var token: TSQLTokens);
1195 + begin
1196 +  FQueueState := tsRelease;
1197 +  PopQueue(token);
1198 + end;
1199 +
1200 + procedure TSQLTokeniser.ReleaseQueue;
1201 + begin
1202 +  FQueueState := tsRelease;
1203 + end;
1204 +
1205 + function TSQLTokeniser.GetQueuedText: AnsiString;
1206 + var i: integer;
1207 + begin
1208 +  Result := '';
1209 +  for i := FQFirst to FQLast do
1210 +    Result := Result + FTokenQueue[i].text;
1211 + end;
1212 +
1213 + procedure TSQLTokeniser.SetTokenText(text: AnsiString);
1214 + begin
1215 +  FString := text;
1216 + end;
1217 +
1218 + constructor TSQLTokeniser.Create;
1219 + begin
1220 +  inherited Create;
1221 +  Reset;
1222 + end;
1223 +
1224 + destructor TSQLTokeniser.Destroy;
1225 + begin
1226 +  Reset;
1227 +  inherited Destroy;
1228 + end;
1229 +
1230 + procedure TSQLTokeniser.Reset;
1231 + begin
1232 +  FNextToken := sqltInit;
1233 +  FState := stDefault;
1234 +  FString := '';
1235 +  FEOF := false;
1236 +  ResetQueue;
1237 + end;
1238 +
1239 + function TSQLTokeniser.GetNextToken: TSQLTokens;
1240 + begin
1241 +  if FQueueState = tsRelease then
1242 +  repeat
1243 +    PopQueue(Result);
1244 +    FEOF := Result = sqltEOF;
1245 +    if TokenFound(Result) then
1246 +      Exit;
1247 +  until FQueueState <> tsRelease;
1248 +
1249 +  Result := InternalGetNextToken;
1250 + end;
1251 +
1252 + {a simple lookahead one algorithm to extra the next symbol}
1253 +
1254 + function TSQLTokeniser.InternalGetNextToken: TSQLTokens;
1255 + var C: AnsiChar;
1256 + begin
1257 +  Result := sqltEOF;
1258 +
1259 +  if FNextToken = sqltInit then
1260 +    GetNext;
1261 +
1262 +  repeat
1263 +    Result := FNextToken;
1264 +    C := FLastChar;
1265 +    GetNext;
1266 +
1267 +    if FSkipNext then
1268 +    begin
1269 +      FSkipNext := false;
1270 +      continue;
1271 +    end;
1272 +
1273 +    case FState of
1274 +    stInComment:
1275 +      begin
1276 +        if (Result = sqltAsterisk) and (FNextToken = sqltForwardSlash) then
1277 +        begin
1278 +          FState := stDefault;
1279 +          Result := sqltComment;
1280 +          GetNext;
1281 +        end
1282 +        else
1283 +          FString := FString + C;
1284 +      end;
1285 +
1286 +    stInCommentLine:
1287 +      begin
1288 +        case Result of
1289 +        sqltEOL:
1290 +          begin
1291 +            FState := stDefault;
1292 +            Result := sqltCommentLine;
1293 +          end;
1294 +
1295 +        sqltCR: {ignore};
1296 +
1297 +        else
1298 +          FString := FString + C;
1299 +        end;
1300 +      end;
1301 +
1302 +    stSingleQuoted:
1303 +      begin
1304 +        if (Result = sqltSingleQuotes) then
1305 +        begin
1306 +          if (FNextToken = sqltSingleQuotes) then
1307 +          begin
1308 +            FSkipNext := true;
1309 +            FString := FString + C;
1310 +          end
1311 +          else
1312 +          begin
1313 +            Result := sqltQuotedString;
1314 +            FState := stDefault;
1315 +          end;
1316 +        end
1317 +        else
1318 +          FString := FString + C;
1319 +      end;
1320 +
1321 +    stDoubleQuoted:
1322 +      begin
1323 +        if (Result = sqltDoubleQuotes) then
1324 +        begin
1325 +          if (FNextToken = sqltDoubleQuotes) then
1326 +          begin
1327 +            FSkipNext := true;
1328 +            FString := FString + C;
1329 +          end
1330 +          else
1331 +          begin
1332 +            Result := sqltIdentifierInDoubleQuotes;
1333 +            FState := stDefault;
1334 +          end;
1335 +        end
1336 +        else
1337 +          FString := FString + C;
1338 +      end;
1339 +
1340 +    stInIdentifier:
1341 +      begin
1342 +        FString := FString + C;
1343 +        Result := sqltIdentifier;
1344 +        if not (FNextToken in [sqltIdentifier,sqltNumberString]) then
1345 +          FState := stDefault
1346 +      end;
1347 +
1348 +    stInNumeric:
1349 +      begin
1350 +        FString := FString + C;
1351 +        if (Result = sqltPeriod) and (FNextToken = sqltPeriod) then
1352 +        begin
1353 +          {malformed decimal}
1354 +          FState := stInIdentifier;
1355 +          Result := sqltIdentifier
1356 +        end
1357 +        else
1358 +        begin
1359 +          if not (FNextToken in [sqltNumberString,sqltPeriod]) then
1360 +            FState := stDefault;
1361 +          Result := sqltNumberString;
1362 +        end;
1363 +      end;
1364 +
1365 +    else {stDefault}
1366 +      begin
1367 +        FString := C;
1368 +        case Result of
1369 +
1370 +        sqltPipe:
1371 +          if FNextToken = sqltPipe then
1372 +          begin
1373 +            Result := sqltConcatSymbol;
1374 +            FString := C + FLastChar;
1375 +            GetNext;
1376 +          end;
1377 +
1378 +        sqltForwardSlash:
1379 +          begin
1380 +            if FNextToken = sqltAsterisk then
1381 +            begin
1382 +              FString := '';
1383 +              GetNext;
1384 +              FState := stInComment;
1385 +            end
1386 +            else
1387 +            if FNextToken = sqltForwardSlash then
1388 +            begin
1389 +              FString := '';
1390 +              GetNext;
1391 +              FState := stInCommentLine;
1392 +            end;
1393 +          end;
1394 +
1395 +        sqltSingleQuotes:
1396 +          begin
1397 +            FString := '';
1398 +            FState := stSingleQuoted;
1399 +          end;
1400 +
1401 +        sqltDoubleQuotes:
1402 +          begin
1403 +            FString := '';
1404 +            FState := stDoubleQuoted;
1405 +          end;
1406 +
1407 +        sqltIdentifier:
1408 +          if FNextToken = sqltIdentifier then
1409 +            FState := stInIdentifier;
1410 +
1411 +        sqltNumberString:
1412 +          if FNextToken in [sqltNumberString,sqltPeriod] then
1413 +            FState := stInNumeric;
1414 +        end;
1415 +      end;
1416 +    end;
1417 +
1418 + //    writeln(FString);
1419 +    FEOF := Result = sqltEOF;
1420 +  until TokenFound(Result) or EOF;
1421 + end;
1422 +
1423   end.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines