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.
ibx/branches/journaling/fbintf/IBUtils.pas (file contents), Revision 362 by tony, Tue Dec 7 13:27:39 2021 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   {$ENDIF}
43  
44 + { $IF declared(CompilerVersion) and (CompilerVersion >= 22)}
45 + { $define HASDELPHIREQEX}
46 + { $IFEND}
47 +
48   interface
49  
50 < uses
51 < {$IFDEF WINDOWS }
52 <  Windows,
53 < {$ELSE}
54 <  unix,
55 < {$ENDIF}
56 <  Classes, SysUtils;
50 > uses Classes, SysUtils, IB;
51 >
52 > type
53 >  TSQLTokens = (
54 >
55 >  {Reserved Words}
56 >
57 >  sqltAdd,
58 >  sqltAdmin,
59 >  sqltAll,
60 >  sqltAlter,
61 >  sqltAnd,
62 >  sqltAny,
63 >  sqltAs,
64 >  sqltAt,
65 >  sqltAvg,
66 >  sqltBegin,
67 >  sqltBetween,
68 >  sqltBigint,
69 >  sqltBit_Length,
70 >  sqltBlob,
71 >  sqltBoolean,
72 >  sqltBoth,
73 >  sqltBy,
74 >  sqltCase,
75 >  sqltCast,
76 >  sqltChar,
77 >  sqltChar_Length,
78 >  sqltCharacter,
79 >  sqltCharacter_Length,
80 >  sqltCheck,
81 >  sqltClose,
82 >  sqltCollate,
83 >  sqltColumn,
84 >  sqltCommit,
85 >  sqltConnect,
86 >  sqltConstraint,
87 >  sqltCorr,
88 >  sqltCount,
89 >  sqltCovar_Pop,
90 >  sqltCovar_Samp,
91 >  sqltCreate,
92 >  sqltCross,
93 >  sqltCurrent,
94 >  sqltCurrent_Connection,
95 >  sqltCurrent_Date,
96 >  sqltCurrent_Role,
97 >  sqltCurrent_Time,
98 >  sqltCurrent_Timestamp,
99 >  sqltCurrent_Transaction,
100 >  sqltCurrent_User,
101 >  sqltCursor,
102 >  sqltDate,
103 >  sqltDay,
104 >  sqltDec,
105 >  sqltDecimal,
106 >  sqltDeclare,
107 >  sqltDefault,
108 >  sqltDelete,
109 >  sqltDeleting,
110 >  sqltDeterministic,
111 >  sqltDisconnect,
112 >  sqltDistinct,
113 >  sqltDouble,
114 >  sqltDrop,
115 >  sqltElse,
116 >  sqltEnd,
117 >  sqltEscape,
118 >  sqltExecute,
119 >  sqltExists,
120 >  sqltExternal,
121 >  sqltExtract,
122 >  sqltFalse,
123 >  sqltFetch,
124 >  sqltFilter,
125 >  sqltFloat,
126 >  sqltFor,
127 >  sqltForeign,
128 >  sqltFrom,
129 >  sqltFull,
130 >  sqltFunction,
131 >  sqltGdscode,
132 >  sqltGlobal,
133 >  sqltGrant,
134 >  sqltGroup,
135 >  sqltHaving,
136 >  sqltHour,
137 >  sqltIn,
138 >  sqltIndex,
139 >  sqltInner,
140 >  sqltInsensitive,
141 >  sqltInsert,
142 >  sqltInserting,
143 >  sqltInt,
144 >  sqltInteger,
145 >  sqltInto,
146 >  sqltIs,
147 >  sqltJoin,
148 >  sqltKey,
149 >  sqltLeading,
150 >  sqltLeft,
151 >  sqltLike,
152 >  sqltLong,
153 >  sqltLower,
154 >  sqltMax,
155 >  sqltMaximum_Segment,
156 >  sqltMerge,
157 >  sqltMin,
158 >  sqltMinute,
159 >  sqltMonth,
160 >  sqltNational,
161 >  sqltNatural,
162 >  sqltNchar,
163 >  sqltNo,
164 >  sqltNot,
165 >  sqltNull,
166 >  sqltNumeric,
167 >  sqltOctet_Length,
168 >  sqltOf,
169 >  sqltOffset,
170 >  sqltOn,
171 >  sqltOnly,
172 >  sqltOpen,
173 >  sqltOr,
174 >  sqltOrder,
175 >  sqltOuter,
176 >  sqltOver,
177 >  sqltParameter,
178 >  sqltPlan,
179 >  sqltPosition,
180 >  sqltPost_Event,
181 >  sqltPrecision,
182 >  sqltPrimary,
183 >  sqltProcedure,
184 >  sqltRdbDb_Key,
185 >  sqltRdbRecord_Version,
186 >  sqltReal,
187 >  sqltRecord_Version,
188 >  sqltRecreate,
189 >  sqltRecursive,
190 >  sqltReferences,
191 >  sqltRegr_Avgx,
192 >  sqltRegr_Avgy,
193 >  sqltRegr_Count,
194 >  sqltRegr_Intercept,
195 >  sqltRegr_R2,
196 >  sqltRegr_Slope,
197 >  sqltRegr_Sxx,
198 >  sqltRegr_Sxy,
199 >  sqltRegr_Syy,
200 >  sqltRelease,
201 >  sqltReturn,
202 >  sqltReturning_Values,
203 >  sqltReturns,
204 >  sqltRevoke,
205 >  sqltRight,
206 >  sqltRollback,
207 >  sqltRow,
208 >  sqltRows,
209 >  sqltRow_Count,
210 >  sqltSavepoint,
211 >  sqltScroll,
212 >  sqltSecond,
213 >  sqltSelect,
214 >  sqltSensitive,
215 >  sqltSet,
216 >  sqltSimilar,
217 >  sqltSmallint,
218 >  sqltSome,
219 >  sqltSqlcode,
220 >  sqltSqlstate,
221 >  sqltStart,
222 >  sqltStddev_Pop,
223 >  sqltStddev_Samp,
224 >  sqltSum,
225 >  sqltTable,
226 >  sqltThen,
227 >  sqltTime,
228 >  sqltTimestamp,
229 >  sqltTo,
230 >  sqltTrailing,
231 >  sqltTrigger,
232 >  sqltTrim,
233 >  sqltTrue,
234 >  sqltUnion,
235 >  sqltUnique,
236 >  sqltUnknown,
237 >  sqltUpdate,
238 >  sqltUpdating,
239 >  sqltUpper,
240 >  sqltUser,
241 >  sqltUsing,
242 >  sqltValue,
243 >  sqltValues,
244 >  sqltVar_Pop,
245 >  sqltVar_Samp,
246 >  sqltVarchar,
247 >  sqltVariable,
248 >  sqltVarying,
249 >  sqltView,
250 >  sqltWhen,
251 >  sqltWhere,
252 >  sqltWhile,
253 >  sqltWith,
254 >  sqltYear,
255 >
256 >  {symbols}
257 >
258 >  sqltSpace,
259 >  sqltSemiColon,
260 >  sqltPlaceholder,
261 >  sqltSingleQuotes,
262 >  sqltDoubleQuotes,
263 >  sqltBackslash,
264 >  sqltComma,
265 >  sqltPeriod,
266 >  sqltEquals,
267 >  sqltOtherCharacter,
268 >  sqltIdentifier,
269 >  sqltIdentifierInDoubleQuotes,
270 >  sqltNumberString,
271 >  sqltString,
272 >  sqltParam,
273 >  sqltQuotedParam,
274 >  sqltColon,
275 >  sqltComment,
276 >  sqltCommentLine,
277 >  sqltQuotedString,
278 >  sqltAsterisk,
279 >  sqltForwardSlash,
280 >  sqltOpenSquareBracket,
281 >  sqltCloseSquareBracket,
282 >  sqltOpenBracket,
283 >  sqltCloseBracket,
284 >  sqltPipe,
285 >  sqltMinus,
286 >  sqltConcatSymbol,
287 >  sqltLT,
288 >  sqltGT,
289 >  sqltCR,
290 >  sqltEOL,
291 >  sqltEOF,
292 >  sqltInit
293 >  );
294 >
295 >  TSQLReservedWords = sqltAdd..sqltYear;
296  
297   const
298    CRLF = #13 + #10;
# Line 55 | Line 301 | const
301    TAB  = #9;
302    NULL_TERMINATOR = #0;
303  
304 <  sqlReservedWords: array [0..166] of string = (
305 <  'ADD','ADMIN','ALL','ALTER','AND','ANY','AS','AT','AVG','BEGIN','BETWEEN','BIGINT','BIT_LENGTH','BLOB','BOTH',
306 < 'BY','CASE','CAST','CHAR','CHAR_LENGTH','CHARACTER','CHARACTER_LENGTH','CHECK','CLOSE','COLLATE','COLUMN',
307 < 'COMMIT','CONNECT','CONSTRAINT','COUNT','CREATE','CROSS','CURRENT','CURRENT_CONNECTION','CURRENT_DATE',
308 < 'CURRENT_ROLE','CURRENT_TIME','CURRENT_TIMESTAMP','CURRENT_TRANSACTION','CURRENT_USER','CURSOR','DATE',
309 < 'DAY','DEC','DECIMAL','DECLARE','DEFAULT','DELETE','DISCONNECT','DISTINCT','DOUBLE','DROP','ELSE','END',
310 < 'ESCAPE','EXECUTE','EXISTS','EXTERNAL','EXTRACT','FETCH','FILTER','FLOAT','FOR','FOREIGN','FROM','FULL',
311 < 'FUNCTION','GDSCODE','GLOBAL','GRANT','GROUP','HAVING','HOUR','IN','INDEX','INNER','INSENSITIVE','INSERT',
312 < 'INT','INTEGER','INTO','IS','JOIN','LEADING','LEFT','LIKE','LONG','LOWER','MAX','MAXIMUM_SEGMENT','MERGE',
313 < 'MIN','MINUTE','MONTH','NATIONAL','NATURAL','NCHAR','NO','NOT','NULL','NUMERIC','OCTET_LENGTH','OF','ON',
314 < 'ONLY','OPEN','OR','ORDER','OUTER','PARAMETER','PLAN','POSITION','POST_EVENT','PRECISION','PRIMARY',
315 < 'PROCEDURE','RDB$DB_KEY','REAL','RECORD_VERSION','RECREATE','RECURSIVE','REFERENCES','RELEASE','RETURNING_VALUES',
316 < 'RETURNS','REVOKE','RIGHT','ROLLBACK','ROW_COUNT','ROWS','SAVEPOINT','SECOND','SELECT','SENSITIVE',
317 < 'SET','SIMILAR','SMALLINT','SOME','SQLCODE','SQLSTATE','START','SUM','TABLE','THEN','TIME',
318 < 'TIMESTAMP','TO','TRAILING','TRIGGER','TRIM','UNION','UNIQUE','UPDATE','UPPER','USER','USING',
319 < 'VALUE','VALUES','VARCHAR','VARIABLE','VARYING','VIEW','WHEN','WHERE','WHILE','WITH','YEAR');
304 >  {$IFNDEF FPC}
305 >  LineEnding = CRLF;
306 >  {$ENDIF}
307 >
308 >  {SQL Reserved words in alphabetical order}
309 >
310 >  sqlReservedWords: array [TSQLReservedWords] of string = (
311 >  'ADD',
312 >  'ADMIN',
313 >  'ALL',
314 >  'ALTER',
315 >  'AND',
316 >  'ANY',
317 >  'AS',
318 >  'AT',
319 >  'AVG',
320 >  'BEGIN',
321 >  'BETWEEN',
322 >  'BIGINT',
323 >  'BIT_LENGTH',
324 >  'BLOB',
325 >  'BOOLEAN',
326 >  'BOTH',
327 >  'BY',
328 >  'CASE',
329 >  'CAST',
330 >  'CHAR',
331 >  'CHAR_LENGTH',
332 >  'CHARACTER',
333 >  'CHARACTER_LENGTH',
334 >  'CHECK',
335 >  'CLOSE',
336 >  'COLLATE',
337 >  'COLUMN',
338 >  'COMMIT',
339 >  'CONNECT',
340 >  'CONSTRAINT',
341 >  'CORR',
342 >  'COUNT',
343 >  'COVAR_POP',
344 >  'COVAR_SAMP',
345 >  'CREATE',
346 >  'CROSS',
347 >  'CURRENT',
348 >  'CURRENT_CONNECTION',
349 >  'CURRENT_DATE',
350 >  'CURRENT_ROLE',
351 >  'CURRENT_TIME',
352 >  'CURRENT_TIMESTAMP',
353 >  'CURRENT_TRANSACTION',
354 >  'CURRENT_USER',
355 >  'CURSOR',
356 >  'DATE',
357 >  'DAY',
358 >  'DEC',
359 >  'DECIMAL',
360 >  'DECLARE',
361 >  'DEFAULT',
362 >  'DELETE',
363 >  'DELETING',
364 >  'DETERMINISTIC',
365 >  'DISCONNECT',
366 >  'DISTINCT',
367 >  'DOUBLE',
368 >  'DROP',
369 >  'ELSE',
370 >  'END',
371 >  'ESCAPE',
372 >  'EXECUTE',
373 >  'EXISTS',
374 >  'EXTERNAL',
375 >  'EXTRACT',
376 >  'FALSE',
377 >  'FETCH',
378 >  'FILTER',
379 >  'FLOAT',
380 >  'FOR',
381 >  'FOREIGN',
382 >  'FROM',
383 >  'FULL',
384 >  'FUNCTION',
385 >  'GDSCODE',
386 >  'GLOBAL',
387 >  'GRANT',
388 >  'GROUP',
389 >  'HAVING',
390 >  'HOUR',
391 >  'IN',
392 >  'INDEX',
393 >  'INNER',
394 >  'INSENSITIVE',
395 >  'INSERT',
396 >  'INSERTING',
397 >  'INT',
398 >  'INTEGER',
399 >  'INTO',
400 >  'IS',
401 >  'JOIN',
402 >  'KEY',
403 >  'LEADING',
404 >  'LEFT',
405 >  'LIKE',
406 >  'LONG',
407 >  'LOWER',
408 >  'MAX',
409 >  'MAXIMUM_SEGMENT',
410 >  'MERGE',
411 >  'MIN',
412 >  'MINUTE',
413 >  'MONTH',
414 >  'NATIONAL',
415 >  'NATURAL',
416 >  'NCHAR',
417 >  'NO',
418 >  'NOT',
419 >  'NULL',
420 >  'NUMERIC',
421 >  'OCTET_LENGTH',
422 >  'OF',
423 >  'OFFSET',
424 >  'ON',
425 >  'ONLY',
426 >  'OPEN',
427 >  'OR',
428 >  'ORDER',
429 >  'OUTER',
430 >  'OVER',
431 >  'PARAMETER',
432 >  'PLAN',
433 >  'POSITION',
434 >  'POST_EVENT',
435 >  'PRECISION',
436 >  'PRIMARY',
437 >  'PROCEDURE',
438 >  'RDB$DB_KEY',
439 >  'RDB$RECORD_VERSION',
440 >  'REAL',
441 >  'RECORD_VERSION',
442 >  'RECREATE',
443 >  'RECURSIVE',
444 >  'REFERENCES',
445 >  'REGR_AVGX',
446 >  'REGR_AVGY',
447 >  'REGR_COUNT',
448 >  'REGR_INTERCEPT',
449 >  'REGR_R2',
450 >  'REGR_SLOPE',
451 >  'REGR_SXX',
452 >  'REGR_SXY',
453 >  'REGR_SYY',
454 >  'RELEASE',
455 >  'RETURN',
456 >  'RETURNING_VALUES',
457 >  'RETURNS',
458 >  'REVOKE',
459 >  'RIGHT',
460 >  'ROLLBACK',
461 >  'ROW',
462 >  'ROWS',
463 >  'ROW_COUNT',
464 >  'SAVEPOINT',
465 >  'SCROLL',
466 >  'SECOND',
467 >  'SELECT',
468 >  'SENSITIVE',
469 >  'SET',
470 >  'SIMILAR',
471 >  'SMALLINT',
472 >  'SOME',
473 >  'SQLCODE',
474 >  'SQLSTATE',
475 >  'START',
476 >  'STDDEV_POP',
477 >  'STDDEV_SAMP',
478 >  'SUM',
479 >  'TABLE',
480 >  'THEN',
481 >  'TIME',
482 >  'TIMESTAMP',
483 >  'TO',
484 >  'TRAILING',
485 >  'TRIGGER',
486 >  'TRIM',
487 >  'TRUE',
488 >  'UNION',
489 >  'UNIQUE',
490 >  'UNKNOWN',
491 >  'UPDATE',
492 >  'UPDATING',
493 >  'UPPER',
494 >  'USER',
495 >  'USING',
496 >  'VALUE',
497 >  'VALUES',
498 >  'VAR_POP',
499 >  'VAR_SAMP',
500 >  'VARCHAR',
501 >  'VARIABLE',
502 >  'VARYING',
503 >  'VIEW',
504 >  'WHEN',
505 >  'WHERE',
506 >  'WHILE',
507 >  'WITH',
508 >  'YEAR'
509 >  );
510 >
511 > type
512 >  {The TSQLTokeniser class provides a common means to parse an SQL statement, or
513 >   even a stream of SQL Statements. The TSQLStringTokeniser class is instantiated
514 >   with a single SQL statement or a set of concatenated statements. The TSQLStreamTokeniser
515 >   is instantiated with a stream from which the SQL statements are read.
516 >
517 >   Successive calls to GetNextToken then return each SQL token. The TokenText contains
518 >   either the single character, the identifier or reserved word, the string or comment.}
519 >
520 >  { TSQLTokeniser }
521 >
522 >  TSQLTokeniser = class
523 >  private
524 >    const
525 >      TokenQueueMaxSize = 64;
526 >    type
527 >      TLexState = (stDefault, stInCommentLine, stInComment, stSingleQuoted, stDoubleQuoted,
528 >                   stInIdentifier, stInNumeric);
529 >
530 >      TTokenQueueItem = record
531 >                          token: TSQLTokens;
532 >                          text: AnsiString;
533 >                        end;
534 >      TTokenQueueState = (tsHold, tsRelease);
535 >
536 >  private
537 >    FLastChar: AnsiChar;
538 >    FState: TLexState;
539 >    FSkipNext: boolean;
540 >    function GetNext: TSQLTokens;
541 >
542 >    {The token Queue is available for use by descendents so that they can
543 >     hold back tokens in order to lookahead by token rather than just a single
544 >     character}
545 >
546 >  private
547 >    FTokenQueue: array[0..TokenQueueMaxSize] of TTokenQueueItem;
548 >    FQueueState: TTokenQueueState;
549 >    FQFirst: integer;  {first and last pointers first=last => queue empty}
550 >    FQLast: integer;
551 >    FEOF: boolean;
552 >    procedure PopQueue(var token: TSQLTokens);
553 >  protected
554 >    FString: AnsiString;
555 >    FNextToken: TSQLTokens;
556 >    procedure Assign(source: TSQLTokeniser); virtual;
557 >    function GetChar: AnsiChar; virtual; abstract;
558 >    function TokenFound(var token: TSQLTokens): boolean; virtual;
559 >    function InternalGetNextToken: TSQLTokens; virtual;
560 >    procedure Reset; virtual;
561 >    function ReadCharacters(NumOfChars: integer): AnsiString;
562 >
563 >    {Token stack}
564 >    procedure QueueToken(token: TSQLTokens; text:AnsiString); overload;
565 >    procedure QueueToken(token: TSQLTokens); overload;
566 >    procedure ResetQueue; overload;
567 >    procedure ResetQueue(token: TSQLTokens; text:AnsiString); overload;
568 >    procedure ResetQueue(token: TSQLTokens); overload;
569 >    procedure ReleaseQueue(var token: TSQLTokens); overload;
570 >    procedure ReleaseQueue; overload;
571 >    function GetQueuedText: AnsiString;
572 >    procedure SetTokenText(text: AnsiString);
573 >
574 >  public
575 >    const
576 >        DefaultTerminator = ';';
577 >  public
578 >    constructor Create;
579 >    destructor Destroy; override;
580 >    function GetNextToken: TSQLTokens;
581 >    property EOF: boolean read FEOF;
582 >    property TokenText: AnsiString read FString;
583 >  end;
584 >
585 >  { TSQLwithNamedParamsTokeniser }
586 >
587 >  TSQLwithNamedParamsTokeniser = class(TSQLTokeniser)
588 >  private
589 >    type
590 >      TSQLState = (stInit,stInParam,stInBlock, stInArrayDim);
591 >  private
592 >    FState: TSQLState;
593 >    FNested: integer;
594 >  protected
595 >    procedure Assign(source: TSQLTokeniser); override;
596 >    procedure Reset; override;
597 >    function TokenFound(var token: TSQLTokens): boolean; override;
598 >  end;
599 >
600 >    { TSQLParamProcessor }
601 >
602 >  TSQLParamProcessor = class(TSQLwithNamedParamsTokeniser)
603 >  private
604 >  const
605 >    sIBXParam = 'IBXParam';  {do not localize}
606 >  private
607 >    FInString: AnsiString;
608 >    FIndex: integer;
609 >    function DoExecute(GenerateParamNames: boolean;
610 >        var slNames: TStrings): AnsiString;
611 >  protected
612 >    function GetChar: AnsiChar; override;
613 >  public
614 >    class function Execute(sSQL: AnsiString; GenerateParamNames: boolean;
615 >        var slNames: TStrings): AnsiString;
616 >  end;
617 >
618  
619   function Max(n1, n2: Integer): Integer;
620   function Min(n1, n2: Integer): Integer;
621 < function RandomString(iLength: Integer): String;
621 > function RandomString(iLength: Integer): AnsiString;
622   function RandomInteger(iLow, iHigh: Integer): Integer;
623 < function StripString(st: String; CharsToStrip: String): String;
624 < function FormatIdentifier(Dialect: Integer; Value: String): String;
625 < function FormatIdentifierValue(Dialect: Integer; Value: String): String;
626 < function FormatIdentifierValueNC(Dialect: Integer; Value: String): String;
627 < function ExtractIdentifier(Dialect: Integer; Value: String): String;
628 < function QuoteIdentifier(Dialect: Integer; Value: String): String;
629 < function QuoteIdentifierIfNeeded(Dialect: Integer; Value: String): String;
630 < function Space2Underscore(s: string): string;
623 > function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
624 > function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
625 > function FindReservedWord(w: AnsiString; var token: TSQLTokens): boolean;
626 > function IsReservedWord(w: AnsiString): boolean;
627 > function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
628 > function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
629 > function Space2Underscore(s: AnsiString): AnsiString;
630 > function SQLSafeString(const s: AnsiString): AnsiString;
631 > function IsSQLIdentifier(Value: AnsiString): boolean;
632 > function ExtractConnectString(const CreateSQL: AnsiString; var ConnectString: AnsiString): boolean;
633 > function MakeConnectString(ServerName, DatabaseName: AnsiString; Protocol: TProtocol;
634 >              PortNo: AnsiString = ''): AnsiString;
635 > function ParseConnectString(ConnectString: AnsiString;
636 >              var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
637 >              var PortNo: AnsiString): boolean;
638 > function GetProtocol(ConnectString: AnsiString): TProtocolAll;
639 >
640 > {$IF declared(TFormatSettings)}
641 > function ParseDateTimeTZString(aDateTimeStr: Ansistring; var aDateTime: TDateTime;
642 >              var aTimezone: AnsiString; aFormatSettings: TFormatSettings; TimeOnly: boolean=false): boolean; overload;
643 > {$IFEND}
644 > function ParseDateTimeTZString(aDateTimeStr: Ansistring; var aDateTime: TDateTime;
645 >              var aTimezone: AnsiString; TimeOnly: boolean=false): boolean;  overload;
646 > procedure FBDecodeTime(aTime: TDateTime; var Hour, Minute, Second: word; var DeciMillisecond: cardinal);
647 > function FBEncodeTime(Hour, Minute, Second, DeciMillisecond: cardinal): TDateTime;
648 > function FBFormatDateTime(fmt: AnsiString; aDateTime: TDateTime): AnsiString;
649 > function FormatTimeZoneOffset(EffectiveTimeOffsetMins: integer): AnsiString;
650 > function DecodeTimeZoneOffset(TZOffset: AnsiString; var dstOffset: integer): boolean;
651 > function StripLeadingZeros(Value: AnsiString): AnsiString;
652 > function TryStrToNumeric(S: Ansistring; out Value: int64; out scale: integer): boolean;
653 > function NumericToDouble(aValue: Int64; aScale: integer): double;
654 >
655  
656   implementation
657  
658 + uses FBMessages, Math
659 +
660 + {$IFDEF FPC}
661 + ,RegExpr
662 + {$ELSE}
663 + {$IF declared(CompilerVersion) and (CompilerVersion >= 22)}
664 + , RegularExpressions
665 + {$IFEND}
666 + {$ENDIF};
667 +
668 +
669   function Max(n1, n2: Integer): Integer;
670   begin
671    if (n1 > n2) then
# Line 103 | Line 682 | begin
682      result := n2;
683   end;
684  
685 < function RandomString(iLength: Integer): String;
685 > function RandomString(iLength: Integer): AnsiString;
686   begin
687    result := '';
688    while Length(result) < iLength do
# Line 117 | Line 696 | begin
696    result := Trunc(Random(iHigh - iLow)) + iLow;
697   end;
698  
699 < function StripString(st: String; CharsToStrip: String): String;
699 > function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
700   var
701    i: Integer;
702   begin
# Line 128 | Line 707 | begin
707    end;
708   end;
709  
710 < 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;
710 > {Extracts SQL Identifier typically from a  Dialect 3 encoding}
711  
712 < function FormatIdentifierValue(Dialect: Integer; Value: String): String;
712 > function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
713   begin
714    Value := Trim(Value);
715    if Dialect = 1 then
# Line 160 | Line 728 | begin
728    Result := Value;
729   end;
730  
731 < function FormatIdentifierValueNC(Dialect: Integer; Value: String): String;
731 > {Returns true if "w" is a Firebird SQL reserved word, and the
732 > corresponding TSQLTokens value.}
733 >
734 > function FindReservedWord(w: AnsiString; var token: TSQLTokens): boolean;
735 > var i: TSQLTokens;
736   begin
737 <  Value := Trim(Value);
737 >   Result := true;
738 >   w := AnsiUpperCase(Trim(w));
739 >   for i := Low(TSQLReservedWords) to High(TSQLReservedWords) do
740 >   begin
741 >       if w = sqlReservedWords[i] then
742 >       begin
743 >         token := i;
744 >         Exit;
745 >       end;
746 >       if w <  sqlReservedWords[i] then
747 >         break;
748 >   end;
749 >   Result := false;
750 > end;
751 >
752 > {Returns true if "w" is a Firebird SQL reserved word}
753 >
754 > function IsReservedWord(w: AnsiString): boolean;
755 > var token: TSQLTokens;
756 > begin
757 >  Result := FindReservedWord(w,token);
758 > end;
759 >
760 > {Format an SQL Identifier according to SQL Dialect}
761 >
762 > function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
763 > begin
764 >  Value := TrimRight(Value);
765    if Dialect = 1 then
766      Value := AnsiUpperCase(Value)
767    else
768 <  begin
769 <    if (Value <> '') and (Value[1] = '"') then
768 >    Value := '"' + StringReplace (Value, '""', '"', [rfReplaceAll]) + '"';
769 >  Result := Value;
770 > end;
771 >
772 > const
773 >  ValidSQLIdentifierChars = ['A'..'Z','a'..'z','0'..'9','_','$'];
774 >
775 > {Returns true if the value is a valid SQL Identifier - note lower case accepted}
776 >
777 > function IsSQLIdentifier(Value: AnsiString): boolean;
778 > var i: integer;
779 > begin
780 >  Result := false;
781 >  for i := 1 to Length(Value) do
782 >    if not (Value[i] in ValidSQLIdentifierChars) then Exit;
783 >  Result := true;
784 > end;
785 >
786 > function SchemeToProtocol(scheme: AnsiString): TProtocolAll;
787 > begin
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 > {Extracts the Database Connect string from a Create Database Statement}
806 >
807 > {$IF declared(TRegexpr)}
808 > function ExtractConnectString(const CreateSQL: AnsiString;
809 >  var ConnectString: AnsiString): boolean;
810 > var RegexObj: TRegExpr;
811 > begin
812 >  RegexObj := TRegExpr.Create;
813 >  try
814 >    {extact database file spec}
815 >    RegexObj.ModifierG := false; {turn off greedy matches}
816 >    RegexObj.ModifierI := true; {case insensitive match}
817 >    RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''';
818 >    Result := RegexObj.Exec(CreateSQL);
819 >    if Result then
820 >      ConnectString := RegexObj.Match[2];
821 >  finally
822 >    RegexObj.Free;
823 >  end;
824 > end;
825 >
826 > function ParseConnectString(ConnectString: AnsiString; var ServerName,
827 >  DatabaseName: AnsiString; var Protocol: TProtocolAll; var PortNo: AnsiString
828 >  ): boolean;
829 >
830 > var RegexObj: TRegExpr;
831 > begin
832 >  ServerName := '';
833 >  DatabaseName := ConnectString;
834 >  PortNo := '';
835 >  Protocol := unknownProtocol;
836 >  RegexObj := TRegExpr.Create;
837 >  try
838 >    {extact database file spec}
839 >    RegexObj.ModifierG := false; {turn off greedy matches}
840 >    RegexObj.Expression := '^([a-zA-Z46]+)://([a-zA-Z0-9\-\.]*)(|:[0-9a-zA-Z\-]+)/(.*)$';
841 >    Result := RegexObj.Exec(ConnectString);
842 >    if Result then
843      begin
844 <      Delete(Value, 1, 1);
845 <      Delete(Value, Length(Value), 1);
846 <      Value := AnsiUpperCase(StringReplace (Value, '""', '"', [rfReplaceAll]));
844 >      {URL type connect string}
845 >      Protocol := SchemeToProtocol(RegexObj.Match[1]);
846 >      ServerName := RegexObj.Match[2];
847 >      if RegexObj.MatchLen[3] > 0 then
848 >        PortNo := system.Copy(ConnectString,RegexObj.MatchPos[3]+1,RegexObj.MatchLen[3]-1);
849 >      DatabaseName := RegexObj.Match[4];
850 >      if ServerName = '' then
851 >        DatabaseName := '/' + DatabaseName;
852      end
853      else
854 <      Value := AnsiUpperCase(Value);
854 >    begin
855 >      {URL type connect string - local loop}
856 >      RegexObj.Expression := '^([a-zA-Z46]+)://(.*)$';
857 >      Result := RegexObj.Exec(ConnectString);
858 >      if Result then
859 >      begin
860 >        Protocol := SchemeToProtocol(RegexObj.Match[1]);
861 >        DatabaseName := RegexObj.Match[2];
862 >      end
863 >      else
864 >      begin
865 >        RegexObj.Expression := '^([a-zA-Z]:\\.*)';
866 >        Result := RegexObj.Exec(ConnectString);
867 >        if Result then
868 >          Protocol := Local {Windows with leading drive ID}
869 >        else
870 >        begin
871 >          RegexObj.Expression := '^([a-zA-Z0-9\-\.]+)(|/[0-9a-zA-Z\-]+):(.*)$';
872 >          Result := RegexObj.Exec(ConnectString);
873 >          if Result then
874 >          begin
875 >            {Legacy TCP Format}
876 >            ServerName := RegexObj.Match[1];
877 >            if RegexObj.MatchLen[2] > 0 then
878 >              PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
879 >            DatabaseName := RegexObj.Match[3];
880 >            Protocol := TCP;
881 >          end
882 >          else
883 >          begin
884 >            RegexObj.Expression := '^\\\\([a-zA-Z0-9\-\.]+)(|@[0-9a-zA-Z\-]+)\\(.*)$';
885 >            Result := RegexObj.Exec(ConnectString);
886 >            if Result then
887 >            begin
888 >              {Netbui}
889 >              ServerName := RegexObj.Match[1];
890 >              if RegexObj.MatchLen[2] > 0 then
891 >                PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
892 >              DatabaseName := RegexObj.Match[3];
893 >              Protocol := NamedPipe
894 >            end
895 >            else
896 >            begin
897 >              Result := true;
898 >              Protocol := Local; {Assume local}
899 >            end;
900 >          end;
901 >        end;
902 >      end;
903 >    end;
904 >  finally
905 >    RegexObj.Free;
906    end;
179 –  Result := Value;
907   end;
908  
909 < function ExtractIdentifier(Dialect: Integer; Value: String): String;
909 > {$ELSE}
910 > {$IF declared(TRegex)}
911 > function ExtractConnectString(const CreateSQL: AnsiString;
912 >  var ConnectString: AnsiString): boolean;
913 > var Regex: TRegEx;
914 >    Match: TMatch;
915   begin
916 <  Value := Trim(Value);
917 <  if Dialect = 1 then
918 <    Value := AnsiUpperCase(Value)
916 >  Regex := TRegEx.Create('^ *CREATE +(DATABASE|SCHEMA) +''(.*)''',[roIgnoreCase]);
917 >  {extact database file spec}
918 >  Match := Regex.Match(CreateSQL);
919 >  Result := Match.Success and (Match.Groups.Count = 3);
920 >  if Result then
921 >    ConnectString := Match.Groups[2].Value;
922 > end;
923 >
924 > function ParseConnectString(ConnectString: AnsiString; var ServerName,
925 >  DatabaseName: AnsiString; var Protocol: TProtocolAll; var PortNo: AnsiString
926 >  ): boolean;
927 >
928 > var Regex: TRegEx;
929 >    Match: TMatch;
930 > begin
931 >  ServerName := '';
932 >  DatabaseName := ConnectString;
933 >  PortNo := '';
934 >  Protocol := unknownProtocol;
935 >  {extact database file spec}
936 >  Match := Regex.Match(ConnectString,'^([a-zA-Z46]+)://([a-zA-Z0-9\-\.]*)(|:[0-9a-zA-Z\-]+)/(.*)$',[roIgnoreCase]);
937 >  Result := Match.Success and (Match.Groups.Count = 5);
938 >  if Result then
939 >  begin
940 >    {URL type connect string}
941 >    Protocol := SchemeToProtocol(Match.Groups[1].Value);
942 >    ServerName := Match.Groups[2].Value;
943 >    PortNo := Match.Groups[3].Value;
944 >    DatabaseName := Match.Groups[4].Value;
945 >    if ServerName = '' then
946 >      DatabaseName := '/' + DatabaseName;
947 >  end
948    else
949    begin
950 <    if (Value <> '') and (Value[1] = '"') then
950 >    {URL type connect string - local loop}
951 >    Match := Regex.Match(ConnectString,'^([a-zA-Z46]+)://(.*)$',[roIgnoreCase]);
952 >    Result := Match.Success and (Match.Groups.Count = 3);
953 >    if Result then
954      begin
955 <      Delete(Value, 1, 1);
956 <      Delete(Value, Length(Value), 1);
193 <      Value := StringReplace (Value, '""', '"', [rfReplaceAll]);
955 >      Protocol := SchemeToProtocol(Match.Groups[1].Value);
956 >      DatabaseName := Match.Groups[2].Value;
957      end
958      else
959 <      Value := AnsiUpperCase(Value);
959 >    begin
960 >      Match := Regex.Match(ConnectString,'^([a-zA-Z]:\\.*)',[roIgnoreCase]);
961 >      Result := Match.Success;
962 >      if Result then
963 >        Protocol := Local {Windows with leading drive ID}
964 >      else
965 >      begin
966 >        Match := Regex.Match(ConnectString,'^([a-zA-Z0-9\-\.]+)(|/[0-9a-zA-Z\-]+):(.*)$',[roIgnoreCase]);
967 >        Result := Match.Success and (Match.Groups.Count = 4);
968 >        if Result then
969 >        begin
970 >          {Legacy TCP Format}
971 >          ServerName := Match.Groups[1].Value;
972 >          PortNo := Match.Groups[2].Value;
973 >          DatabaseName := Match.Groups[3].Value;
974 >          Protocol := TCP;
975 >        end
976 >        else
977 >        begin
978 >          Match := Regex.Match(ConnectString,'^\\\\([a-zA-Z0-9\-\.]+)(|@[0-9a-zA-Z\-]+)\\(.*)$',[roIgnoreCase]);
979 >          Result := Match.Success and (Match.Groups.Count = 4);
980 >          if Result then
981 >          begin
982 >            {Netbui}
983 >            ServerName := Match.Groups[1].Value;
984 >            PortNo := Match.Groups[2].Value;
985 >            DatabaseName := Match.Groups[3].Value;
986 >            Protocol := NamedPipe
987 >          end
988 >          else
989 >          begin
990 >            Result := true;
991 >            Protocol := Local; {Assume local}
992 >          end;
993 >        end;
994 >      end;
995 >    end;
996    end;
198 –  Result := Value;
997   end;
998 <
999 < function IsReservedWord(w: string): boolean;
998 > {$ELSE}
999 > {cruder version of above for Delphi < XE. Older versions lack regular expression
1000 > handling.}
1001 > function ExtractConnectString(const CreateSQL: AnsiString;
1002 >  var ConnectString: AnsiString): boolean;
1003   var i: integer;
1004   begin
1005 <     Result := true;
1006 <     for i := 0 to Length(sqlReservedWords) - 1 do
1007 <         if w = sqlReservedWords[i] then
1008 <            Exit;
1009 <     Result := false;
1005 >  Result := false;
1006 >  i := Pos('''',CreateSQL);
1007 >  if i > 0 then
1008 >  begin
1009 >    ConnectString := CreateSQL;
1010 >    delete(ConnectString,1,i);
1011 >    i := Pos('''',ConnectString);
1012 >    if i > 0 then
1013 >    begin
1014 >      delete(ConnectString,i,Length(ConnectString)-i+1);
1015 >      Result := true;
1016 >    end;
1017 >  end;
1018   end;
1019  
1020 < function QuoteIdentifier(Dialect: Integer; Value: String): String;
1020 > function ParseConnectString(ConnectString: AnsiString;
1021 >              var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
1022 >              var PortNo: AnsiString): boolean;
1023   begin
1024 <  if Dialect = 1 then
1025 <    Value := AnsiUpperCase(Trim(Value))
1026 <  else
1027 <    Value := '"' + Value + '"';
1028 <  Result := Value;
1024 >  Result := false;
1025 > end;
1026 >
1027 > {$IFEND}
1028 > {$IFEND}
1029 >
1030 > function GetProtocol(ConnectString: AnsiString): TProtocolAll;
1031 > var ServerName,
1032 >    DatabaseName: AnsiString;
1033 >    PortNo: AnsiString;
1034 > begin
1035 >  if not ParseConnectString(ConnectString,ServerName,DatabaseName,Result,PortNo) then
1036 >    Result := unknownProtocol;
1037   end;
1038  
1039 < function QuoteIdentifierIfNeeded(Dialect: Integer; Value: String): String;
1039 > {Make a connect string in format appropriate protocol}
1040 >
1041 > function MakeConnectString(ServerName, DatabaseName: AnsiString;
1042 >  Protocol: TProtocol; PortNo: AnsiString): AnsiString;
1043 >
1044 >  function FormatURL: AnsiString;
1045 >  begin
1046 >    if (ServerName = '') and (Pos('/',DatabaseName) <= 1) then
1047 >      Result := DatabaseName
1048 >    else
1049 >      Result := ServerName + '/' + DatabaseName;
1050 >  end;
1051 >
1052   begin
1053 +  if ServerName = '' then ServerName := 'localhost';
1054 +  if PortNo <> '' then
1055 +    case Protocol of
1056 +    NamedPipe:
1057 +      ServerName := ServerName + '@' + PortNo;
1058 +    Local,
1059 +    SPX,
1060 +    xnet: {do nothing};
1061 +    TCP:
1062 +      ServerName := ServerName + '/' + PortNo;
1063 +    else
1064 +      ServerName := ServerName + ':' + PortNo;
1065 +    end;
1066 +
1067 +  case Protocol of
1068 +    TCP:        Result := ServerName + ':' + DatabaseName; {do not localize}
1069 +    SPX:        Result := ServerName + '@' + DatabaseName; {do not localize}
1070 +    NamedPipe:  Result := '\\' + ServerName + '\' + DatabaseName; {do not localize}
1071 +    Local:      Result := DatabaseName; {do not localize}
1072 +    inet:       Result := 'inet://' + FormatURL; {do not localize}
1073 +    inet4:       Result := 'inet4://' + FormatURL; {do not localize}
1074 +    inet6:       Result := 'inet6://' + FormatURL; {do not localize}
1075 +    wnet:       Result := 'wnet://' + FormatURL; {do not localize}
1076 +    xnet:       Result := 'xnet://' + FormatURL;  {do not localize}
1077 +  end;
1078 + end;
1079 +
1080 + {Format an SQL Identifier according to SQL Dialect with encapsulation if necessary}
1081 +
1082 + function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
1083 + begin
1084 +  Value := TrimRight(Value);
1085    if (Dialect = 3) and
1086 <    ((AnsiUpperCase(Value) <> Value) or IsReservedWord(Value)) then
1087 <     Result := '"' + Value + '"'
1086 >    (IsReservedWord(Value) or not IsSQLIdentifier(Value) or (AnsiUpperCase(Value) <> Value)) then
1087 >     Result := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
1088    else
1089      Result := Value
1090   end;
1091  
1092 < function Space2Underscore(s: string): string;
1092 > {Replaces unknown characters in a string with underscores}
1093 >
1094 > function Space2Underscore(s: AnsiString): AnsiString;
1095   var
1096     k: integer;
1097   begin
1098       Result := s;
1099       for k := 1 to Length(s) do
1100 <         if not (Result[k] in ['0'..'9','A'..'Z','_','$'])  then
1100 >         if not (Result[k] in ValidSQLIdentifierChars)  then
1101              Result[k] := '_';
1102   end;
1103  
1104 + {Reformats an SQL string with single quotes duplicated.}
1105 +
1106 + function SQLSafeString(const s: AnsiString): AnsiString;
1107 + begin
1108 +  Result := StringReplace(s,'''','''''',[rfReplaceAll]);
1109 + end;
1110 +
1111 + { TSQLParamProcessor }
1112 +
1113 + function TSQLParamProcessor.DoExecute(GenerateParamNames: boolean;
1114 +  var slNames: TStrings): AnsiString;
1115 + var token: TSQLTokens;
1116 +    iParamSuffix: Integer;
1117 + begin
1118 +  Result := '';
1119 +  iParamSuffix := 0;
1120 +
1121 +  while not EOF do
1122 +  begin
1123 +    token := GetNextToken;
1124 +    case token of
1125 +    sqltParam,
1126 +    sqltQuotedParam:
1127 +      begin
1128 +        Result := Result + '?';
1129 +        slNames.Add(TokenText);
1130 +      end;
1131 +
1132 +    sqltPlaceHolder:
1133 +      if GenerateParamNames then
1134 +      begin
1135 +        Inc(iParamSuffix);
1136 +        slNames.AddObject(sIBXParam + IntToStr(iParamSuffix),self); //Note local convention
1137 +                                            //add pointer to self to mark entry
1138 +        Result := Result + '?';
1139 +      end
1140 +      else
1141 +        IBError(ibxeSQLParseError, [SParamNameExpected]);
1142 +
1143 +    sqltQuotedString:
1144 +      Result := Result + '''' + SQLSafeString(TokenText) + '''';
1145 +
1146 +    sqltIdentifierInDoubleQuotes:
1147 +      Result := Result + '"' + StringReplace(TokenText,'"','""',[rfReplaceAll]) + '"';
1148 +
1149 +    sqltComment:
1150 +      Result := Result + '/*' + TokenText + '*/';
1151 +
1152 +    sqltCommentLine:
1153 +      Result := Result + '--' + TokenText + LineEnding;
1154 +
1155 +    sqltEOL:
1156 +      Result := Result + LineEnding;
1157 +
1158 +    else
1159 +      Result := Result + TokenText;
1160 +    end;
1161 +  end;
1162 + end;
1163 +
1164 + function TSQLParamProcessor.GetChar: AnsiChar;
1165 + begin
1166 +  if FIndex <= Length(FInString) then
1167 +  begin
1168 +    Result := FInString[FIndex];
1169 +    Inc(FIndex);
1170 +  end
1171 +  else
1172 +    Result := #0;
1173 + end;
1174 +
1175 + class function TSQLParamProcessor.Execute(sSQL: AnsiString;
1176 +  GenerateParamNames: boolean; var slNames: TStrings): AnsiString;
1177 + begin
1178 +  with self.Create do
1179 +  try
1180 +    FInString := sSQL;
1181 +    FIndex := 1;
1182 +    Result := DoExecute(GenerateParamNames,slNames);
1183 +  finally
1184 +    Free;
1185 +  end;
1186 + end;
1187 +
1188 + { TSQLwithNamedParamsTokeniser }
1189 +
1190 + procedure TSQLwithNamedParamsTokeniser.Assign(source: TSQLTokeniser);
1191 + begin
1192 +  inherited Assign(source);
1193 +  if source is TSQLwithNamedParamsTokeniser then
1194 +  begin
1195 +    FState := TSQLwithNamedParamsTokeniser(source).FState;
1196 +    FNested := TSQLwithNamedParamsTokeniser(source).FNested;
1197 +  end;
1198 + end;
1199 +
1200 + procedure TSQLwithNamedParamsTokeniser.Reset;
1201 + begin
1202 +  inherited Reset;
1203 +  FState := stInit;
1204 +  FNested := 0;
1205 + end;
1206 +
1207 + function TSQLwithNamedParamsTokeniser.TokenFound(var token: TSQLTokens
1208 +  ): boolean;
1209 + begin
1210 +  Result := inherited TokenFound(token);
1211 +  if not Result then Exit;
1212 +
1213 +  case FState of
1214 +  stInit:
1215 +    begin
1216 +      case token of
1217 +      sqltColon:
1218 +        begin
1219 +          FState := stInParam;
1220 +          ResetQueue(token);
1221 +        end;
1222 +
1223 +      sqltBegin:
1224 +        begin
1225 +          FState := stInBlock;
1226 +          FNested := 1;
1227 +        end;
1228 +
1229 +      sqltOpenSquareBracket:
1230 +          FState := stInArrayDim;
1231 +
1232 +      end;
1233 +    end;
1234 +
1235 +  stInParam:
1236 +    begin
1237 +      case token of
1238 +      sqltIdentifier:
1239 +        token := sqltParam;
1240 +
1241 +      sqltIdentifierInDoubleQuotes:
1242 +        token := sqltQuotedParam;
1243 +
1244 +      else
1245 +        begin
1246 +          QueueToken(token);
1247 +          ReleaseQueue(token);
1248 +        end;
1249 +      end;
1250 +      FState := stInit;
1251 +    end;
1252 +
1253 +  stInBlock:
1254 +    begin
1255 +      case token of
1256 +      sqltBegin,
1257 +      sqltCase:
1258 +          Inc(FNested);
1259 +
1260 +      sqltEnd:
1261 +        begin
1262 +          Dec(FNested);
1263 +          if FNested = 0 then
1264 +            FState := stInit;
1265 +        end;
1266 +      end;
1267 +    end;
1268 +
1269 +    stInArrayDim:
1270 +      begin
1271 +        if token = sqltCloseSquareBracket then
1272 +            FState := stInit;
1273 +      end;
1274 +    end;
1275 +
1276 +  Result := (FState <> stInParam);
1277 + end;
1278 +
1279 + { TSQLTokeniser }
1280 +
1281 + function TSQLTokeniser.GetNext: TSQLTokens;
1282 + var C: AnsiChar;
1283 + begin
1284 +  if EOF then
1285 +    Result := sqltEOF
1286 +  else
1287 +  begin
1288 +    C := GetChar;
1289 +    case C of
1290 +    #0:
1291 +      Result := sqltEOF;
1292 +    ' ',TAB:
1293 +      Result := sqltSpace;
1294 +    '0'..'9':
1295 +      Result := sqltNumberString;
1296 +    ';':
1297 +      Result := sqltSemiColon;
1298 +    '?':
1299 +      Result := sqltPlaceholder;
1300 +    '|':
1301 +      Result := sqltPipe;
1302 +    '"':
1303 +      Result := sqltDoubleQuotes;
1304 +    '''':
1305 +      Result := sqltSingleQuotes;
1306 +    '/':
1307 +      Result := sqltForwardSlash;
1308 +    '\':
1309 +      Result := sqltBackslash;
1310 +    '*':
1311 +      Result := sqltAsterisk;
1312 +    '(':
1313 +      Result := sqltOpenBracket;
1314 +    ')':
1315 +      Result := sqltCloseBracket;
1316 +    ':':
1317 +      Result := sqltColon;
1318 +    ',':
1319 +      Result := sqltComma;
1320 +    '.':
1321 +      Result := sqltPeriod;
1322 +    '=':
1323 +      Result := sqltEquals;
1324 +    '[':
1325 +      Result := sqltOpenSquareBracket;
1326 +    ']':
1327 +      Result := sqltCloseSquareBracket;
1328 +    '-':
1329 +      Result := sqltMinus;
1330 +    '<':
1331 +      Result := sqltLT;
1332 +    '>':
1333 +      Result := sqltGT;
1334 +    CR:
1335 +      Result := sqltCR;
1336 +    LF:
1337 +      Result := sqltEOL;
1338 +    else
1339 +      if C in ValidSQLIdentifierChars then
1340 +        Result := sqltIdentifier
1341 +      else
1342 +        Result := sqltOtherCharacter;
1343 +    end;
1344 +    FLastChar := C
1345 +  end;
1346 +  FNextToken := Result;
1347 + end;
1348 +
1349 + procedure TSQLTokeniser.PopQueue(var token: TSQLTokens);
1350 + begin
1351 +  if FQFirst = FQLast then
1352 +    IBError(ibxeTokenQueueUnderflow,[]);
1353 +  token := FTokenQueue[FQFirst].token;
1354 +  FString := FTokenQueue[FQFirst].text;
1355 +  Inc(FQFirst);
1356 +  if FQFirst = FQLast then
1357 +    FQueueState := tsHold;
1358 + end;
1359 +
1360 + procedure TSQLTokeniser.Assign(source: TSQLTokeniser);
1361 + begin
1362 +  FString := source.FString;
1363 +  FNextToken := source.FNextToken;
1364 +  FTokenQueue := source.FTokenQueue;
1365 +  FQueueState := source.FQueueState;
1366 +  FQFirst := source.FQFirst;
1367 +  FQLast := source.FQLast;
1368 + end;
1369 +
1370 + function TSQLTokeniser.TokenFound(var token: TSQLTokens): boolean;
1371 + begin
1372 +  Result := (FState = stDefault);
1373 +  if Result and (token = sqltIdentifier)  then
1374 +    FindReservedWord(FString,token);
1375 + end;
1376 +
1377 + procedure TSQLTokeniser.QueueToken(token: TSQLTokens; text: AnsiString);
1378 + begin
1379 +  if FQLast > TokenQueueMaxSize then
1380 +    IBError(ibxeTokenQueueOverflow,[]);
1381 +  FTokenQueue[FQLast].token := token;
1382 +  FTokenQueue[FQLast].text := text;
1383 +  Inc(FQLast);
1384 + end;
1385 +
1386 + procedure TSQLTokeniser.QueueToken(token: TSQLTokens);
1387 + begin
1388 +  QueueToken(token,TokenText);
1389 + end;
1390 +
1391 + procedure TSQLTokeniser.ResetQueue;
1392 + begin
1393 +  FQFirst := 0;
1394 +  FQLast := 0;
1395 +  FQueueState := tsHold;
1396 + end;
1397 +
1398 + procedure TSQLTokeniser.ResetQueue(token: TSQLTokens; text: AnsiString);
1399 + begin
1400 +  ResetQueue;
1401 +  QueueToken(token,text);
1402 + end;
1403 +
1404 + procedure TSQLTokeniser.ResetQueue(token: TSQLTokens);
1405 + begin
1406 +  ResetQueue;
1407 +  QueueToken(token);
1408 + end;
1409 +
1410 + procedure TSQLTokeniser.ReleaseQueue(var token: TSQLTokens);
1411 + begin
1412 +  FQueueState := tsRelease;
1413 +  PopQueue(token);
1414 + end;
1415 +
1416 + procedure TSQLTokeniser.ReleaseQueue;
1417 + begin
1418 +  FQueueState := tsRelease;
1419 + end;
1420 +
1421 + function TSQLTokeniser.GetQueuedText: AnsiString;
1422 + var i: integer;
1423 + begin
1424 +  Result := '';
1425 +  for i := FQFirst to FQLast do
1426 +    Result := Result + FTokenQueue[i].text;
1427 + end;
1428 +
1429 + procedure TSQLTokeniser.SetTokenText(text: AnsiString);
1430 + begin
1431 +  FString := text;
1432 + end;
1433 +
1434 + constructor TSQLTokeniser.Create;
1435 + begin
1436 +  inherited Create;
1437 +  Reset;
1438 + end;
1439 +
1440 + destructor TSQLTokeniser.Destroy;
1441 + begin
1442 +  Reset;
1443 +  inherited Destroy;
1444 + end;
1445 +
1446 + procedure TSQLTokeniser.Reset;
1447 + begin
1448 +  FNextToken := sqltInit;
1449 +  FState := stDefault;
1450 +  FString := '';
1451 +  FEOF := false;
1452 +  ResetQueue;
1453 + end;
1454 +
1455 + function TSQLTokeniser.ReadCharacters(NumOfChars: integer): AnsiString;
1456 + var i: integer;
1457 + begin
1458 +  Result := FLastChar;
1459 +  for i := 2 to NumOfChars do
1460 +  begin
1461 +    if GetNext = sqltEOF then break;
1462 +    Result := Result + FLastChar;
1463 +  end;
1464 + end;
1465 +
1466 + function TSQLTokeniser.GetNextToken: TSQLTokens;
1467 + begin
1468 +  if FQueueState = tsRelease then
1469 +  repeat
1470 +    PopQueue(Result);
1471 +    FEOF := Result = sqltEOF;
1472 +    if TokenFound(Result) then
1473 +      Exit;
1474 +  until FQueueState <> tsRelease;
1475 +
1476 +  Result := InternalGetNextToken;
1477 + end;
1478 +
1479 + {a simple lookahead one algorithm to extra the next symbol}
1480 +
1481 + function TSQLTokeniser.InternalGetNextToken: TSQLTokens;
1482 + var C: AnsiChar;
1483 + begin
1484 +  Result := sqltEOF;
1485 +
1486 +  if FNextToken = sqltInit then
1487 +    GetNext;
1488 +
1489 +  repeat
1490 +    if FSkipNext then
1491 +    begin
1492 +      FSkipNext := false;
1493 +      GetNext;
1494 +    end;
1495 +
1496 +    Result := FNextToken;
1497 +    C := FLastChar;
1498 +    GetNext;
1499 +
1500 +    if (Result = sqltCR) and (FNextToken = sqltEOL) then
1501 +    begin
1502 +      FSkipNext := true;
1503 +      Result := sqltEOL;
1504 +      C := LF;
1505 +    end;
1506 +
1507 +    case FState of
1508 +    stInComment:
1509 +      begin
1510 +        if (Result = sqltAsterisk) and (FNextToken = sqltForwardSlash) then
1511 +        begin
1512 +          FState := stDefault;
1513 +          Result := sqltComment;
1514 +          GetNext;
1515 +        end
1516 +        else
1517 +        if Result = sqltEOL then
1518 +          FString := FString + LineEnding
1519 +        else
1520 +          FString := FString + C;
1521 +      end;
1522 +
1523 +    stInCommentLine:
1524 +      begin
1525 +        case Result of
1526 +        sqltEOL:
1527 +          begin
1528 +            FState := stDefault;
1529 +            Result := sqltCommentLine;
1530 +          end;
1531 +
1532 +        else
1533 +          FString := FString + C;
1534 +        end;
1535 +      end;
1536 +
1537 +    stSingleQuoted:
1538 +      begin
1539 +        if (Result = sqltSingleQuotes) then
1540 +        begin
1541 +          if (FNextToken = sqltSingleQuotes) then
1542 +          begin
1543 +            FSkipNext := true;
1544 +            FString := FString + C;
1545 +          end
1546 +          else
1547 +          begin
1548 +            Result := sqltQuotedString;
1549 +            FState := stDefault;
1550 +          end;
1551 +        end
1552 +        else
1553 +        if Result = sqltEOL then
1554 +          FString := FString + LineEnding
1555 +        else
1556 +          FString := FString + C;
1557 +      end;
1558 +
1559 +    stDoubleQuoted:
1560 +      begin
1561 +        if (Result = sqltDoubleQuotes) then
1562 +        begin
1563 +          if (FNextToken = sqltDoubleQuotes) then
1564 +          begin
1565 +            FSkipNext := true;
1566 +            FString := FString + C;
1567 +          end
1568 +          else
1569 +          begin
1570 +            Result := sqltIdentifierInDoubleQuotes;
1571 +            FState := stDefault;
1572 +          end;
1573 +        end
1574 +        else
1575 +        if Result = sqltEOL then
1576 +          FString := FString + LineEnding
1577 +        else
1578 +          FString := FString + C;
1579 +      end;
1580 +
1581 +    stInIdentifier:
1582 +      begin
1583 +        FString := FString + C;
1584 +        Result := sqltIdentifier;
1585 +        if not (FNextToken in [sqltIdentifier,sqltNumberString]) then
1586 +          FState := stDefault
1587 +      end;
1588 +
1589 +    stInNumeric:
1590 +      begin
1591 +        FString := FString + C;
1592 +        if (Result = sqltPeriod) and (FNextToken = sqltPeriod) then
1593 +        begin
1594 +          {malformed decimal}
1595 +          FState := stInIdentifier;
1596 +          Result := sqltIdentifier
1597 +        end
1598 +        else
1599 +        begin
1600 +          if not (FNextToken in [sqltNumberString,sqltPeriod]) then
1601 +            FState := stDefault;
1602 +          Result := sqltNumberString;
1603 +        end;
1604 +      end;
1605 +
1606 +    else {stDefault}
1607 +      begin
1608 +        FString := C;
1609 +        case Result of
1610 +
1611 +        sqltPipe:
1612 +          if FNextToken = sqltPipe then
1613 +          begin
1614 +            Result := sqltConcatSymbol;
1615 +            FString := C + FLastChar;
1616 +            GetNext;
1617 +          end;
1618 +
1619 +        sqltForwardSlash:
1620 +          begin
1621 +            if FNextToken = sqltAsterisk then
1622 +            begin
1623 +              FString := '';
1624 +              GetNext;
1625 +              FState := stInComment;
1626 +            end
1627 +          end;
1628 +
1629 +        sqltMinus:
1630 +          begin
1631 +            if FNextToken = sqltMinus then
1632 +            begin
1633 +              FString := '';
1634 +              GetNext;
1635 +              FState := stInCommentLine;
1636 +            end;
1637 +          end;
1638 +
1639 +        sqltSingleQuotes:
1640 +          begin
1641 +            FString := '';
1642 +            FState := stSingleQuoted;
1643 +          end;
1644 +
1645 +        sqltDoubleQuotes:
1646 +          begin
1647 +            FString := '';
1648 +            FState := stDoubleQuoted;
1649 +          end;
1650 +
1651 +        sqltIdentifier:
1652 +          if FNextToken in [sqltIdentifier,sqltNumberString] then
1653 +            FState := stInIdentifier;
1654 +
1655 +        sqltNumberString:
1656 +          if FNextToken in [sqltNumberString,sqltPeriod] then
1657 +            FState := stInNumeric;
1658 +
1659 +        sqltEOL:
1660 +          FString := LineEnding;
1661 +        end;
1662 +      end;
1663 +    end;
1664 +
1665 + //    writeln(FString);
1666 +    FEOF := Result = sqltEOF;
1667 +  until TokenFound(Result) or EOF;
1668 + end;
1669 +
1670 + function ParseDateTimeTZString(aDateTimeStr: Ansistring; var aDateTime: TDateTime;
1671 +  var aTimezone: AnsiString; TimeOnly: boolean): boolean;
1672 + {$IF declared(TFormatSettings)}
1673 + begin
1674 +    {$IF declared(DefaultFormatSettings)}
1675 +    Result := ParseDateTimeTZString(aDateTimeStr,aDateTime,aTimeZone,DefaultFormatSettings,TimeOnly);
1676 +    {$ELSE}
1677 +    {$IF declared(FormatSettings)}
1678 +    Result := ParseDateTimeTZString(aDateTimeStr,aDateTime,aTimeZone,FormatSettings,TimeOnly);
1679 +    {$IFEND} {$IFEND}
1680 + end;
1681 +
1682 + function ParseDateTimeTZString(aDateTimeStr: Ansistring; var aDateTime: TDateTime;
1683 +              var aTimezone: AnsiString; aFormatSettings: TFormatSettings; TimeOnly: boolean=false): boolean;
1684 + {$IFEND}
1685 + const
1686 +  whitespacechars = [' ',#$09,#$0A,#$0D];
1687 + var i,j,l: integer;
1688 +    aTime: TDateTime;
1689 +    DMs: longint;
1690 + begin
1691 +  Result := false;
1692 +  aTimezone := '';
1693 +  if aDateTimeStr <> '' then
1694 +  {$if declared(TFormatSettings)}
1695 +  with aFormatSettings do
1696 +  {$IFEND}
1697 +  begin
1698 +    aDateTime := 0;
1699 +    {Parse to get time zone info}
1700 +    i := 1;
1701 +    while (i <= length(aDateTimeStr)) and (aDateTimeStr[i] in whitespacechars) do inc(i); {skip white space}
1702 +    if not TimeOnly then
1703 +    begin
1704 +      {decode date}
1705 +      j := i;
1706 +      while (j <= length(aDateTimeStr)) and (aDateTimeStr[j] in ['0'..'9',DateSeparator]) do inc(j);
1707 +      if TryStrToDate(system.copy(aDateTimeStr,i,j-i),aDateTime) then
1708 +        i := j; {otherwise start again i.e. assume time only}
1709 +    end;
1710 +
1711 +    while (i <= length(aDateTimeStr)) and (aDateTimeStr[i] in whitespacechars) do inc(i); {skip white space}
1712 +    {decode time}
1713 +    j := i;
1714 +    while (j <= length(aDateTimeStr)) and (aDateTimeStr[j] in ['0'..'9',TimeSeparator]) do inc(j);
1715 +    Result := TryStrToTime(system.copy(aDateTimeStr,i,j-i),aTime);
1716 +    if not Result then Exit;
1717 +    aDateTime := aDateTime + aTime;
1718 +    i := j;
1719 +
1720 +    {is there a factional second part}
1721 +    if (i <= length(aDateTimeStr)) and (aDateTimeStr[i] = '.') then
1722 +    begin
1723 +      inc(i);
1724 +      inc(j);
1725 +      while (j <= Length(aDateTimeStr)) and (aDateTimeStr[j] in ['0'..'9']) do inc(j);
1726 +      if j > i then
1727 +      begin
1728 +        l := j-i;
1729 +        if l > 4 then l := 4;
1730 +        Result := TryStrToInt(system.copy(aDateTimeStr,i,l),DMs);
1731 +        if not Result then Exit;
1732 +
1733 +        {adjust for number of significant digits}
1734 +        case l of
1735 +        3:   DMs := DMs * 10;
1736 +        2:   DMs := DMs * 100;
1737 +        1:   DMs := DMs * 1000;
1738 +        end;
1739 +       aDateTime := aDateTime + (DMs / (MsecsPerDay*10));
1740 +      end;
1741 +    end;
1742 +    i := j;
1743 +
1744 +    while (i <= length(aDateTimeStr)) and (aDateTimeStr[i] in whitespacechars) do inc(i); {skip white space}
1745 +    {decode time zone}
1746 +    if i < length(aDateTimeStr) then
1747 +    begin
1748 +      j := i;
1749 +      while (j <= length(aDateTimeStr)) and not (aDateTimeStr[j] in whitespacechars) do inc(j);
1750 +      aTimezone := system.copy(aDateTimeStr,i,j-i);
1751 +    end;
1752 +    Result := true;
1753 +  end
1754 + end;
1755 +
1756 + {The following is similar to FPC DecodeTime except that the Firebird standard
1757 + decimilliseconds is used instead of milliseconds for fractional seconds}
1758 +
1759 + procedure FBDecodeTime(aTime: TDateTime; var Hour, Minute, Second: word;
1760 +  var DeciMillisecond: cardinal);
1761 + var D : Double;
1762 +    l : cardinal;
1763 + begin
1764 +  {conversion to decimilliseconds hacked from FPC DateTimeToTimeStamp}
1765 +  D := aTime * MSecsPerDay *10;
1766 +  if D < 0 then
1767 +    D := D - 0.5
1768 +  else
1769 +    D := D + 0.5;
1770 +  {rest hacked from FPC DecodeTIme}
1771 +  l := Abs(Trunc(D)) Mod (MSecsPerDay*10);
1772 +  Hour   := l div 36000000;
1773 +  l := l mod 36000000;
1774 +  Minute := l div 600000;
1775 +  l := l mod 600000;
1776 +  Second := l div 10000;
1777 +  DeciMillisecond := l mod 10000;
1778 + end;
1779 +
1780 + {The following is similar to FPC EncodeTime except that the Firebird standard
1781 + decimilliseconds is used instead of milliseconds for fractional seconds}
1782 +
1783 + function FBEncodeTime(Hour, Minute, Second, DeciMillisecond: cardinal): TDateTime;
1784 + const DMSecsPerDay = MSecsPerDay*10;
1785 + var DMs: cardinal;
1786 +    D: Double;
1787 + begin
1788 +  if (Hour<24) and (Minute<60) and (Second<60) and (DeciMillisecond<10000) then
1789 +  begin
1790 +    DMs := Hour*36000000+Minute*600000+Second*10000+DeciMillisecond;
1791 +    D := DMs/DMSecsPerDay;
1792 +    Result:=TDateTime(d)
1793 +  end
1794 +  else
1795 +    IBError(ibxeBadTimeSpecification,[Hour, Minute, Second, DeciMillisecond]);
1796 + end;
1797 +
1798 + {The following is similar to FPC FormatDateTime except that it additionally
1799 + allows the timstamp to have a fractional seconds component with a resolution
1800 + of four decimal places. This is appended to the result for FormatDateTime
1801 + if the format string contains a "zzzz' string.}
1802 +
1803 + function FBFormatDateTime(fmt: AnsiString; aDateTime: TDateTime): AnsiString;
1804 + var Hour, Minute, Second: word;
1805 +    DeciMillisecond: cardinal;
1806 + begin
1807 +  if Pos('zzzz',fmt) > 0 then
1808 +  begin
1809 +    FBDecodeTime(aDateTime, Hour, Minute, Second, DeciMillisecond);
1810 +    fmt := StringReplace(fmt, 'zzzz', Format('%.4d',[DeciMillisecond]), [rfReplaceAll]);
1811 +  end;
1812 +  Result := FormatDateTime(fmt,aDateTime);
1813 + end;
1814 +
1815 + function FormatTimeZoneOffset(EffectiveTimeOffsetMins: integer): AnsiString;
1816 + begin
1817 +  if EffectiveTimeOffsetMins > 0 then
1818 +    Result := Format('+%.2d:%.2d',[EffectiveTimeOffsetMins div 60,abs(EffectiveTimeOffsetMins mod 60)])
1819 +  else
1820 +    Result := Format('%.2d:%.2d',[EffectiveTimeOffsetMins div 60,abs(EffectiveTimeOffsetMins mod 60)]);
1821 + end;
1822 +
1823 + function DecodeTimeZoneOffset(TZOffset: AnsiString; var dstOffset: integer): boolean;
1824 + var i: integer;
1825 + begin
1826 +  Result := false;
1827 +  TZOffset := Trim(TZOffset);
1828 +  for i := 1 to Length(TZOffset) do
1829 +    if not (TZOffset[i] in ['0'..'9','-','+',':']) then Exit;
1830 +
1831 +  Result := true;
1832 +  i := Pos(':',TZOffset);
1833 +  if i > 0 then
1834 +    dstOffset := StrToInt(copy(TZOffset,1,i-1)) * 60 + StrToInt(copy(TZOffset,i + 1))
1835 +  else
1836 +    dstOffset := StrToInt(TZOffset) * 60;
1837 + end;
1838 +
1839 + function StripLeadingZeros(Value: AnsiString): AnsiString;
1840 + var i: Integer;
1841 +    start: integer;
1842 + begin
1843 +  Result := '';
1844 +  start := 1;
1845 +  if (Length(Value) > 0) and (Value[1] = '-') then
1846 +  begin
1847 +    Result := '-';
1848 +    start := 2;
1849 +  end;
1850 +  for i := start to Length(Value) do
1851 +    if Value[i] <> '0' then
1852 +    begin
1853 +      Result := Result + system.copy(Value, i, MaxInt);
1854 +      Exit;
1855 +    end;
1856 + end;
1857 +
1858 + function TryStrToNumeric(S: Ansistring; out Value: int64; out scale: integer): boolean;
1859 + var i: integer;
1860 +    ds: integer;
1861 +    exponent: integer;
1862 + begin
1863 +  Result := false;
1864 +  ds := 0;
1865 +  exponent := 0;
1866 +  S := Trim(S);
1867 +  Value := 0;
1868 +  scale := 0;
1869 +  if Length(S) = 0 then
1870 +    Exit;
1871 +  {$IF declared(DefaultFormatSettings)}
1872 +  with DefaultFormatSettings do
1873 +  {$ELSE}
1874 +  {$IF declared(FormatSettings)}
1875 +  with FormatSettings do
1876 +  {$IFEND}
1877 +  {$IFEND}
1878 +  begin
1879 +    for i := length(S) downto 1 do
1880 +    begin
1881 +      if S[i] = AnsiChar(DecimalSeparator) then
1882 +      begin
1883 +          if ds <> 0 then Exit; {only one allowed}
1884 +          ds := i;
1885 +          dec(exponent);
1886 +          system.Delete(S,i,1);
1887 +      end
1888 +      else
1889 +      if S[i] in ['+','-'] then
1890 +      begin
1891 +       if (i > 1) and not (S[i-1] in ['e','E']) then
1892 +          Exit; {malformed}
1893 +      end
1894 +      else
1895 +      if S[i] in ['e','E'] then {scientific notation}
1896 +      begin
1897 +        if ds <> 0 then Exit; {not permitted in exponent}
1898 +        if exponent <> 0 then Exit; {only one allowed}
1899 +        exponent := i;
1900 +      end
1901 +      else
1902 +      if not (S[i] in ['0'..'9']) then
1903 +      {Note: ThousandSeparator not allowed by Delphi specs}
1904 +          Exit; {bad character}
1905 +    end;
1906 +
1907 +    if exponent > 0 then
1908 +    begin
1909 +      Result := TryStrToInt(system.copy(S,exponent+1,maxint),Scale);
1910 +      if Result then
1911 +      begin
1912 +        {adjust scale for decimal point}
1913 +        if ds <> 0 then
1914 +          Scale := Scale - (exponent - ds);
1915 +        Result := TryStrToInt64(system.copy(S,1,exponent-1),Value);
1916 +      end;
1917 +    end
1918 +    else
1919 +    begin
1920 +      if ds <> 0 then
1921 +        scale := ds - Length(S) - 1;
1922 +      Result := TryStrToInt64(S,Value);
1923 +    end;
1924 +  end;
1925 + end;
1926 +
1927 + function NumericToDouble(aValue: Int64; aScale: integer): double;
1928 + begin
1929 +  Result := aValue * IntPower(10,aScale)
1930 + end;
1931  
1932   end.

Diff Legend

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