jvquibmetadata.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{******************************************************************************}
{                        UNIFIED INTERBASE (UIB)                               }
{                                                                              }
{ Project JEDI Code Library (JCL)                                              }
{                                                                              }
{ The contents of this file are subject to the Mozilla Public License Version  }
{ 1.1 (the "License"); you may not use this file except in compliance with the }
{ License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ }
{                                                                              }
{ Software distributed under the License is distributed on an "AS IS" basis,   }
{ WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for }
{ the specific language governing rights and limitations under the License.    }
{                                                                              }
{ The Initial Developer of the Original Code is documented in the accompanying }
{ help file JCL.chm. Portions created by these individuals are Copyright (C)   }
{ 2003 of these individuals.                                                   }
{                                                                              }
{ Unit owner:    Henri Gourvest                                                }
{ Contributor:   Ritsaert Hornstra                                             }
{ Last modified: September 21, 2003                                            }
{                                                                              }
{******************************************************************************}
{ Class needed to read MetaData. }

{$I jvcl.inc}
{$I JvUIB.inc}

unit JvQUIBMetaData;

interface

uses
  Classes, SysUtils,
  JvQUIBase, JvQUIBLib, JvQUIB, JvQUIBConst;

type
  // (rom) the names of the elements need prefixes
  TTriggerPrefix = (Before, After);
  TTriggerSuffix = (Insert, Update, Delete);
  TTriggerSuffixes = set of TTriggerSuffix;
  TIndexOrder = (IoDescending, IoAscending);
  TUpdateRule = (Restrict, Cascade, SetNull, SetDefault);
  TTableFieldInfo = (fPrimary, fForeign, fIndice, fUnique);
  TTableFieldInfos = set of TTableFieldInfo;

  // indentation = inherit
  TMetaNodeType =
   (
    MetaNode,
      MetaDatabase,
      MetaException,
      MetaGenerator,
      MetaCheck,
      MetaTrigger,
      MetaUDF,
      MetaView,
      MetaProcedure,
      MetaRole,
      MetaTable,
      MetaBaseField,
        MetaUDFField,
        MetaField,
          MetaProcInField,
          MetaProcOutField,
          MetaTableField,
            MetaDomain,
      MetaConstraint,
        MetaForeign,
        MetaIndex,
        MetaPrimary,
        MetaUnique
   );

  // forward declarations
  TMetaNode = class;
  TMetaDomain = class;
  TMetaTable = class;

  TMetaNodeClass = class of TMetaNode;

  TNodeItem = record
    Childs: TList;
    ClassID: TMetaNodeClass;
  end;

  TMetaNode = class(TObject)
  private
    FName: string;
    FOwner: TMetaNode;
    FNodeItems: array of TNodeItem;
    FNodeItemsCount: Integer;
    function GetItems(const ClassIndex, Index: Integer): TMetaNode;
    function GetAsDDL: string;
    procedure AddClass(ClassID: TMetaNodeClass);
    procedure CheckTransaction(Transaction: TJvUIBTransaction);
    procedure SaveNode(Stream: TStringStream; OID: Integer; Separator: string = BreakLine);
    procedure LoadFromStream(Stream: TStream); virtual; abstract;
    function GetAsDDLNode: string;
  public
    procedure SaveToDDLNode(Stream: TStringStream); virtual;
    function GetNodes(const Index: Integer): TNodeItem;
    class function NodeClass: string; virtual;
    class function NodeType: TMetaNodeType; virtual;
    constructor Create(AOwner: TMetaNode; ClassIndex: Integer); virtual;
    constructor CreateFromStream(AOwner: TMetaNode; ClassIndex: Integer; Stream: TStream); virtual;
    destructor Destroy; override;
    procedure SaveToStream(Stream: TStream); virtual;
    procedure SaveToDDL(Stream: TStringStream); virtual;
    property Name: string read FName;
    property AsDDL: string read GetAsDDL;
    property AsDDLNode: string read GetAsDDLNode;
    property NodeCount: Integer read FNodeItemsCount;
    property Nodes[const Index: Integer]: TNodeItem read GetNodes;
    property Parent: TMetaNode read FOwner;
  end;

  TMetaGenerator = class(TMetaNode)
  private
    FValue: Integer;
    procedure LoadFromDataBase(Transaction: TJvUIBTransaction; const Name: string);
    procedure LoadFromStream(Stream: TStream); override;
  public
    procedure SaveToDDLNode(Stream: TStringStream); override;
    class function NodeClass: string; override;
    class function NodeType: TMetaNodeType; override;
    procedure SaveToStream(Stream: TStream); override;
    property Value: Integer read FValue;
  end;

  TMetaBaseField = class(TMetaNode)
  private
    FScale: Word;
    FLength: Smallint;
    FPrecision: Smallint;
    FFieldType: TUIBFieldType;
    FCharSet: string;
    FSegmentLength: Smallint;
    FSubType: Smallint;
    FBytesPerCharacter: Smallint;
    procedure LoadFromQuery(QField, QCharset: TJvUIBStatement); virtual;
    procedure LoadFromStream(Stream: TStream); override;
    property SegmentLength: Smallint read FSegmentLength;
    function GetShortFieldType: string;
  public
    procedure SaveToDDLNode(Stream: TStringStream); override;
    class function NodeClass: string; override;
    class function NodeType: TMetaNodeType; override;
    procedure SaveToStream(Stream: TStream); override;
    property Scale: Word read FScale;
    property Length: Smallint read FLength;
    property Precision: Smallint read FPrecision;
    property FieldType: TUIBFieldType read FFieldType;
    property CharSet: string read FCharSet;
    property SubType: Smallint read FSubType;
    property BytesPerCharacter: Smallint read FBytesPerCharacter;
    property ShortFieldType: string read GetShortFieldType;
  end;

  TMetaField = class(TMetaBaseField)
  private
    procedure LoadFromQuery(Q, C: TJvUIBStatement); override;
  public
    class function NodeType: TMetaNodeType; override;
    procedure SaveToDDL(Stream: TStringStream); override;
    property SegmentLength;
  end;

  TMetaProcInField = class(TMetaField)
  public
    class function NodeClass: string; override;
    class function NodeType: TMetaNodeType; override;
  end;

  TMetaProcOutField = class(TMetaField)
  public
    class function NodeClass: string; override;
    class function NodeType: TMetaNodeType; override;
  end;

  TMetaTableField = class(TMetaField)
  private
    FDefaultValue: string;
    FNotNull: Boolean;
    FDomain: Integer;
    FInfos: TTableFieldInfos;
    FComputedSource: string;
    procedure LoadFromQuery(Q, C: TJvUIBStatement); override;
    procedure LoadFromStream(Stream: TStream); override;
    function GetDomain: TMetaDomain;
  public
    class function NodeType: TMetaNodeType; override;
    procedure SaveToDDLNode(Stream: TStringStream); override;
    procedure SaveToStream(Stream: TStream); override;
    property DefaultValue: string read FDefaultValue;
    property NotNull: Boolean read FNotNull;
    property Domain: TMetaDomain read GetDomain;
    property FieldInfos: TTableFieldInfos read FInfos;
    property ComputedSource: string read FComputedSource;
  end;

  TMetaDomain = class(TMetaTableField)
  protected
    property Domain; // hidden
    property ComputedSource; // hidden
  public
    procedure SaveToDDLNode(Stream: TStringStream); override;
    procedure SaveToDDL(Stream: TStringStream); override;
    class function NodeClass: string; override;
    class function NodeType: TMetaNodeType; override;
  end;

  TMetaConstraint = class(TMetaNode)
  private
    FFields: array of Integer;
    function GetFields(const Index: Word): TMetaTableField;
    function GetFieldsCount: Word;
    procedure LoadFromStream(Stream: TStream); override;
  public
    class function NodeClass: string; override;
    class function NodeType: TMetaNodeType; override;
    procedure SaveToStream(Stream: TStream); override;
    property Fields[const Index: Word]: TMetaTableField read GetFields;
    property FieldsCount: Word read GetFieldsCount;
  end;

  TMetaPrimary = class(TMetaConstraint)
  private
    procedure LoadFromQuery(Q: TJvUIBStatement);
  public
    class function NodeClass: string; override;
    class function NodeType: TMetaNodeType; override;
    procedure SaveToDDLNode(Stream: TStringStream); override;
  end;

  TMetaUnique = class(TMetaConstraint)
  public
    class function NodeClass: string; override;
    class function NodeType: TMetaNodeType; override;
    procedure SaveToDDL(Stream: TStringStream); override;
  end;

  TMetaForeign = class(TMetaConstraint)
  private
    FForTable: Integer;
    FForFields: array of Integer;
    FOnDelete: TUpdateRule;
    FOnUpdate: TUpdateRule;
    function GetForFields(const Index: Word): TMetaTableField;
    function GetForFieldsCount: Word;
    function GetForTable: TMetaTable;
    procedure LoadFromStream(Stream: TStream); override;
  public
    class function NodeClass: string; override;
    class function NodeType: TMetaNodeType; override;
    procedure SaveToStream(Stream: TStream); override;
    procedure SaveToDDLNode(Stream: TStringStream); override;
    property ForTable: TMetaTable read GetForTable;
    property ForFields[const Index: Word]: TMetaTableField read GetForFields;
    property ForFieldsCount: Word read GetForFieldsCount;
    property OnDelete: TUpdateRule read FOnDelete;
    property OnUpdate: TUpdateRule read FOnUpdate;
  end;

  TMetaCheck = class(TMetaNode)
  private
    FConstraint: string;
    procedure LoadFromStream(Stream: TStream); override;
  public
    class function NodeClass: string; override;
    class function NodeType: TMetaNodeType; override;
    procedure SaveToDDLNode(Stream: TStringStream); override;
    procedure SaveToStream(Stream: TStream); override;
    property Constraint: string read FConstraint;
  end;

  TMetaIndex = class(TMetaConstraint)
  private
    FUnique: Boolean;
    FActive: Boolean;
    FOrder: TIndexOrder;
    procedure LoadFromStream(Stream: TStream); override;
  public
    class function NodeClass: string; override;
    class function NodeType: TMetaNodeType; override;
    procedure SaveToDDLNode(Stream: TStringStream); override;
    procedure SaveToStream(Stream: TStream); override;
    property Unique: Boolean read FUnique;
    property Active: Boolean read FActive;
    property Order: TIndexOrder read FOrder;
  end;

  TMetaTrigger = class(TMetaNode)
  private
    FPrefix: TTriggerPrefix;
    FSuffix: TTriggerSuffixes;
    FPosition: Smallint;
    FActive: Boolean;
    FSource: string;
    class function DecodePrefix(Value: Integer): TTriggerPrefix;
    class function DecodeSuffixes(Value: Integer): TTriggerSuffixes;
    procedure LoadFromQuery(Q: TJvUIBStatement);
    procedure LoadFromStream(Stream: TStream); override;
  public
    class function NodeClass: string; override;
    class function NodeType: TMetaNodeType; override;
    procedure SaveToStream(Stream: TStream); override;
    procedure SaveToDDLNode(Stream: TStringStream); override;
    property Prefix: TTriggerPrefix read FPrefix;
    property Suffix: TTriggerSuffixes read FSuffix;
    property Position: Smallint read FPosition;
    property Active: Boolean read FActive;
    property Source: string read FSource;
  end;

  TMetaTable = class(TMetaNode)
  private
    function GetFields(const Index: Integer): TMetaTableField;
    function GetFieldsCount: Integer;
    procedure LoadFromDataBase(QNames, QFields, QCharset, QPrimary,
      QIndex, QForeign, QCheck, QTrigger: TJvUIBStatement; OIDs: TOIDTables);
    function FindFieldIndex(const Name: string): Integer;
    function GetUniques(const Index: Integer): TMetaUnique;
    function GetUniquesCount: Integer;
    function GetPrimary(const Index: Integer): TMetaPrimary;
    function GetPrimaryCount: Integer;
    function GetIndices(const Index: Integer): TMetaIndex;
    function GetIndicesCount: Integer;
    function GetForeign(const Index: Integer): TMetaForeign;
    function GetForeignCount: Integer;
    function GetChecks(const Index: Integer): TMetaCheck;
    function GetChecksCount: Integer;
    function GetTriggers(const Index: Integer): TMetaTrigger;
    function GetTriggersCount: Integer;
    procedure LoadFromStream(Stream: TStream); override;
  public
    procedure SaveToDDLNode(Stream: TStringStream); override;
    class function NodeClass: string; override;
    class function NodeType: TMetaNodeType; override;
    function FindFieldName(const Name: string): TMetaTableField;
    constructor Create(AOwner: TMetaNode; ClassIndex: Integer); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure SaveToDDL(Stream: TStringStream); override;

    property Fields[const Index: Integer]: TMetaTableField read GetFields;
    property FieldsCount: Integer read GetFieldsCount;

    property Primary[const Index: Integer]: TMetaPrimary read GetPrimary;
    property PrimaryCount: Integer read GetPrimaryCount; // 0 or 1

    property Uniques[const Index: Integer]: TMetaUnique read GetUniques;
    property UniquesCount: Integer read GetUniquesCount;

    property Indices[const Index: Integer]: TMetaIndex read GetIndices;
    property IndicesCount: Integer read GetIndicesCount;

    property Foreign[const Index: Integer]: TMetaForeign read GetForeign;
    property ForeignCount: Integer read GetForeignCount;

    property Checks[const Index: Integer]: TMetaCheck read GetChecks;
    property ChecksCount: Integer read GetChecksCount;

    property Triggers[const Index: Integer]: TMetaTrigger read GetTriggers;
    property TriggersCount: Integer read GetTriggersCount;
  end;

  TMetaView = class(TMetaNode)
  private
    FSource: string;
    function GetFields(const Index: Integer): TMetaField;
    function GetFieldsCount: Integer;
    function GetTriggers(const Index: Integer): TMetaTrigger;
    function GetTriggersCount: Integer;
    procedure LoadFromDataBase(QName, QFields, QTriggers,
      QCharset: TJvUIBStatement; OIDs: TOIDViews);
    procedure LoadFromStream(Stream: TStream); override;
  public
    procedure SaveToDDLNode(Stream: TStringStream); override;
    class function NodeClass: string; override;
    class function NodeType: TMetaNodeType; override;
    constructor Create(AOwner: TMetaNode; ClassIndex: Integer); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure SaveToDDL(Stream: TStringStream); override;
    property Source: string read FSource;
    property Fields[const Index: Integer]: TMetaField read GetFields;
    property FieldsCount: Integer read GetFieldsCount;
    property Triggers[const Index: Integer]: TMetaTrigger read GetTriggers;
    property TriggersCount: Integer read GetTriggersCount;
  end;

  TMetaProcedure = class(TMetaNode)
  private
    FSource: string;
    procedure LoadFromQuery(QNames, QFields, QCharset: TJvUIBStatement; OIDs: TOIDProcedures);
    function GetInputFields(const Index: Integer): TMetaProcInField;
    function GetInputFieldsCount: Integer;
    function GetOutputFields(const Index: Integer): TMetaProcOutField;