2932 lines
88 KiB
ObjectPascal
2932 lines
88 KiB
ObjectPascal
{******************************************************************************}
|
|
{ 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 JvUIBMetaData;
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF USEJVCL}
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
{$ENDIF USEJVCL}
|
|
Classes, SysUtils,
|
|
JvUIBase, JvUIBLib, JvUIB, JvUIBConst;
|
|
|
|
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;
|
|
function GetOutputFieldsCount: Integer;
|
|
procedure LoadFromStream(Stream: TStream); override;
|
|
procedure InternalSaveToDDL(Stream: TStringStream; Operation: string);
|
|
procedure SaveToPostDDL(Stream: TStringStream);
|
|
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 SaveToAlterDDL(Stream: TStringStream);
|
|
|
|
property Source: string read FSource;
|
|
|
|
property InputFields[const Index: Integer]: TMetaProcInField read GetInputFields;
|
|
property InputFieldsCount: Integer read GetInputFieldsCount;
|
|
|
|
property OutputFields[const Index: Integer]: TMetaProcOutField read GetOutputFields;
|
|
property OutputFieldsCount: Integer read GetOutputFieldsCount;
|
|
end;
|
|
|
|
TMetaException = class(TMetaNode)
|
|
private
|
|
FMessage: string;
|
|
FNumber: Integer;
|
|
procedure LoadFromStream(Stream: TStream); override;
|
|
procedure LoadFromQuery(QName: TJvUIBStatement);
|
|
public
|
|
procedure SaveToDDLNode(Stream: TStringStream); override;
|
|
class function NodeClass: string; override;
|
|
class function NodeType: TMetaNodeType; override;
|
|
procedure SaveToStream(Stream: TStream); override;
|
|
property Message: string read FMessage;
|
|
property Number: Integer read FNumber;
|
|
end;
|
|
|
|
TMetaUDFField = class(TMetaBaseField)
|
|
private
|
|
FPosition: Smallint;
|
|
FMechanism: Smallint;
|
|
procedure LoadFromQuery(QField, QCharset: TJvUIBStatement); override;
|
|
procedure LoadFromStream(Stream: TStream); override;
|
|
public
|
|
class function NodeType: TMetaNodeType; override;
|
|
procedure SaveToDDLNode(Stream: TStringStream); override;
|
|
procedure SaveToStream(Stream: TStream); override;
|
|
property Position: Smallint read FPosition;
|
|
property Mechanism: Smallint read FMechanism;
|
|
end;
|
|
|
|
TMetaUDF = class(TMetaNode)
|
|
private
|
|
FModule: string;
|
|
FEntry: string;
|
|
FReturn: Smallint;
|
|
procedure LoadFromStream(Stream: TStream); override;
|
|
procedure LoadFromQuery(QNames, QFields, QCharset: TJvUIBStatement; OIDs: TOIDUDFs);
|
|
function GetFields(const Index: Integer): TMetaUDFField;
|
|
function GetFieldsCount: Integer;
|
|
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;
|
|
property Module: string read FModule;
|
|
property Entry: string read FEntry;
|
|
property Return: Smallint read FReturn;
|
|
property Fields[const Index: Integer]: TMetaUDFField read GetFields;
|
|
property FieldsCount: Integer read GetFieldsCount;
|
|
end;
|
|
|
|
TMetaRole = class(TMetaNode)
|
|
private
|
|
FOwner: string;
|
|
procedure LoadFromStream(Stream: TStream); override;
|
|
procedure LoadFromQuery(QName: TJvUIBStatement);
|
|
public
|
|
procedure SaveToDDLNode(Stream: TStringStream); override;
|
|
class function NodeClass: string; override;
|
|
class function NodeType: TMetaNodeType; override;
|
|
procedure SaveToStream(Stream: TStream); override;
|
|
property Owner: string read FOwner;
|
|
end;
|
|
|
|
TMetaDataBase = class(TMetaNode)
|
|
private
|
|
FOIDDatabases: TOIDDatabases;
|
|
FOIDTables: TOIDTables;
|
|
FOIDViews: TOIDViews;
|
|
FOIDProcedures: TOIDProcedures;
|
|
FOIDUDFs: TOIDUDFs;
|
|
FSysInfos: Boolean;
|
|
function GetGenerators(const Index: Integer): TMetaGenerator;
|
|
function GetGeneratorsCount: Integer;
|
|
|
|
function GetTables(const Index: Integer): TMetaTable;
|
|
function GetTablesCount: Integer;
|
|
function FindTableIndex(const TableName: string): Integer;
|
|
function FindDomainIndex(const DomainName: string): Integer;
|
|
function GetViews(const Index: Integer): TMetaView;
|
|
function GetViewsCount: Integer;
|
|
function GetDomains(const Index: Integer): TMetaDomain;
|
|
function GetDomainsCount: Integer;
|
|
|
|
procedure LoadFromStream(Stream: TStream); override;
|
|
function GetProcedures(const Index: Integer): TMetaProcedure;
|
|
function GetProceduresCount: Integer;
|
|
function GetExceptions(const Index: Integer): TMetaException;
|
|
function GetExceptionsCount: Integer;
|
|
function GetUDFS(const Index: Integer): TMetaUDF;
|
|
function GetUDFSCount: Integer;
|
|
function GetRoles(const Index: Integer): TMetaRole;
|
|
function GetRolesCount: Integer;
|
|
public
|
|
class function NodeClass: string; override;
|
|
class function NodeType: TMetaNodeType; override;
|
|
procedure SaveToStream(Stream: TStream); override;
|
|
function FindTableName(const TableName: string): TMetaTable;
|
|
function FindProcName(const ProcName: string): TMetaProcedure;
|
|
constructor Create(AOwner: TMetaNode; ClassIndex: Integer); override;
|
|
procedure LoadFromDatabase(Transaction: TJvUIBTransaction);
|
|
procedure SaveToDDL(Stream: TStringStream); override;
|
|
|
|
property OIDDatabases: TOIDDatabases read FOIDDatabases write FOIDDatabases;
|
|
|
|
property Generators[const Index: Integer]: TMetaGenerator read GetGenerators;
|
|
property GeneratorsCount: Integer read GetGeneratorsCount;
|
|
|
|
property Tables[const Index: Integer]: TMetaTable read GetTables;
|
|
property TablesCount: Integer read GetTablesCount;
|
|
property OIDTables: TOIDTables read FOIDTables write FOIDTables;
|
|
|
|
property Views[const Index: Integer]: TMetaView read GetViews;
|
|
property ViewsCount: Integer read GetViewsCount;
|
|
property OIDViews: TOIDViews read FOIDViews write FOIDViews;
|
|
|
|
property Domains[const Index: Integer]: TMetaDomain read GetDomains;
|
|
property DomainsCount: Integer read GetDomainsCount;
|
|
|
|
property Procedures[const Index: Integer]: TMetaProcedure read GetProcedures;
|
|
property ProceduresCount: Integer read GetProceduresCount;
|
|
property OIDProcedures: TOIDProcedures read FOIDProcedures write FOIDProcedures;
|
|
|
|
property Exceptions[const Index: Integer]: TMetaException read GetExceptions;
|
|
property ExceptionsCount: Integer read GetExceptionsCount;
|
|
|
|
property UDFS[const Index: Integer]: TMetaUDF read GetUDFS;
|
|
property UDFSCount: Integer read GetUDFSCount;
|
|
property OIDUDFs: TOIDUDFs read FOIDUDFs write FOIDUDFs;
|
|
|
|
property Roles[const Index: Integer]: TMetaRole read GetRoles;
|
|
property RolesCount: Integer read GetRolesCount;
|
|
|
|
property SysInfos: Boolean read FSysInfos write FSysInfos;
|
|
end;
|
|
|
|
{$IFDEF USEJVCL}
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvUIBMetaData.pas $';
|
|
Revision: '$Revision: 10612 $';
|
|
Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $';
|
|
LogPath: 'JVCL\run'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
{$ENDIF USEJVCL}
|
|
|
|
implementation
|
|
|
|
// Database Tree
|
|
//------------------------
|
|
// OIDDomains = 0;
|
|
// OIDTable = 1;
|
|
// OIDTableFields = 0;
|
|
// OIDPrimary = 1;
|
|
// OIDForeign = 2;
|
|
// OIDTableTrigger = 3;
|
|
// OIDUnique = 4;
|
|
// OIDIndex = 5;
|
|
// OIDCheck = 6;
|
|
// OIDView = 2;
|
|
// OIDViewFields = 0;
|
|
// OIDViewTrigers = 1;
|
|
// OIDProcedure = 3;
|
|
// OIDProcFieldIn = 0;
|
|
// OIDProcFieldOut = 1;
|
|
// OIDGenerator = 4;
|
|
// OIDException = 5;
|
|
// OIDUDF = 6;
|
|
// OIDUDFField = 0;
|
|
// OIDRole = 7;
|
|
|
|
const
|
|
TriggerPrefixTypes: array [TTriggerPrefix] of PChar =
|
|
('BEFORE', 'AFTER');
|
|
|
|
TriggerSuffixTypes: array [TTriggerSuffix] of PChar =
|
|
('INSERT', 'UPDATE', 'DELETE');
|
|
|
|
FieldTypes: array [TUIBFieldType] of PChar =
|
|
('', 'NUMERIC', 'CHAR', 'VARCHAR', 'CSTRING', 'SMALLINT', 'INTEGER', 'QUAD',
|
|
'FLOAT', 'DOUBLE PRECISION', 'TIMESTAMP', 'BLOB', 'BLOBID', 'DATE', 'TIME',
|
|
'INT64' {$IFDEF IB7_UP}, 'BOOLEAN' {$ENDIF});
|
|
|
|
QRYGenerators =
|
|
'SELECT RDB$GENERATOR_NAME FROM RDB$GENERATORS GEN WHERE ' +
|
|
'(NOT GEN.RDB$GENERATOR_NAME STARTING WITH ''RDB$'') AND ' +
|
|
'(NOT GEN.RDB$GENERATOR_NAME STARTING WITH ''SQL$'') AND ' +
|
|
'((GEN.RDB$SYSTEM_FLAG IS NULL) OR (GEN.RDB$SYSTEM_FLAG <> 1)) ' +
|
|
'ORDER BY GEN.RDB$GENERATOR_NAME';
|
|
|
|
QRYTables =
|
|
'SELECT REL.RDB$RELATION_NAME FROM RDB$RELATIONS REL WHERE ' +
|
|
'(REL.RDB$SYSTEM_FLAG <> 1 OR REL.RDB$SYSTEM_FLAG IS NULL) AND ' +
|
|
'(NOT REL.RDB$FLAGS IS NULL) AND ' +
|
|
'(REL.RDB$VIEW_BLR IS NULL) AND ' +
|
|
'(REL.RDB$SECURITY_CLASS STARTING WITH ''SQL$'') ' +
|
|
'ORDER BY REL.RDB$RELATION_NAME';
|
|
|
|
QRYSysTables =
|
|
'SELECT REL.RDB$RELATION_NAME FROM RDB$RELATIONS REL ' +
|
|
'WHERE REL.RDB$VIEW_BLR IS NULL ORDER BY REL.RDB$RELATION_NAME';
|
|
|
|
QRYTableFields =
|
|
'SELECT FLD.RDB$FIELD_TYPE, FLD.RDB$FIELD_SCALE, ' +
|
|
'FLD.RDB$FIELD_LENGTH, FLD.RDB$FIELD_PRECISION, ' +
|
|
'FLD.RDB$CHARACTER_SET_ID, FLD.RDB$FIELD_SUB_TYPE, RFR.RDB$FIELD_NAME, ' +
|
|
'FLD.RDB$SEGMENT_LENGTH, RFR.RDB$NULL_FLAG, RFR.RDB$DEFAULT_SOURCE, ' +
|
|
'RFR.RDB$FIELD_SOURCE , FLD.RDB$COMPUTED_SOURCE ' +
|
|
'FROM RDB$RELATIONS REL, RDB$RELATION_FIELDS RFR, RDB$FIELDS FLD ' +
|
|
'WHERE (RFR.RDB$FIELD_SOURCE = FLD.RDB$FIELD_NAME) AND ' +
|
|
'(RFR.RDB$RELATION_NAME = REL.RDB$RELATION_NAME) AND ' +
|
|
'(REL.RDB$RELATION_NAME = ?) ' +
|
|
'ORDER BY RFR.RDB$FIELD_POSITION, RFR.RDB$FIELD_NAME';
|
|
|
|
QRYCharset =
|
|
'SELECT RDB$CHARACTER_SET_ID, RDB$CHARACTER_SET_NAME, RDB$BYTES_PER_CHARACTER FROM RDB$CHARACTER_SETS';
|
|
|
|
QRYUnique =
|
|
'SELECT RC.RDB$CONSTRAINT_NAME, IDX.RDB$FIELD_NAME ' +
|
|
'FROM RDB$RELATION_CONSTRAINTS RC, RDB$INDEX_SEGMENTS IDX ' +
|
|
'WHERE (IDX.RDB$INDEX_NAME = RC.RDB$INDEX_NAME) AND ' +
|
|
'(RC.RDB$CONSTRAINT_TYPE = ?) ' +
|
|
'AND (RC.RDB$RELATION_NAME = ?) ' +
|
|
'ORDER BY RC.RDB$RELATION_NAME, IDX.RDB$FIELD_POSITION';
|
|
|
|
QRYIndex =
|
|
'SELECT IDX.RDB$INDEX_NAME, ISG.RDB$FIELD_NAME, IDX.RDB$UNIQUE_FLAG, ' +
|
|
'IDX.RDB$INDEX_INACTIVE, IDX.RDB$INDEX_TYPE FROM RDB$INDICES IDX ' +
|
|
'LEFT JOIN RDB$INDEX_SEGMENTS ISG ON ISG.RDB$INDEX_NAME = IDX.RDB$INDEX_NAME ' +
|
|
'LEFT JOIN RDB$RELATION_CONSTRAINTS C ON IDX.RDB$INDEX_NAME = C.RDB$INDEX_NAME ' +
|
|
'WHERE (C.RDB$CONSTRAINT_NAME IS NULL) AND (IDX.RDB$RELATION_NAME = ?) ' +
|
|
'ORDER BY IDX.RDB$RELATION_NAME, IDX.RDB$INDEX_NAME, ISG.RDB$FIELD_POSITION';
|
|
|
|
QRYForeign =
|
|
'SELECT A.RDB$CONSTRAINT_NAME, B.RDB$UPDATE_RULE, B.RDB$DELETE_RULE, ' +
|
|
'C.RDB$RELATION_NAME AS FK_TABLE, D.RDB$FIELD_NAME AS FK_FIELD, ' +
|
|
'E.RDB$FIELD_NAME AS ONFIELD ' +
|
|
'FROM RDB$REF_CONSTRAINTS B, RDB$RELATION_CONSTRAINTS A, RDB$RELATION_CONSTRAINTS C, ' +
|
|
'RDB$INDEX_SEGMENTS D, RDB$INDEX_SEGMENTS E ' +
|
|
'WHERE (A.RDB$CONSTRAINT_TYPE = ''FOREIGN KEY'') AND ' +
|
|
'(A.RDB$CONSTRAINT_NAME = B.RDB$CONSTRAINT_NAME) AND ' +
|
|
'(B.RDB$CONST_NAME_UQ=C.RDB$CONSTRAINT_NAME) AND (C.RDB$INDEX_NAME=D.RDB$INDEX_NAME) AND ' +
|
|
'(A.RDB$INDEX_NAME=E.RDB$INDEX_NAME) AND ' +
|
|
'(D.RDB$FIELD_POSITION = E.RDB$FIELD_POSITION) ' +
|
|
'AND (A.RDB$RELATION_NAME = ?) ' +
|
|
'ORDER BY A.RDB$CONSTRAINT_NAME, A.RDB$RELATION_NAME, D.RDB$FIELD_POSITION, E.RDB$FIELD_POSITION';
|
|
|
|
QRYCheck =
|
|
'SELECT A.RDB$CONSTRAINT_NAME, C.RDB$TRIGGER_SOURCE ' +
|
|
'FROM RDB$RELATION_CONSTRAINTS A, RDB$CHECK_CONSTRAINTS B, RDB$TRIGGERS C ' +
|
|
'WHERE (A.RDB$CONSTRAINT_TYPE = ''CHECK'') AND ' +
|
|
'(A.RDB$CONSTRAINT_NAME = B.RDB$CONSTRAINT_NAME) AND ' +
|
|
'(B.RDB$TRIGGER_NAME = C.RDB$TRIGGER_NAME) AND ' +
|
|
'(C.RDB$TRIGGER_TYPE = 1) ' +
|
|
'AND (A.RDB$RELATION_NAME = ?)';
|
|
|
|
QRYTrigger =
|
|
'SELECT T.RDB$TRIGGER_NAME, T.RDB$TRIGGER_SOURCE, T.RDB$TRIGGER_SEQUENCE, ' +
|
|
'T.RDB$TRIGGER_TYPE, T.RDB$TRIGGER_INACTIVE, T.RDB$SYSTEM_FLAG ' +
|
|
'from RDB$TRIGGERS T left join RDB$CHECK_CONSTRAINTS C ON C.RDB$TRIGGER_NAME = ' +
|
|
'T.RDB$TRIGGER_NAME where ((T.RDB$SYSTEM_FLAG = 0) or (T.RDB$SYSTEM_FLAG is null)) ' +
|
|
'and (c.rdb$trigger_name is null) and (T.RDB$RELATION_NAME = ?) ' +
|
|
'order by T.RDB$TRIGGER_NAME';
|
|
|
|
QRYSysTrigger =
|
|
'SELECT T.RDB$TRIGGER_NAME, T.RDB$TRIGGER_SOURCE, T.RDB$TRIGGER_SEQUENCE, ' +
|
|
'T.RDB$TRIGGER_TYPE, T.RDB$TRIGGER_INACTIVE, T.RDB$SYSTEM_FLAG ' +
|
|
'FROM RDB$TRIGGERS T LEFT JOIN RDB$CHECK_CONSTRAINTS C ON C.RDB$TRIGGER_NAME = ' +
|
|
'T.RDB$TRIGGER_NAME WHERE (T.RDB$RELATION_NAME = ?) ORDER BY T.RDB$TRIGGER_NAME';
|
|
|
|
QRYView =
|
|
'SELECT REL.RDB$RELATION_NAME, REL.RDB$VIEW_SOURCE FROM RDB$RELATIONS REL WHERE ' +
|
|
'(REL.RDB$SYSTEM_FLAG <> 1 OR REL.RDB$SYSTEM_FLAG IS NULL) AND ' +
|
|
'(NOT REL.RDB$FLAGS IS NULL) AND ' +
|
|
'(NOT REL.RDB$VIEW_BLR IS NULL) AND ' +
|
|
'(REL.RDB$SECURITY_CLASS STARTING WITH ''SQL$'') ' +
|
|
'ORDER BY REL.RDB$RELATION_NAME';
|
|
|
|
QRYDomains =
|
|
'select RDB$FIELD_TYPE, RDB$FIELD_SCALE, RDB$FIELD_LENGTH, ' +
|
|
'RDB$FIELD_PRECISION, RDB$CHARACTER_SET_ID, RDB$FIELD_SUB_TYPE, ' +
|
|
'RDB$FIELD_NAME, RDB$SEGMENT_LENGTH, RDB$NULL_FLAG, RDB$DEFAULT_SOURCE, RDB$COMPUTED_SOURCE ' +
|
|
'FROM RDB$FIELDS WHERE NOT (RDB$FIELD_NAME STARTING WITH ''RDB$'')';
|
|
|
|
QRYSysDomains =
|
|
'select RDB$FIELD_TYPE, RDB$FIELD_SCALE, RDB$FIELD_LENGTH, ' +
|
|
'RDB$FIELD_PRECISION, RDB$CHARACTER_SET_ID, RDB$FIELD_SUB_TYPE, ' +
|
|
'RDB$FIELD_NAME, RDB$SEGMENT_LENGTH, RDB$NULL_FLAG, RDB$DEFAULT_SOURCE, RDB$COMPUTED_SOURCE ' +
|
|
'from RDB$FIELDS';
|
|
|
|
QRYProcedures =
|
|
'SELECT RDB$PROCEDURE_NAME, RDB$PROCEDURE_SOURCE FROM RDB$PROCEDURES ORDER BY RDB$PROCEDURE_NAME';
|
|
|
|
QRYProcFields =
|
|
'SELECT FS.RDB$FIELD_TYPE, FS.RDB$FIELD_SCALE, FS.RDB$FIELD_LENGTH, FS.RDB$FIELD_PRECISION, ' +
|
|
'FS.RDB$CHARACTER_SET_ID, FS.RDB$FIELD_SUB_TYPE, PP.RDB$PARAMETER_NAME, FS.RDB$SEGMENT_LENGTH ' +
|
|
'FROM RDB$PROCEDURES PR LEFT JOIN RDB$PROCEDURE_PARAMETERS PP ' +
|
|
'ON PP.RDB$PROCEDURE_NAME = PR.RDB$PROCEDURE_NAME LEFT JOIN RDB$FIELDS FS ON ' +
|
|
'FS.RDB$FIELD_NAME = PP.RDB$FIELD_SOURCE LEFT JOIN RDB$CHARACTER_SETS CR ON ' +
|
|
'FS.RDB$CHARACTER_SET_ID = CR.RDB$CHARACTER_SET_ID LEFT JOIN RDB$COLLATIONS CO ' +
|
|
'ON ((FS.RDB$COLLATION_ID = CO.RDB$COLLATION_ID) AND (FS.RDB$CHARACTER_SET_ID = ' +
|
|
'CO.RDB$CHARACTER_SET_ID)) WHERE (PR.RDB$PROCEDURE_NAME = ?) AND ' +
|
|
'(PP.RDB$PARAMETER_TYPE = ?) ORDER BY PP.RDB$PARAMETER_TYPE, PP.RDB$PARAMETER_NUMBER';
|
|
|
|
QRYExceptions =
|
|
'SELECT RDB$EXCEPTION_NAME, RDB$MESSAGE, RDB$EXCEPTION_NUMBER FROM RDB$EXCEPTIONS ORDER BY RDB$EXCEPTION_NAME';
|
|
|
|
QRYUDF =
|
|
'SELECT RDB$FUNCTION_NAME, RDB$MODULE_NAME, RDB$ENTRYPOINT, RDB$RETURN_ARGUMENT ' +
|
|
'FROM RDB$FUNCTIONS WHERE (RDB$SYSTEM_FLAG IS NULL) ORDER BY RDB$FUNCTION_NAME';
|
|
|
|
QRYUDFFields =
|
|
'SELECT RDB$FIELD_TYPE, RDB$FIELD_SCALE, RDB$FIELD_LENGTH, RDB$FIELD_PRECISION, ' +
|
|
'RDB$CHARACTER_SET_ID, RDB$FIELD_SUB_TYPE, RDB$ARGUMENT_POSITION, RDB$MECHANISM ' +
|
|
'FROM RDB$FUNCTION_ARGUMENTS WHERE RDB$FUNCTION_NAME = ? ' +
|
|
'ORDER BY RDB$ARGUMENT_POSITION';
|
|
|
|
QRYRoles =
|
|
'SELECT RDB$ROLE_NAME, RDB$OWNER_NAME FROM RDB$ROLES';
|
|
|
|
procedure WriteString(Stream: TStream; var Str: string);
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
Len := Length(Str);
|
|
Stream.Write(Len, SizeOf(Len));
|
|
if Len > 0 then
|
|
Stream.Write(PChar(Str)^, Len);
|
|
end;
|
|
|
|
procedure ReadString(Stream: TStream; var Str: string);
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
Stream.Read(Len, SizeOf(Len));
|
|
SetLength(Str, Len);
|
|
if Len > 0 then
|
|
Stream.Read(PChar(Str)^, Len);
|
|
end;
|
|
|
|
//=== { TMetaNode } ==========================================================
|
|
|
|
constructor TMetaNode.Create(AOwner: TMetaNode; ClassIndex: Integer);
|
|
begin
|
|
// (rom) added inherited Create
|
|
inherited Create;
|
|
FNodeItemsCount := 0;
|
|
FOwner := AOwner;
|
|
if (FOwner <> nil) and (ClassIndex >= 0) then
|
|
FOwner.FNodeItems[ClassIndex].Childs.Add(Self)
|
|
end;
|
|
|
|
constructor TMetaNode.CreateFromStream(AOwner: TMetaNode; ClassIndex: Integer; Stream: TStream);
|
|
var
|
|
I, J: Integer;
|
|
begin
|
|
Create(AOwner, ClassIndex);
|
|
LoadFromStream(Stream);
|
|
for J := 0 to FNodeItemsCount - 1 do
|
|
begin
|
|
Stream.Read(I, SizeOf(I));
|
|
for I := 0 to I - 1 do
|
|
FNodeItems[J].ClassID.CreateFromStream(Self, J, Stream);
|
|
end;
|
|
end;
|
|
|
|
destructor TMetaNode.Destroy;
|
|
var
|
|
I, J: Integer;
|
|
begin
|
|
for I := 0 to FNodeItemsCount - 1 do
|
|
begin
|
|
for J := 0 to FNodeItems[I].Childs.Count - 1 do
|
|
TObJect(FNodeItems[I].Childs[J]).Free;
|
|
FNodeItems[I].Childs.Free;
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TMetaNode.GetAsDDL: string;
|
|
var
|
|
Stream: TStringStream;
|
|
begin
|
|
Stream := TStringStream.Create('');
|
|
try
|
|
SaveToDDL(Stream);
|
|
Result := Stream.DataString;
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
function TMetaNode.GetItems(const ClassIndex, Index: Integer): TMetaNode;
|
|
var
|
|
FChilds: TList;
|
|
begin
|
|
FChilds := FNodeItems[ClassIndex].Childs;
|
|
if (FChilds.Count > 0) and (Index >= 0) and
|
|
(Index < FChilds.Count) then
|
|
Result := TMetaNode(FChilds.Items[Index])
|
|
else
|
|
raise EUIBError.CreateFmt(EUIB_INDEXERROR, [Index]);
|
|
end;
|
|
|
|
procedure TMetaNode.SaveToStream(Stream: TStream);
|
|
var
|
|
I, J: Integer;
|
|
begin
|
|
for J := 0 to FNodeItemsCount - 1 do
|
|
begin
|
|
I := FNodeItems[J].Childs.Count;
|
|
Stream.Write(I, SizeOf(I));
|
|
for I := 0 to I - 1 do
|
|
TMetaNode(FNodeItems[J].Childs.Items[I]).SaveToStream(Stream);
|
|
end;
|
|
end;
|
|
|
|
procedure TMetaNode.AddClass(ClassID: TMetaNodeClass);
|
|
begin
|
|
SetLength(FNodeItems, FNodeItemsCount + 1);
|
|
FNodeItems[FNodeItemsCount].Childs := TList.Create;
|
|
FNodeItems[FNodeItemsCount].ClassID := ClassID;
|
|
Inc(FNodeItemsCount);
|
|
end;
|
|
|
|
procedure TMetaNode.CheckTransaction(Transaction: TJvUIBTransaction);
|
|
begin
|
|
Assert(Transaction <> nil);
|
|
Assert(Transaction.DataBase <> nil);
|
|
end;
|
|
|
|
procedure TMetaNode.SaveNode(Stream: TStringStream; OID: Integer;
|
|
Separator: string);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to FNodeItems[OID].Childs.Count - 1 do
|
|
begin
|
|
if I = 0 then
|
|
Stream.WriteString(NewLine)
|
|
else
|
|
Stream.WriteString(Separator);
|
|
TMetaNode(FNodeItems[OID].Childs[I]).SaveToDDL(Stream);
|
|
end;
|
|
end;
|
|
|
|
procedure TMetaNode.SaveToDDLNode(Stream: TStringStream);
|
|
begin
|
|
end;
|
|
|
|
function TMetaNode.GetNodes(const Index: Integer): TNodeItem;
|
|
begin
|
|
Assert((Index >= 0) and (FNodeItemsCount > 0) and (Index < FNodeItemsCount));
|
|
Result := FNodeItems[Index];
|
|
end;
|
|
|
|
class function TMetaNode.NodeClass: string;
|
|
begin
|
|
Result := 'Node'
|
|
end;
|
|
|
|
procedure TMetaNode.SaveToDDL(Stream: TStringStream);
|
|
begin
|
|
SaveToDDLNode(Stream);
|
|
end;
|
|
|
|
function TMetaNode.GetAsDDLNode: string;
|
|
var
|
|
Stream: TStringStream;
|
|
begin
|
|
Stream := TStringStream.Create('');
|
|
try
|
|
SaveToDDLNode(Stream);
|
|
Result := Stream.DataString;
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TMetaNode.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaNode;
|
|
end;
|
|
|
|
//=== { TMetaGenerator } =====================================================
|
|
|
|
procedure TMetaGenerator.LoadFromDataBase(Transaction: TJvUIBTransaction;
|
|
const Name: string);
|
|
var
|
|
Query: TJvUIBStatement;
|
|
begin
|
|
CheckTransaction(Transaction);
|
|
Query := TJvUIBStatement.Create(nil);
|
|
Query.Transaction := Transaction;
|
|
Query.CachedFetch := False;
|
|
try
|
|
FName := Name;
|
|
Query.SQL.Text := Format('select gen_id(%s, 0) from rdb$database', [FName]);
|
|
Query.Open;
|
|
if not Query.Eof then
|
|
FValue := Query.Fields.AsInteger[0]
|
|
else
|
|
raise EUIBError.CreateFmt(EUIB_NOGENERATOR, [FName]);
|
|
finally
|
|
Query.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMetaGenerator.LoadFromStream(Stream: TStream);
|
|
begin
|
|
ReadString(Stream, FName);
|
|
Stream.Read(FValue, SizeOf(FValue));
|
|
end;
|
|
|
|
procedure TMetaGenerator.SaveToStream(Stream: TStream);
|
|
begin
|
|
WriteString(Stream, FName);
|
|
Stream.Write(FValue, SizeOf(FValue));
|
|
end;
|
|
|
|
procedure TMetaGenerator.SaveToDDLNode(Stream: TStringStream);
|
|
begin
|
|
Stream.WriteString(Format(
|
|
'CREATE GENERATOR %s;%sSET GENERATOR %0:s TO %2:d;',
|
|
[FName, BreakLine, FValue]));
|
|
end;
|
|
|
|
class function TMetaGenerator.NodeClass: string;
|
|
begin
|
|
Result := 'Generator';
|
|
end;
|
|
|
|
class function TMetaGenerator.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaGenerator;
|
|
end;
|
|
|
|
//=== { TMetaTable } =========================================================
|
|
|
|
constructor TMetaTable.Create(AOwner: TMetaNode; ClassIndex: Integer);
|
|
begin
|
|
inherited Create(AOwner, ClassIndex);
|
|
AddClass(TMetaTableField);
|
|
AddClass(TMetaPrimary);
|
|
AddClass(TMetaForeign);
|
|
AddClass(TMetaTrigger);
|
|
AddClass(TMetaUnique);
|
|
AddClass(TMetaIndex);
|
|
AddClass(TMetaCheck);
|
|
end;
|
|
|
|
function TMetaTable.FindFieldName(const Name: string): TMetaTableField;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to FieldsCount - 1 do
|
|
if Fields[I].FName = Name then
|
|
begin
|
|
Result := Fields[I];
|
|
Exit;
|
|
end;
|
|
raise EUIBError.CreateFmt(EUIB_NOFIELD, [Name]);
|
|
end;
|
|
|
|
function TMetaTable.GetFields(const Index: Integer): TMetaTableField;
|
|
begin
|
|
Result := TMetaTableField(GetItems(Ord(OIDTableField), Index))
|
|
end;
|
|
|
|
function TMetaTable.GetFieldsCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDTableField)].Childs.Count;
|
|
end;
|
|
|
|
function TMetaTable.GetPrimary(const Index: Integer): TMetaPrimary;
|
|
begin
|
|
Result := TMetaPrimary(GetItems(Ord(OIDPrimary), Index))
|
|
end;
|
|
|
|
function TMetaTable.GetPrimaryCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDPrimary)].Childs.Count;
|
|
end;
|
|
|
|
function TMetaTable.GetUniques(const Index: Integer): TMetaUnique;
|
|
begin
|
|
Result := TMetaUnique(GetItems(Ord(OIDUnique), Index))
|
|
end;
|
|
|
|
function TMetaTable.GetUniquesCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDUnique)].Childs.Count;
|
|
end;
|
|
|
|
procedure TMetaTable.LoadFromDataBase(QNames, QFields, QCharset, QPrimary,
|
|
QIndex, QForeign, QCheck, QTrigger: TJvUIBStatement; OIDs: TOIDTables);
|
|
var
|
|
Unk: string;
|
|
begin
|
|
// Fields
|
|
FName := Trim(QNames.Fields.AsString[0]);
|
|
|
|
if OIDTableField in OIDs then
|
|
begin
|
|
QFields.Params.AsString[0] := FName;
|
|
QFields.Open;
|
|
while not QFields.Eof do
|
|
begin
|
|
with TMetaTableField.Create(Self, Ord(OIDTableField)) do
|
|
LoadFromQuery(QFields, QCharset);
|
|
QFields.Next;
|
|
end;
|
|
|
|
// PRIMARY
|
|
if OIDPrimary in OIDs then
|
|
begin
|
|
QPrimary.Params.AsString[1] := FName;
|
|
QPrimary.Params.AsString[0] := 'PRIMARY KEY';
|
|
QPrimary.Open;
|
|
if not QPrimary.Eof then
|
|
TMetaPrimary.Create(Self, Ord(OIDPrimary)).LoadFromQuery(QPrimary);
|
|
end;
|
|
|
|
// INDICES
|
|
if OIDIndex in OIDs then
|
|
begin
|
|
Unk := '';
|
|
QIndex.Params.AsString[0] := FName;
|
|
QIndex.Open;
|
|
while not QIndex.Eof do
|
|
begin
|
|
if Unk <> Trim(QIndex.Fields.AsString[0]) then
|
|
with TMetaIndex.Create(Self, Ord(OIDIndex)) do
|
|
begin
|
|
SetLength(FFields, 1);
|
|
FName := Trim(QIndex.Fields.AsString[0]);
|
|
FFields[0] := FindFieldIndex(Trim(QIndex.Fields.AsString[1]));
|
|
FUnique := QIndex.Fields.AsSingle[2] = 1;
|
|
FActive := QIndex.Fields.AsSingle[3] = 0;
|
|
if QIndex.Fields.AsSingle[4] = 0 then
|
|
FOrder := IoAscending
|
|
else
|
|
FOrder := IoDescending;
|
|
Unk := FName;
|
|
end
|
|
else
|
|
with Indices[IndicesCount - 1] do
|
|
begin
|
|
SetLength(FFields, FieldsCount + 1);
|
|
FFields[FieldsCount - 1] := FindFieldIndex(Trim(QIndex.Fields.AsString[1]));
|
|
Include(Fields[FieldsCount - 1].FInfos, fIndice);
|
|
end;
|
|
QIndex.Next;
|
|
end;
|
|
end;
|
|
|
|
// UNIQUE
|
|
if OIDUnique in OIDs then
|
|
begin
|
|
QPrimary.Params.AsString[0] := 'UNIQUE';
|
|
if not (OIDPrimary in OIDs) then
|
|
QPrimary.Params.AsString[1] := FName;
|
|
QPrimary.Open;
|
|
while not QPrimary.Eof do
|
|
begin
|
|
if Unk <> Trim(QPrimary.Fields.AsString[0]) then
|
|
with TMetaUnique.Create(Self, Ord(OIDUnique)) do
|
|
begin
|
|
SetLength(FFields, 1);
|
|
FName := Trim(QPrimary.Fields.AsString[0]);
|
|
FFields[0] := FindFieldIndex(Trim(QPrimary.Fields.AsString[1]));
|
|
Unk := FName;
|
|
end
|
|
else
|
|
with Uniques[UniquesCount - 1] do
|
|
begin
|
|
SetLength(FFields, FieldsCount + 1);
|
|
FFields[FieldsCount - 1] := FindFieldIndex(Trim(QPrimary.Fields.AsString[1]));
|
|
Include(Fields[FieldsCount - 1].FInfos, fUnique);
|
|
end;
|
|
QPrimary.Next;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
// Check
|
|
if OIDCheck in OIDs then
|
|
begin
|
|
QCheck.Params.AsString[0] := FName;
|
|
QCheck.Open;
|
|
while not QCheck.Eof do
|
|
with TMetaCheck.Create(Self, Ord(OIDCheck)) do
|
|
begin
|
|
FName := Trim(QCheck.Fields.AsString[0]);
|
|
QCheck.ReadBlob(1, FConstraint);
|
|
QCheck.Next;
|
|
end;
|
|
end;
|
|
|
|
// TRIGGER
|
|
if OIDTableTrigger in OIDs then
|
|
begin
|
|
QTrigger.Params.AsString[0] := FName;
|
|
QTrigger.Open;
|
|
while not QTrigger.Eof do
|
|
begin
|
|
TMetaTrigger.Create(Self, Ord(OIDTableTrigger)).LoadFromQuery(QTrigger);
|
|
QTrigger.Next;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMetaTable.LoadFromStream(Stream: TStream);
|
|
begin
|
|
ReadString(Stream, FName);
|
|
end;
|
|
|
|
procedure TMetaTable.SaveToStream(Stream: TStream);
|
|
begin
|
|
WriteString(Stream, FName);
|
|
inherited SaveToStream(Stream);
|
|
end;
|
|
|
|
procedure TMetaTable.SaveToDDL(Stream: TStringStream);
|
|
begin
|
|
inherited SaveToDDL(Stream);
|
|
SaveNode(Stream, Ord(OIDPrimary));
|
|
SaveNode(Stream, Ord(OIDUnique));
|
|
SaveNode(Stream, Ord(OIDIndex));
|
|
SaveNode(Stream, Ord(OIDForeign));
|
|
SaveNode(Stream, Ord(OIDCheck));
|
|
SaveNode(Stream, Ord(OIDTableTrigger), NewLine);
|
|
end;
|
|
|
|
function TMetaTable.GetIndices(const Index: Integer): TMetaIndex;
|
|
begin
|
|
Result := TMetaIndex(GetItems(Ord(OIDIndex), Index))
|
|
end;
|
|
|
|
function TMetaTable.GetIndicesCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDIndex)].Childs.Count;
|
|
end;
|
|
|
|
function TMetaTable.GetForeign(const Index: Integer): TMetaForeign;
|
|
begin
|
|
Result := TMetaForeign(GetItems(Ord(OIDForeign), Index))
|
|
end;
|
|
|
|
function TMetaTable.GetForeignCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDForeign)].Childs.Count;
|
|
end;
|
|
|
|
function TMetaTable.FindFieldIndex(const Name: string): Integer;
|
|
begin
|
|
for Result := 0 to FieldsCount - 1 do
|
|
if Fields[Result].FName = Name then
|
|
Exit;
|
|
raise EUIBError.CreateFmt(EUIB_FIELDSTRNOTFOUND, [Name]);
|
|
end;
|
|
|
|
function TMetaTable.GetChecks(const Index: Integer): TMetaCheck;
|
|
begin
|
|
Result := TMetaCheck(GetItems(Ord(OIDCheck), Index));
|
|
end;
|
|
|
|
function TMetaTable.GetChecksCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDCheck)].Childs.Count;
|
|
end;
|
|
|
|
function TMetaTable.GetTriggers(const Index: Integer): TMetaTrigger;
|
|
begin
|
|
Result := TMetaTrigger(GetItems(Ord(OIDTableTrigger), Index));
|
|
end;
|
|
|
|
function TMetaTable.GetTriggersCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDTableTrigger)].Childs.Count;
|
|
end;
|
|
|
|
procedure TMetaTable.SaveToDDLNode(Stream: TStringStream);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Stream.WriteString(Format('CREATE TABLE %s (', [FName]));
|
|
for I := 0 to FieldsCount - 1 do
|
|
begin
|
|
Stream.WriteString(BreakLine + ' ');
|
|
Fields[I].SaveToDDL(Stream);
|
|
if I <> FieldsCount - 1 then
|
|
Stream.WriteString(',');
|
|
end;
|
|
Stream.WriteString(BreakLine + ');');
|
|
end;
|
|
|
|
class function TMetaTable.NodeClass: string;
|
|
begin
|
|
Result := 'Table';
|
|
end;
|
|
|
|
class function TMetaTable.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaTable;
|
|
end;
|
|
|
|
//=== { TMetaBaseField } =====================================================
|
|
|
|
procedure TMetaBaseField.LoadFromStream(Stream: TStream);
|
|
begin
|
|
ReadString(Stream, FName);
|
|
Stream.Read(FFieldType, SizeOf(FFieldType));
|
|
|
|
if FFieldType = uftNumeric then
|
|
begin
|
|
Stream.Read(FScale, SizeOf(FScale));
|
|
Stream.Read(FPrecision, SizeOf(FPrecision));
|
|
end
|
|
else
|
|
begin
|
|
FScale := 0;
|
|
FPrecision := 0;
|
|
end;
|
|
|
|
if FFieldType in [uftChar..uftCstring] then
|
|
begin
|
|
Stream.Read(FLength, SizeOf(FLength));
|
|
ReadString(Stream, FCharSet);
|
|
Stream.Read(FBytesPerCharacter, SizeOf(FBytesPerCharacter));
|
|
end
|
|
else
|
|
begin
|
|
FLength := 0;
|
|
FCharSet := '';
|
|
end;
|
|
|
|
if FFieldType = uftBlob then
|
|
begin
|
|
Stream.Read(FSegmentLength, SizeOf(FSegmentLength));
|
|
Stream.Read(FSubType, SizeOf(FSubType));
|
|
end
|
|
else
|
|
begin
|
|
FSegmentLength := 0;
|
|
FSubType := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TMetaBaseField.SaveToStream(Stream: TStream);
|
|
begin
|
|
WriteString(Stream, FName);
|
|
Stream.Write(FFieldType, SizeOf(FFieldType));
|
|
|
|
if FFieldType = uftNumeric then
|
|
begin
|
|
Stream.Write(FScale, SizeOf(FScale));
|
|
Stream.Write(FPrecision, SizeOf(FPrecision));
|
|
end;
|
|
|
|
if FFieldType in [uftChar..uftCstring] then
|
|
begin
|
|
Stream.Write(FLength, SizeOf(FLength));
|
|
WriteString(Stream, FCharSet);
|
|
Stream.Write(FBytesPerCharacter, SizeOf(FBytesPerCharacter));
|
|
end;
|
|
|
|
if FFieldType = uftBlob then
|
|
begin
|
|
Stream.Write(FSegmentLength, SizeOf(FSegmentLength));
|
|
Stream.Write(FSubType, SizeOf(FSubType));
|
|
end;
|
|
end;
|
|
|
|
procedure TMetaBaseField.LoadFromQuery(QField, QCharset: TJvUIBStatement);
|
|
|
|
procedure FindCharset(const Id: Single; var Charset: string; var Count: Smallint);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to QCharset.Fields.RecordCount - 1 do
|
|
begin
|
|
QCharset.Fields.GetRecord(I);
|
|
if QCharset.Fields.AsSmallint[0] = Id then
|
|
begin
|
|
Charset := Trim(QCharset.Fields.AsString[1]);
|
|
Count := QCharset.Fields.AsSmallint[2];
|
|
Exit;
|
|
end;
|
|
Charset := '';
|
|
FBytesPerCharacter := 1;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
FScale := Abs(QField.Fields.AsSmallInt[1]);
|
|
FLength := QField.Fields.AsSmallInt[2];
|
|
FPrecision := QField.Fields.AsSmallInt[3];
|
|
if FScale > 0 then
|
|
begin
|
|
FFieldType := uftNumeric;
|
|
if FPrecision = 0 then
|
|
case QField.Fields.AsSmallint[0] of
|
|
blr_short:
|
|
FPrecision := 4;
|
|
blr_long:
|
|
FPrecision := 7;
|
|
blr_int64, blr_quad, blr_double:
|
|
FPrecision := 15;
|
|
else
|
|
raise EUIBError.Create(EUIB_UNEXPECTEDERROR);
|
|
end;
|
|
end
|
|
else
|
|
case QField.Fields.AsSmallint[0] of
|
|
blr_text, blr_text2:
|
|
FFieldType := uftChar;
|
|
blr_varying, blr_varying2:
|
|
FFieldType := uftVarchar;
|
|
blr_cstring, blr_cstring2:
|
|
FFieldType := uftCstring;
|
|
blr_short:
|
|
FFieldType := uftSmallint;
|
|
blr_long:
|
|
FFieldType := uftInteger;
|
|
blr_quad:
|
|
FFieldType := uftQuad;
|
|
blr_float, blr_d_float:
|
|
FFieldType := uftFloat;
|
|
blr_double:
|
|
FFieldType := uftDoublePrecision;
|
|
blr_timestamp:
|
|
FFieldType := uftTimestamp;
|
|
blr_blob:
|
|
FFieldType := uftBlob;
|
|
blr_blob_id:
|
|
FFieldType := uftBlobId;
|
|
blr_sql_date:
|
|
FFieldType := uftDate;
|
|
blr_sql_time:
|
|
FFieldType := uftTime;
|
|
blr_int64:
|
|
FFieldType := uftInt64;
|
|
{$IFDEF IB7_UP}
|
|
blr_boolean_dtype:
|
|
FFieldType := uftBoolean;
|
|
{$ENDIF IB7_UP}
|
|
end;
|
|
if (FFieldType in [uftChar, uftVarchar, uftCstring]) and
|
|
not QField.Fields.IsNull[4] then
|
|
FindCharset(QField.Fields.AsSmallint[4], FCharSet, FBytesPerCharacter)
|
|
else
|
|
FBytesPerCharacter := 1;
|
|
|
|
FSubType := QField.Fields.AsSmallint[5];
|
|
end;
|
|
|
|
procedure TMetaBaseField.SaveToDDLNode(Stream: TStringStream);
|
|
begin
|
|
case FFieldType of
|
|
uftNumeric:
|
|
Stream.WriteString(Format('%s(%d,%d)',
|
|
[FieldTypes[FFieldType], FPrecision, FScale]));
|
|
uftChar..uftCstring:
|
|
begin
|
|
Stream.WriteString(Format('%s(%d)',
|
|
[FieldTypes[FFieldType], FLength div FBytesPerCharacter]));
|
|
if FCharSet <> '' then
|
|
Stream.WriteString(' CHARACTER SET ' + FCharSet);
|
|
end;
|
|
uftBlob:
|
|
Stream.WriteString(Format('%s SUB_TYPE %d SEGMENT SIZE %d',
|
|
[FieldTypes[FFieldType], FSubType, FSegmentLength]));
|
|
else
|
|
Stream.WriteString(Format('%s', [FieldTypes[FFieldType]]));
|
|
end;
|
|
end;
|
|
|
|
class function TMetaBaseField.NodeClass: string;
|
|
begin
|
|
Result := 'Field';
|
|
end;
|
|
|
|
function TMetaBaseField.GetShortFieldType: string;
|
|
begin
|
|
case FFieldType of
|
|
uftChar..uftCstring:
|
|
Result := Format('%s(%d)', [FieldTypes[FFieldType],
|
|
FLength div FBytesPerCharacter]);
|
|
uftNumeric:
|
|
Result := Format('%s(%d,%d)',
|
|
[FieldTypes[FFieldType], FPrecision, FScale]);
|
|
else
|
|
Result := Format('%s', [FieldTypes[FFieldType]]);
|
|
end;
|
|
end;
|
|
|
|
class function TMetaBaseField.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaBaseField;
|
|
end;
|
|
|
|
//=== { TMetaDataBase } ======================================================
|
|
|
|
constructor TMetaDataBase.Create(AOwner: TMetaNode; ClassIndex: Integer);
|
|
begin
|
|
inherited Create(nil, -1);
|
|
AddClass(TMetaDomain);
|
|
AddClass(TMetaTable);
|
|
AddClass(TMetaView);
|
|
AddClass(TMetaProcedure);
|
|
AddClass(TMetaGenerator);
|
|
AddClass(TMetaException);
|
|
AddClass(TMetaUDF);
|
|
AddClass(TMetaRole);
|
|
|
|
FOIDDatabases := ALLOBjects;
|
|
FOIDTables := ALLTables;
|
|
FOIDViews := ALLViews;
|
|
FOIDProcedures := ALLProcedures;
|
|
FOIDUDFs := ALLUDFs;
|
|
FSysInfos := False;
|
|
end;
|
|
|
|
procedure TMetaDataBase.LoadFromDatabase(Transaction: TJvUIBTransaction);
|
|
var
|
|
I: Integer;
|
|
ConStr, Str: string;
|
|
QNames, QFields, QCharset, QPrimary: TJvUIBStatement;
|
|
QIndex, QForeign, QCheck, QTrigger: TJvUIBStatement;
|
|
|
|
procedure Configure(var Q: TJvUIBStatement; const Qry: string;
|
|
CachedFetch: Boolean = False);
|
|
begin
|
|
Q := TJvUIBStatement.Create(nil);
|
|
Q.Transaction := Transaction;
|
|
Q.CachedFetch := CachedFetch;
|
|
Q.SQL.Text := Qry;
|
|
end;
|
|
|
|
begin
|
|
CheckTransaction(Transaction);
|
|
|
|
FName := Transaction.DataBase.DatabaseName;
|
|
|
|
Configure(QNames, '');
|
|
if FSysInfos then
|
|
Configure(QTrigger, QRYSysTrigger)
|
|
else
|
|
Configure(QTrigger, QRYTrigger);
|
|
Configure(QCharset, QRYCharset, True);
|
|
Configure(QFields, QRYTableFields);
|
|
Configure(QPrimary, QRYUnique, True);
|
|
Configure(QIndex, QRYIndex);
|
|
Configure(QForeign, QRYForeign);
|
|
Configure(QCheck, QRYCheck);
|
|
try
|
|
// preload Charsets
|
|
QCharset.Open;
|
|
QCharset.FetchAll;
|
|
|
|
// DOMAINS
|
|
if OIDDomain in FOIDDatabases then
|
|
begin
|
|
FNodeItems[Ord(OIDDomain)].Childs.Clear;
|
|
if FSysInfos then
|
|
QNames.SQL.Text := QRYSysDomains
|
|
else
|
|
QNames.SQL.Text := QRYDomains;
|
|
QNames.Open;
|
|
while not QNames.Eof do
|
|
begin
|
|
with TMetaDomain.Create(Self, Ord(OIDDomain)) do
|
|
LoadFromQuery(QNames, QCharset);
|
|
QNames.Next;
|
|
end;
|
|
end;
|
|
|
|
// GENERATORS
|
|
if OIDGenerator in FOIDDatabases then
|
|
begin
|
|
FNodeItems[Ord(OIDGenerator)].Childs.Clear;
|
|
QNames.SQL.Text := QRYGenerators;
|
|
QNames.Open;
|
|
while not QNames.Eof do
|
|
begin
|
|
with TMetaGenerator.Create(Self, Ord(OIDGenerator)) do
|
|
LoadFromDataBase(Transaction, Trim(QNames.Fields.AsString[0]));
|
|
QNames.Next;
|
|
end;
|
|
end;
|
|
|
|
// TABLES
|
|
if OIDTable in FOIDDatabases then
|
|
begin
|
|
FNodeItems[Ord(OIDTable)].Childs.Clear;
|
|
if FSysInfos then
|
|
QNames.SQL.Text := QRYSysTables
|
|
else
|
|
QNames.SQL.Text := QRYTables;
|
|
QNames.Open;
|
|
while not QNames.Eof do
|
|
begin
|
|
with TMetaTable.Create(Self, Ord(OIDTable)) do
|
|
LoadFromDataBase(QNames, QFields, QCharset, QPrimary,
|
|
QIndex, QForeign, QCheck, QTrigger, FOIDTables);
|
|
QNames.Next;
|
|
end;
|
|
|
|
// FOREIGN
|
|
if [OIDForeign, OIDTableField] <= FOIDTables then
|
|
begin
|
|
for I := 0 to TablesCount - 1 do
|
|
begin
|
|
QForeign.Params.AsString[0] := Tables[I].Name;
|
|
QForeign.Open;
|
|
ConStr := '';
|
|
while not QForeign.Eof do
|
|
begin
|
|
if ConStr <> Trim(QForeign.Fields.AsString[0]) then // new
|
|
begin
|
|
with TMetaForeign.Create(Tables[I], Ord(OIDForeign)) do
|
|
begin
|
|
FName := Trim(QForeign.Fields.AsString[0]);
|
|
ConStr := FName;
|
|
FForTable := FindTableIndex(Trim(QForeign.Fields.AsString[3]));
|
|
if 'TABLE1' = Trim(QForeign.Fields.AsString[3]) then
|
|
beep;
|
|
SetLength(FFields, 1);
|
|
FFields[0] := Tables[I].FindFieldIndex(Trim(QForeign.Fields.AsString[5]));
|
|
Include(Tables[I].Fields[FFields[0]].FInfos, fForeign);
|
|
SetLength(FForFields, 1);
|
|
FForFields[0] := ForTable.FindFieldIndex(Trim(QForeign.Fields.AsString[4]));
|
|
|
|
Str := Trim(QForeign.Fields.AsString[1]);
|
|
if Str = 'RESTRICT' then
|
|
FOnUpdate := Restrict
|
|
else
|
|
if Str = 'CASCADE' then
|
|
FOnUpdate := Cascade
|
|
else
|
|
if Str = 'SET NULL' then
|
|
FOnUpdate := SetNull
|
|
else
|
|
FOnUpdate := SetDefault;
|
|
|
|
Str := Trim(QForeign.Fields.AsString[2]);
|
|
if Str = 'RESTRICT' then
|
|
FOnDelete := Restrict
|
|
else
|
|
if Str = 'CASCADE' then
|
|
FOnDelete := Cascade
|
|
else
|
|
if Str = 'SET NULL' then
|
|
FOnDelete := SetNull
|
|
else
|
|
FOnDelete := SetDefault;
|
|
end;
|
|
end
|
|
else
|
|
with Tables[I].Foreign[Tables[I].ForeignCount - 1] do
|
|
begin
|
|
SetLength(FFields, Length(FFields) + 1);
|
|
FFields[FieldsCount - 1] := Tables[I].FindFieldIndex(Trim(QForeign.Fields.AsString[5]));
|
|
Include(Tables[I].Fields[FFields[FieldsCount - 1]].FInfos, fForeign);
|
|
SetLength(FForFields, Length(FForFields) + 1);
|
|
FForFields[ForFieldsCount - 1] := ForTable.FindFieldIndex(Trim(QForeign.Fields.AsString[4]));
|
|
end;
|
|
QForeign.Next;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// VIEWS
|
|
if OIDView in FOIDDatabases then
|
|
begin
|
|
FNodeItems[Ord(OIDView)].Childs.Clear;
|
|
QNames.SQL.Text := QRYView;
|
|
QNames.Open;
|
|
while not QNames.Eof do
|
|
begin
|
|
with TMetaView.Create(Self, Ord(OIDView)) do
|
|
LoadFromDataBase(QNames, QFields, QTrigger, QCharset, FOIDViews);
|
|
QNames.Next;
|
|
end;
|
|
end;
|
|
|
|
// PROCEDURE
|
|
if OIDProcedure in FOIDDatabases then
|
|
begin
|
|
FNodeItems[Ord(OIDProcedure)].Childs.Clear;
|
|
QNames.SQL.Text := QRYProcedures;
|
|
QFields.SQL.Text := QRYProcFields;
|
|
QNames.Open;
|
|
while not QNames.Eof do
|
|
begin
|
|
with TMetaProcedure.Create(Self, Ord(OIDProcedure)) do
|
|
LoadFromQuery(QNames, QFields, QCharset, FOIDProcedures);
|
|
QNames.Next;
|
|
end;
|
|
end;
|
|
|
|
// EXCEPTION
|
|
if OIDException in FOIDDatabases then
|
|
begin
|
|
FNodeItems[Ord(OIDException)].Childs.Clear;
|
|
QNames.SQL.Text := QRYExceptions;
|
|
QNames.Open;
|
|
while not QNames.Eof do
|
|
begin
|
|
TMetaException.Create(Self, Ord(OIDException)).LoadFromQuery(QNames);
|
|
QNames.Next;
|
|
end;
|
|
end;
|
|
|
|
// UDF
|
|
if OIDUDF in FOIDDatabases then
|
|
begin
|
|
FNodeItems[Ord(OIDUDF)].Childs.Clear;
|
|
QNames.SQL.Text := QRYUDF;
|
|
QFields.SQL.Text := QRYUDFFields;
|
|
QNames.Open;
|
|
while not QNames.Eof do
|
|
begin
|
|
TMetaUDF.Create(Self, Ord(OIDUDF)).LoadFromQuery(QNames, QFields, QCharset, FOIDUDFs);
|
|
QNames.Next;
|
|
end;
|
|
end;
|
|
|
|
// ROLES
|
|
if OIDRole in FOIDDatabases then
|
|
begin
|
|
FNodeItems[Ord(OIDRole)].Childs.Clear;
|
|
QNames.SQL.Text := QRYRoles;
|
|
QNames.Open;
|
|
while not QNames.Eof do
|
|
begin
|
|
TMetaRole.Create(Self, Ord(OIDRole)).LoadFromQuery(QNames);
|
|
QNames.Next;
|
|
end;
|
|
end;
|
|
finally
|
|
QNames.Free;
|
|
QCharset.Free;
|
|
QFields.Free;
|
|
QPrimary.Free;
|
|
QIndex.Free;
|
|
QForeign.Free;
|
|
QCheck.Free;
|
|
QTrigger.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMetaDataBase.SaveToDDL(Stream: TStringStream);
|
|
var
|
|
I: Integer;
|
|
|
|
procedure SaveChildNodes(comment: string; OIDParent, OIDChild: Integer;
|
|
Separator: string = BreakLine);
|
|
var
|
|
I, J: Integer;
|
|
begin
|
|
if TablesCount > 0 then
|
|
begin
|
|
Stream.WriteString(NewLine);
|
|
Stream.WriteString(Format('/* %s */', [comment]));
|
|
Stream.WriteString(BreakLine);
|
|
for I := 0 to FNodeItems[OIDParent].Childs.Count - 1 do
|
|
for J := 0 to GetItems(OIDParent, I).FNodeItems[OIDChild].Childs.Count - 1 do
|
|
begin
|
|
Stream.WriteString(Separator);
|
|
TMetaNode(GetItems(OIDParent, I).FNodeItems[OIDChild].Childs[J]).SaveToDDL(Stream);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SaveMainNodes(Comment: string; OID: Integer;
|
|
Separator: string = NewLine);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if FNodeItems[OID].Childs.Count > 0 then
|
|
begin
|
|
Stream.WriteString(NewLine);
|
|
Stream.WriteString(Format('/* %s */', [comment]));
|
|
for I := 0 to FNodeItems[OID].Childs.Count - 1 do
|
|
begin
|
|
if I = 0 then
|
|
Stream.WriteString(NewLine)
|
|
else
|
|
Stream.WriteString(Separator);
|
|
if GetItems(OID, I) is TMetaProcedure then
|
|
TMetaProcedure(GetItems(OID, I)).SaveToPostDDL(Stream)
|
|
else
|
|
GetItems(OID, I).SaveToDDLNode(Stream);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
SaveMainNodes('ROLES', Ord(OIDRole), NewLine);
|
|
SaveMainNodes('FUNCTIONS', Ord(OIDUDF), NewLine);
|
|
SaveMainNodes('DOMAINS', Ord(OIDDomain), BreakLine);
|
|
SaveMainNodes('GENERATORS', Ord(OIDGenerator));
|
|
SaveMainNodes('EXEPTIONS', Ord(OIDException), BreakLine);
|
|
SaveMainNodes('PROCEDURES', Ord(OIDProcedure));
|
|
SaveMainNodes('TABLES', Ord(OIDTable));
|
|
SaveMainNodes('VIEWS', Ord(OIDView));
|
|
|
|
SaveChildNodes('UNIQUE', Ord(OIDTable), Ord(OIDUnique));
|
|
SaveChildNodes('PRIMARY', Ord(OIDTable), Ord(OIDPrimary));
|
|
SaveChildNodes('FOREIGN', Ord(OIDTable), Ord(OIDForeign));
|
|
SaveChildNodes('INDICES', Ord(OIDTable), Ord(OIDIndex));
|
|
SaveChildNodes('CHECKS', Ord(OIDTable), Ord(OIDCheck), NewLine);
|
|
SaveChildNodes('TRIGGERS', Ord(OIDTable), Ord(OIDTableTrigger), NewLine);
|
|
SaveChildNodes('TRIGGERS (Views)', Ord(OIDView), Ord(OIDViewTrigers), NewLine);
|
|
|
|
if ProceduresCount > 0 then
|
|
begin
|
|
Stream.WriteString(NewLine);
|
|
Stream.WriteString('/* PROCEDURES */');
|
|
for I := 0 to ProceduresCount - 1 do
|
|
begin
|
|
Stream.WriteString(NewLine);
|
|
Procedures[I].SaveToAlterDDL(Stream);
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
function TMetaDataBase.GetGenerators(const Index: Integer): TMetaGenerator;
|
|
begin
|
|
Result := TMetaGenerator(GetItems(Ord(OIDGenerator), Index));
|
|
end;
|
|
|
|
function TMetaDataBase.GetGeneratorsCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDGenerator)].Childs.Count
|
|
end;
|
|
|
|
function TMetaDataBase.GetTables(const Index: Integer): TMetaTable;
|
|
begin
|
|
Result := TMetaTable(GetItems(Ord(OIDTable), Index));
|
|
end;
|
|
|
|
function TMetaDataBase.GetTablesCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDTable)].Childs.Count
|
|
end;
|
|
|
|
function TMetaDataBase.FindTableName(const TableName: string): TMetaTable;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := nil;
|
|
for I := 0 to TablesCount - 1 do
|
|
if Tables[I].Name = TableName then
|
|
begin
|
|
Result := Tables[I];
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
function TMetaDataBase.FindTableIndex(const TableName: string): Integer;
|
|
begin
|
|
for Result := 0 to TablesCount - 1 do
|
|
if Tables[Result].Name = TableName then
|
|
Exit;
|
|
raise Exception.CreateFmt(EUIB_TABLESTRNOTFOUND, [TableName]);
|
|
end;
|
|
|
|
function TMetaDataBase.FindDomainIndex(const DomainName: string): Integer;
|
|
begin
|
|
for Result := 0 to DomainsCount - 1 do
|
|
if Domains[Result].Name = DomainName then
|
|
Exit;
|
|
raise Exception.CreateFmt(EUIB_DOMAINSTRNOTFOUND, [DomainName]);
|
|
end;
|
|
|
|
procedure TMetaDataBase.LoadFromStream(Stream: TStream);
|
|
begin
|
|
ReadString(Stream, FName);
|
|
end;
|
|
|
|
function TMetaDataBase.GetViews(const Index: Integer): TMetaView;
|
|
begin
|
|
Result := TMetaView(GetItems(Ord(OIDView), Index));
|
|
end;
|
|
|
|
function TMetaDataBase.GetViewsCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDView)].Childs.Count
|
|
end;
|
|
|
|
function TMetaDataBase.GetDomains(const Index: Integer): TMetaDomain;
|
|
begin
|
|
Result := TMetaDomain(GetItems(Ord(OIDDomain), Index));
|
|
end;
|
|
|
|
function TMetaDataBase.GetDomainsCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDDomain)].Childs.Count
|
|
end;
|
|
|
|
function TMetaDataBase.GetProcedures(const Index: Integer): TMetaProcedure;
|
|
begin
|
|
Result := TMetaProcedure(GetItems(Ord(OIDProcedure), Index));
|
|
end;
|
|
|
|
function TMetaDataBase.GetProceduresCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDProcedure)].Childs.Count
|
|
end;
|
|
|
|
function TMetaDataBase.GetExceptions(const Index: Integer): TMetaException;
|
|
begin
|
|
Result := TMetaException(GetItems(Ord(OIDException), Index));
|
|
end;
|
|
|
|
function TMetaDataBase.GetExceptionsCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDException)].Childs.Count
|
|
end;
|
|
|
|
function TMetaDataBase.GetUDFS(const Index: Integer): TMetaUDF;
|
|
begin
|
|
Result := TMetaUDF(GetItems(Ord(OIDUDF), Index));
|
|
end;
|
|
|
|
function TMetaDataBase.GetUDFSCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDUDF)].Childs.Count
|
|
end;
|
|
|
|
class function TMetaDataBase.NodeClass: string;
|
|
begin
|
|
Result := 'Database';
|
|
end;
|
|
|
|
procedure TMetaDataBase.SaveToStream(Stream: TStream);
|
|
begin
|
|
WriteString(Stream, FName);
|
|
inherited SaveToStream(Stream);
|
|
end;
|
|
|
|
function TMetaDataBase.GetRoles(const Index: Integer): TMetaRole;
|
|
begin
|
|
Result := TMetaRole(GetItems(Ord(OIDRole), Index));
|
|
end;
|
|
|
|
function TMetaDataBase.GetRolesCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDRole)].Childs.Count
|
|
end;
|
|
|
|
class function TMetaDataBase.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaDatabase;
|
|
end;
|
|
|
|
function TMetaDataBase.FindProcName(const ProcName: string): TMetaProcedure;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to ProceduresCount - 1 do
|
|
if Procedures[I].Name = ProcName then
|
|
begin
|
|
Result := Procedures[I];
|
|
Exit;
|
|
end;
|
|
raise Exception.CreateFmt(EUIB_PROCSTRNOTFOUND, [ProcName]);
|
|
end;
|
|
|
|
//=== { TMetaConstraint } ====================================================
|
|
|
|
function TMetaConstraint.GetFields(const Index: Word): TMetaTableField;
|
|
begin
|
|
Assert((FieldsCount > 0) and (Index < FieldsCount), IntToStr(Index) + ' ' + ClassName);
|
|
Result := TMetaTable(FOwner).Fields[FFields[Index]];
|
|
end;
|
|
|
|
function TMetaConstraint.GetFieldsCount: Word;
|
|
begin
|
|
Result := Length(FFields);
|
|
end;
|
|
|
|
class function TMetaConstraint.NodeClass: string;
|
|
begin
|
|
Result := 'Constraint'
|
|
end;
|
|
|
|
procedure TMetaConstraint.LoadFromStream(Stream: TStream);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Stream.Read(I, SizeOf(I));
|
|
SetLength(FFields, I);
|
|
if I > 0 then
|
|
begin
|
|
ReadString(Stream, FName);
|
|
for I := 0 to I - 1 do
|
|
begin
|
|
Stream.Read(FFields[I], SizeOf(FFields[I]));
|
|
case NodeType of
|
|
MetaForeign:
|
|
Include(TMetaTable(FOwner).Fields[FFields[I]].FInfos, fForeign);
|
|
MetaIndex:
|
|
Include(TMetaTable(FOwner).Fields[FFields[I]].FInfos, fIndice);
|
|
MetaPrimary:
|
|
Include(TMetaTable(FOwner).Fields[FFields[I]].FInfos, fPrimary);
|
|
MetaUnique:
|
|
Include(TMetaTable(FOwner).Fields[FFields[I]].FInfos, fPrimary);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMetaConstraint.SaveToStream(Stream: TStream);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := FieldsCount;
|
|
Stream.Write(I, SizeOf(I));
|
|
if I > 0 then
|
|
begin
|
|
WriteString(Stream, FName);
|
|
for I := 0 to I - 1 do
|
|
Stream.Write(FFields[I], SizeOf(FFields[I]));
|
|
end;
|
|
end;
|
|
|
|
class function TMetaConstraint.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaConstraint;
|
|
end;
|
|
|
|
//=== { TMetaUnique } ========================================================
|
|
|
|
class function TMetaUnique.NodeClass: string;
|
|
begin
|
|
Result := 'Unique';
|
|
end;
|
|
|
|
class function TMetaUnique.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaUnique;
|
|
end;
|
|
|
|
procedure TMetaUnique.SaveToDDL(Stream: TStringStream);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Stream.WriteString(Format('ALTER TABLE %s ADD UNIQUE (',
|
|
[TMetaTable(FOwner).FName]));
|
|
for I := 0 to FieldsCount - 1 do
|
|
begin
|
|
Stream.WriteString(Fields[I].Name);
|
|
if I <> FieldsCount - 1 then
|
|
Stream.WriteString(', ');
|
|
end;
|
|
Stream.WriteString(');');
|
|
end;
|
|
|
|
//=== { TMetaPrimary } =======================================================
|
|
|
|
class function TMetaPrimary.NodeClass: string;
|
|
begin
|
|
Result := 'Primary key';
|
|
end;
|
|
|
|
procedure TMetaPrimary.LoadFromQuery(Q: TJvUIBStatement);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FName := Trim(Q.Fields.AsString[0]);
|
|
Q.FetchAll;
|
|
SetLength(FFields, Q.Fields.RecordCount);
|
|
for I := 0 to Q.Fields.RecordCount - 1 do
|
|
begin
|
|
Q.Fields.GetRecord(I);
|
|
FFields[I] := TMetaTable(FOwner).FindFieldIndex(Trim(Q.Fields.AsString[1]));
|
|
Include(TMetaTable(FOwner).Fields[FFields[I]].FInfos, fPrimary);
|
|
end;
|
|
end;
|
|
|
|
procedure TMetaPrimary.SaveToDDLNode(Stream: TStringStream);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if copy(FName, 0, 6) = 'INTEG_' then
|
|
Stream.WriteString(Format('ALTER TABLE %s ADD PRIMARY KEY (',
|
|
[TMetaTable(FOwner).FName]))
|
|
else
|
|
Stream.WriteString(Format('ALTER TABLE %s ADD CONSTRAINT %s PRIMARY KEY (',
|
|
[TMetaTable(FOwner).FName, FName]));
|
|
for I := 0 to FieldsCount - 1 do
|
|
begin
|
|
Stream.WriteString(Fields[I].Name);
|
|
if I <> FieldsCount - 1 then
|
|
Stream.WriteString(', ');
|
|
end;
|
|
Stream.WriteString(');');
|
|
end;
|
|
|
|
class function TMetaPrimary.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaPrimary;
|
|
end;
|
|
|
|
//=== { TMetaIndex } =========================================================
|
|
|
|
class function TMetaIndex.NodeClass: string;
|
|
begin
|
|
// (rom) better Indices or Index?
|
|
Result := 'Indice';
|
|
end;
|
|
|
|
procedure TMetaIndex.LoadFromStream(Stream: TStream);
|
|
begin
|
|
inherited LoadFromStream(Stream);
|
|
Stream.Read(FUnique, SizeOf(FUnique));
|
|
Stream.Read(FActive, SizeOf(FActive));
|
|
Stream.Read(FOrder, SizeOf(FOrder));
|
|
end;
|
|
|
|
procedure TMetaIndex.SaveToDDLNode(Stream: TStringStream);
|
|
var
|
|
I: Integer;
|
|
UNIQUE, ORDER: string;
|
|
begin
|
|
if FUnique then
|
|
UNIQUE := ' UNIQUE';
|
|
if FOrder = IoDescending then
|
|
ORDER := ' DESCENDING';
|
|
|
|
Stream.WriteString(Format('CREATE%s%s INDEX %s ON %s (',
|
|
[ORDER, UNIQUE, FName, TMetaTable(FOwner).FName]));
|
|
|
|
for I := 0 to FieldsCount - 1 do
|
|
begin
|
|
Stream.WriteString(Fields[I].Name);
|
|
if I <> FieldsCount - 1 then
|
|
Stream.WriteString(', ');
|
|
end;
|
|
Stream.WriteString(');');
|
|
if not FActive then
|
|
Stream.WriteString(Format('%sALTER INDEX %s INACTIVE;', [BreakLine, FName]));
|
|
end;
|
|
|
|
procedure TMetaIndex.SaveToStream(Stream: TStream);
|
|
begin
|
|
inherited SaveToStream(Stream);
|
|
Stream.Write(FUnique, SizeOf(FUnique));
|
|
Stream.Write(FActive, SizeOf(FActive));
|
|
Stream.Write(FOrder, SizeOf(FOrder));
|
|
end;
|
|
|
|
class function TMetaIndex.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaIndex;
|
|
end;
|
|
|
|
//=== { TMetaForeign } =======================================================
|
|
|
|
function TMetaForeign.GetForFields(const Index: Word): TMetaTableField;
|
|
begin
|
|
Assert((ForFieldsCount > 0) and (Index < ForFieldsCount));
|
|
|
|
Result := ForTable.Fields[FForFields[Index]];
|
|
end;
|
|
|
|
function TMetaForeign.GetForFieldsCount: Word;
|
|
begin
|
|
Result := Length(FForFields);
|
|
end;
|
|
|
|
function TMetaForeign.GetForTable: TMetaTable;
|
|
begin
|
|
Result := TMetaDataBase(FOwner.FOwner).Tables[FForTable];
|
|
end;
|
|
|
|
class function TMetaForeign.NodeClass: string;
|
|
begin
|
|
Result := 'Foreign';
|
|
end;
|
|
|
|
procedure TMetaForeign.LoadFromStream(Stream: TStream);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
inherited LoadFromStream(Stream);
|
|
Stream.Read(FForTable, SizeOf(FForTable));
|
|
Stream.Read(FOnDelete, SizeOf(FOnDelete));
|
|
Stream.Read(FOnUpdate, SizeOf(FOnUpdate));
|
|
Stream.Read(I, SizeOf(I));
|
|
SetLength(FForFields, I);
|
|
for I := 0 to I - 1 do
|
|
Stream.Read(FForFields[I], SizeOf(FForFields[I]));
|
|
end;
|
|
|
|
procedure TMetaForeign.SaveToDDLNode(Stream: TStringStream);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if copy(FName, 0, 6) = 'INTEG_' then
|
|
Stream.WriteString(Format('ALTER TABLE %s ADD FOREIGN KEY (',
|
|
[TMetaTable(FOwner).FName]))
|
|
else
|
|
Stream.WriteString(Format('ALTER TABLE %s ADD CONSTRAINT %s FOREIGN KEY (',
|
|
[TMetaTable(FOwner).FName, FName]));
|
|
|
|
for I := 0 to FieldsCount - 1 do
|
|
begin
|
|
Stream.WriteString(Fields[I].Name);
|
|
if I <> FieldsCount - 1 then
|
|
Stream.WriteString(', ');
|
|
end;
|
|
Stream.WriteString(Format(') REFERENCES %s (', [ForTable.Name]));
|
|
for I := 0 to ForFieldsCount - 1 do
|
|
begin
|
|
Stream.WriteString(ForFields[I].Name);
|
|
if I <> ForFieldsCount - 1 then
|
|
Stream.WriteString(', ');
|
|
end;
|
|
Stream.WriteString(')');
|
|
|
|
case OnDelete of
|
|
Cascade:
|
|
Stream.WriteString(' ON DELETE CASCADE');
|
|
SetNull:
|
|
Stream.WriteString(' ON DELETE SET NULL');
|
|
SetDefault:
|
|
Stream.WriteString(' ON DELETE SET DEFAULT');
|
|
end;
|
|
|
|
case OnUpdate of
|
|
Cascade:
|
|
Stream.WriteString(' ON UPDATE CASCADE');
|
|
SetNull:
|
|
Stream.WriteString(' ON UPDATE SET NULL');
|
|
SetDefault:
|
|
Stream.WriteString(' ON UPDATE SET DEFAULT');
|
|
end;
|
|
|
|
Stream.WriteString(';');
|
|
end;
|
|
|
|
procedure TMetaForeign.SaveToStream(Stream: TStream);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
inherited SaveToStream(Stream);
|
|
Stream.Write(FForTable, SizeOf(FForTable));
|
|
Stream.Write(FOnDelete, SizeOf(FOnDelete));
|
|
Stream.Write(FOnUpdate, SizeOf(FOnUpdate));
|
|
I := ForFieldsCount;
|
|
Stream.Write(I, SizeOf(I));
|
|
for I := 0 to I - 1 do
|
|
Stream.Write(FForFields[I], SizeOf(FForFields[I]));
|
|
end;
|
|
|
|
class function TMetaForeign.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaForeign;
|
|
end;
|
|
|
|
//=== { TMetaCheck } =========================================================
|
|
|
|
class function TMetaCheck.NodeClass: string;
|
|
begin
|
|
Result := 'Check';
|
|
end;
|
|
|
|
procedure TMetaCheck.LoadFromStream(Stream: TStream);
|
|
begin
|
|
ReadString(Stream, FName);
|
|
ReadString(Stream, FConstraint);
|
|
end;
|
|
|
|
procedure TMetaCheck.SaveToDDLNode(Stream: TStringStream);
|
|
begin
|
|
Stream.WriteString(Format('ALTER TABLE %s ADD %s;',
|
|
[TMetaTable(FOwner).Name, FConstraint]));
|
|
end;
|
|
|
|
procedure TMetaCheck.SaveToStream(Stream: TStream);
|
|
begin
|
|
WriteString(Stream, FName);
|
|
WriteString(Stream, FConstraint);
|
|
end;
|
|
|
|
class function TMetaCheck.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaCheck;
|
|
end;
|
|
|
|
//=== { TMetaTrigger } =======================================================
|
|
|
|
class function TMetaTrigger.DecodePrefix(Value: Integer): TTriggerPrefix;
|
|
begin
|
|
Result := TTriggerPrefix((Value + 1) and 1);
|
|
end;
|
|
|
|
class function TMetaTrigger.DecodeSuffixes(Value: Integer): TTriggerSuffixes;
|
|
var
|
|
V, Slot: Integer;
|
|
begin
|
|
Result := [];
|
|
for Slot := 1 to 3 do
|
|
begin
|
|
V := ((Value + 1) shr (Slot * 2 - 1)) and 3;
|
|
if V > 0 then
|
|
Include(Result, TTriggerSuffix(V - 1));
|
|
end;
|
|
end;
|
|
|
|
class function TMetaTrigger.NodeClass: string;
|
|
begin
|
|
Result := 'Trigger';
|
|
end;
|
|
|
|
procedure TMetaTrigger.LoadFromQuery(Q: TJvUIBStatement);
|
|
begin
|
|
FName := Trim(Q.Fields.AsString[0]);
|
|
Q.ReadBlob(1, FSource);
|
|
FPosition := Q.Fields.AsSmallint[2];
|
|
FPrefix := DecodePrefix(Q.Fields.AsSmallint[3]);
|
|
FSuffix := DecodeSuffixes(Q.Fields.AsSmallint[3]);
|
|
FActive := Q.Fields.AsSmallint[4] = 0;
|
|
end;
|
|
|
|
procedure TMetaTrigger.LoadFromStream(Stream: TStream);
|
|
begin
|
|
ReadString(Stream, FName);
|
|
Stream.Read(FPrefix, SizeOf(FPrefix));
|
|
Stream.Read(FSuffix, SizeOf(FSuffix));
|
|
Stream.Read(FPosition, SizeOf(FPosition));
|
|
Stream.Read(FActive, SizeOf(FActive));
|
|
ReadString(Stream, FSource);
|
|
end;
|
|
|
|
procedure TMetaTrigger.SaveToDDLNode(Stream: TStringStream);
|
|
var
|
|
Count: Smallint;
|
|
Suf: TTriggerSuffix;
|
|
begin
|
|
Stream.WriteString(Format('CREATE TRIGGER %s FOR %s%s',
|
|
[Name, TMetaNode(FOwner).Name, BreakLine]));
|
|
if FActive then
|
|
Stream.WriteString('ACTIVE ');
|
|
|
|
Stream.WriteString(TriggerPrefixTypes[FPrefix] + ' ');
|
|
Count := 0;
|
|
for Suf := Insert to Delete do
|
|
if Suf in FSuffix then
|
|
begin
|
|
Inc(Count);
|
|
if Count > 1 then
|
|
Stream.WriteString(' OR ');
|
|
Stream.WriteString(TriggerSuffixTypes[Suf]);
|
|
end;
|
|
Stream.WriteString(Format(' POSITION %d%s%s;', [FPosition, BreakLine, FSource]));
|
|
end;
|
|
|
|
procedure TMetaTrigger.SaveToStream(Stream: TStream);
|
|
begin
|
|
WriteString(Stream, FName);
|
|
Stream.Write(FPrefix, SizeOf(FPrefix));
|
|
Stream.Write(FSuffix, SizeOf(FSuffix));
|
|
Stream.Write(FPosition, SizeOf(FPosition));
|
|
Stream.Write(FActive, SizeOf(FActive));
|
|
WriteString(Stream, FSource);
|
|
end;
|
|
|
|
class function TMetaTrigger.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaTrigger;
|
|
end;
|
|
|
|
//=== { TMetaView } ==========================================================
|
|
|
|
constructor TMetaView.Create(AOwner: TMetaNode; ClassIndex: Integer);
|
|
begin
|
|
inherited Create(AOwner, ClassIndex);
|
|
AddClass(TMetaField);
|
|
AddClass(TMetaTrigger);
|
|
end;
|
|
|
|
function TMetaView.GetFields(const Index: Integer): TMetaField;
|
|
begin
|
|
Result := TMetaField(GetItems(Ord(OIDViewFields), Index))
|
|
end;
|
|
|
|
function TMetaView.GetFieldsCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDViewFields)].Childs.Count;
|
|
end;
|
|
|
|
class function TMetaView.NodeClass: string;
|
|
begin
|
|
Result := 'View';
|
|
end;
|
|
|
|
function TMetaView.GetTriggers(const Index: Integer): TMetaTrigger;
|
|
begin
|
|
Result := TMetaTrigger(GetItems(Ord(OIDViewTrigers), Index))
|
|
end;
|
|
|
|
function TMetaView.GetTriggersCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDViewTrigers)].Childs.Count;
|
|
end;
|
|
|
|
procedure TMetaView.LoadFromDataBase(QName, QFields, QTriggers,
|
|
QCharset: TJvUIBStatement; OIDs: TOIDViews);
|
|
begin
|
|
FName := Trim(QName.Fields.AsString[0]);
|
|
QName.ReadBlob(1, FSource);
|
|
FSource := Trim(FSource);
|
|
|
|
// FIELD
|
|
if OIDViewFields in OIDs then
|
|
begin
|
|
QFields.Params.AsString[0] := FName;
|
|
QFields.Open;
|
|
while not QFields.Eof do
|
|
begin
|
|
TMetaField.Create(Self, Ord(OIDViewFields)).LoadFromQuery(QFields, QCharset);
|
|
QFields.Next;
|
|
end;
|
|
end;
|
|
|
|
// TRIGGER
|
|
if OIDViewTrigers in OIDs then
|
|
begin
|
|
QTriggers.Params.AsString[0] := FName;
|
|
QTriggers.Open;
|
|
while not QTriggers.Eof do
|
|
begin
|
|
TMetaTrigger.Create(Self, Ord(OIDViewTrigers)).LoadFromQuery(QTriggers);
|
|
QTriggers.Next;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMetaView.LoadFromStream(Stream: TStream);
|
|
begin
|
|
ReadString(Stream, FName);
|
|
ReadString(Stream, FSource);
|
|
end;
|
|
|
|
procedure TMetaView.SaveToDDL(Stream: TStringStream);
|
|
begin
|
|
inherited SaveToDDL(Stream);
|
|
SaveNode(Stream, Ord(OIDViewTrigers), NewLine);
|
|
end;
|
|
|
|
procedure TMetaView.SaveToDDLNode(Stream: TStringStream);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Stream.WriteString(Format('CREATE VIEW %s (', [Name]));
|
|
for I := 0 to FieldsCount - 1 do
|
|
begin
|
|
Stream.WriteString(BreakLine + ' ' + Fields[I].Name);
|
|
if I <> FieldsCount - 1 then
|
|
Stream.WriteString(',');
|
|
end;
|
|
Stream.WriteString(BreakLine + ')' + BreakLine + 'AS' + BreakLine);
|
|
Stream.WriteString(Source);
|
|
Stream.WriteString(';');
|
|
end;
|
|
|
|
procedure TMetaView.SaveToStream(Stream: TStream);
|
|
begin
|
|
WriteString(Stream, FName);
|
|
WriteString(Stream, FSource);
|
|
inherited SaveToStream(Stream);
|
|
end;
|
|
|
|
class function TMetaView.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaView;
|
|
end;
|
|
|
|
//=== { TMetaDomain } ========================================================
|
|
|
|
class function TMetaDomain.NodeClass: string;
|
|
begin
|
|
Result := 'Domain';
|
|
end;
|
|
|
|
class function TMetaDomain.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaDomain;
|
|
end;
|
|
|
|
procedure TMetaDomain.SaveToDDL(Stream: TStringStream);
|
|
begin
|
|
SaveToDDLNode(Stream);
|
|
end;
|
|
|
|
procedure TMetaDomain.SaveToDDLNode(Stream: TStringStream);
|
|
begin
|
|
Stream.WriteString(Format('CREATE DOMAIN %s AS ', [FName]));
|
|
inherited SaveToDDLNode(Stream);
|
|
Stream.WriteString(';');
|
|
end;
|
|
|
|
//=== { TMetaProcedure } =====================================================
|
|
|
|
constructor TMetaProcedure.Create(AOwner: TMetaNode; ClassIndex: Integer);
|
|
begin
|
|
inherited Create(AOwner, ClassIndex);
|
|
AddClass(TMetaProcInField); // in
|
|
AddClass(TMetaProcOutField); // out
|
|
end;
|
|
|
|
function TMetaProcedure.GetInputFields(const Index: Integer): TMetaProcInField;
|
|
begin
|
|
Result := TMetaProcInField(GetItems(Ord(OIDProcFieldIn), Index))
|
|
end;
|
|
|
|
function TMetaProcedure.GetInputFieldsCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDProcFieldIn)].Childs.Count;
|
|
end;
|
|
|
|
class function TMetaProcedure.NodeClass: string;
|
|
begin
|
|
Result := 'Procedure';
|
|
end;
|
|
|
|
function TMetaProcedure.GetOutputFields(const Index: Integer): TMetaProcOutField;
|
|
begin
|
|
Result := TMetaProcOutField(GetItems(Ord(OIDProcFieldOut), Index))
|
|
end;
|
|
|
|
function TMetaProcedure.GetOutputFieldsCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDProcFieldOut)].Childs.Count;
|
|
end;
|
|
|
|
procedure TMetaProcedure.InternalSaveToDDL(Stream: TStringStream;
|
|
Operation: string);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Stream.WriteString(Format('%s PROCEDURE %s', [Operation, FName]));
|
|
if InputFieldsCount > 0 then
|
|
begin
|
|
Stream.WriteString(' (');
|
|
for I := 0 to InPutFieldsCount - 1 do
|
|
begin
|
|
Stream.WriteString(BreakLine + ' ');
|
|
InputFields[I].SaveToDDL(Stream);
|
|
if I <> InputFieldsCount - 1 then
|
|
Stream.WriteString(',');
|
|
end;
|
|
Stream.WriteString(')');
|
|
end;
|
|
|
|
if OutputFieldsCount > 0 then
|
|
begin
|
|
Stream.WriteString(Format('%sRETURNS (', [BreakLine]));
|
|
for I := 0 to OutputFieldsCount - 1 do
|
|
begin
|
|
Stream.WriteString(BreakLine + ' ');
|
|
OutputFields[I].SaveToDDL(Stream);
|
|
if I <> OutputFieldsCount - 1 then
|
|
Stream.WriteString(',');
|
|
end;
|
|
Stream.WriteString(')');
|
|
end;
|
|
end;
|
|
|
|
procedure TMetaProcedure.LoadFromQuery(QNames, QFields,
|
|
QCharset: TJvUIBStatement; OIDs: TOIDProcedures);
|
|
begin
|
|
FName := Trim(QNames.Fields.AsString[0]);
|
|
QNames.ReadBlob(1, FSource);
|
|
QFields.Params.AsString[0] := FName;
|
|
|
|
if OIDProcFieldIn in OIDs then
|
|
begin
|
|
QFields.Params.AsSmallint[1] := 0; // in
|
|
QFields.Open;
|
|
while not QFields.Eof do
|
|
begin
|
|
TMetaProcInField.Create(Self, Ord(OIDProcFieldIn)).LoadFromQuery(QFields, QCharset);
|
|
QFields.Next;
|
|
end;
|
|
end;
|
|
|
|
if OIDProcFieldOut in OIDs then
|
|
begin
|
|
QFields.Params.AsSmallint[1] := 1; // out
|
|
QFields.Open;
|
|
while not QFields.Eof do
|
|
begin
|
|
TMetaProcOutField.Create(Self, Ord(OIDProcFieldOut)).LoadFromQuery(QFields, QCharset);
|
|
QFields.Next;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMetaProcedure.LoadFromStream(Stream: TStream);
|
|
begin
|
|
ReadString(Stream, FName);
|
|
ReadString(Stream, FSource);
|
|
end;
|
|
|
|
procedure TMetaProcedure.SaveToAlterDDL(Stream: TStringStream);
|
|
begin
|
|
InternalSaveToDDL(Stream, 'ALTER');
|
|
Stream.WriteString(BreakLine + 'AS');
|
|
Stream.WriteString(FSource);
|
|
Stream.WriteString(';');
|
|
end;
|
|
|
|
procedure TMetaProcedure.SaveToPostDDL(Stream: TStringStream);
|
|
begin
|
|
InternalSaveToDDL(Stream, 'CREATE');
|
|
Stream.WriteString(BreakLine + 'AS' + breakline + 'BEGIN' + breakline +
|
|
' EXIT;' + breakline + 'END;');
|
|
end;
|
|
|
|
procedure TMetaProcedure.SaveToDDLNode(Stream: TStringStream);
|
|
begin
|
|
InternalSaveToDDL(Stream, 'CREATE');
|
|
Stream.WriteString(BreakLine + 'AS');
|
|
Stream.WriteString(FSource);
|
|
Stream.WriteString(';');
|
|
end;
|
|
|
|
procedure TMetaProcedure.SaveToStream(Stream: TStream);
|
|
begin
|
|
WriteString(Stream, FName);
|
|
WriteString(Stream, FSource);
|
|
inherited SaveToStream(Stream);
|
|
end;
|
|
|
|
class function TMetaProcedure.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaProcedure;
|
|
end;
|
|
|
|
//=== { TMetaException } =====================================================
|
|
|
|
class function TMetaException.NodeClass: string;
|
|
begin
|
|
Result := 'Exception';
|
|
end;
|
|
|
|
procedure TMetaException.LoadFromQuery(QName: TJvUIBStatement);
|
|
begin
|
|
FName := Trim(QName.Fields.AsString[0]);
|
|
FMessage := QName.Fields.AsString[1];
|
|
FNumber := QName.Fields.AsInteger[2];
|
|
end;
|
|
|
|
procedure TMetaException.LoadFromStream(Stream: TStream);
|
|
begin
|
|
ReadString(Stream, FName);
|
|
ReadString(Stream, FMessage);
|
|
Stream.Read(FNumber, SizeOf(FNumber))
|
|
end;
|
|
|
|
procedure TMetaException.SaveToDDLNode(Stream: TStringStream);
|
|
begin
|
|
Stream.WriteString(Format('CREATE EXCEPTION %s ''%s'';', [FName, FMessage]));
|
|
end;
|
|
|
|
procedure TMetaException.SaveToStream(Stream: TStream);
|
|
begin
|
|
WriteString(Stream, FName);
|
|
WriteString(Stream, FMessage);
|
|
Stream.Write(FNumber, SizeOf(FNumber));
|
|
inherited SaveToStream(Stream);
|
|
end;
|
|
|
|
class function TMetaException.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaException;
|
|
end;
|
|
|
|
//=== { TMetaUDF } ===========================================================
|
|
|
|
constructor TMetaUDF.Create(AOwner: TMetaNode; ClassIndex: Integer);
|
|
begin
|
|
inherited Create(AOwner, ClassIndex);
|
|
AddClass(TMetaUDFField);
|
|
end;
|
|
|
|
class function TMetaUDF.NodeClass: string;
|
|
begin
|
|
Result := 'UDF';
|
|
end;
|
|
|
|
procedure TMetaUDF.LoadFromStream(Stream: TStream);
|
|
begin
|
|
ReadString(Stream, FName);
|
|
ReadString(Stream, FModule);
|
|
ReadString(Stream, FEntry);
|
|
Stream.Read(FReturn, SizeOf(FReturn));
|
|
end;
|
|
|
|
procedure TMetaUDF.SaveToDDLNode(Stream: TStringStream);
|
|
var
|
|
I, C: Integer;
|
|
begin
|
|
Stream.WriteString(Format('DECLARE EXTERNAL FUNCTION %s', [Fname]));
|
|
C := 0;
|
|
|
|
if FReturn = 0 then
|
|
begin // return position
|
|
for I := 0 to FieldsCount - 1 do
|
|
if Fields[I].Position <> Return then
|
|
begin
|
|
if C > 0 then
|
|
Stream.WriteString(',');
|
|
Stream.WriteString(BreakLine + ' ');
|
|
Fields[I].SaveToDDL(Stream);
|
|
Inc(C);
|
|
end;
|
|
for I := 0 to FieldsCount - 1 do
|
|
if Fields[I].Position = Return then
|
|
begin
|
|
Stream.WriteString(BreakLine + ' RETURNS ');
|
|
Fields[I].SaveToDDL(Stream);
|
|
Break;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
for I := 0 to FieldsCount - 1 do
|
|
begin
|
|
if C > 0 then
|
|
Stream.WriteString(',');
|
|
Stream.WriteString(BreakLine + ' ');
|
|
Fields[I].SaveToDDL(Stream);
|
|
Inc(C);
|
|
end;
|
|
Stream.WriteString(Format('%s RETURNS PARAMETER %d', [BreakLine, Freturn]));
|
|
end;
|
|
|
|
Stream.WriteString(Format('%s ENTRY_POINT ''%s'' MODULE_NAME ''%s'';',
|
|
[BreakLine, FEntry, FModule]));
|
|
end;
|
|
|
|
procedure TMetaUDF.SaveToStream(Stream: TStream);
|
|
begin
|
|
WriteString(Stream, FName);
|
|
WriteString(Stream, FModule);
|
|
WriteString(Stream, FEntry);
|
|
Stream.Write(FReturn, SizeOf(FReturn));
|
|
inherited SaveToStream(Stream);
|
|
end;
|
|
|
|
procedure TMetaUDF.LoadFromQuery(QNames, QFields, QCharset: TJvUIBStatement; OIDs: TOIDUDFs);
|
|
begin
|
|
FName := Trim(QNames.Fields.AsString[0]);
|
|
FModule := QNames.Fields.AsString[1];
|
|
FEntry := Trim(QNames.Fields.AsString[2]);
|
|
FReturn := QNames.Fields.AsSmallint[3];
|
|
|
|
if OIDUDFField in OIDs then
|
|
begin
|
|
QFields.Params.AsString[0] := FName;
|
|
QFields.Open;
|
|
while not QFields.Eof do
|
|
begin
|
|
TMetaUDFField.Create(Self, Ord(OIDUDFField)).LoadFromQuery(QFields, QCharset);
|
|
QFields.Next;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TMetaUDF.GetFields(const Index: Integer): TMetaUDFField;
|
|
begin
|
|
Result := TMetaUDFField(GetItems(Ord(OIDUDFField), Index))
|
|
end;
|
|
|
|
function TMetaUDF.GetFieldsCount: Integer;
|
|
begin
|
|
Result := FNodeItems[Ord(OIDUDFField)].Childs.Count;
|
|
end;
|
|
|
|
class function TMetaUDF.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaUDF;
|
|
end;
|
|
|
|
//=== { TMetaTableField } ====================================================
|
|
|
|
function TMetaTableField.GetDomain: TMetaDomain;
|
|
begin
|
|
if FDomain >= 0 then
|
|
Result := TMetaDatabase(FOwner.FOwner).Domains[FDomain]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TMetaTableField.LoadFromQuery(Q, C: TJvUIBStatement);
|
|
begin
|
|
inherited LoadFromQuery(Q, C);
|
|
FNotNull := (Q.Fields.AsSmallint[8] = 1);
|
|
if not Q.Fields.IsNull[9] then
|
|
begin
|
|
Q.ReadBlob(9, FDefaultValue);
|
|
|
|
FDefaultValue := Trim(FDefaultValue);
|
|
if FDefaultValue <> '' then
|
|
FDefaultValue := Copy(FDefaultValue, 9,
|
|
System.Length(FDefaultValue) - 8);
|
|
end
|
|
else
|
|
FDefaultValue := '';
|
|
|
|
FDomain := -1;
|
|
if not (Self is TMetaDomain) then
|
|
begin
|
|
if OIDDomain in TMetaDataBase(FOwner.FOwner).FOIDDatabases then
|
|
if not (Q.Fields.IsNull[10] or (Copy(Q.Fields.AsString[10], 1, 4) = 'RDB$')) then
|
|
FDomain :=
|
|
TMetaDataBase(FOwner.FOwner).FindDomainIndex(Trim(Q.Fields.AsString[10]));
|
|
Q.ReadBlob(11, FComputedSource);
|
|
end;
|
|
end;
|
|
|
|
procedure TMetaTableField.LoadFromStream(Stream: TStream);
|
|
begin
|
|
inherited LoadFromStream(Stream);
|
|
ReadString(Stream, FDefaultValue);
|
|
Stream.Read(FNotNull, SizeOf(FNotNull));
|
|
Stream.Read(FDomain, SizeOf(FDomain));
|
|
ReadString(Stream, FComputedSource);
|
|
end;
|
|
|
|
class function TMetaTableField.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaTableField;
|
|
end;
|
|
|
|
procedure TMetaTableField.SaveToDDLNode(Stream: TStringStream);
|
|
begin
|
|
if FDomain >= 0 then
|
|
Stream.WriteString(Domain.Name) else
|
|
if FComputedSource <> '' then
|
|
Stream.WriteString('COMPUTED BY ' + FComputedSource) else
|
|
inherited SaveToDDLNode(Stream);
|
|
if FDefaultValue <> '' then
|
|
Stream.WriteString(' DEFAULT ' + FDefaultValue);
|
|
if FNotNull then
|
|
Stream.WriteString(' NOT NULL');
|
|
end;
|
|
|
|
procedure TMetaTableField.SaveToStream(Stream: TStream);
|
|
begin
|
|
inherited SaveToStream(Stream);
|
|
WriteString(Stream, FDefaultValue);
|
|
Stream.Write(FNotNull, SizeOf(FNotNull));
|
|
Stream.Write(FDomain, SizeOf(FDomain));
|
|
WriteString(Stream, FComputedSource);
|
|
end;
|
|
|
|
//=== { TMetaProcInField } ===================================================
|
|
|
|
class function TMetaProcInField.NodeClass: string;
|
|
begin
|
|
Result := 'Input parameter';
|
|
end;
|
|
|
|
class function TMetaProcInField.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaProcInField;
|
|
end;
|
|
|
|
//=== { TMetaProcOutField } ==================================================
|
|
|
|
class function TMetaProcOutField.NodeClass: string;
|
|
begin
|
|
Result := 'Output parameter';
|
|
end;
|
|
|
|
class function TMetaProcOutField.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaProcOutField;
|
|
end;
|
|
|
|
//=== { TMetaField } =========================================================
|
|
|
|
procedure TMetaField.LoadFromQuery(Q, C: TJvUIBStatement);
|
|
begin
|
|
inherited LoadFromQuery(Q, C);
|
|
FName := Trim(Q.Fields.AsString[6]);
|
|
FSegmentLength := Q.Fields.AsSmallint[7];
|
|
end;
|
|
|
|
class function TMetaField.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaField;
|
|
end;
|
|
|
|
procedure TMetaField.SaveToDDL(Stream: TStringStream);
|
|
begin
|
|
Stream.WriteString(FName + ' ');
|
|
inherited SaveToDDL(Stream);
|
|
end;
|
|
|
|
//=== { TMetaUDFField } ======================================================
|
|
|
|
procedure TMetaUDFField.LoadFromQuery(QField, QCharset: TJvUIBStatement);
|
|
begin
|
|
inherited LoadFromQuery(QField, QCharset);
|
|
FPosition := QField.Fields.AsSmallint[6];
|
|
FMechanism := QField.Fields.AsSmallint[7];
|
|
FName := 'Field ' + IntToStr(FPosition);
|
|
end;
|
|
|
|
procedure TMetaUDFField.LoadFromStream(Stream: TStream);
|
|
begin
|
|
inherited LoadFromStream(Stream);
|
|
Stream.Read(FPosition, SizeOf(FPosition));
|
|
Stream.Read(FMechanism, SizeOf(FMechanism));
|
|
end;
|
|
|
|
class function TMetaUDFField.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaUDFField;
|
|
end;
|
|
|
|
procedure TMetaUDFField.SaveToDDLNode(Stream: TStringStream);
|
|
begin
|
|
if FFieldType = uftBlob then
|
|
Stream.WriteString('BLOB')
|
|
else
|
|
inherited SaveToDDLNode(Stream);
|
|
case FMechanism of
|
|
-1:
|
|
Stream.WriteString(' FREE_IT');
|
|
0:
|
|
Stream.WriteString(' BY VALUE');
|
|
1:
|
|
; // BY REFERENCE = default
|
|
2:
|
|
Stream.WriteString(' BY DESCRIPTOR');
|
|
end;
|
|
end;
|
|
|
|
procedure TMetaUDFField.SaveToStream(Stream: TStream);
|
|
begin
|
|
inherited SaveToStream(Stream);
|
|
Stream.Write(FPosition, SizeOf(FPosition));
|
|
Stream.Write(FMechanism, SizeOf(FMechanism));
|
|
end;
|
|
|
|
//=== { TMetaRole } ==========================================================
|
|
|
|
procedure TMetaRole.LoadFromQuery(QName: TJvUIBStatement);
|
|
begin
|
|
FName := Trim(QName.Fields.AsString[0]);
|
|
FOwner := QName.Fields.AsString[1];
|
|
end;
|
|
|
|
procedure TMetaRole.LoadFromStream(Stream: TStream);
|
|
begin
|
|
ReadString(Stream, FName);
|
|
ReadString(Stream, FOwner);
|
|
end;
|
|
|
|
class function TMetaRole.NodeClass: string;
|
|
begin
|
|
Result := 'Role';
|
|
end;
|
|
|
|
class function TMetaRole.NodeType: TMetaNodeType;
|
|
begin
|
|
Result := MetaRole;
|
|
end;
|
|
|
|
procedure TMetaRole.SaveToDDLNode(Stream: TStringStream);
|
|
begin
|
|
Stream.WriteString(Format('CREATE ROLE %s /* By user %s */', [FName, Trim(FOwner)]));
|
|
end;
|
|
|
|
procedure TMetaRole.SaveToStream(Stream: TStream);
|
|
begin
|
|
WriteString(Stream, FName);
|
|
WriteString(Stream, FOwner);
|
|
inherited SaveToStream(Stream);
|
|
end;
|
|
|
|
{$IFDEF USEJVCL}
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
{$ENDIF USEJVCL}
|
|
|
|
end.
|
|
|