[ViewVC] Diff of: public/ibx/branches/udr/client/IBUtils.pas

Comparing:
ibx/trunk/fbintf/IBUtils.pas (file contents), Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC vs.
ibx/branches/udr/IBUtils.pas (file contents), Revision 370 by tony, Wed Jan 5 14:59:15 2022 UTC

+{$IFDEF FPC}
+{$Mode Delphi}
+{$codepage UTF8}
-–
+{$define HASREQEX}
+{$ENDIF}
-+
+{ $IF declared(CompilerVersion) and (CompilerVersion >= 22)}
-+
+{ $define HASDELPHIREQEX}
-+
+{ $IFEND}
+interface
+uses Classes, SysUtils, IB;
-+
+{$IF not defined(LineEnding)}
-+
+const
-+
+  {$IFDEF WINDOWS}
-+
+  LineEnding = #$0D#$0A;
-+
+  {$ELSE}
-+
+  LineEnding = #$0A;
-+
+  {$ENDIF}
-+
+{$IFEND}
-+
-+
+type
-+
+  TSQLTokens = (
-+
-+
+  {Reserved Words}
-+
-+
+  sqltAdd,
-+
+  sqltAdmin,
-+
+  sqltAll,
-+
+  sqltAlter,
-+
+  sqltAnd,
-+
+  sqltAny,
-+
+  sqltAs,
-+
+  sqltAt,
-+
+  sqltAvg,
-+
+  sqltBegin,
-+
+  sqltBetween,
-+
+  sqltBigint,
-+
+  sqltBit_Length,
-+
+  sqltBlob,
-+
+  sqltBoolean,
-+
+  sqltBoth,
-+
+  sqltBy,
-+
+  sqltCase,
-+
+  sqltCast,
-+
+  sqltChar,
-+
+  sqltChar_Length,
-+
+  sqltCharacter,
-+
+  sqltCharacter_Length,
-+
+  sqltCheck,
-+
+  sqltClose,
-+
+  sqltCollate,
-+
+  sqltColumn,
-+
+  sqltCommit,
-+
+  sqltConnect,
-+
+  sqltConstraint,
-+
+  sqltCorr,
-+
+  sqltCount,
-+
+  sqltCovar_Pop,
-+
+  sqltCovar_Samp,
-+
+  sqltCreate,
-+
+  sqltCross,
-+
+  sqltCurrent,
-+
+  sqltCurrent_Connection,
-+
+  sqltCurrent_Date,
-+
+  sqltCurrent_Role,
-+
+  sqltCurrent_Time,
-+
+  sqltCurrent_Timestamp,
-+
+  sqltCurrent_Transaction,
-+
+  sqltCurrent_User,
-+
+  sqltCursor,
-+
+  sqltDate,
-+
+  sqltDay,
-+
+  sqltDec,
-+
+  sqltDecimal,
-+
+  sqltDeclare,
-+
+  sqltDefault,
-+
+  sqltDelete,
-+
+  sqltDeleting,
-+
+  sqltDeterministic,
-+
+  sqltDisconnect,
-+
+  sqltDistinct,
-+
+  sqltDouble,
-+
+  sqltDrop,
-+
+  sqltElse,
-+
+  sqltEnd,
-+
+  sqltEscape,
-+
+  sqltExecute,
-+
+  sqltExists,
-+
+  sqltExternal,
-+
+  sqltExtract,
-+
+  sqltFalse,
-+
+  sqltFetch,
-+
+  sqltFilter,
-+
+  sqltFloat,
-+
+  sqltFor,
-+
+  sqltForeign,
-+
+  sqltFrom,
-+
+  sqltFull,
-+
+  sqltFunction,
-+
+  sqltGdscode,
-+
+  sqltGlobal,
-+
+  sqltGrant,
-+
+  sqltGroup,
-+
+  sqltHaving,
-+
+  sqltHour,
-+
+  sqltIn,
-+
+  sqltIndex,
-+
+  sqltInner,
-+
+  sqltInsensitive,
-+
+  sqltInsert,
-+
+  sqltInserting,
-+
+  sqltInt,
-+
+  sqltInteger,
-+
+  sqltInto,
-+
+  sqltIs,
-+
+  sqltJoin,
-+
+  sqltKey,
-+
+  sqltLeading,
-+
+  sqltLeft,
-+
+  sqltLike,
-+
+  sqltLong,
-+
+  sqltLower,
-+
+  sqltMax,
-+
+  sqltMaximum_Segment,
-+
+  sqltMerge,
-+
+  sqltMin,
-+
+  sqltMinute,
-+
+  sqltMonth,
-+
+  sqltNational,
-+
+  sqltNatural,
-+
+  sqltNchar,
-+
+  sqltNo,
-+
+  sqltNot,
-+
+  sqltNull,
-+
+  sqltNumeric,
-+
+  sqltOctet_Length,
-+
+  sqltOf,
-+
+  sqltOffset,
-+
+  sqltOn,
-+
+  sqltOnly,
-+
+  sqltOpen,
-+
+  sqltOr,
-+
+  sqltOrder,
-+
+  sqltOuter,
-+
+  sqltOver,
-+
+  sqltParameter,
-+
+  sqltPlan,
-+
+  sqltPosition,
-+
+  sqltPost_Event,
-+
+  sqltPrecision,
-+
+  sqltPrimary,
-+
+  sqltProcedure,
-+
+  sqltRdbDb_Key,
-+
+  sqltRdbRecord_Version,
-+
+  sqltReal,
-+
+  sqltRecord_Version,
-+
+  sqltRecreate,
-+
+  sqltRecursive,
-+
+  sqltReferences,
-+
+  sqltRegr_Avgx,
-+
+  sqltRegr_Avgy,
-+
+  sqltRegr_Count,
-+
+  sqltRegr_Intercept,
-+
+  sqltRegr_R2,
-+
+  sqltRegr_Slope,
-+
+  sqltRegr_Sxx,
-+
+  sqltRegr_Sxy,
-+
+  sqltRegr_Syy,
-+
+  sqltRelease,
-+
+  sqltReturn,
-+
+  sqltReturning_Values,
-+
+  sqltReturns,
-+
+  sqltRevoke,
-+
+  sqltRight,
-+
+  sqltRollback,
-+
+  sqltRow,
-+
+  sqltRows,
-+
+  sqltRow_Count,
-+
+  sqltSavepoint,
-+
+  sqltScroll,
-+
+  sqltSecond,
-+
+  sqltSelect,
-+
+  sqltSensitive,
-+
+  sqltSet,
-+
+  sqltSimilar,
-+
+  sqltSmallint,
-+
+  sqltSome,
-+
+  sqltSqlcode,
-+
+  sqltSqlstate,
-+
+  sqltStart,
-+
+  sqltStddev_Pop,
-+
+  sqltStddev_Samp,
-+
+  sqltSum,
-+
+  sqltTable,
-+
+  sqltThen,
-+
+  sqltTime,
-+
+  sqltTimestamp,
-+
+  sqltTo,
-+
+  sqltTrailing,
-+
+  sqltTrigger,
-+
+  sqltTrim,
-+
+  sqltTrue,
-+
+  sqltUnion,
-+
+  sqltUnique,
-+
+  sqltUnknown,
-+
+  sqltUpdate,
-+
+  sqltUpdating,
-+
+  sqltUpper,
-+
+  sqltUser,
-+
+  sqltUsing,
-+
+  sqltValue,
-+
+  sqltValues,
-+
+  sqltVar_Pop,
-+
+  sqltVar_Samp,
-+
+  sqltVarchar,
-+
+  sqltVariable,
-+
+  sqltVarying,
-+
+  sqltView,
-+
+  sqltWhen,
-+
+  sqltWhere,
-+
+  sqltWhile,
-+
+  sqltWith,
-+
+  sqltYear,
-+
-+
+  {symbols}
-+
-+
+  sqltSpace,
-+
+  sqltSemiColon,
-+
+  sqltPlaceholder,
-+
+  sqltSingleQuotes,
-+
+  sqltDoubleQuotes,
-+
+  sqltBackslash,
-+
+  sqltComma,
-+
+  sqltPeriod,
-+
+  sqltEquals,
-+
+  sqltOtherCharacter,
-+
+  sqltIdentifier,
-+
+  sqltIdentifierInDoubleQuotes,
-+
+  sqltNumberString,
-+
+  sqltString,
-+
+  sqltParam,
-+
+  sqltQuotedParam,
-+
+  sqltColon,
-+
+  sqltComment,
-+
+  sqltCommentLine,
-+
+  sqltQuotedString,
-+
+  sqltAsterisk,
-+
+  sqltForwardSlash,
-+
+  sqltOpenSquareBracket,
-+
+  sqltCloseSquareBracket,
-+
+  sqltOpenBracket,
-+
+  sqltCloseBracket,
-+
+  sqltPipe,
-+
+  sqltMinus,
-+
+  sqltConcatSymbol,
-+
+  sqltLT,
-+
+  sqltGT,
-+
+  sqltCR,
-+
+  sqltEOL,
-+
+  sqltEOF,
-+
+  sqltInit
-+
+  );
-+
-+
+  TSQLReservedWords = sqltAdd..sqltYear;
-+
+const
+  CRLF = #13 + #10;
+  CR   = #13;
+  TAB  = #9;
+  NULL_TERMINATOR = #0;
-<
+  sqlReservedWords: array [0..197] of string = (
->
+  {SQL Reserved words in alphabetical order}
->
->
+  sqlReservedWords: array [TSQLReservedWords] of string = (
+  'ADD',
+  'ADMIN',
+  'ALL',
+  'INTO',
+  'IS',
+  'JOIN',
-+
+  'KEY',
+  'LEADING',
+  'LEFT',
+  'LIKE',
+  'RIGHT',
+  'ROLLBACK',
+  'ROW',
-–
+  'ROW_COUNT',
+  'ROWS',
-+
+  'ROW_COUNT',
+  'SAVEPOINT',
+  'SCROLL',
+  'SECOND',
+  'SOME',
+  'SQLCODE',
+  'SQLSTATE',
-–
+  'SQLSTATE',
+  'START',
+  'STDDEV_POP',
+  'STDDEV_SAMP',
+  'YEAR'
+  );
-+
+type
-+
+  {The TSQLTokeniser class provides a common means to parse an SQL statement, or
-+
+   even a stream of SQL Statements. The TSQLStringTokeniser class is instantiated
-+
+   with a single SQL statement or a set of concatenated statements. The TSQLStreamTokeniser
-+
+   is instantiated with a stream from which the SQL statements are read.
-+
-+
+   Successive calls to GetNextToken then return each SQL token. The TokenText contains
-+
+   either the single character, the identifier or reserved word, the string or comment.}
-+
-+
+  { TSQLTokeniser }
-+
-+
+  TSQLTokeniser = class
-+
+  private
-+
+    const
-+
+      TokenQueueMaxSize = 64;
-+
+    type
-+
+      TLexState = (stDefault, stInCommentLine, stInComment, stSingleQuoted, stDoubleQuoted,
-+
+                   stInIdentifier, stInNumeric);
-+
-+
+      TTokenQueueItem = record
-+
+                          token: TSQLTokens;
-+
+                          text: AnsiString;
-+
+                        end;
-+
+      TTokenQueueState = (tsHold, tsRelease);
-+
-+
+  private
-+
+    FLastChar: AnsiChar;
-+
+    FState: TLexState;
-+
+    FSkipNext: boolean;
-+
+    function GetNext: TSQLTokens;
-+
-+
+    {The token Queue is available for use by descendents so that they can
-+
+     hold back tokens in order to lookahead by token rather than just a single
-+
+     character}
-+
-+
+  private
-+
+    FTokenQueue: array[0..TokenQueueMaxSize] of TTokenQueueItem;
-+
+    FQueueState: TTokenQueueState;
-+
+    FQFirst: integer;  {first and last pointers first=last => queue empty}
-+
+    FQLast: integer;
-+
+    FEOF: boolean;
-+
+    procedure PopQueue(var token: TSQLTokens);
-+
+  protected
-+
+    FString: AnsiString;
-+
+    FNextToken: TSQLTokens;
-+
+    procedure Assign(source: TSQLTokeniser); virtual;
-+
+    function GetChar: AnsiChar; virtual; abstract;
-+
+    function TokenFound(var token: TSQLTokens): boolean; virtual;
-+
+    function InternalGetNextToken: TSQLTokens; virtual;
-+
+    procedure Reset; virtual;
-+
+    function ReadCharacters(NumOfChars: integer): AnsiString;
-+
-+
+    {Token stack}
-+
+    procedure QueueToken(token: TSQLTokens; text:AnsiString); overload;
-+
+    procedure QueueToken(token: TSQLTokens); overload;
-+
+    procedure ResetQueue; overload;
-+
+    procedure ResetQueue(token: TSQLTokens; text:AnsiString); overload;
-+
+    procedure ResetQueue(token: TSQLTokens); overload;
-+
+    procedure ReleaseQueue(var token: TSQLTokens); overload;
-+
+    procedure ReleaseQueue; overload;
-+
+    function GetQueuedText: AnsiString;
-+
+    procedure SetTokenText(text: AnsiString);
-+
-+
+  public
-+
+    const
-+
+        DefaultTerminator = ';';
-+
+  public
-+
+    constructor Create;
-+
+    destructor Destroy; override;
-+
+    function GetNextToken: TSQLTokens;
-+
+    property EOF: boolean read FEOF;
-+
+    property TokenText: AnsiString read FString;
-+
+  end;
-+
-+
+  { TSQLwithNamedParamsTokeniser }
-+
-+
+  TSQLwithNamedParamsTokeniser = class(TSQLTokeniser)
-+
+  private
-+
+    type
-+
+      TSQLState = (stInit,stInParam,stInBlock, stInArrayDim);
-+
+  private
-+
+    FState: TSQLState;
-+
+    FNested: integer;
-+
+  protected
-+
+    procedure Assign(source: TSQLTokeniser); override;
-+
+    procedure Reset; override;
-+
+    function TokenFound(var token: TSQLTokens): boolean; override;
-+
+  end;
-+
-+
+    { TSQLParamProcessor }
-+
-+
+  TSQLParamProcessor = class(TSQLwithNamedParamsTokeniser)
-+
+  private
-+
+  const
-+
+    sIBXParam = 'IBXParam';  {do not localize}
-+
+  private
-+
+    FInString: AnsiString;
-+
+    FIndex: integer;
-+
+    function DoExecute(GenerateParamNames: boolean;
-+
+        var slNames: TStrings): AnsiString;
-+
+  protected
-+
+    function GetChar: AnsiChar; override;
-+
+  public
-+
+    class function Execute(sSQL: AnsiString; GenerateParamNames: boolean;
-+
+        var slNames: TStrings): AnsiString;
-+
+  end;
-+
-+
+  TOnProgressEvent = procedure (Sender: TObject; Reset: boolean; value: integer) of object;
-+
-+
+  { TSQLXMLReader - used to save and read back blob and array data in a pseudo XML format}
-+
-+
+  TSQLXMLReader = class(TSQLTokeniser)
-+
+  private
-+
+      type
-+
+        TXMLStates =  (stNoXML, stInTag,stInTagBody,
-+
+                       stAttribute,stAttributeValue,stQuotedAttributeValue,
-+
+                       stInEndTag, stInEndTagBody,
-+
+                       stXMLData);
-+
-+
+        TXMLTag    =   (xtNone,xtBlob,xtArray,xtElt);
-+
-+
+        TXMLTagDef = record
-+
+          XMLTag: TXMLTag;
-+
+          TagValue: string;
-+
+        end;
-+
-+
+      const
-+
+        XMLTagDefs: array [xtBlob..xtElt] of TXMLTagDef = (
-+
+          (XMLTag: xtBlob;   TagValue: 'blob'),
-+
+          (XMLTag: xtArray;  TagValue: 'array'),
-+
+          (XMLTag: xtElt;    TagValue: 'elt')
-+
+          );
-+
+        MaxXMLTags = 20;
-+
+        BlobLineLength = 40;
-+
-+
+    public
-+
+      const
-+
+        ibx_blob = 'IBX_BLOB';
-+
+        ibx_array = 'IBX_ARRAY';
-+
-+
+      type
-+
+        TBlobData = record
-+
+          BlobIntf: IBlob;
-+
+          SubType: cardinal;
-+
+        end;
-+
-+
+        TArrayData = record
-+
+          ArrayIntf: IArray;
-+
+          SQLType: cardinal;
-+
+          relationName: string;
-+
+          columnName: string;
-+
+          dim: cardinal;
-+
+          Size: cardinal;
-+
+          Scale: integer;
-+
+          CharSet: string;
-+
+          bounds: TArrayBounds;
-+
+          CurrentRow: integer;
-+
+          Index: array of integer;
-+
+        end;
-+
-+
+  private
-+
+    FOnProgressEvent: TOnProgressEvent;
-+
+    FXMLState: TXMLStates;
-+
+    FXMLTagStack: array [1..MaxXMLTags] of TXMLTag;
-+
+    FXMLTagIndex: integer;
-+
+    FAttributeName: string;
-+
+    FBlobData: array of TBlobData;
-+
+    FCurrentBlob: integer;
-+
+    FBlobBuffer: PByte;
-+
+    FArrayData: array of TArrayData;
-+
+    FCurrentArray: integer;
-+
+    FXMLString: string;
-+
+    function FindTag(tag: string; var xmlTag: TXMLTag): boolean;
-+
+    function GetArrayData(index: integer): TArrayData;
-+
+    function GetArrayDataCount: integer;
-+
+    function GetBlobData(index: integer): TBlobData;
-+
+    function GetBlobDataCount: integer;
-+
+    function GetTagName(xmltag: TXMLTag): string;
-+
+    procedure ProcessAttributeValue(attrValue: string);
-+
+    procedure ProcessBoundsList(boundsList: string);
-+
+    procedure ProcessTagValue(tagValue: string);
-+
+    procedure XMLTagInit(xmltag: TXMLTag);
-+
+    function XMLTagEnd(var xmltag: TXMLTag): boolean;
-+
+    procedure XMLTagEnter;
-+
+  protected
-+
+    function GetAttachment: IAttachment; virtual; abstract;
-+
+    function GetTransaction: ITransaction; virtual; abstract;
-+
+    function GetErrorPrefix: string; virtual; abstract;
-+
+    function TokenFound(var token: TSQLTokens): boolean; override;
-+
+    procedure Reset; override;
-+
+    procedure ShowError(msg: string; params: array of const); overload; virtual;
-+
+    procedure ShowError(msg: string); overload;
-+
+  public
-+
+    constructor Create;
-+
+    procedure FreeDataObjects;
-+
+    class function FormatBlob(Field: ISQLData): string; overload;
-+
+    class function FormatBlob(contents: string; subtype:integer): string; overload;
-+
+    class function FormatArray(ar: IArray): string;
-+
+    property BlobData[index: integer]: TBlobData read GetBlobData;
-+
+    property BlobDataCount: integer read GetBlobDataCount;
-+
+    property ArrayData[index: integer]: TArrayData read GetArrayData;
-+
+    property ArrayDataCount: integer read GetArrayDataCount;
-+
+    property Attachment: IAttachment read GetAttachment;
-+
+    property Transaction: ITransaction read GetTransaction;
-+
+    property OnProgressEvent: TOnProgressEvent read FOnProgressEvent write FOnProgressEvent; {Progress Bar Support}
-+
+ end;
-+
-+
+ TJnlEntryType = (jeTransStart, jeTransCommit, jeTransCommitRet, jeTransRollback,
-+
+                   jeTransRollbackRet, jeTransEnd, jeQuery,jeUnknown);
-+
-+
+ TJnlEntry = record
-+
+   JnlEntryType: TJnlEntryType;
-+
+   Timestamp: TDateTime;
-+
+   SessionID: integer;
-+
+   TransactionID: integer;
-+
+   OldTransactionID: integer;
-+
+   TransactionName: AnsiString;
-+
+   TPB: ITPB;
-+
+   DefaultCompletion: TTransactionCompletion;
-+
+   QueryText: AnsiString;
-+
+ end;
-+
-+
+ TOnNextJournalEntry = procedure(JnlEntry: TJnlEntry) of object;
-+
-+
+ { TJournalProcessor - used to parse a client side journal}
-+
-+
+   TJournalProcessor = class(TSQLTokeniser)
-+
+    private
-+
+      type TLineState = (lsInit, lsJnlFound, lsGotTimestamp, lsGotJnlType,  lsGotSessionID,
-+
+                          lsGotTransactionID,  lsGotOldTransactionID, lsGotText1Length,
-+
+                          lsGotText1, lsGotText2Length, lsGotText2);
-+
+    private
-+
+      FOnNextJournalEntry: TOnNextJournalEntry;
-+
+      FInStream: TStream;
-+
+      FFirebirdClientAPI: IFirebirdAPI;
-+
+      procedure DoExecute;
-+
+      function IdentifyJnlEntry(aTokenText: AnsiString): TJnlEntryType;
-+
+    protected
-+
+      function GetChar: AnsiChar; override;
-+
+      property OnNextJournalEntry: TOnNextJournalEntry read FOnNextJournalEntry write FOnNextJournalEntry;
-+
+    public
-+
+      destructor Destroy; override;
-+
+      class procedure Execute( aFileName: string; api: IFirebirdAPI; aOnNextJournalEntry: TOnNextJournalEntry);
-+
+      class function JnlEntryText(je: TJnlEntryType): string;
-+
+    end;
-+
-+
+function Max(n1, n2: Integer): Integer;
+function Min(n1, n2: Integer): Integer;
+function RandomString(iLength: Integer): AnsiString;
+function RandomInteger(iLow, iHigh: Integer): Integer;
+function StripString(st: AnsiString; CharsToStrip: AnsiString): AnsiString;
+function ExtractIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
-+
+function FindReservedWord(w: AnsiString; var token: TSQLTokens): boolean;
-+
+function IsReservedWord(w: AnsiString): boolean;
+function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
+function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
+function Space2Underscore(s: AnsiString): AnsiString;
+              var PortNo: AnsiString): boolean;
+function GetProtocol(ConnectString: AnsiString): TProtocolAll;
-+
+{$IF declared(TFormatSettings)}
-+
+function ParseDateTimeTZString(aDateTimeStr: Ansistring; var aDateTime: TDateTime;
-+
+              var aTimezone: AnsiString; aFormatSettings: TFormatSettings; TimeOnly: boolean=false): boolean; overload;
-+
+{$IFEND}
-+
+function ParseDateTimeTZString(aDateTimeStr: Ansistring; var aDateTime: TDateTime;
-+
+              var aTimezone: AnsiString; TimeOnly: boolean=false): boolean;  overload;
-+
+procedure FBDecodeTime(aTime: TDateTime; var Hour, Minute, Second: word; var DeciMillisecond: cardinal);
-+
+function FBEncodeTime(Hour, Minute, Second, DeciMillisecond: cardinal): TDateTime;
-+
+function FBFormatDateTime(fmt: AnsiString; aDateTime: TDateTime): AnsiString;
-+
+function FormatTimeZoneOffset(EffectiveTimeOffsetMins: integer): AnsiString;
-+
+function DecodeTimeZoneOffset(TZOffset: AnsiString; var dstOffset: integer): boolean;
-+
+function StripLeadingZeros(Value: AnsiString): AnsiString;
-+
+function TryStrToNumeric(S: Ansistring; out Value: int64; out scale: integer): boolean;
-+
+function NumericToDouble(aValue: Int64; aScale: integer): double;
-+
+function StringToHex(octetString: string; MaxLineLength: integer=0): string; overload;
-+
+procedure StringToHex(octetString: string; TextOut: TStrings; MaxLineLength: integer=0); overload;
-+
-+
+implementation
-<
+{$IFDEF HASREQEX}
-<
+uses RegExpr;
-<
+{$ENDIF}
->
+uses FBMessages, Math
->
->
+{$IFDEF FPC}
->
+,RegExpr
->
+{$ELSE}
->
+{$IF declared(CompilerVersion) and (CompilerVersion >= 22)}
->
+, RegularExpressions
->
+{$IFEND}
->
+{$ENDIF};
->
->
+resourcestring
->
+  sXMLStackUnderflow = 'XML Stack Underflow';
->
+  sInvalidEndTag = 'XML End Tag Mismatch - %s';
->
+  sBadEndTagClosing = 'XML End Tag incorrectly closed';
->
+  sXMLStackOverFlow = 'XML Stack Overflow';
->
+  sXMLAttributeError = 'Unexpected attribute - "%s" = "%s"';
->
+  sInvalidBoundsList = 'Invalid array bounds list - "%s"';
->
+  sBinaryBlockMustbeEven = 'Binary block must have an even number of characters';
->
+  sArrayIndexError = 'Array Index Error (%d)';
->
+  sBlobIndexError = 'Blob Index Error (%d)';
->
+  sNoDatabase = 'Missing database for xml tag import';
->
+  sNoTransaction = 'Missing transaction for xml tag import';
->
+function Max(n1, n2: Integer): Integer;
+begin
+  Result := Value;
+end;
-+
+{Returns true if "w" is a Firebird SQL reserved word, and the
-+
+ corresponding TSQLTokens value.}
-+
-+
+function FindReservedWord(w: AnsiString; var token: TSQLTokens): boolean;
-+
+var i: TSQLTokens;
-+
+begin
-+
+   Result := true;
-+
+   w := AnsiUpperCase(Trim(w));
-+
+   for i := Low(TSQLReservedWords) to High(TSQLReservedWords) do
-+
+   begin
-+
+       if w = sqlReservedWords[i] then
-+
+       begin
-+
+         token := i;
-+
+         Exit;
-+
+       end;
-+
+       if w <  sqlReservedWords[i] then
-+
+         break;
-+
+   end;
-+
+   Result := false;
-+
+end;
-+
+{Returns true if "w" is a Firebird SQL reserved word}
+function IsReservedWord(w: AnsiString): boolean;
-<
+var i: integer;
->
+var token: TSQLTokens;
+begin
-<
+     Result := true;
-<
+     for i := 0 to Length(sqlReservedWords) - 1 do
-<
+         if w = sqlReservedWords[i] then
-<
+            Exit;
-<
+     Result := false;
->
+  Result := FindReservedWord(w,token);
+end;
+{Format an SQL Identifier according to SQL Dialect}
+function QuoteIdentifier(Dialect: Integer; Value: AnsiString): AnsiString;
+begin
-+
+  Value := TrimRight(Value);
+  if Dialect = 1 then
-<
+    Value := AnsiUpperCase(Trim(Value))
->
+    Value := AnsiUpperCase(Value)
+  else
+    Value := '"' + StringReplace (Value, '""', '"', [rfReplaceAll]) + '"';
+  Result := Value;
+  Result := true;
+end;
-+
+function SchemeToProtocol(scheme: AnsiString): TProtocolAll;
-+
+begin
-+
+  scheme := AnsiUpperCase(scheme);
-+
+  if scheme = 'INET' then
-+
+    Result := inet
-+
+  else
-+
+  if scheme = 'INET4' then
-+
+    Result := inet4
-+
+  else
-+
+  if scheme = 'INET6' then
-+
+    Result := inet6
-+
+  else
-+
+  if scheme = 'XNET' then
-+
+    Result := xnet
-+
+  else
-+
+  if scheme = 'WNET' then
-+
+    Result := wnet
-+
+end;
-+
+{Extracts the Database Connect string from a Create Database Statement}
-<
+{$IFDEF HASREQEX}
->
+{$IF declared(TRegexpr)}
+function ExtractConnectString(const CreateSQL: AnsiString;
+  var ConnectString: AnsiString): boolean;
+var RegexObj: TRegExpr;
+function ParseConnectString(ConnectString: AnsiString; var ServerName,
+  DatabaseName: AnsiString; var Protocol: TProtocolAll; var PortNo: AnsiString
+  ): boolean;
-+
+var RegexObj: TRegExpr;
-–
+    scheme: AnsiString;
+begin
+  ServerName := '';
+  DatabaseName := ConnectString;
+  try
+    {extact database file spec}
+    RegexObj.ModifierG := false; {turn off greedy matches}
-<
+    RegexObj.Expression := '^([a-zA-Z]+)://([a-zA-Z0-9\-\.]+)(|:[0-9a-zA-Z\-]+)/(.*)$';
->
+    RegexObj.Expression := '^([a-zA-Z46]+)://([a-zA-Z0-9\-\.]*)(|:[0-9a-zA-Z\-]+)/(.*)$';
+    Result := RegexObj.Exec(ConnectString);
+    if Result then
+    begin
+      {URL type connect string}
-<
+      scheme := AnsiUpperCase(RegexObj.Match[1]);
->
+      Protocol := SchemeToProtocol(RegexObj.Match[1]);
+      ServerName := RegexObj.Match[2];
+      if RegexObj.MatchLen[3] > 0 then
+        PortNo := system.Copy(ConnectString,RegexObj.MatchPos[3]+1,RegexObj.MatchLen[3]-1);
+      DatabaseName := RegexObj.Match[4];
-<
+      if scheme = 'INET' then
-<
+        Protocol := inet
-<
+      else
-<
+      if scheme = 'XNET' then
-<
+        Protocol := xnet
-<
+      else
-<
+      if scheme = 'WNET' then
-<
+        Protocol := wnet
->
+      if ServerName = '' then
->
+        DatabaseName := '/' + DatabaseName;
+    end
+    else
+    begin
-<
+      RegexObj.Expression := '^([a-zA-Z]:\\.*)';
->
+      {URL type connect string - local loop}
->
+      RegexObj.Expression := '^([a-zA-Z46]+)://(.*)$';
+      Result := RegexObj.Exec(ConnectString);
+      if Result then
-<
+        Protocol := Local {Windows with leading drive ID}
->
+      begin
->
+        Protocol := SchemeToProtocol(RegexObj.Match[1]);
->
+        DatabaseName := RegexObj.Match[2];
->
+      end
+      else
+      begin
-<
+        RegexObj.Expression := '^([a-zA-Z0-9\-\.]+)(|/[0-9a-zA-Z\-]+):(.*)$';
->
+        RegexObj.Expression := '^([a-zA-Z]:\\.*)';
+        Result := RegexObj.Exec(ConnectString);
+        if Result then
-<
+        begin
-<
+          {Legacy TCP Format}
-<
+          ServerName := RegexObj.Match[1];
-<
+          if RegexObj.MatchLen[2] > 0 then
-<
+            PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
-<
+          DatabaseName := RegexObj.Match[3];
-<
+          Protocol := TCP;
-<
+        end
->
+          Protocol := Local {Windows with leading drive ID}
+        else
+        begin
-<
+          RegexObj.Expression := '^\\\\([a-zA-Z0-9\-\.]+)(|@[0-9a-zA-Z\-]+)\\(.*)$';
->
+          RegexObj.Expression := '^([a-zA-Z0-9\-\.]+)(|/[0-9a-zA-Z\-]+):(.*)$';
+          Result := RegexObj.Exec(ConnectString);
+          if Result then
+          begin
-<
+            {Netbui}
->
+            {Legacy TCP Format}
+            ServerName := RegexObj.Match[1];
+            if RegexObj.MatchLen[2] > 0 then
+              PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
+            DatabaseName := RegexObj.Match[3];
-<
+            Protocol := NamedPipe
->
+            Protocol := TCP;
+          end
+          else
+          begin
-<
+            Result := true;
-<
+            Protocol := Local; {Assume local}
->
+            RegexObj.Expression := '^\\\\([a-zA-Z0-9\-\.]+)(|@[0-9a-zA-Z\-]+)\\(.*)$';
->
+            Result := RegexObj.Exec(ConnectString);
->
+            if Result then
->
+            begin
->
+              {Netbui}
->
+              ServerName := RegexObj.Match[1];
->
+              if RegexObj.MatchLen[2] > 0 then
->
+                PortNo := system.Copy(ConnectString,RegexObj.MatchPos[2]+1,RegexObj.MatchLen[2]-1);
->
+              DatabaseName := RegexObj.Match[3];
->
+              Protocol := NamedPipe
->
+            end
->
+            else
->
+            begin
->
+              Result := true;
->
+              Protocol := Local; {Assume local}
->
+            end;
+          end;
+        end;
+      end;
+  end;
+end;
-<
+function GetProtocol(ConnectString: AnsiString): TProtocolAll;
-<
+var ServerName,
-<
+    DatabaseName: AnsiString;
-<
+    PortNo: AnsiString;
->
+{$ELSE}
->
+{$IF declared(TRegex)}
->
+function ExtractConnectString(const CreateSQL: AnsiString;
->
+  var ConnectString: AnsiString): boolean;
->
+var Regex: TRegEx;
->
+    Match: TMatch;
+begin
-<
+  ParseConnectString(ConnectString,ServerName,DatabaseName,Result,PortNo);
->
+  Regex := TRegEx.Create('^ *CREATE +(DATABASE|SCHEMA) +''(.*)''',[roIgnoreCase]);
->
+  {extact database file spec}
->
+  Match := Regex.Match(CreateSQL);
->
+  Result := Match.Success and (Match.Groups.Count = 3);
->
+  if Result then
->
+    ConnectString := Match.Groups[2].Value;
+end;
-+
+function ParseConnectString(ConnectString: AnsiString; var ServerName,
-+
+  DatabaseName: AnsiString; var Protocol: TProtocolAll; var PortNo: AnsiString
-+
+  ): boolean;
-+
-+
+var Regex: TRegEx;
-+
+    Match: TMatch;
-+
+begin
-+
+  ServerName := '';
-+
+  DatabaseName := ConnectString;
-+
+  PortNo := '';
-+
+  Protocol := unknownProtocol;
-+
+  {extact database file spec}
-+
+  Match := Regex.Match(ConnectString,'^([a-zA-Z46]+)://([a-zA-Z0-9\-\.]*)(|:[0-9a-zA-Z\-]+)/(.*)$',[roIgnoreCase]);
-+
+  Result := Match.Success and (Match.Groups.Count = 5);
-+
+  if Result then
-+
+  begin
-+
+    {URL type connect string}
-+
+    Protocol := SchemeToProtocol(Match.Groups[1].Value);
-+
+    ServerName := Match.Groups[2].Value;
-+
+    PortNo := Match.Groups[3].Value;
-+
+    DatabaseName := Match.Groups[4].Value;
-+
+    if ServerName = '' then
-+
+      DatabaseName := '/' + DatabaseName;
-+
+  end
-+
+  else
-+
+  begin
-+
+    {URL type connect string - local loop}
-+
+    Match := Regex.Match(ConnectString,'^([a-zA-Z46]+)://(.*)$',[roIgnoreCase]);
-+
+    Result := Match.Success and (Match.Groups.Count = 3);
-+
+    if Result then
-+
+    begin
-+
+      Protocol := SchemeToProtocol(Match.Groups[1].Value);
-+
+      DatabaseName := Match.Groups[2].Value;
-+
+    end
-+
+    else
-+
+    begin
-+
+      Match := Regex.Match(ConnectString,'^([a-zA-Z]:\\.*)',[roIgnoreCase]);
-+
+      Result := Match.Success;
-+
+      if Result then
-+
+        Protocol := Local {Windows with leading drive ID}
-+
+      else
-+
+      begin
-+
+        Match := Regex.Match(ConnectString,'^([a-zA-Z0-9\-\.]+)(|/[0-9a-zA-Z\-]+):(.*)$',[roIgnoreCase]);
-+
+        Result := Match.Success and (Match.Groups.Count = 4);
-+
+        if Result then
-+
+        begin
-+
+          {Legacy TCP Format}
-+
+          ServerName := Match.Groups[1].Value;
-+
+          PortNo := Match.Groups[2].Value;
-+
+          DatabaseName := Match.Groups[3].Value;
-+
+          Protocol := TCP;
-+
+        end
-+
+        else
-+
+        begin
-+
+          Match := Regex.Match(ConnectString,'^\\\\([a-zA-Z0-9\-\.]+)(|@[0-9a-zA-Z\-]+)\\(.*)$',[roIgnoreCase]);
-+
+          Result := Match.Success and (Match.Groups.Count = 4);
-+
+          if Result then
-+
+          begin
-+
+            {Netbui}
-+
+            ServerName := Match.Groups[1].Value;
-+
+            PortNo := Match.Groups[2].Value;
-+
+            DatabaseName := Match.Groups[3].Value;
-+
+            Protocol := NamedPipe
-+
+          end
-+
+          else
-+
+          begin
-+
+            Result := true;
-+
+            Protocol := Local; {Assume local}
-+
+          end;
-+
+        end;
-+
+      end;
-+
+    end;
-+
+  end;
-+
+end;
+{$ELSE}
-<
+{cruder version of above for Delphi. Older versions lack regular expression
->
+{cruder version of above for Delphi < XE. Older versions lack regular expression
+ handling.}
+function ExtractConnectString(const CreateSQL: AnsiString;
+  var ConnectString: AnsiString): boolean;
+  end;
+end;
-–
+function GetProtocol(ConnectString: AnsiString): TProtocolAll;
-–
+begin
-–
+  Result := unknownProtocol; {not implemented for Delphi}
-–
+end;
-–
+function ParseConnectString(ConnectString: AnsiString;
+              var ServerName, DatabaseName: AnsiString; var Protocol: TProtocolAll;
+              var PortNo: AnsiString): boolean;
+  Result := false;
+end;
-<
+{$ENDIF}
->
+{$IFEND}
->
+{$IFEND}
->
->
+function GetProtocol(ConnectString: AnsiString): TProtocolAll;
->
+var ServerName,
->
+    DatabaseName: AnsiString;
->
+    PortNo: AnsiString;
->
+begin
->
+  if not ParseConnectString(ConnectString,ServerName,DatabaseName,Result,PortNo) then
->
+    Result := unknownProtocol;
->
+end;
+{Make a connect string in format appropriate protocol}
+function MakeConnectString(ServerName, DatabaseName: AnsiString;
+  Protocol: TProtocol; PortNo: AnsiString): AnsiString;
-+
-+
+  function FormatURL: AnsiString;
-+
+  begin
-+
+    if (ServerName = '') and (Pos('/',DatabaseName) <= 1) then
-+
+      Result := DatabaseName
-+
+    else
-+
+      Result := ServerName + '/' + DatabaseName;
-+
+  end;
-+
+begin
-+
+  if ServerName = '' then ServerName := 'localhost';
+  if PortNo <> '' then
+    case Protocol of
+    NamedPipe:
+    SPX:        Result := ServerName + '@' + DatabaseName; {do not localize}
+    NamedPipe:  Result := '\\' + ServerName + '\' + DatabaseName; {do not localize}
+    Local:      Result := DatabaseName; {do not localize}
-<
+    inet:       Result := 'inet://' + ServerName + '/'+ DatabaseName; {do not localize}
-<
+    wnet:       Result := 'wnet://' + ServerName + '/'+ DatabaseName; {do not localize}
-<
+    xnet:       Result := 'xnet://' + ServerName + '/'+ DatabaseName;  {do not localize}
->
+    inet:       Result := 'inet://' + FormatURL; {do not localize}
->
+    inet4:       Result := 'inet4://' + FormatURL; {do not localize}
->
+    inet6:       Result := 'inet6://' + FormatURL; {do not localize}
->
+    wnet:       Result := 'wnet://' + FormatURL; {do not localize}
->
+    xnet:       Result := 'xnet://' + FormatURL;  {do not localize}
+  end;
+end;
+function QuoteIdentifierIfNeeded(Dialect: Integer; Value: AnsiString): AnsiString;
+begin
-+
+  Value := TrimRight(Value);
+  if (Dialect = 3) and
+    (IsReservedWord(Value) or not IsSQLIdentifier(Value) or (AnsiUpperCase(Value) <> Value)) then
+     Result := '"' + StringReplace (TrimRight(Value), '"', '""', [rfReplaceAll]) + '"'
+  Result := StringReplace(s,'''','''''',[rfReplaceAll]);
+end;
-+
+{ TSQLParamProcessor }
-+
-+
+function TSQLParamProcessor.DoExecute(GenerateParamNames: boolean;
-+
+  var slNames: TStrings): AnsiString;
-+
+var token: TSQLTokens;
-+
+    iParamSuffix: Integer;
-+
+begin
-+
+  Result := '';
-+
+  iParamSuffix := 0;
-+
-+
+  while not EOF do
-+
+  begin
-+
+    token := GetNextToken;
-+
+    case token of
-+
+    sqltParam,
-+
+    sqltQuotedParam:
-+
+      begin
-+
+        Result := Result + '?';
-+
+        slNames.Add(TokenText);
-+
+      end;
-+
-+
+    sqltPlaceHolder:
-+
+      if GenerateParamNames then
-+
+      begin
-+
+        Inc(iParamSuffix);
-+
+        slNames.AddObject(sIBXParam + IntToStr(iParamSuffix),self); //Note local convention
-+
+                                            //add pointer to self to mark entry
-+
+        Result := Result + '?';
-+
+      end
-+
+      else
-+
+        IBError(ibxeSQLParseError, [SParamNameExpected]);
-+
-+
+    sqltQuotedString:
-+
+      Result := Result + '''' + SQLSafeString(TokenText) + '''';
-+
-+
+    sqltIdentifierInDoubleQuotes:
-+
+      Result := Result + '"' + StringReplace(TokenText,'"','""',[rfReplaceAll]) + '"';
-+
-+
+    sqltComment:
-+
+      Result := Result + '/*' + TokenText + '*/';
-+
-+
+    sqltCommentLine:
-+
+      Result := Result + '--' + TokenText + LineEnding;
-+
-+
+    sqltEOL:
-+
+      Result := Result + LineEnding;
-+
-+
+    else
-+
+      Result := Result + TokenText;
-+
+    end;
-+
+  end;
-+
+end;
-+
-+
+function TSQLParamProcessor.GetChar: AnsiChar;
-+
+begin
-+
+  if FIndex <= Length(FInString) then
-+
+  begin
-+
+    Result := FInString[FIndex];
-+
+    Inc(FIndex);
-+
+  end
-+
+  else
-+
+    Result := #0;
-+
+end;
-+
-+
+class function TSQLParamProcessor.Execute(sSQL: AnsiString;
-+
+  GenerateParamNames: boolean; var slNames: TStrings): AnsiString;
-+
+begin
-+
+  with self.Create do
-+
+  try
-+
+    FInString := sSQL;
-+
+    FIndex := 1;
-+
+    Result := DoExecute(GenerateParamNames,slNames);
-+
+  finally
-+
+    Free;
-+
+  end;
-+
+end;
-+
-+
+{ TSQLwithNamedParamsTokeniser }
-+
-+
+procedure TSQLwithNamedParamsTokeniser.Assign(source: TSQLTokeniser);
-+
+begin
-+
+  inherited Assign(source);
-+
+  if source is TSQLwithNamedParamsTokeniser then
-+
+  begin
-+
+    FState := TSQLwithNamedParamsTokeniser(source).FState;
-+
+    FNested := TSQLwithNamedParamsTokeniser(source).FNested;
-+
+  end;
-+
+end;
-+
-+
+procedure TSQLwithNamedParamsTokeniser.Reset;
-+
+begin
-+
+  inherited Reset;
-+
+  FState := stInit;
-+
+  FNested := 0;
-+
+end;
-+
-+
+function TSQLwithNamedParamsTokeniser.TokenFound(var token: TSQLTokens
-+
+  ): boolean;
-+
+begin
-+
+  Result := inherited TokenFound(token);
-+
+  if not Result then Exit;
-+
-+
+  case FState of
-+
+  stInit:
-+
+    begin
-+
+      case token of
-+
+      sqltColon:
-+
+        begin
-+
+          FState := stInParam;
-+
+          ResetQueue(token);
-+
+        end;
-+
-+
+      sqltBegin:
-+
+        begin
-+
+          FState := stInBlock;
-+
+          FNested := 1;
-+
+        end;
-+
-+
+      sqltOpenSquareBracket:
-+
+          FState := stInArrayDim;
-+
-+
+      end;
-+
+    end;
-+
-+
+  stInParam:
-+
+    begin
-+
+      case token of
-+
+      sqltIdentifier:
-+
+        token := sqltParam;
-+
-+
+      sqltIdentifierInDoubleQuotes:
-+
+        token := sqltQuotedParam;
-+
-+
+      else
-+
+        begin
-+
+          QueueToken(token);
-+
+          ReleaseQueue(token);
-+
+        end;
-+
+      end;
-+
+      FState := stInit;
-+
+    end;
-+
-+
+  stInBlock:
-+
+    begin
-+
+      case token of
-+
+      sqltBegin,
-+
+      sqltCase:
-+
+          Inc(FNested);
-+
-+
+      sqltEnd:
-+
+        begin
-+
+          Dec(FNested);
-+
+          if FNested = 0 then
-+
+            FState := stInit;
-+
+        end;
-+
+      end;
-+
+    end;
-+
-+
+    stInArrayDim:
-+
+      begin
-+
+        if token = sqltCloseSquareBracket then
-+
+            FState := stInit;
-+
+      end;
-+
+    end;
-+
-+
+  Result := (FState <> stInParam);
-+
+end;
-+
-+
+{ TSQLTokeniser }
-+
-+
+function TSQLTokeniser.GetNext: TSQLTokens;
-+
+var C: AnsiChar;
-+
+begin
-+
+  if EOF then
-+
+    Result := sqltEOF
-+
+  else
-+
+  begin
-+
+    C := GetChar;
-+
+    case C of
-+
+    #0:
-+
+      Result := sqltEOF;
-+
+    ' ',TAB:
-+
+      Result := sqltSpace;
-+
+    '0'..'9':
-+
+      Result := sqltNumberString;
-+
+    ';':
-+
+      Result := sqltSemiColon;
-+
+    '?':
-+
+      Result := sqltPlaceholder;
-+
+    '|':
-+
+      Result := sqltPipe;
-+
+    '"':
-+
+      Result := sqltDoubleQuotes;
-+
+    '''':
-+
+      Result := sqltSingleQuotes;
-+
+    '/':
-+
+      Result := sqltForwardSlash;
-+
+    '\':
-+
+      Result := sqltBackslash;
-+
+    '*':
-+
+      Result := sqltAsterisk;
-+
+    '(':
-+
+      Result := sqltOpenBracket;
-+
+    ')':
-+
+      Result := sqltCloseBracket;
-+
+    ':':
-+
+      Result := sqltColon;
-+
+    ',':
-+
+      Result := sqltComma;
-+
+    '.':
-+
+      Result := sqltPeriod;
-+
+    '=':
-+
+      Result := sqltEquals;
-+
+    '[':
-+
+      Result := sqltOpenSquareBracket;
-+
+    ']':
-+
+      Result := sqltCloseSquareBracket;
-+
+    '-':
-+
+      Result := sqltMinus;
-+
+    '<':
-+
+      Result := sqltLT;
-+
+    '>':
-+
+      Result := sqltGT;
-+
+    CR:
-+
+      Result := sqltCR;
-+
+    LF:
-+
+      Result := sqltEOL;
-+
+    else
-+
+      if C in ValidSQLIdentifierChars then
-+
+        Result := sqltIdentifier
-+
+      else
-+
+        Result := sqltOtherCharacter;
-+
+    end;
-+
+    FLastChar := C
-+
+  end;
-+
+  FNextToken := Result;
-+
+end;
-+
-+
+procedure TSQLTokeniser.PopQueue(var token: TSQLTokens);
-+
+begin
-+
+  if FQFirst = FQLast then
-+
+    IBError(ibxeTokenQueueUnderflow,[]);
-+
+  token := FTokenQueue[FQFirst].token;
-+
+  FString := FTokenQueue[FQFirst].text;
-+
+  Inc(FQFirst);
-+
+  if FQFirst = FQLast then
-+
+    FQueueState := tsHold;
-+
+end;
-+
-+
+procedure TSQLTokeniser.Assign(source: TSQLTokeniser);
-+
+begin
-+
+  FString := source.FString;
-+
+  FNextToken := source.FNextToken;
-+
+  FTokenQueue := source.FTokenQueue;
-+
+  FQueueState := source.FQueueState;
-+
+  FQFirst := source.FQFirst;
-+
+  FQLast := source.FQLast;
-+
+end;
-+
-+
+function TSQLTokeniser.TokenFound(var token: TSQLTokens): boolean;
-+
+begin
-+
+  Result := (FState = stDefault);
-+
+  if Result and (token = sqltIdentifier)  then
-+
+    FindReservedWord(FString,token);
-+
+end;
-+
-+
+procedure TSQLTokeniser.QueueToken(token: TSQLTokens; text: AnsiString);
-+
+begin
-+
+  if FQLast > TokenQueueMaxSize then
-+
+    IBError(ibxeTokenQueueOverflow,[]);
-+
+  FTokenQueue[FQLast].token := token;
-+
+  FTokenQueue[FQLast].text := text;
-+
+  Inc(FQLast);
-+
+end;
-+
-+
+procedure TSQLTokeniser.QueueToken(token: TSQLTokens);
-+
+begin
-+
+  QueueToken(token,TokenText);
-+
+end;
-+
-+
+procedure TSQLTokeniser.ResetQueue;
-+
+begin
-+
+  FQFirst := 0;
-+
+  FQLast := 0;
-+
+  FQueueState := tsHold;
-+
+end;
-+
-+
+procedure TSQLTokeniser.ResetQueue(token: TSQLTokens; text: AnsiString);
-+
+begin
-+
+  ResetQueue;
-+
+  QueueToken(token,text);
-+
+end;
-+
-+
+procedure TSQLTokeniser.ResetQueue(token: TSQLTokens);
-+
+begin
-+
+  ResetQueue;
-+
+  QueueToken(token);
-+
+end;
-+
-+
+procedure TSQLTokeniser.ReleaseQueue(var token: TSQLTokens);
-+
+begin
-+
+  FQueueState := tsRelease;
-+
+  PopQueue(token);
-+
+end;
-+
-+
+procedure TSQLTokeniser.ReleaseQueue;
-+
+begin
-+
+  FQueueState := tsRelease;
-+
+end;
-+
-+
+function TSQLTokeniser.GetQueuedText: AnsiString;
-+
+var i: integer;
-+
+begin
-+
+  Result := '';
-+
+  for i := FQFirst to FQLast do
-+
+    Result := Result + FTokenQueue[i].text;
-+
+end;
-+
-+
+procedure TSQLTokeniser.SetTokenText(text: AnsiString);
-+
+begin
-+
+  FString := text;
-+
+end;
-+
-+
+constructor TSQLTokeniser.Create;
-+
+begin
-+
+  inherited Create;
-+
+  Reset;
-+
+end;
-+
-+
+destructor TSQLTokeniser.Destroy;
-+
+begin
-+
+  Reset;
-+
+  inherited Destroy;
-+
+end;
-+
-+
+procedure TSQLTokeniser.Reset;
-+
+begin
-+
+  FNextToken := sqltInit;
-+
+  FState := stDefault;
-+
+  FString := '';
-+
+  FEOF := false;
-+
+  ResetQueue;
-+
+end;
-+
-+
+function TSQLTokeniser.ReadCharacters(NumOfChars: integer): AnsiString;
-+
+var i: integer;
-+
+begin
-+
+  Result := FLastChar;
-+
+  for i := 2 to NumOfChars do
-+
+  begin
-+
+    if GetNext = sqltEOF then Exit;
-+
+    Result := Result + FLastChar;
-+
+  end;
-+
+  GetNext;
-+
+end;
-+
-+
+function TSQLTokeniser.GetNextToken: TSQLTokens;
-+
+begin
-+
+  if FQueueState = tsRelease then
-+
+  repeat
-+
+    PopQueue(Result);
-+
+    FEOF := Result = sqltEOF;
-+
+    if TokenFound(Result) then
-+
+      Exit;
-+
+  until FQueueState <> tsRelease;
-+
-+
+  Result := InternalGetNextToken;
-+
+end;
-+
-+
+{a simple lookahead one algorithm to extra the next symbol}
-+
-+
+function TSQLTokeniser.InternalGetNextToken: TSQLTokens;
-+
+var C: AnsiChar;
-+
+begin
-+
+  Result := sqltEOF;
-+
-+
+  if FNextToken = sqltInit then
-+
+    GetNext;
-+
-+
+  repeat
-+
+    if FSkipNext then
-+
+    begin
-+
+      FSkipNext := false;
-+
+      GetNext;
-+
+    end;
-+
-+
+    Result := FNextToken;
-+
+    C := FLastChar;
-+
+    GetNext;
-+
-+
+    if (Result = sqltCR) and (FNextToken = sqltEOL) then
-+
+    begin
-+
+      FSkipNext := true;
-+
+      Result := sqltEOL;
-+
+      C := LF;
-+
+    end;
-+
-+
+    case FState of
-+
+    stInComment:
-+
+      begin
-+
+        if (Result = sqltAsterisk) and (FNextToken = sqltForwardSlash) then
-+
+        begin
-+
+          FState := stDefault;
-+
+          Result := sqltComment;
-+
+          GetNext;
-+
+        end
-+
+        else
-+
+        if Result = sqltEOL then
-+
+          FString := FString + LineEnding
-+
+        else
-+
+          FString := FString + C;
-+
+      end;
-+
-+
+    stInCommentLine:
-+
+      begin
-+
+        case Result of
-+
+        sqltEOL:
-+
+          begin
-+
+            FState := stDefault;
-+
+            Result := sqltCommentLine;
-+
+          end;
-+
-+
+        else
-+
+          FString := FString + C;
-+
+        end;
-+
+      end;
-+
-+
+    stSingleQuoted:
-+
+      begin
-+
+        if (Result = sqltSingleQuotes) then
-+
+        begin
-+
+          if (FNextToken = sqltSingleQuotes) then
-+
+          begin
-+
+            FSkipNext := true;
-+
+            FString := FString + C;
-+
+          end
-+
+          else
-+
+          begin
-+
+            Result := sqltQuotedString;
-+
+            FState := stDefault;
-+
+          end;
-+
+        end
-+
+        else
-+
+        if Result = sqltEOL then
-+
+          FString := FString + LineEnding
-+
+        else
-+
+          FString := FString + C;
-+
+      end;
-+
-+
+    stDoubleQuoted:
-+
+      begin
-+
+        if (Result = sqltDoubleQuotes) then
-+
+        begin
-+
+          if (FNextToken = sqltDoubleQuotes) then
-+
+          begin
-+
+            FSkipNext := true;
-+
+            FString := FString + C;
-+
+          end
-+
+          else
-+
+          begin
-+
+            Result := sqltIdentifierInDoubleQuotes;
-+
+            FState := stDefault;
-+
+          end;
-+
+        end
-+
+        else
-+
+        if Result = sqltEOL then
-+
+          FString := FString + LineEnding
-+
+        else
-+
+          FString := FString + C;
-+
+      end;
-+
-+
+    stInIdentifier:
-+
+      begin
-+
+        FString := FString + C;
-+
+        Result := sqltIdentifier;
-+
+        if not (FNextToken in [sqltIdentifier,sqltNumberString]) then
-+
+          FState := stDefault
-+
+      end;
-+
-+
+    stInNumeric:
-+
+      begin
-+
+        FString := FString + C;
-+
+        if (Result = sqltPeriod) and (FNextToken = sqltPeriod) then
-+
+        begin
-+
+          {malformed decimal}
-+
+          FState := stInIdentifier;
-+
+          Result := sqltIdentifier
-+
+        end
-+
+        else
-+
+        begin
-+
+          if not (FNextToken in [sqltNumberString,sqltPeriod]) then
-+
+            FState := stDefault;
-+
+          Result := sqltNumberString;
-+
+        end;
-+
+      end;
-+
-+
+    else {stDefault}
-+
+      begin
-+
+        FString := C;
-+
+        case Result of
-+
-+
+        sqltPipe:
-+
+          if FNextToken = sqltPipe then
-+
+          begin
-+
+            Result := sqltConcatSymbol;
-+
+            FString := C + FLastChar;
-+
+            GetNext;
-+
+          end;
-+
-+
+        sqltForwardSlash:
-+
+          begin
-+
+            if FNextToken = sqltAsterisk then
-+
+            begin
-+
+              FString := '';
-+
+              GetNext;
-+
+              FState := stInComment;
-+
+            end
-+
+          end;
-+
-+
+        sqltMinus:
-+
+          begin
-+
+            if FNextToken = sqltMinus then
-+
+            begin
-+
+              FString := '';
-+
+              GetNext;
-+
+              FState := stInCommentLine;
-+
+            end;
-+
+          end;
-+
-+
+        sqltSingleQuotes:
-+
+          begin
-+
+            FString := '';
-+
+            FState := stSingleQuoted;
-+
+          end;
-+
-+
+        sqltDoubleQuotes:
-+
+          begin
-+
+            FString := '';
-+
+            FState := stDoubleQuoted;
-+
+          end;
-+
-+
+        sqltIdentifier:
-+
+          if FNextToken in [sqltIdentifier,sqltNumberString] then
-+
+            FState := stInIdentifier;
-+
-+
+        sqltNumberString:
-+
+          if FNextToken in [sqltNumberString,sqltPeriod] then
-+
+            FState := stInNumeric;
-+
-+
+        sqltEOL:
-+
+          FString := LineEnding;
-+
+        end;
-+
+      end;
-+
+    end;
-+
-+
+//    writeln(FString);
-+
+    FEOF := Result = sqltEOF;
-+
+  until TokenFound(Result) or EOF;
-+
+end;
-+
-+
+function ParseDateTimeTZString(aDateTimeStr: Ansistring; var aDateTime: TDateTime;
-+
+  var aTimezone: AnsiString; TimeOnly: boolean): boolean;
-+
+{$IF declared(TFormatSettings)}
-+
+begin
-+
+    {$IF declared(DefaultFormatSettings)}
-+
+    Result := ParseDateTimeTZString(aDateTimeStr,aDateTime,aTimeZone,DefaultFormatSettings,TimeOnly);
-+
+    {$ELSE}
-+
+    {$IF declared(FormatSettings)}
-+
+    Result := ParseDateTimeTZString(aDateTimeStr,aDateTime,aTimeZone,FormatSettings,TimeOnly);
-+
+    {$IFEND} {$IFEND}
-+
+end;
-+
-+
+function ParseDateTimeTZString(aDateTimeStr: Ansistring; var aDateTime: TDateTime;
-+
+              var aTimezone: AnsiString; aFormatSettings: TFormatSettings; TimeOnly: boolean=false): boolean;
-+
+{$IFEND}
-+
+const
-+
+  whitespacechars = [' ',#$09,#$0A,#$0D];
-+
+var i,j,l: integer;
-+
+    aTime: TDateTime;
-+
+    DMs: longint;
-+
+begin
-+
+  Result := false;
-+
+  aTimezone := '';
-+
+  if aDateTimeStr <> '' then
-+
+  {$if declared(TFormatSettings)}
-+
+  with aFormatSettings do
-+
+  {$IFEND}
-+
+  begin
-+
+    aDateTime := 0;
-+
+    {Parse to get time zone info}
-+
+    i := 1;
-+
+    while (i <= length(aDateTimeStr)) and (aDateTimeStr[i] in whitespacechars) do inc(i); {skip white space}
-+
+    if not TimeOnly then
-+
+    begin
-+
+      {decode date}
-+
+      j := i;
-+
+      while (j <= length(aDateTimeStr)) and (aDateTimeStr[j] in ['0'..'9',DateSeparator]) do inc(j);
-+
+      if TryStrToDate(system.copy(aDateTimeStr,i,j-i),aDateTime) then
-+
+        i := j; {otherwise start again i.e. assume time only}
-+
+    end;
-+
-+
+    while (i <= length(aDateTimeStr)) and (aDateTimeStr[i] in whitespacechars) do inc(i); {skip white space}
-+
+    {decode time}
-+
+    j := i;
-+
+    while (j <= length(aDateTimeStr)) and (aDateTimeStr[j] in ['0'..'9',TimeSeparator]) do inc(j);
-+
+    Result := TryStrToTime(system.copy(aDateTimeStr,i,j-i),aTime);
-+
+    if not Result then Exit;
-+
+    aDateTime := aDateTime + aTime;
-+
+    i := j;
-+
-+
+    {is there a factional second part}
-+
+    if (i <= length(aDateTimeStr)) and (aDateTimeStr[i] = '.') then
-+
+    begin
-+
+      inc(i);
-+
+      inc(j);
-+
+      while (j <= Length(aDateTimeStr)) and (aDateTimeStr[j] in ['0'..'9']) do inc(j);
-+
+      if j > i then
-+
+      begin
-+
+        l := j-i;
-+
+        if l > 4 then l := 4;
-+
+        Result := TryStrToInt(system.copy(aDateTimeStr,i,l),DMs);
-+
+        if not Result then Exit;
-+
-+
+        {adjust for number of significant digits}
-+
+        case l of
-+
+:   DMs := DMs * 10;
-+
+:   DMs := DMs * 100;
-+
+:   DMs := DMs * 1000;
-+
+        end;
-+
+       aDateTime := aDateTime + (DMs / (MsecsPerDay*10));
-+
+      end;
-+
+    end;
-+
+    i := j;
-+
-+
+    while (i <= length(aDateTimeStr)) and (aDateTimeStr[i] in whitespacechars) do inc(i); {skip white space}
-+
+    {decode time zone}
-+
+    if i < length(aDateTimeStr) then
-+
+    begin
-+
+      j := i;
-+
+      while (j <= length(aDateTimeStr)) and not (aDateTimeStr[j] in whitespacechars) do inc(j);
-+
+      aTimezone := system.copy(aDateTimeStr,i,j-i);
-+
+    end;
-+
+    Result := true;
-+
+  end
-+
+end;
-+
-+
+{The following is similar to FPC DecodeTime except that the Firebird standard
-+
+ decimilliseconds is used instead of milliseconds for fractional seconds}
-+
-+
+procedure FBDecodeTime(aTime: TDateTime; var Hour, Minute, Second: word;
-+
+  var DeciMillisecond: cardinal);
-+
+var D : Double;
-+
+    l : cardinal;
-+
+begin
-+
+  {conversion to decimilliseconds hacked from FPC DateTimeToTimeStamp}
-+
+  D := aTime * MSecsPerDay *10;
-+
+  if D < 0 then
-+
+    D := D - 0.5
-+
+  else
-+
+    D := D + 0.5;
-+
+  {rest hacked from FPC DecodeTIme}
-+
+  l := Abs(Trunc(D)) Mod (MSecsPerDay*10);
-+
+  Hour   := l div 36000000;
-+
+  l := l mod 36000000;
-+
+  Minute := l div 600000;
-+
+  l := l mod 600000;
-+
+  Second := l div 10000;
-+
+  DeciMillisecond := l mod 10000;
-+
+end;
-+
-+
+{The following is similar to FPC EncodeTime except that the Firebird standard
-+
+ decimilliseconds is used instead of milliseconds for fractional seconds}
-+
-+
+function FBEncodeTime(Hour, Minute, Second, DeciMillisecond: cardinal): TDateTime;
-+
+const DMSecsPerDay = MSecsPerDay*10;
-+
+var DMs: cardinal;
-+
+    D: Double;
-+
+begin
-+
+  if (Hour<24) and (Minute<60) and (Second<60) and (DeciMillisecond<10000) then
-+
+  begin
-+
+    DMs := Hour*36000000+Minute*600000+Second*10000+DeciMillisecond;
-+
+    D := DMs/DMSecsPerDay;
-+
+    Result:=TDateTime(d)
-+
+  end
-+
+  else
-+
+    IBError(ibxeBadTimeSpecification,[Hour, Minute, Second, DeciMillisecond]);
-+
+end;
-+
-+
+{The following is similar to FPC FormatDateTime except that it additionally
-+
+ allows the timstamp to have a fractional seconds component with a resolution
-+
+ of four decimal places. This is appended to the result for FormatDateTime
-+
+ if the format string contains a "zzzz' string.}
-+
-+
+function FBFormatDateTime(fmt: AnsiString; aDateTime: TDateTime): AnsiString;
-+
+var Hour, Minute, Second: word;
-+
+    DeciMillisecond: cardinal;
-+
+begin
-+
+  if Pos('zzzz',fmt) > 0 then
-+
+  begin
-+
+    FBDecodeTime(aDateTime, Hour, Minute, Second, DeciMillisecond);
-+
+    fmt := StringReplace(fmt, 'zzzz', Format('%.4d',[DeciMillisecond]), [rfReplaceAll]);
-+
+  end;
-+
+  Result := FormatDateTime(fmt,aDateTime);
-+
+end;
-+
-+
+function FormatTimeZoneOffset(EffectiveTimeOffsetMins: integer): AnsiString;
-+
+begin
-+
+  if EffectiveTimeOffsetMins > 0 then
-+
+    Result := Format('+%.2d:%.2d',[EffectiveTimeOffsetMins div 60,abs(EffectiveTimeOffsetMins mod 60)])
-+
+  else
-+
+    Result := Format('%.2d:%.2d',[EffectiveTimeOffsetMins div 60,abs(EffectiveTimeOffsetMins mod 60)]);
-+
+end;
-+
-+
+function DecodeTimeZoneOffset(TZOffset: AnsiString; var dstOffset: integer): boolean;
-+
+var i: integer;
-+
+begin
-+
+  Result := false;
-+
+  TZOffset := Trim(TZOffset);
-+
+  for i := 1 to Length(TZOffset) do
-+
+    if not (TZOffset[i] in ['0'..'9','-','+',':']) then Exit;
-+
-+
+  Result := true;
-+
+  i := Pos(':',TZOffset);
-+
+  if i > 0 then
-+
+    dstOffset := StrToInt(copy(TZOffset,1,i-1)) * 60 + StrToInt(copy(TZOffset,i + 1))
-+
+  else
-+
+    dstOffset := StrToInt(TZOffset) * 60;
-+
+end;
-+
-+
+function StripLeadingZeros(Value: AnsiString): AnsiString;
-+
+var i: Integer;
-+
+    start: integer;
-+
+begin
-+
+  Result := '';
-+
+  start := 1;
-+
+  if (Length(Value) > 0) and (Value[1] = '-') then
-+
+  begin
-+
+    Result := '-';
-+
+    start := 2;
-+
+  end;
-+
+  for i := start to Length(Value) do
-+
+    if Value[i] <> '0' then
-+
+    begin
-+
+      Result := Result + system.copy(Value, i, MaxInt);
-+
+      Exit;
-+
+    end;
-+
+end;
-+
-+
+function TryStrToNumeric(S: Ansistring; out Value: int64; out scale: integer): boolean;
-+
+var i: integer;
-+
+    ds: integer;
-+
+    exponent: integer;
-+
+begin
-+
+  Result := false;
-+
+  ds := 0;
-+
+  exponent := 0;
-+
+  S := Trim(S);
-+
+  Value := 0;
-+
+  scale := 0;
-+
+  if Length(S) = 0 then
-+
+    Exit;
-+
+  {$IF declared(DefaultFormatSettings)}
-+
+  with DefaultFormatSettings do
-+
+  {$ELSE}
-+
+  {$IF declared(FormatSettings)}
-+
+  with FormatSettings do
-+
+  {$IFEND}
-+
+  {$IFEND}
-+
+  begin
-+
+    for i := length(S) downto 1 do
-+
+    begin
-+
+      if S[i] = AnsiChar(DecimalSeparator) then
-+
+      begin
-+
+          if ds <> 0 then Exit; {only one allowed}
-+
+          ds := i;
-+
+          dec(exponent);
-+
+          system.Delete(S,i,1);
-+
+      end
-+
+      else
-+
+      if S[i] in ['+','-'] then
-+
+      begin
-+
+       if (i > 1) and not (S[i-1] in ['e','E']) then
-+
+          Exit; {malformed}
-+
+      end
-+
+      else
-+
+      if S[i] in ['e','E'] then {scientific notation}
-+
+      begin
-+
+        if ds <> 0 then Exit; {not permitted in exponent}
-+
+        if exponent <> 0 then Exit; {only one allowed}
-+
+        exponent := i;
-+
+      end
-+
+      else
-+
+      if not (S[i] in ['0'..'9']) then
-+
+      {Note: ThousandSeparator not allowed by Delphi specs}
-+
+          Exit; {bad character}
-+
+    end;
-+
-+
+    if exponent > 0 then
-+
+    begin
-+
+      Result := TryStrToInt(system.copy(S,exponent+1,maxint),Scale);
-+
+      if Result then
-+
+      begin
-+
+        {adjust scale for decimal point}
-+
+        if ds <> 0 then
-+
+          Scale := Scale - (exponent - ds);
-+
+        Result := TryStrToInt64(system.copy(S,1,exponent-1),Value);
-+
+      end;
-+
+    end
-+
+    else
-+
+    begin
-+
+      if ds <> 0 then
-+
+        scale := ds - Length(S) - 1;
-+
+      Result := TryStrToInt64(S,Value);
-+
+    end;
-+
+  end;
-+
+end;
-+
-+
+function NumericToDouble(aValue: Int64; aScale: integer): double;
-+
+begin
-+
+  Result := aValue * IntPower(10,aScale)
-+
+end;
-+
-+
-+
+function StringToHex(octetString: string; MaxLineLength: integer): string; overload;
-+
-+
+  function ToHex(aValue: byte): string;
-+
+  const
-+
+    HexChars: array [0..15] of char = '0123456789ABCDEF';
-+
+  begin
-+
+    Result := HexChars[aValue shr 4] +
-+
+               HexChars[(aValue and $0F)];
-+
+  end;
-+
-+
+var i, j: integer;
-+
+begin
-+
+  i := 1;
-+
+  Result := '';
-+
+  if MaxLineLength = 0 then
-+
+  while i <= Length(octetString) do
-+
+  begin
-+
+    Result := Result +  ToHex(byte(octetString[i]));
-+
+    Inc(i);
-+
+  end
-+
+  else
-+
+  while i <= Length(octetString) do
-+
+  begin
-+
+      for j := 1 to MaxLineLength do
-+
+      begin
-+
+        if i > Length(octetString) then
-+
+          Exit
-+
+        else
-+
+          Result := Result + ToHex(byte(octetString[i]));
-+
+        inc(i);
-+
+      end;
-+
+      Result := Result + LineEnding;
-+
+  end;
-+
+end;
-+
-+
+procedure StringToHex(octetString: string; TextOut: TStrings; MaxLineLength: integer); overload;
-+
+begin
-+
+    TextOut.Add(StringToHex(octetString,MaxLineLength));
-+
+end;
-+
-+
+{ TSQLXMLReader }
-+
-+
+function TSQLXMLReader.FindTag(tag: string; var xmlTag: TXMLTag): boolean;
-+
+var i: TXMLTag;
-+
+begin
-+
+  Result := false;
-+
+  for i := xtBlob to xtElt do
-+
+    if XMLTagDefs[i].TagValue = tag then
-+
+    begin
-+
+      xmlTag := XMLTagDefs[i].XMLTag;
-+
+      Result := true;
-+
+      break;
-+
+    end;
-+
+end;
-+
-+
+function TSQLXMLReader.GetArrayData(index: integer): TArrayData;
-+
+begin
-+
+  if (index < 0) or (index > ArrayDataCount) then
-+
+    ShowError(sArrayIndexError,[index]);
-+
+  Result := FArrayData[index];
-+
+end;
-+
-+
+function TSQLXMLReader.GetArrayDataCount: integer;
-+
+begin
-+
+  Result := Length(FArrayData);
-+
+end;
-+
-+
+function TSQLXMLReader.GetBlobData(index: integer): TBlobData;
-+
+begin
-+
+  if (index < 0) or (index > BlobDataCount) then
-+
+    ShowError(sBlobIndexError,[index]);
-+
+  Result := FBlobData[index];
-+
+end;
-+
-+
+function TSQLXMLReader.GetBlobDataCount: integer;
-+
+begin
-+
+  Result := Length(FBlobData);
-+
+end;
-+
-+
+function TSQLXMLReader.GetTagName(xmltag: TXMLTag): string;
-+
+var i: TXMLTag;
-+
+begin
-+
+  Result := 'unknown';
-+
+  for i := xtBlob to xtElt do
-+
+    if XMLTagDefs[i].XMLTag = xmltag then
-+
+    begin
-+
+      Result := XMLTagDefs[i].TagValue;
-+
+      Exit;
-+
+    end;
-+
+end;
-+
-+
+procedure TSQLXMLReader.ProcessAttributeValue(attrValue: string);
-+
+begin
-+
+  case FXMLTagStack[FXMLTagIndex] of
-+
+  xtBlob:
-+
+    if FAttributeName = 'subtype' then
-+
+      FBlobData[FCurrentBlob].SubType := StrToInt(attrValue)
-+
+    else
-+
+      ShowError(sXMLAttributeError,[FAttributeName,attrValue]);
-+
-+
+  xtArray:
-+
+    if FAttributeName = 'sqltype' then
-+
+      FArrayData[FCurrentArray].SQLType := StrToInt(attrValue)
-+
+    else
-+
+    if FAttributeName = 'relation_name' then
-+
+      FArrayData[FCurrentArray].relationName := attrValue
-+
+    else
-+
+    if FAttributeName = 'column_name' then
-+
+      FArrayData[FCurrentArray].columnName := attrValue
-+
+    else
-+
+    if FAttributeName = 'dim' then
-+
+      FArrayData[FCurrentArray].Dim := StrToInt(attrValue)
-+
+    else
-+
+    if FAttributeName = 'length' then
-+
+      FArrayData[FCurrentArray].Size := StrToInt(attrValue)
-+
+    else
-+
+    if FAttributeName = 'scale' then
-+
+      FArrayData[FCurrentArray].Scale := StrToInt(attrValue)
-+
+    else
-+
+    if FAttributeName = 'charset' then
-+
+      FArrayData[FCurrentArray].CharSet := attrValue
-+
+    else
-+
+    if FAttributeName = 'bounds' then
-+
+      ProcessBoundsList(attrValue)
-+
+    else
-+
+      ShowError(sXMLAttributeError,[FAttributeName,attrValue]);
-+
-+
+  xtElt:
-+
+    if FAttributeName = 'ix' then
-+
+      with FArrayData[FCurrentArray] do
-+
+        Index[CurrentRow] :=  StrToInt(attrValue)
-+
+     else
-+
+        ShowError(sXMLAttributeError,[FAttributeName,attrValue]);
-+
+  end;
-+
+end;
-+
-+
+procedure TSQLXMLReader.ProcessBoundsList(boundsList: string);
-+
+var list: TStringList;
-+
+    i,j: integer;
-+
+begin
-+
+  list := TStringList.Create;
-+
+  try
-+
+    list.Delimiter := ',';
-+
+    list.DelimitedText := boundsList;
-+
+    with FArrayData[FCurrentArray] do
-+
+    begin
-+
+      if dim <> list.Count then
-+
+        ShowError(sInvalidBoundsList,[boundsList]);
-+
+      SetLength(bounds,dim);
-+
+      for i := 0 to list.Count - 1 do
-+
+      begin
-+
+        j := Pos(':',list[i]);
-+
+        if j = 0 then
-+
+          raise Exception.CreateFmt(sInvalidBoundsList,[boundsList]);
-+
+        bounds[i].LowerBound := StrToInt(system.copy(list[i],1,j-1));
-+
+        bounds[i].UpperBound := StrToInt(system.copy(list[i],j+1,length(list[i])-j));
-+
+      end;
-+
+    end;
-+
+  finally
-+
+    list.Free;
-+
+  end;
-+
+end;
-+
-+
+procedure TSQLXMLReader.ProcessTagValue(tagValue: string);
-+
-+
+  function nibble(hex: char): byte;
-+
+  begin
-+
+    case hex of
-+
+    '0': Result := 0;
-+
+    '1': Result := 1;
-+
+    '2': Result := 2;
-+
+    '3': Result := 3;
-+
+    '4': Result := 4;
-+
+    '5': Result := 5;
-+
+    '6': Result := 6;
-+
+    '7': Result := 7;
-+
+    '8': Result := 8;
-+
+    '9': Result := 9;
-+
+    'a','A': Result := 10;
-+
+    'b','B': Result := 11;
-+
+    'c','C': Result := 12;
-+
+    'd','D': Result := 13;
-+
+    'e','E': Result := 14;
-+
+    'f','F': Result := 15;
-+
+    end;
-+
+  end;
-+
-+
+  procedure RemoveWhiteSpace(var hexData: string);
-+
+  var i: integer;
-+
+  begin
-+
+    {Remove White Space}
-+
+    i := 1;
-+
+    while i <= length(hexData) do
-+
+    begin
-+
+      case hexData[i] of
-+
+      ' ',#9,#10,#13:
-+
+        begin
-+
+          if i < Length(hexData) then
-+
+            Move(hexData[i+1],hexData[i],Length(hexData)-i);
-+
+          SetLength(hexData,Length(hexData)-1);
-+
+        end;
-+
+      else
-+
+        Inc(i);
-+
+      end;
-+
+    end;
-+
+  end;
-+
-+
+  procedure WriteToBlob(hexData: string);
-+
+  var i,j : integer;
-+
+      blength: integer;
-+
+      P: PByte;
-+
+  begin
-+
+    RemoveWhiteSpace(hexData);
-+
+    if odd(length(hexData)) then
-+
+      ShowError(sBinaryBlockMustbeEven,[nil]);
-+
+    blength := Length(hexData) div 2;
-+
+    ReallocMem(FBlobBuffer,blength);
-+
+    j := 1;
-+
+    P := FBlobBuffer;
-+
+    for i := 1 to blength do
-+
+    begin
-+
+      P^ := (nibble(hexData[j]) shl 4) or nibble(hexdata[j+1]);
-+
+      Inc(j,2);
-+
+      Inc(P);
-+
+    end;
-+
+    FBlobData[FCurrentBlob].BlobIntf.Write(FBlobBuffer^,blength);
-+
+  end;
-+
-+
+begin
-+
+  if tagValue = '' then Exit;
-+
+  case FXMLTagStack[FXMLTagIndex] of
-+
+  xtBlob:
-+
+    WriteToBlob(tagValue);
-+
-+
+  xtElt:
-+
+    with FArrayData[FCurrentArray] do
-+
+      ArrayIntf.SetAsString(index,tagValue);
-+
-+
+  end;
-+
+end;
-+
-+
+procedure TSQLXMLReader.XMLTagInit(xmltag: TXMLTag);
-+
+begin
-+
+  if FXMLTagIndex > MaxXMLTags then
-+
+    ShowError(sXMLStackOverFlow,[nil]);
-+
+  Inc(FXMLTagIndex);
-+
+  FXMLTagStack[FXMLTagIndex] := xmltag;
-+
+  FXMLString := '';
-+
-+
+  case xmltag of
-+
+  xtBlob:
-+
+    begin
-+
+      Inc(FCurrentBlob);
-+
+      SetLength(FBlobData,FCurrentBlob+1);
-+
+      FBlobData[FCurrentBlob].BlobIntf := nil;
-+
+      FBlobData[FCurrentBlob].SubType := 0;
-+
+    end;
-+
-+
+  xtArray:
-+
+    begin
-+
+      Inc(FCurrentArray);
-+
+      SetLength(FArrayData,FCurrentArray+1);
-+
+      with FArrayData[FCurrentArray] do
-+
+      begin
-+
+        ArrayIntf := nil;
-+
+        SQLType := 0;
-+
+        dim := 0;
-+
+        Size := 0;
-+
+        Scale := 0;
-+
+        CharSet := 'NONE';
-+
+        SetLength(Index,0);
-+
+        CurrentRow := -1;
-+
+      end;
-+
+    end;
-+
-+
+  xtElt:
-+
+      with FArrayData[FCurrentArray] do
-+
+        Inc(CurrentRow)
-+
+  end;
-+
+end;
-+
-+
+function TSQLXMLReader.XMLTagEnd(var xmltag: TXMLTag): boolean;
-+
+begin
-+
+  if FXMLTagIndex = 0 then
-+
+    ShowError(sXMLStackUnderflow,[nil]);
-+
-+
+  xmlTag := FXMLTagStack[FXMLTagIndex];
-+
+  case FXMLTagStack[FXMLTagIndex] of
-+
+  xtBlob:
-+
+    FBlobData[FCurrentBlob].BlobIntf.Close;
-+
-+
+  xtArray:
-+
+    FArrayData[FCurrentArray].ArrayIntf.SaveChanges;
-+
-+
+  xtElt:
-+
+    Dec(FArrayData[FCurrentArray].CurrentRow);
-+
+  end;
-+
+  Dec(FXMLTagIndex);
-+
+  Result := FXMLTagIndex = 0;
-+
+end;
-+
-+
+procedure TSQLXMLReader.XMLTagEnter;
-+
+var aCharSetID: integer;
-+
+begin
-+
+  if (Attachment = nil) or not Attachment.IsConnected then
-+
+    ShowError(sNoDatabase);
-+
+  if Transaction = nil then
-+
+    ShowError(sNoTransaction);
-+
+  case FXMLTagStack[FXMLTagIndex] of
-+
+  xtBlob:
-+
+    begin
-+
+      if not Transaction.InTransaction then
-+
+        Transaction.Start;
-+
+      FBlobData[FCurrentBlob].BlobIntf := Attachment.CreateBlob(
-+
+        Transaction,FBlobData[FCurrentBlob].SubType);
-+
+    end;
-+
-+
+  xtArray:
-+
+    with FArrayData[FCurrentArray] do
-+
+    begin
-+
+      if not Transaction.InTransaction then
-+
+        Transaction.Start;
-+
+      Attachment.CharSetName2CharSetID(CharSet,aCharSetID);
-+
+      SetLength(Index,dim);
-+
+      ArrayIntf := Attachment.CreateArray(
-+
+                     Transaction,
-+
+                     Attachment.CreateArrayMetaData(SQLType,
-+
+                       relationName,columnName,Scale,Size,
-+
+                       aCharSetID,dim,bounds)
-+
+                     );
-+
+    end;
-+
+  end;
-+
+end;
-+
-+
+{This is where the XML tags are identified and the token stream modified in
-+
+ consequence}
-+
-+
+function TSQLXMLReader.TokenFound(var token: TSQLTokens): boolean;
-+
-+
+ procedure NotAnXMLTag;
-+
+ begin
-+
+   begin
-+
+     if FXMLTagIndex = 0 then
-+
+     {nothing to do with XML so go back to processing SQL}
-+
+     begin
-+
+       QueueToken(token);
-+
+       ReleaseQueue(token);
-+
+       FXMLState := stNoXML
-+
+     end
-+
+     else
-+
+     begin
-+
+       {Not an XML tag, so just push back to XML Data}
-+
+       FXMLState := stXMLData;
-+
+       FXMLString := FXMLString + GetQueuedText;
-+
+       ResetQueue;
-+
+     end;
-+
+   end;
-+
+ end;
-+
-+
+var XMLTag: TXMLTag;
-+
+begin
-+
+  Result := inherited TokenFound(token);
-+
+  if not Result then Exit;
-+
-+
+  case FXMLState of
-+
+  stNoXML:
-+
+    if token = sqltLT then
-+
+    begin
-+
+      ResetQueue;
-+
+      QueueToken(token); {save in case this is not XML}
-+
+      FXMLState := stInTag;
-+
+    end;
-+
-+
+  stInTag:
-+
+    {Opening '<' found, now looking for tag name or end tag marker}
-+
+    case token of
-+
+    sqltIdentifier:
-+
+      begin
-+
+        if FindTag(TokenText,XMLTag) then
-+
+        begin
-+
+          XMLTagInit(XMLTag);
-+
+          QueueToken(token);
-+
+          FXMLState := stInTagBody;
-+
+        end
-+
+        else
-+
+          NotAnXMLTag;
-+
+      end;
-+
-+
+    sqltForwardSlash:
-+
+      FXMLState := stInEndTag;
-+
-+
+    else
-+
+      NotAnXMLTag;
-+
+    end {case token};
-+
-+
+  stInTagBody:
-+
+    {Tag name found. Now looking for attribute or closing '>'}
-+
+    case token of
-+
+    sqltIdentifier:
-+
+      begin
-+
+        FAttributeName := TokenText;
-+
+        QueueToken(token);
-+
+        FXMLState := stAttribute;
-+
+      end;
-+
-+
+    sqltGT:
-+
+      begin
-+
+        ResetQueue;
-+
+        XMLTagEnter;
-+
+        FXMLState := stXMLData;
-+
+      end;
-+
-+
+    sqltSpace,
-+
+    sqltEOL:
-+
+      QueueToken(token);
-+
-+
+    else
-+
+      NotAnXMLTag;
-+
+    end {case token};
-+
-+
+  stAttribute:
-+
+    {Attribute name found. Must be followed by an '=', a '>' or another tag name}
-+
+    case token of
-+
+      sqltEquals:
-+
+      begin
-+
+        QueueToken(token);
-+
+        FXMLState := stAttributeValue;
-+
+      end;
-+
-+
+      sqltSpace,
-+
+      sqltEOL:
-+
+        QueueToken(token);
-+
-+
+      sqltIdentifier:
-+
+        begin
-+
+          ProcessAttributeValue('');
-+
+          FAttributeName := TokenText;
-+
+          QueueToken(token);
-+
+          FXMLState := stAttribute;
-+
+        end;
-+
-+
+      sqltGT:
-+
+        begin
-+
+          ProcessAttributeValue('');
-+
+          ResetQueue;
-+
+          XMLTagEnter;
-+
+          FXMLState := stXMLData;
-+
+        end;
-+
-+
+      else
-+
+        NotAnXMLTag;
-+
+    end; {case token}
-+
-+
+  stAttributeValue:
-+
+    {Looking for attribute value as a single identifier or a double quoted value}
-+
+    case token of
-+
+    sqltIdentifier,sqltIdentifierInDoubleQuotes:
-+
+      begin
-+
+        ProcessAttributeValue(TokenText);
-+
+        QueueToken(token);
-+
+        FXMLState := stInTagBody;
-+
+      end;
-+
-+
+    sqltSpace,
-+
+    sqltEOL:
-+
+      QueueToken(token);
-+
-+
+    else
-+
+      NotAnXMLTag;
-+
+    end; {case token}
-+
-+
+  stXMLData:
-+
+    if token = sqltLT then
-+
+    begin
-+
+      QueueToken(token); {save in case this is not XML}
-+
+      FXMLState := stInTag;
-+
+    end
-+
+    else
-+
+      FXMLString := FXMLString + TokenText;
-+
-+
+  stInEndTag:
-+
+    {Opening '</' found, now looking for tag name}
-+
+    case token of
-+
+    sqltIdentifier:
-+
+      begin
-+
+        if FindTag(TokenText,XMLTag) and (XMLTag = FXMLTagStack[FXMLTagIndex]) then
-+
+        begin
-+
+          QueueToken(token);
-+
+          FXMLState := stInEndTagBody;
-+
+        end
-+
+        else
-+
+          ShowError(sInvalidEndTag,[TokenText]);
-+
+      end;
-+
+    else
-+
+      NotAnXMLTag;
-+
+    end {case token};
-+
-+
+  stInEndTagBody:
-+
+  {End tag name found, now looping for closing '>'}
-+
+    case Token of
-+
+    sqltGT:
-+
+      begin
-+
+        ProcessTagValue(FXMLString);
-+
+        if XMLTagEnd(XMLTag) then
-+
+        begin
-+
+          ResetQueue;
-+
+          QueueToken(sqltColon,':');
-+
+          case XMLTag of
-+
+            xtBlob:
-+
+              QueueToken(sqltIdentifier,Format(ibx_blob+'%d',[FCurrentBlob]));
-+
-+
+            xtArray:
-+
+              QueueToken(sqltIdentifier, Format(ibx_array+'%d',[FCurrentArray]));
-+
+          end;
-+
+          ReleaseQueue(token);
-+
+          FXMLState := stNoXML;
-+
+       end
-+
+       else
-+
+         FXMLState := stXMLData;
-+
+      end;
-+
-+
+    sqltSpace,
-+
+    sqltEOL:
-+
+      QueueToken(token);
-+
-+
+    else
-+
+      ShowError(sBadEndTagClosing);
-+
+    end; {case token}
-+
-+
+  end {Case FState};
-+
-+
+  {Only allow token to be returned if not processing an XML tag}
-+
-+
+  Result := FXMLState = stNoXML;
-+
+end;
-+
-+
+procedure TSQLXMLReader.ShowError(msg: string; params: array of const);
-+
+begin
-+
+  raise EIBClientError.CreateFmt(GetErrorPrefix + msg,params);
-+
+end;
-+
-+
+procedure TSQLXMLReader.ShowError(msg: string);
-+
+begin
-+
+  ShowError(msg,[nil]);
-+
+end;
-+
-+
+constructor TSQLXMLReader.Create;
-+
+begin
-+
+  inherited;
-+
+  FXMLState := stNoXML;
-+
+end;
-+
-+
+procedure TSQLXMLReader.FreeDataObjects;
-+
+begin
-+
+  FXMLTagIndex := 0;
-+
+  SetLength(FBlobData,0);
-+
+  FCurrentBlob := -1;
-+
+  SetLength(FArrayData,0);
-+
+  FCurrentArray := -1;
-+
+end;
-+
-+
+class function TSQLXMLReader.FormatBlob(Field: ISQLData): string;
-+
+begin
-+
+  Result := FormatBlob(Field.AsString,Field.getSubtype);
-+
+end;
-+
-+
+class function TSQLXMLReader.FormatBlob(contents: string; subtype: integer
-+
+  ): string;
-+
+var TextOut: TStrings;
-+
+begin
-+
+  TextOut := TStringList.Create;
-+
+  try
-+
+    TextOut.Add(Format('<blob subtype="%d">',[subtype]));
-+
+    StringToHex(contents,TextOut,BlobLineLength);
-+
+    TextOut.Add('</blob>');
-+
+    Result := TextOut.Text;
-+
+  finally
-+
+    TextOut.Free;
-+
+  end;
-+
+end;
-+
-+
-+
+class function TSQLXMLReader.FormatArray(ar: IArray
-+
+  ): string;
-+
+var index: array of integer;
-+
+    TextOut: TStrings;
-+
-+
+    procedure AddElements(dim: integer; indent:string = ' ');
-+
+    var i: integer;
-+
+        recurse: boolean;
-+
+    begin
-+
+      SetLength(index,dim+1);
-+
+      recurse := dim < ar.GetDimensions - 1;
-+
+      with ar.GetBounds[dim] do
-+
+      for i := LowerBound to UpperBound do
-+
+      begin
-+
+        index[dim] := i;
-+
+        if recurse then
-+
+        begin
-+
+          TextOut.Add(Format('%s<elt id="%d">',[indent,i]));
-+
+          AddElements(dim+1,indent + ' ');
-+
+          TextOut.Add('</elt>');
-+
+        end
-+
+        else
-+
+        if ((ar.GetSQLType = SQL_TEXT) or (ar.GetSQLType = SQL_VARYING)) and
-+
+           (ar.GetCharSetID = 1) then
-+
+           TextOut.Add(Format('%s<elt ix="%d">%s</elt>',[indent,i,StringToHex(ar.GetAsString(index))]))
-+
+        else
-+
+          TextOut.Add(Format('%s<elt ix="%d">%s</elt>',[indent,i,ar.GetAsString(index)]));
-+
+      end;
-+
+    end;
-+
-+
+var
-+
+    s: string;
-+
+    bounds: TArrayBounds;
-+
+    i: integer;
-+
+    boundsList: string;
-+
+begin
-+
+  TextOut := TStringList.Create;
-+
+  try
-+
+    if ar.GetCharSetWidth = 0 then
-+
+      s := Format('<array dim = "%d" sqltype = "%d" length = "%d" relation_name = "%s" column_name = "%s"',
-+
+                              [ar.GetDimensions,ar.GetSQLType,ar.GetSize,
-+
+                               ar.GetTableName,ar.GetColumnName])
-+
+    else
-+
+      s := Format('<array dim = "%d" sqltype = "%d" length = "%d" relation_name = "%s" column_name = "%s"',
-+
+                                [ar.GetDimensions,ar.GetSQLType,ar.GetSize div ar.GetCharSetWidth,
-+
+                                 ar.GetTableName,ar.GetColumnName]);
-+
+    case ar.GetSQLType of
-+
+    SQL_DOUBLE, SQL_FLOAT, SQL_LONG, SQL_SHORT, SQL_D_FLOAT, SQL_INT64:
-+
+       s := s + Format(' scale = "%d"',[ ar.GetScale]);
-+
+    SQL_TEXT,
-+
+    SQL_VARYING:
-+
+      s := s + Format(' charset = "%s"',[ar.GetAttachment.GetCharsetName(ar.GetCharSetID)]);
-+
+    end;
-+
+    bounds := ar.GetBounds;
-+
+    boundsList := '';
-+
+    for i := 0 to length(bounds) - 1 do
-+
+    begin
-+
+      if i <> 0 then boundsList := boundsList + ',';
-+
+      boundsList := boundsList + Format('%d:%d',[bounds[i].LowerBound,bounds[i].UpperBound]);
-+
+    end;
-+
+    s := s + Format(' bounds="%s"',[boundsList]);
-+
+    s := s + '>';
-+
+    TextOut.Add(s);
-+
-+
+    SetLength(index,0);
-+
+    AddElements(0);
-+
+    TextOut.Add('</array>');
-+
+    Result := TextOut.Text;
-+
+  finally
-+
+    TextOut.Free;
-+
+  end;
-+
+end;
-+
-+
+procedure TSQLXMLReader.Reset;
-+
+begin
-+
+  inherited Reset;
-+
+  FreeDataObjects;
-+
+  FXMLString := '';
-+
+  FreeMem(FBlobBuffer);
-+
+end;
-+
-+
+{ TJournalProcessor }
-+
-+
+procedure TJournalProcessor.DoExecute;
-+
+var token: TSQLTokens;
-+
+    LineState: TLineState;
-+
+    JnlEntry: TJnlEntry;
-+
+    Len: integer;
-+
+    tz: AnsiString;
-+
-+
+  procedure ClearJnlEntry;
-+
+  begin
-+
+    with JnlEntry do
-+
+    begin
-+
+      TransactionName := '';
-+
+      TPB := nil;
-+
+      QueryText :='';
-+
+      JnlEntryType := jeUnknown;
-+
+      SessionID := 0;
-+
+      TransactionID := 0;
-+
+      DefaultCompletion := taCommit;
-+
+    end;
-+
+  end;
-+
-+
+  function CreateTPB(TPBText: AnsiString): ITPB;
-+
+  var index: integer;
-+
+  begin
-+
+    Result := nil;
-+
+    if Length(TPBText) = 0 then
-+
+      Exit;
-+
+    Result := FFirebirdClientAPI.AllocateTPB;
-+
+    try
-+
+      index := Pos('[',TPBText);
-+
+      if index > 0 then
-+
+        system.Delete(TPBText,1,index);
-+
+      repeat
-+
+        index := Pos(',',TPBText);
-+
+        if index = 0 then
-+
+        begin
-+
+          index := Pos(']',TPBText);
-+
+          if index <> 0 then
-+
+            system.Delete(TPBText,index,1);
-+
+          Result.AddByTypeName(TPBText);
-+
+          break;
-+
+        end;
-+
+        Result.AddByTypeName(system.copy(TPBText,1,index-1));
-+
+        system.Delete(TPBText,1,index);
-+
+      until false;
-+
+    except
-+
+      Result := nil;
-+
+      raise;
-+
+    end;
-+
+  end;
-+
-+
+begin
-+
+  LineState := lsInit;
-+
+  JnlEntry.JnlEntryType := jeUnknown;
-+
+  while not EOF do
-+
+  begin
-+
+    if LineState = lsInit then
-+
+      ClearJnlEntry;
-+
+    token := GetNextToken;
-+
+    with JnlEntry do
-+
+    case token of
-+
+    sqltAsterisk:
-+
+      if LineState = lsInit then
-+
+        LineState := lsJnlFound;
-+
-+
+    sqltIdentifier:
-+
+      if LineState = lsJnlFound then
-+
+        begin
-+
+          JnlEntryType := IdentifyJnlEntry(TokenText);
-+
+          LineState := lsGotJnlType;
-+
+        end
-+
+      else
-+
+        LineState := lsInit;
-+
-+
+    sqltQuotedString:
-+
+      if (LineState = lsGotJnlType)
-+
+          and ParseDateTimeTZString(TokenText,TimeStamp,tz) then
-+
+            LineState := lsGotTimestamp
-+
+      else
-+
+        LineState := lsInit;
-+
-+
+    sqltColon:
-+
+      case LineState of
-+
+      lsGotText1Length:
-+
+        begin
-+
+          if Len > 0 then
-+
+          begin
-+
+            if JnlEntryType = jeTransStart then
-+
+              TransactionName := ReadCharacters(Len)
-+
+            else
-+
+              QueryText := ReadCharacters(Len)
-+
+          end;
-+
+          if JnlEntryType = jeTransStart then
-+
+             LineState := lsGotText1
-+
+          else
-+
+          begin
-+
+            if assigned(FOnNextJournalEntry) then
-+
+              OnNextJournalEntry(JnlEntry);
-+
+            LineState := lsInit;
-+
+          end
-+
+        end;
-+
-+
+      lsGotText2Length:
-+
+        begin
-+
+          if Len > 0 then
-+
+            TPB :=  CreateTPB(ReadCharacters(Len));
-+
+          LineState := lsGotText2;
-+
+        end;
-+
-+
+      else
-+
+      if LineState <> lsGotJnlType then
-+
+        LineState := lsInit;
-+
+    end;
-+
-+
+   sqltComma:
-+
+     if not (LineState in [lsGotTimestamp,lsGotSessionID,lsGotTransactionID,lsGotText1,lsGotText2]) then
-+
+       LineState := lsInit;
-+
-+
+   sqltNumberString:
-+
+     case LineState of
-+
+     lsGotTimestamp:
-+
+       begin
-+
+         SessionID := StrToInt(TokenText);
-+
+         LineState := lsGotSessionID;
-+
+       end;
-+
-+
+     lsGotSessionID:
-+
+       begin
-+
+         TransactionID := StrToInt(TokenText);
-+
+         if JnlEntryType in [jeTransCommit, jeTransRollback] then
-+
+         begin
-+
+           if assigned(FOnNextJournalEntry) then
-+
+             OnNextJournalEntry(JnlEntry);
-+
+           LineState := lsInit;
-+
+         end
-+
+         else
-+
+           LineState := lsGotTransactionID;
-+
+       end;
-+
-+
+     lsGotTransactionID:
-+
+       begin
-+
+         case JnlEntryType of
-+
+         jeTransStart:
-+
+           begin
-+
+             len := StrToInt(TokenText);
-+
+             LineState := lsGotText1Length;
-+
+           end;
-+
-+
+         jeQuery:
-+
+           begin
-+
+             len :=  StrToInt(TokenText);
-+
+             LineState := lsGotText1Length;
-+
+           end;
-+
-+
+         jeTransCommitRet,
-+
+         jeTransRollbackRet:
-+
+           begin
-+
+             OldTransactionID := StrToInt(TokenText);
-+
+             if assigned(FOnNextJournalEntry) then
-+
+               OnNextJournalEntry(JnlEntry);
-+
+             LineState := lsInit;
-+
+           end;
-+
-+
+           else
-+
+             LineState := lsInit;
-+
+         end; {case JnlEntryType}
-+
-+
+       end;
-+
-+
+     lsGotText1:
-+
+       begin
-+
+         len := StrToInt(TokenText);
-+
+         LineState := lsGotText2Length;
-+
+       end;
-+
-+
+     lsGotText2:
-+
+        begin
-+
+          if JnlEntryType = jeTransStart then
-+
+          begin
-+
+            DefaultCompletion := TTransactionCompletion(StrToInt(TokenText));
-+
+            if assigned(FOnNextJournalEntry) then
-+
+              OnNextJournalEntry(JnlEntry);
-+
+          end;
-+
+          LineState := lsInit;
-+
+        end;
-+
+     end; {case LineState}
-+
+    end; {case token}
-+
+  end; {while}
-+
+  ClearJnlEntry;
-+
+end;
-+
-+
+function TJournalProcessor.IdentifyJnlEntry(aTokenText: AnsiString
-+
+  ): TJnlEntryType;
-+
+begin
-+
+  Result := jeUnknown;
-+
+  if Length(aTokenText) > 0 then
-+
+  case aTokenText[1] of
-+
+  'S':
-+
+    Result := jeTransStart;
-+
+  'C':
-+
+    Result := jeTransCommit;
-+
+  'c':
-+
+    Result := jeTransCommitRet;
-+
+  'R':
-+
+    Result := jeTransRollback;
-+
+  'r':
-+
+    Result := jeTransRollbackRet;
-+
+  'E':
-+
+    Result := jeTransEnd;
-+
+  'Q':
-+
+    Result := jeQuery;
-+
+  end;
-+
+end;
-+
-+
+class function TJournalProcessor.JnlEntryText(je: TJnlEntryType): string;
-+
+begin
-+
+  case je of
-+
+  jeTransStart:
-+
+    Result := 'Transaction Start';
-+
+  jeTransCommit:
-+
+    Result := 'Commit';
-+
+  jeTransCommitRet:
-+
+    Result := 'Commit Retaining';
-+
+  jeTransRollback:
-+
+    Result := 'Rollback';
-+
+  jeTransRollbackRet:
-+
+    Result := 'Rollback Retaining';
-+
+  jeTransEnd:
-+
+    Result := 'Transaction End';
-+
+  jeQuery:
-+
+    Result := 'Query';
-+
+  jeUnknown:
-+
+    Result := 'Unknown';
-+
+  end;
-+
+end;
-+
-+
+function TJournalProcessor.GetChar: AnsiChar;
-+
+begin
-+
+  if FInStream.Read(Result,1) = 0 then
-+
+    Result := #0;
-+
+end;
-+
-+
+destructor TJournalProcessor.Destroy;
-+
+begin
-+
+  FInStream.Free;
-+
+  inherited Destroy;
-+
+end;
-+
-+
+class procedure TJournalProcessor.Execute(aFileName: string; api: IFirebirdAPI;
-+
+  aOnNextJournalEntry: TOnNextJournalEntry);
-+
+begin
-+
+  with TJournalProcessor.Create do
-+
+  try
-+
+    FInStream := TFileStream.Create(aFileName,fmOpenRead);
-+
+    FFirebirdClientAPI := api;
-+
+    OnNextJournalEntry := aOnNextJournalEntry;
-+
+    DoExecute;
-+
+  finally
-+
+    Free
-+
+  end;
-+
+end;
-+
-+
+end.

Diff Legend

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

Comparing: ibx/trunk/fbintf/IBUtils.pas (file contents), Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC vs. ibx/branches/udr/IBUtils.pas (file contents), Revision 370 by tony, Wed Jan 5 14:59:15 2022 UTC

Diff Legend

Comparing:
ibx/trunk/fbintf/IBUtils.pas (file contents), Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC vs.
ibx/branches/udr/IBUtils.pas (file contents), Revision 370 by tony, Wed Jan 5 14:59:15 2022 UTC