jvquibmetadata.pas

East make Tray Icon in delphi

  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);